File Coverage

blib/lib/Geo/Leaflet/Marker.pm
Criterion Covered Total %
statement 30 35 85.7
branch 6 14 42.8
condition n/a
subroutine 7 8 87.5
pod 3 3 100.0
total 46 60 76.6


line stmt bran cond sub pod time code
1             package Geo::Leaflet::Marker;
2 2     2   10 use strict;
  2         4  
  2         57  
3 2     2   7 use warnings;
  2         10  
  2         79  
4 2     2   8 use base qw{Geo::Leaflet::Objects};
  2         3  
  2         707  
5              
6             our $VERSION = '0.04';
7             our $PACKAGE = __PACKAGE__;
8              
9             =head1 NAME
10              
11             Geo::Leaflet::Marker - Leaflet marker object
12              
13             =head1 SYNOPSIS
14              
15             use Geo::Leaflet;
16             my $map = Geo::Leaflet->new;
17             my $marker = $map->marker(
18             lat => $lat,
19             lon => $lon,
20             );
21              
22             =head1 DESCRIPTION
23              
24             This package constructs a Leaflet marker object for use on a L map.
25              
26             =head1 PROPERTIES
27              
28             =head2 lat
29              
30             =cut
31              
32             sub lat {
33 1     1 1 1 my $self = shift;
34 1 50       3 $self->{'lat'} = shift if @_;
35 1 50       2 die("Error: lat required") unless defined $self->{'lat'};
36 1         3 return $self->{'lat'};
37             }
38              
39             =head2 lon
40              
41             =cut
42              
43             sub lon {
44 1     1 1 1 my $self = shift;
45 1 50       7 $self->{'lon'} = shift if @_;
46 1 50       3 die("Error: lon required") unless defined $self->{'lon'};
47 1         7 return $self->{'lon'};
48             }
49              
50             =head2 options
51              
52             =head2 popup
53              
54             =head1 METHODS
55              
56             =head2 stringify
57              
58             =cut
59              
60 0     0   0 sub _method_name {'marker'};
61              
62             sub stringify {
63 1     1 1 2 my $self = shift;
64 1         4 my $options = $self->options;
65 1         2 my $value = shift;
66             #const object6 = L.marker([51.498,-0.09],
67             # {"icon":paddle_1})
68             # .addTo(map).bindPopup("marker icon popup").bindTooltip("marker icon tooltip");
69 1         1 my $class = 'marker';
70 1         2 my $addmap = '.addTo(map)';
71 1 50       4 my $popup = $self->popup ? sprintf('.bindPopup(%s)', $self->JSON->encode($self->popup)) : '';
72 1 50       4 my $tooltip = $self->tooltip ? sprintf('.bindTooltip(%s)', $self->JSON->encode($self->tooltip)) : '';
73 1         2 return sprintf(q{L.%s(%s, %s)%s%s%s;},
74             $class,
75             $self->JSON->encode([$self->lat, $self->lon]),
76             $self->_hash_to_json($self->options),
77             $addmap,
78             $popup,
79             $tooltip,
80             );
81             }
82              
83             #head2 _hash_to_json
84             #
85             #Custom JSON encoder! Unfortunately, no Perl encoders support function name encoding as needed here for "icon" keys
86             #
87             #cut
88              
89             sub _hash_to_json {
90 1     1   1 my $self = shift;
91 1         6 my $hash = shift;
92 1         2 my $string = '';
93 1         2 foreach my $key (keys %$hash) {
94 0         0 my $value = $hash->{$key};
95 0 0       0 if ($key eq "icon") {
96 0         0 $string = $string . join(':', $self->JSON->encode($key), $value); #function name encoding is not supported by any perl package!
97             } else {
98 0         0 $string = $string . join(':', $self->JSON->encode($key), $self->JSON->encode($value));
99             }
100             }
101 1         13 return "{$string}";
102             }
103              
104             =head1 SEE ALSO
105              
106             =head1 AUTHOR
107              
108             Michael R. Davis
109              
110             =head1 COPYRIGHT AND LICENSE
111              
112             Copyright (C) 2024 by Michael R. Davis
113              
114             MIT LICENSE
115              
116             =cut
117              
118             1;