File Coverage

blib/lib/Game/Asset.pm
Criterion Covered Total %
statement 79 83 95.1
branch 11 18 61.1
condition n/a
subroutine 18 18 100.0
pod 2 2 100.0
total 110 121 90.9


line stmt bran cond sub pod time code
1             # Copyright (c) 2016 Timm Murray
2             # All rights reserved.
3             #
4             # Redistribution and use in source and binary forms, with or without
5             # modification, are permitted provided that the following conditions are met:
6             #
7             # * Redistributions of source code must retain the above copyright notice,
8             # this list of conditions and the following disclaimer.
9             # * Redistributions in binary form must reproduce the above copyright
10             # notice, this list of conditions and the following disclaimer in the
11             # documentation and/or other materials provided with the distribution.
12             #
13             # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
14             # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
15             # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
16             # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
17             # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
18             # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
19             # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
20             # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
21             # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
22             # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
23             # POSSIBILITY OF SUCH DAMAGE.
24             package Game::Asset;
25             $Game::Asset::VERSION = '0.4';
26             # ABSTRACT: Load assets (images, music, etc.) for games
27 7     7   88810 use strict;
  7         15  
  7         184  
28 7     7   33 use warnings;
  7         15  
  7         134  
29 7     7   2544 use Moose;
  7         2406850  
  7         47  
30 7     7   47884 use namespace::autoclean;
  7         37411  
  7         28  
31              
32 7     7   2453 use Game::Asset::Type;
  7         21  
  7         204  
33 7     7   2367 use Game::Asset::Null;
  7         26  
  7         326  
34 7     7   3245 use Game::Asset::PerlModule;
  7         23  
  7         222  
35 7     7   2901 use Game::Asset::PlainText;
  7         21  
  7         215  
36 7     7   2863 use Game::Asset::YAML;
  7         22  
  7         213  
37 7     7   3151 use Game::Asset::MultiExample;
  7         23  
  7         244  
38              
39 7     7   4531 use Archive::Zip qw( :ERROR_CODES );
  7         462840  
  7         611  
40 7     7   58 use YAML ();
  7         16  
  7         3740  
41              
42              
43             has 'file' => (
44             is => 'ro',
45             isa => 'Str',
46             required => 1,
47             );
48             has 'mappings' => (
49             is => 'ro',
50             isa => 'HashRef[Game::Asset::Type]',
51             default => sub {{}},
52             auto_deref => 1,
53             );
54             has 'entries' => (
55             is => 'ro',
56             isa => 'ArrayRef[Game::Asset::Type]',
57             default => sub {[]},
58             auto_deref => 1,
59             );
60             has '_entries_by_shortname' => (
61             traits => ['Hash'],
62             is => 'ro',
63             isa => 'HashRef[Game::Asset::Type]',
64             default => sub {{}},
65             handles => {
66             _get_by_name => 'get',
67             },
68             );
69             has '_zip' => (
70             is => 'ro',
71             isa => 'Archive::Zip',
72             );
73              
74              
75             sub BUILDARGS
76             {
77 6     6 1 21 my ($class, $args) = @_;
78 6         17 my $file = $args->{file};
79              
80 6         25 my $zip = $class->_read_zip( $file );
81 6         16 $args->{'_zip'} = $zip;
82              
83 6         34 my $index = $class->_read_index( $zip, $file );
84             $args->{mappings} = {
85 6         51 yml => 'Game::Asset::YAML',
86             txt => 'Game::Asset::PlainText',
87             pm => 'Game::Asset::PerlModule',
88             %$index,
89             };
90              
91             my ($entries, $entries_by_shortname) = $class->_build_entries( $zip,
92 6         45 $args->{mappings} );
93 6         16 $args->{entries} = $entries;
94 6         13 $args->{'_entries_by_shortname'} = $entries_by_shortname;
95              
96 6         157 return $args;
97             }
98              
99              
100             sub get_by_name
101             {
102 6     6 1 43 my ($self, $name, @args) = @_;
103 6         183 my $entry = $self->_get_by_name( $name );
104              
105 6 50       21 if( $entry ) {
106 6         155 my $full_name = $entry->full_name;
107 6         144 my $contents = $self->_zip->contents( $full_name );
108 6         4585 $entry->process_content( $contents, @args );
109             }
110              
111 6         18 return $entry;
112             }
113              
114              
115             sub _read_zip
116             {
117 6     6   17 my ($class, $file) = @_;
118              
119 6         50 my $zip = Archive::Zip->new;
120 6         235 my $read_result = $zip->read( $file );
121 6 50       14310 if( $read_result == AZ_STREAM_END ) {
    50          
    50          
    50          
122 0         0 die "Hit end of stream unexpectedly in '$file'\n";
123             }
124             elsif( $read_result == AZ_ERROR ) {
125 0         0 die "Generic error while reading '$file'\n";
126             }
127             elsif( $read_result == AZ_FORMAT_ERROR ) {
128 0         0 die "Formatting error while reading '$file'\n";
129             }
130             elsif( $read_result == AZ_IO_ERROR ) {
131 0         0 die "IO error while reading '$file'\n";
132             }
133              
134 6         21 return $zip;
135             }
136              
137             sub _read_index
138             {
139 6     6   19 my ($class, $zip, $file) = @_;
140 6         32 my $index_contents = $zip->contents( 'index.yml' );
141 6 50       7134 die "Could not find index.yml in '$file'\n" unless $index_contents;
142              
143 6         33 my $index = YAML::Load( $index_contents );
144 6         68412 return $index;
145             }
146              
147             sub _build_entries
148             {
149 6     6   20 my ($class, $zip, $mappings) = @_;
150 6         29 my %mappings = %$mappings;
151              
152 6         18 my (@entries, %entries_by_shortname);
153 6         34 foreach my $member ($zip->memberNames) {
154 42 100       518 next if $member eq 'index.yml'; # Ignore index
155 36 100       107 next if $member =~ m!\/ \z!x;
156 30         152 my ($short_name, $ext) = $member =~ /\A (.*) \. (.*?) \z/x;
157             die "Could not find mapping for '$ext' (full name: $member)\n"
158 30 50       89 if ! exists $mappings{$ext};
159              
160 30         61 my $entry_class = $mappings{$ext};
161 30         983 my $entry = $entry_class->new({
162             name => $short_name,
163             full_name => $member,
164             });
165 30         77 push @entries, $entry;
166 30         91 $entries_by_shortname{$short_name} = $entry;
167             }
168              
169 6         33 return (\@entries, \%entries_by_shortname);
170             }
171              
172              
173              
174 7     7   55 no Moose;
  7         17  
  7         65  
175             __PACKAGE__->meta->make_immutable;
176             1;
177             __END__
178              
179              
180             =head1 NAME
181              
182             Game::Asset - Load assets (images, music, etc.) for games
183              
184             =head1 SYNOPSIS
185              
186             my $asset = Game::Asset->new({
187             file => 't_data/test1.zip',
188             });
189             my $foo = $asset->get_by_name( 'foo' );
190             my $name = $foo->name;
191             my $type = $foo->type;
192              
193             =head1 DESCRIPTION
194              
195             A common way to handle game assets is to load them in one big zip file. It
196             might end up named with extensions like ".wad" or ".pk3" or even ".jar", but
197             it's a zip file.
198              
199             This module allows you to load up these files and fetch their contents into
200             Perl objects. Each type of file is represented by a class that does the
201             L<Game::Asset::Type> Moose role. Which type class, exactly, is determined with
202             mappings defined in the C<index.yml> file. There are also a few built-in
203             mappings.
204              
205             =head1 THE INDEX FILE
206              
207             A file named C<index.yml> (a L<YAML> file) is required inside the zip file,
208             and resolves to a hash. Keys are the file extensions (without the dot), and
209             values are the Perl class that will handle that type. That class must do
210             the L<Game::Asset::Type> Moose role.
211              
212             The file must exist. If you just want to use the built-in mappings, it can
213             resolve to an empty hash.
214              
215             =head2 Built-in Mappings
216              
217             The following mappings are always available without being in the index file:
218              
219             =over 4
220              
221             =item * txt -- L<Game::Asset::PlainText>
222              
223             =item * yml -- L<Game::Asset::YAML>
224              
225             =item * pm -- L<Game::Asset::PerlModule>
226              
227             =back
228              
229             =head2 Multi-mappings
230              
231             There are times when the given content should be processed by more than one
232             mapping. For instance, a game may want to process a L<Graphics::GVG> vector
233             in both OpenGL and Chipmunk (physics library).
234              
235             This is what multi-mappings are for. See L<Game::Asset::Multi> for details.
236              
237             =head1 ATTRIBUTES
238              
239             =head2 file
240              
241             The path to the zip file.
242              
243             =head2 mappings
244              
245             A hashref (with autoderef). The keys are the file extensions, and the values
246             are the L<Game::Asset::Type> classes that will handle that type.
247              
248             =head2 entries
249              
250             A list of all the assets with their file extensions removed. Note that the
251             C<index.yml> file is filtered out.
252              
253             =head1 METHODS
254              
255             =head2 get_by_name
256              
257             $asset->get_by_name( 'foo' );
258              
259             Pass in a name of an asset (without the extension). Returns an object
260             representing the data in the zip file.
261              
262             Any other arguments passed will be passed to the handling class.
263              
264             =head1 LICENSE
265              
266             Copyright (c) 2016 Timm Murray
267             All rights reserved.
268              
269             Redistribution and use in source and binary forms, with or without
270             modification, are permitted provided that the following conditions are met:
271              
272             * Redistributions of source code must retain the above copyright notice,
273             this list of conditions and the following disclaimer.
274             * Redistributions in binary form must reproduce the above copyright
275             notice, this list of conditions and the following disclaimer in the
276             documentation and/or other materials provided with the distribution.
277              
278             THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
279             AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
280             IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
281             ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
282             LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
283             CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
284             SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
285             INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
286             CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
287             ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
288             POSSIBILITY OF SUCH DAMAGE.
289              
290             =cut