File Coverage

blib/lib/Imager/Bing/MapLayer/Tile.pm
Criterion Covered Total %
statement 47 47 100.0
branch 2 4 50.0
condition n/a
subroutine 16 16 100.0
pod 5 5 100.0
total 70 72 97.2


line stmt bran cond sub pod time code
1             package Imager::Bing::MapLayer::Tile;
2              
3 5     5   78646 use Moose;
  5         471495  
  5         44  
4             with 'Imager::Bing::MapLayer::Role::FileHandling';
5              
6 5     5   41686 use MooseX::StrictConstructor;
  5         46653  
  5         45  
7 5     5   26160 use Moose::Util::TypeConstraints;
  5         11  
  5         85  
8              
9             extends 'Imager::Bing::MapLayer::Image';
10              
11 5     5   11692 use Carp qw/ carp confess /;
  5         12  
  5         333  
12 5     5   51 use Class::MOP::Method;
  5         10  
  5         102  
13 5     5   2894 use Imager;
  5         80630  
  5         43  
14 5     5   315 use List::Util 1.30 qw/ pairmap /;
  5         175  
  5         301  
15 5     5   3678 use Path::Class qw/ file /;
  5         150047  
  5         449  
16              
17 5         974 use Imager::Bing::MapLayer::Utils qw/
18             $MIN_ZOOM_LEVEL $MAX_ZOOM_LEVEL
19             $TILE_WIDTH $TILE_HEIGHT
20             width_at_level
21             pixel_to_tile_coords tile_coords_to_pixel_origin
22             tile_coords_to_quad_key quad_key_to_tile_coords
23 5     5   721 /;
  5         12  
24              
25 5     5   33 use version 0.77; our $VERSION = version->declare('v0.1.9');
  5         120  
  5         45  
26              
27             =head1 SYNOPSIS
28              
29             my $tile = Imager::Bing::MapLayer::Tile->new(
30             quad_key => $key, # the "quad key" for the tile
31             base_dir => $base_dir, # the base directory for tiles (defaults to cwd)
32             overwrite => 1, # overwrite existing tile (default) vs load it
33             autosave => 1, # automatically save tile when done (default)
34             );
35              
36             =head1 DESCRIPTION
37              
38             This is the the base tile class for L<Imager::Bing::MapLayer>. It is
39             intended for internal use, but can be subclassed as needed.
40              
41             =head1 ATTRIBUTES
42              
43             =head2 C<quad_key>
44              
45             The quadrant key of the tile.
46              
47             =cut
48              
49             has 'quad_key' => (
50             is => 'ro',
51             isa => subtype(
52             as 'Str', where {qr/^[0-3]{$MIN_ZOOM_LEVEL,$MAX_ZOOM_LEVEL}$/},
53             ),
54             required => 1,
55             );
56              
57             =head2 C<level>
58              
59             The zoom level for this tile. It is determined by the L</quad_key>.
60              
61             =cut
62              
63             has 'level' => (
64             is => 'ro',
65             isa => 'Int',
66             default => sub {
67             my ($self) = @_;
68             return length( $self->quad_key );
69             },
70             lazy => 1,
71             init_arg => undef,
72             );
73              
74             =head2 C<tile_coords>
75              
76             The tile coordinates of this tile. They are determined by the
77             L</quad_key>.
78              
79             =cut
80              
81             has 'tile_coords' => (
82             is => 'ro',
83             isa => 'ArrayRef',
84             default => sub {
85             my ($self) = @_;
86             return [ ( quad_key_to_tile_coords( $self->quad_key ) )[ 0, 1 ] ],;
87             },
88             lazy => 1,
89             init_arg => undef,
90             );
91              
92             =head2 C<pixel_origin>
93              
94             The coordinates of the top-left point on the tile. They are determined
95             by the L</quad_key>.
96              
97             =cut
98              
99             has 'pixel_origin' => (
100             is => 'ro',
101             isa => 'ArrayRef',
102             default => sub {
103             my ($self) = @_;
104             my $tile_coords = $self->tile_coords;
105             return [ tile_coords_to_pixel_origin( @{$tile_coords} ) ],;
106             },
107             lazy => 1,
108             init_arg => undef,
109             );
110              
111             =head2 C<width>
112              
113             The width of the tile.
114              
115             =cut
116              
117             has 'width' => (
118             is => 'ro',
119             default => $TILE_WIDTH,
120             lazy => 1,
121             init_arg => undef,
122             );
123              
124             =head2 C<height>
125              
126             The height of the tile.
127              
128             =cut
129              
130             has 'height' => (
131             is => 'ro',
132             default => $TILE_HEIGHT,
133             lazy => 1,
134             init_arg => undef,
135             );
136              
137             =head2 C<image>
138              
139             The L<Imager> object.
140              
141             =cut
142              
143             has 'image' => (
144             is => 'ro',
145             isa => 'Imager',
146             lazy => 1,
147             default => sub {
148             my ($self) = @_;
149              
150             my $image = Imager->new(
151             xsize => $self->width,
152             ysize => $self->height,
153             channels => 4,
154             );
155              
156             my $file = $self->filename;
157              
158             if ( -s $file ) {
159              
160             if ( $self->overwrite ) {
161              
162             unlink $file
163             or carp
164             sprintf( "Could not remove file '%s': %s", $file, $! );
165              
166             } else {
167              
168             $image->read( file => $file )
169             or confess sprintf( "Cannot read file '%s': %s",
170             $file, $image->errstr );
171              
172             }
173              
174             }
175              
176             return $image;
177             },
178             init_arg => undef,
179             );
180              
181             =head2 C<filename>
182              
183             The full pathname of the tile, when saved.
184              
185             =cut
186              
187             has 'filename' => (
188             is => 'ro',
189             isa => 'Str',
190             lazy => 1,
191             builder => 'build_filename',
192             init_arg => undef,
193             );
194              
195             =head1 METHODS
196              
197             =head2 C<build_filename>
198              
199             This method returns the default filename of the tile, which consists
200             of the L</base_dir> and L</quad_key>. It can be overridden in
201             subclasses for map systems that require alternative filenames.
202              
203             =cut
204              
205             sub build_filename {
206 14     14 1 23 my ($self) = @_;
207 14         561 return file( $self->base_dir, $self->quad_key . '.png' )->stringify;
208             }
209              
210             =head2 C<latlon_to_pixel>
211              
212             Translate latitude and longitude to a pixel on this zoom level.
213              
214             =cut
215              
216             sub latlon_to_pixel {
217 10     10 1 25 my ( $self, @latlon ) = @_;
218 10         456 return Imager::Bing::MapLayer::Utils::latlon_to_pixel( $self->level,
219             @latlon );
220             }
221              
222             =head2 C<latlons_to_pixels>
223              
224             Translate a list reference of latitude and longitude coordinates to
225             pixels on this zoom level.
226              
227             =cut
228              
229             sub latlons_to_pixels {
230 2     2 1 3937 my ( $self, $latlons ) = @_;
231 2         5 return [ map { [ $self->latlon_to_pixel( @{$_} ) ] } @{$latlons} ];
  8         13  
  8         29  
  2         8  
232             }
233              
234             =head2 C<save>
235              
236             Save this tile.
237              
238             =cut
239              
240             sub save {
241 28     28 1 39 my ($self) = @_;
242              
243             # Only save an image if there's something on it
244              
245 28 50       936 if ( $self->image->getcolorusage ) {
246 28         85684 $self->image->write( file => $self->filename );
247             }
248             }
249              
250             =begin :internal
251              
252             =head2 C<DEMOLISH>
253              
254             This method auto-saves the tile, if L</autosave> is enabled.
255              
256             =end :internal
257              
258             =cut
259              
260             sub DEMOLISH {
261 15     15 1 3338 my ($self) = @_;
262 15 50       602 $self->save if ( $self->autosave );
263             }
264              
265 5     5   4140 use namespace::autoclean;
  5         8  
  5         62  
266              
267             1;