lib/HTML/OSM.pm

Index
Structural Coverage (Approximate)

TER1 (Statement): 100.00%
TER2 (Branch): 95.28%
TER3 (LCSAJ): 100.0% (31/31)
Approximate LCSAJ segments: 213

LCSAJ Legend

● Covered — this LCSAJ path was executed during testing.

● Not covered — this LCSAJ path was never executed. These are the paths to focus on.

Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows: 

        start → end → jump

Uncovered paths show [NOT COVERED] in the tooltip.

Mutant Testing Legend

Survived (tests missed this) Killed (tests detected this) No mutation 
    1: package HTML::OSM;
    2: 
    3: use strict;
    4: use warnings;
    5: 
    6: use autodie qw(:all);
    7: use B ();
    8: use Carp qw(carp croak);
    9: use CHI;
   10: use JSON::MaybeXS qw(decode_json encode_json);
   11: use LWP::UserAgent;
   12: use Object::Configure 0.15;
   13: use Params::Get 0.13;
   14: use Params::Validate::Strict 0.28;
   15: use POSIX qw(localeconv setlocale LC_NUMERIC);
   16: use Readonly;
   17: use Scalar::Util qw(blessed);
   18: use Time::HiRes qw(time);
   19: use URI::Escape qw(uri_escape_utf8);
   20: 
   21: =head1 NAME
   22: 
   23: HTML::OSM - Generate an interactive OpenStreetMap with Leaflet.js
   24: 
   25: =head1 VERSION
   26: 
   27: Version 0.12
   28: 
   29: =cut
   30: 
   31: our $VERSION = '0.12';
   32: 
   33: # CDN URLs pinned to tested versions.  Override via constructor params to use
   34: # a self-hosted copy or a different version.
   35: Readonly::Scalar my $LEAFLET_CSS_URL         => 'https://unpkg.com/leaflet@1.9.4/dist/leaflet.css';
   36: Readonly::Scalar my $LEAFLET_JS_URL          => 'https://unpkg.com/leaflet@1.9.4/dist/leaflet.js';
   37: Readonly::Scalar my $CLUSTER_JS_URL          => 'https://unpkg.com/leaflet.markercluster@1.5.3/dist/leaflet.markercluster.js';
   38: Readonly::Scalar my $CLUSTER_CSS_URL         => 'https://unpkg.com/leaflet.markercluster@1.5.3/dist/MarkerCluster.css';
   39: Readonly::Scalar my $CLUSTER_DEFAULT_CSS_URL => 'https://unpkg.com/leaflet.markercluster@1.5.3/dist/MarkerCluster.Default.css';
   40: Readonly::Scalar my $HEATMAP_JS_URL          => 'https://unpkg.com/leaflet.heat@0.2.0/dist/leaflet-heat.js';
   41: Readonly::Scalar my $GPX_JS_URL              => 'https://cdnjs.cloudflare.com/ajax/libs/leaflet-gpx/1.7.0/gpx.min.js';
   42: Readonly::Scalar my $TILE_URL                => 'https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png';
   43: Readonly::Scalar my $TILE_ATTRIBUTION        => '&copy; <a href="https://www.openstreetmap.org/copyright">OpenStreetMap</a> contributors';
   44: Readonly::Scalar my $NOMINATIM_HOST          => 'nominatim.openstreetmap.org/search';
   45: 
   46: # Rendering defaults, also used when a stored value is unusable at render time
   47: Readonly::Scalar my $DEFAULT_ZOOM   => 12;
   48: Readonly::Scalar my $DEFAULT_HEIGHT => '400px';
   49: Readonly::Scalar my $DEFAULT_WIDTH  => '600px';
   50: Readonly::Scalar my $DEFAULT_RADIUS => 25;
   51: Readonly::Scalar my $DEFAULT_BLUR   => 15;
   52: 
   53: # A CSS length: a number with an optional unit, or 'auto'
   54: Readonly::Scalar my $CSS_LENGTH => qr/\A(?:auto|[0-9]+(?:\.[0-9]+)?(?:px|%|em|rem|ex|ch|vh|vw|vmin|vmax|pt|pc|cm|mm|in)?)\z/;
   55: 
   56: # WGS-84 valid ranges
   57: Readonly::Scalar my $LAT_MIN => -90;
   58: Readonly::Scalar my $LAT_MAX =>  90;
   59: Readonly::Scalar my $LON_MIN => -180;
   60: Readonly::Scalar my $LON_MAX =>  180;
   61: Readonly::Scalar my $ZOOM_MIN =>  0;
   62: Readonly::Scalar my $ZOOM_MAX => 19;
   63: 
   64: # The highest maxZoom Leaflet supports on a tile layer
   65: Readonly::Scalar my $MAX_ZOOM_LIMIT => 28;
   66: 
   67: # Circle markers: Leaflet's default path colour, and a hex colour check
   68: Readonly::Scalar my $DEFAULT_CIRCLE_RADIUS => 8;
   69: Readonly::Scalar my $DEFAULT_CIRCLE_COLOUR => '#3388ff';
   70: Readonly::Scalar my $HEX_COLOUR            => qr/\A#(?:[0-9a-fA-F]{3}|[0-9a-fA-F]{6})\z/;
   71: 
   72: =head1 SYNOPSIS
   73: 
   74:     use HTML::OSM;
   75: 
   76:     my $map = HTML::OSM->new(
   77:         coordinates => [
   78:             [37.7749, -122.4194, 'San Francisco'],
   79:             [undef,   undef,     'Paris'],
   80:         ],
   81:         zoom => 10,
   82:     );
   83:     my ($head, $body) = $map->onload_render();
   84: 
   85: =over 4
   86: 
   87: =item * Caching
   88: 
   89: Geocode results are cached via L<CHI> (default: in-memory, 1-day TTL).
   90: Supply your own C<cache> object to persist across processes.
   91: 
   92: =item * Rate-Limiting
   93: 
   94: Set C<min_interval> (seconds) to throttle outbound Nominatim calls
   95: and comply with the API fair-use policy.
   96: 
   97: =item * Tile server
   98: 
   99: C<tile_url> replaces the OpenStreetMap tile layer, so a map can use an
  100: internal tile server or run on an air-gapped network.  It accepts the same
  101: Leaflet placeholders as the default, for example
  102: C<http://tiles.internal/{z}/{x}/{y}.png>.  The attribution remains the
  103: OpenStreetMap credit, which is the usual requirement for OSM-derived tiles.
  104: The in-page search box still calls Nominatim when a reader uses it; set
  105: C<< search => 0 >> to leave it out.
  106: 
  107: =item * Maximum zoom
  108: 
  109: C<max_zoom> (0 to 28) stops readers zooming in further than the tile server
  110: has tiles for.  Without it, Leaflet allows zooming past the server's coverage
  111: and the map shows empty grey tiles.  When it is not given, no limit is set.
  112: 
  113: =item * Tile attribution
  114: 
  115: C<tile_attribution> replaces the credit shown in the corner of the map.
  116: Set it when the tiles come from a provider that asks for a different
  117: credit.  The value is HTML that Leaflet renders as it is, so pass only
  118: trusted text.
  119: 
  120: =item * Nominatim contact address
  121: 
  122: C<email> is added to every Nominatim request the module makes, as the
  123: Nominatim usage policy asks of heavy users.  It is not put into the rendered
  124: page, so the in-page search box sends no address.
  125: 
  126: =item * Search box
  127: 
  128: By default the rendered page has a search box that sends whatever the reader
  129: types to Nominatim, and a button that clears the markers it adds.  Set
  130: C<< search => 0 >> to leave both out, so that nothing typed on the page leaves
  131: the reader's machine.  The "Reset Map" button is always included.
  132: 
  133: =back
  134: 
  135: =head1 DESCRIPTION
  136: 
  137: C<HTML::OSM> builds an interactive map from OpenStreetMap tiles and the
  138: Leaflet.js library.  Give it points as latitude and longitude, as place
  139: names, or as geocoder result objects.  It can also draw GeoJSON shapes,
  140: heatmaps, GPX tracks and choropleth (colour-filled region) layers, and can
  141: group nearby markers into clusters.
  142: 
  143: Place names are turned into coordinates by an injected geocoder or, without
  144: one, by the Nominatim service.  The answers are cached, and requests can be
  145: spaced out with C<min_interval>.
  146: 
  147: C<onload_render()> returns two HTML fragments: one for the page's
  148: C<< <head> >> and one for its C<< <body> >>.  The interface follows
  149: L<HTML::GoogleMaps::V3>, so code written for that module needs few changes.

  Mutants (Total: 1, Killed: 1, Survived: 0)
  150: 
  151: =head1 SUBROUTINES/METHODS
  152: 
  153: =head2 new
  154: 
  155: Construct a new C<HTML::OSM> object.
  156: 

  Mutants (Total: 1, Killed: 1, Survived: 0)
  157:     my $map = HTML::OSM->new(%params);
  158:     my $map = HTML::OSM->new(\%params);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  159: 
  160: Both method-style (C<< HTML::OSM->new(...) >>) and function-style
  161: (C<HTML::OSM::new(...)>) calls are supported.
  162: Calling C<< $existing_obj->new(%overrides) >> performs a shallow clone,
  163: merging C<%overrides> onto the existing object's state without re-validating.
  164: 
  165: =head3 API SPECIFICATION
  166: 
  167: =head4 INPUT
  168: 
  169:   {
  170:     cache                   => { type => object, can => [get, set], optional },
  171:     cluster                 => { type => boolean,                   optional },
  172:     cluster_css_url         => { type => string,                    optional },
  173:     cluster_default_css_url => { type => string,                    optional },
  174:     cluster_js_url          => { type => string,                    optional },
  175:     config_file             => { type => string,                    optional },
  176:     coordinates             => { type => arrayref,                  optional },
  177:     css_url                 => { type => string,                    optional },
  178:     email                   => { type => string,                    optional },
  179:     geocoder                => { type => object, can => geocode,    optional },
  180:     gpx_js_url              => { type => string,                    optional },
  181:     heatmap_js_url          => { type => string,                    optional },
  182:     height                  => { type => string,                    optional },
  183:     host                    => { type => string,                    optional },
  184:     js_url                  => { type => string,                    optional },
  185:     logger                  => { type => object,                    optional },
  186:     max_zoom                => { type => integer, min => 0, max => 28, optional },
  187:     min_interval            => { type => number,  min => 0,         optional },
  188:     search                  => { type => boolean,                   optional },
  189:     tile_attribution        => { type => string,                    optional },
  190:     tile_url                => { type => string,                    optional },
  191:     ua                      => { type => object,                    optional },
  192:     width                   => { type => string,                    optional },
  193:     zoom                    => { type => integer, min => 0, max => 19, optional },
  194:   }
  195: 
  196: =head4 OUTPUT
  197: 
  198:   { type => object, isa => 'HTML::OSM' }

  Mutants (Total: 2, Killed: 2, Survived: 0)
  199: 
  200: =head3 MESSAGES
  201: 
  202:   | Message                                        | Meaning / Resolution                          |
  203:   |------------------------------------------------|-----------------------------------------------|
  204:   | (validation error from Params::Validate::Strict) | A param has the wrong type or is out of range |
  205: 
  206: =head3 PSEUDOCODE
  207: 
  208:   1. If $class is neither a package name nor a blessed ref, treat as
  209:      function-style call: prepend $class back onto @_ and use __PACKAGE__.
  210:   2. If $class is a blessed ref (clone call): merge override params onto a
  211:      shallow copy and return immediately, bypassing schema validation.
  212:   3. Validate all supplied args against the declared schema.
  213:   4. Merge config-file settings via Object::Configure.
  214:   5. Resolve the cache: caller-supplied object, or in-memory CHI instance.
  215:   6. Bless and return with Readonly CDN constants as defaults.
  216: 
  217: =cut
  218: 
  219: sub new
  220: {
●221 → 226 → 233  221: 	my $class = shift;
  222: 
  223: 	# Function-style call: HTML::OSM::new(key => val).
  224: 	# Perl places the first argument where the class name should be,
  225: 	# so we put it back and set the class explicitly.
  226: 	if(defined($class) && !blessed($class) && !UNIVERSAL::isa($class, __PACKAGE__)) {
  227: 		unshift @_, $class;
  228: 		$class = __PACKAGE__;
  229: 	}
  230: 
  231: 	# Clone path: $obj->new(%overrides) — shallow-merge onto the existing
  232: 	# object without re-running schema validation so subclasses can extend.
●233 → 233 → 238  233: 	if(blessed($class)) {
  234: 		my $extra = Params::Get::get_params(undef, \@_) || {};
  235: 		return bless { %{$class}, %{$extra} }, ref($class);
  236: 	}
  237: 
  238: 	$class //= __PACKAGE__;
  239: 
  240: 	my $params = Params::Validate::Strict::validate_strict({
  241: 		args   => Params::Get::get_params(undef, \@_) || {},
  242: 		schema => {
  243: 			cache                   => { type => 'object',  can => [qw(get set)], optional => 1 },
  244: 			cluster                 => { type => 'boolean',                        optional => 1 },
  245: 			cluster_css_url         => { type => 'string',                         optional => 1 },
  246: 			cluster_default_css_url => { type => 'string',                         optional => 1 },
  247: 			cluster_js_url          => { type => 'string',                         optional => 1 },
  248: 			config_file             => { type => 'string',                         optional => 1 },
  249: 			coordinates             => { type => 'arrayref',                       optional => 1 },
  250: 			css_url                 => { type => 'string',                         optional => 1 },
  251: 			email                   => { type => 'string',                         optional => 1 },
  252: 			geocoder                => { type => 'object',  can => 'geocode',      optional => 1 },
  253: 			gpx_js_url              => { type => 'string',                         optional => 1 },
  254: 			heatmap_js_url          => { type => 'string',                         optional => 1 },
  255: 			height                  => { type => 'string',                         optional => 1 },
  256: 			host                    => { type => 'string',                         optional => 1 },
  257: 			js_url                  => { type => 'string',                         optional => 1 },
  258: 			logger                  => { type => 'object',                         optional => 1 },
  259: 			max_zoom                => { type => 'integer', min => $ZOOM_MIN, max => $MAX_ZOOM_LIMIT, optional => 1 },
  260: 			min_interval            => { type => 'number',  min => 0,              optional => 1 },
  261: 			search                  => { type => 'boolean',                        optional => 1 },
  262: 			tile_attribution        => { type => 'string',                         optional => 1 },
  263: 			tile_url                => { type => 'string',                         optional => 1 },
  264: 			ua                      => { type => 'object',                         optional => 1 },
  265: 			width                   => { type => 'string',                         optional => 1 },
  266: 			zoom                    => { type => 'integer', min => $ZOOM_MIN, max => $ZOOM_MAX, optional => 1 },
  267: 		},
  268: 	});
  269: 
  270: 	# Config file values override programmatic defaults (separation of config and code).
  271: 	$params = Object::Configure::configure($class, $params);
  272: 
  273: 	# Inject the resolved cache so the bless hash spreads it correctly.
  274: 	$params->{cache} //= CHI->new(
  275: 		driver     => 'Memory',
  276: 		global     => 1,
  277: 		expires_in => '1 day',
  278: 	);
  279: 

  Mutants (Total: 1, Killed: 1, Survived: 0)
  280: 	return bless {
  281: 		# Defaults — spread of %{$params} below overrides each one when supplied.
  282: 		coordinates             => [],
  283: 		height                  => $DEFAULT_HEIGHT,

  Mutants (Total: 1, Killed: 1, Survived: 0)
  284: 		host                    => $NOMINATIM_HOST,
  285: 		width                   => $DEFAULT_WIDTH,
  286: 		zoom                    => $DEFAULT_ZOOM,
  287: 		min_interval            => 0,
  288: 		last_request            => 0,
  289: 		cluster                 => 0,

  Mutants (Total: 1, Killed: 1, Survived: 0)
  290: 		search                  => 1,
  291: 		css_url                 => $LEAFLET_CSS_URL,
  292: 		js_url                  => $LEAFLET_JS_URL,
  293: 		cluster_js_url          => $CLUSTER_JS_URL,
  294: 		cluster_css_url         => $CLUSTER_CSS_URL,
  295: 		cluster_default_css_url => $CLUSTER_DEFAULT_CSS_URL,
  296: 		heatmap_js_url          => $HEATMAP_JS_URL,
  297: 		gpx_js_url              => $GPX_JS_URL,
  298: 		tile_url                => $TILE_URL,
  299: 		tile_attribution        => $TILE_ATTRIBUTION,
  300: 		%{$params},
  301: 	}, $class;

  Mutants (Total: 1, Killed: 1, Survived: 0)
  302: }

  Mutants (Total: 3, Killed: 3, Survived: 0)
  303: 
  304: =head2 add_marker
  305: 
  306: Add a point marker to the map.
  307: 
  308:     $map->add_marker([51.5074, -0.1278], html => 'London');
  309:     $map->add_marker('Paris, France',    html => 'Paris');
  310:     $map->add_marker($geo_coder_result);
  311: 
  312: Returns 1 on success, 0 if the point cannot be resolved or is out of range.
  313: An empty address, or an arrayref that does not hold exactly two elements,
  314: also returns 0.

  Mutants (Total: 2, Killed: 2, Survived: 0)
  315: 

  Mutants (Total: 2, Killed: 2, Survived: 0)
  316: =head3 API SPECIFICATION
  317: 
  318: =head4 INPUT

  Mutants (Total: 2, Killed: 2, Survived: 0)
  319: 
  320:   point : arrayref [lat, lon] | string address | object with latitude()/longitude()
  321:   html  : string   (optional popup label)
  322:   icon  : string   (optional icon URL)
  323: 
  324: =head4 OUTPUT
  325: 
  326:   { type => integer, enum => [0, 1] }
  327: 
  328: =head3 MESSAGES
  329: 
  330:   | Message                                 | Meaning / Resolution                        |
  331:   |-----------------------------------------|---------------------------------------------|
  332:   | add_marker(): unknown point type: TYPE | Point is a ref type with no lat/lon methods |
  333:   | Skipping invalid coordinate: (LAT, LON) | Warning: the point is not numeric or is out of range; 0 is returned |
  334: 
  335: =head3 EXAMPLES
  336: 
  337:     # Coordinate array with a popup label
  338:     $map->add_marker([51.5074, -0.1278], html => 'London');
  339: 
  340:     # String address geocoded via the injected geocoder or Nominatim
  341:     $map->add_marker('Paris, France', html => 'Paris');
  342: 
  343:     # Custom icon URL with a popup
  344:     $map->add_marker(
  345:         [40.7128, -74.0060],
  346:         html => 'New York',
  347:         icon => 'https://example.com/pin.png',
  348:     );
  349: 
  350:     # Geo::Coder result object that implements latitude()/longitude()
  351:     my $result = $geocoder->geocode('Berlin, Germany');
  352:     $map->add_marker($result, html => 'Berlin');
  353: 
  354:     # Accumulate several markers, warn on geocode failure
  355:     for my $city (@cities) {
  356:         $map->add_marker($city->{coords}, html => $city->{name})
  357:             or warn "Could not place $city->{name}";
  358:     }
  359: 
  360: =cut
  361: 
  362: sub add_marker
  363: {
  364: 	my $self = shift;
  365: 
  366: 	my ($lat, $lon, $params) = $self->_point_args('add_marker', @_);
  367: 	return 0 unless defined($lat);
  368: 
  369: 	push @{$self->{coordinates}}, [$lat, $lon, $params->{'html'}, $params->{'icon'}];
  370: 	return 1;
  371: }
  372: 
  373: =head2 add_circle_marker
  374: 
  375: Add a filled circle whose size in pixels can show a quantity, such as the
  376: population of a town.

  Mutants (Total: 2, Killed: 2, Survived: 0)
  377: 
  378:     $map->add_circle_marker([51.5074, -0.1278],
  379:         html   => 'London',
  380:         radius => 12,
  381:         colour => '#e45c3a',
  382:     );
  383: 
  384: The point may be anything C<add_marker()> accepts.  The radius is in screen
  385: pixels, so a circle stays the same size as the reader zooms in and out.
  386: With C<< cluster => 1 >>, circles join the same cluster group as the pin
  387: markers.
  388: 
  389: Returns 1 on success, 0 if the point cannot be resolved or is out of range.
  390: 
  391: =head3 API SPECIFICATION
  392: 
  393: =head4 INPUT
  394: 
  395:   point  : arrayref [lat, lon] | string address | object with latitude()/longitude()
  396:   html   : string   (optional popup label)
  397:   radius : number > 0 and < 1e6   (optional, default 8)
  398:   colour : string   hex #rrggbb or #rgb, any case   (optional, default '#3388ff')
  399: 
  400: =head4 OUTPUT
  401: 
  402:   { type => integer, enum => [0, 1] }
  403: 
  404: =head3 MESSAGES
  405: 
  406:   | Message                                             | Meaning / Resolution                        |
  407:   |-----------------------------------------------------|---------------------------------------------|
  408:   | add_circle_marker(): radius must be a positive number | radius is 0, negative, 1e6 or more, or not a plain number |
  409:   | add_circle_marker(): invalid colour: VALUE          | colour is not a #rgb or #rrggbb hex string  |
  410:   | add_circle_marker(): unknown point type: TYPE       | Point is a ref type with no lat/lon methods |
  411:   | Skipping invalid coordinate: (LAT, LON)             | Warning: the point is not numeric or is out of range; 0 is returned |
  412: 
  413: =head3 EXAMPLES
  414: 
  415:     # Bubble whose area shows the population
  416:     $map->add_circle_marker([$lat, $lon],
  417:         html   => "$city ($pop)",
  418:         radius => sqrt($pop / $max_pop) * 30,
  419:         colour => '#e45c3a',
  420:     );
  421: 
  422:     # Mixed map: pins for offices, circles for market size
  423:     $map->add_marker([$lat1, $lon1], html => 'HQ');
  424:     $map->add_circle_marker([$lat2, $lon2], html => 'Market A', radius => 20);
  425: 
  426: =cut
  427: 
  428: sub add_circle_marker
  429: {
●430 → 438 → 444  430: 	my $self = shift;
  431: 
  432: 	my ($lat, $lon, $params) = $self->_point_args('add_circle_marker', @_);
  433: 
  434: 	# Check the options even when the point is unusable, so a bad radius or

  Mutants (Total: 2, Killed: 2, Survived: 0)
  435: 	# colour is reported whatever the data
  436: 	my $radius = $params->{'radius'} // $DEFAULT_CIRCLE_RADIUS;
  437: 	my $checked = _positive_number($radius, undef);
  438: 	if(!defined($checked)) {
  439: 		my $msg = 'add_circle_marker(): radius must be a positive number';
  440: 		$self->{logger}->error($msg) if $self->{logger};
  441: 		croak $msg;
  442: 	}
  443: 
●444 → 445 → 451  444: 	my $colour = $params->{'colour'} // $DEFAULT_CIRCLE_COLOUR;
  445: 	if(ref($colour) || $colour !~ $HEX_COLOUR) {
  446: 		my $msg = "add_circle_marker(): invalid colour: $colour";
  447: 		$self->{logger}->error($msg) if $self->{logger};
  448: 		croak $msg;
  449: 	}
  450: 
  451: 	return 0 unless defined($lat);
  452: 
  453: 	push @{$self->{circle_markers}}, [$lat, $lon, $params->{'html'}, $checked, lc($colour)];
  454: 	return 1;
  455: }
  456: 
  457: =head2 add_geojson
  458: 
  459: Add a GeoJSON layer to the map.
  460: 
  461:     $map->add_geojson(\%data, style => { color => '#ff0000' }, popup => 'name');
  462: 
  463: The first argument may be a hashref/arrayref (GeoJSON structure) or a JSON string.
  464: Returns 1 on success.
  465: 
  466: =head3 API SPECIFICATION
  467: 
  468: =head4 INPUT
  469: 
  470:   data  : hashref | arrayref | string (JSON)
  471:   style : hashref   Leaflet path-style options (color, weight, fillColor, fillOpacity)
  472:   popup : string    Feature property name whose value becomes the popup text
  473: 
  474: =head4 OUTPUT
  475: 
  476:   { type => integer, value => 1 }
  477: 
  478: =head3 MESSAGES
  479: 
  480:   | Message              | Meaning / Resolution            |
  481:   |----------------------|---------------------------------|
  482:   | (JSON parse error)   | data string is not valid JSON   |
  483: 

  Mutants (Total: 2, Killed: 2, Survived: 0)
  484: =head3 EXAMPLES
  485: 
  486:     # Pre-parsed GeoJSON structure with style and popup property
  487:     $map->add_geojson(
  488:         { type => 'FeatureCollection', features => \@features },
  489:         style => { color => '#ff0000', weight => 2, fillOpacity => 0.4 },
  490:         popup => 'name',
  491:     );
  492: 
  493:     # Raw JSON string - decoded automatically
  494:     $map->add_geojson('{"type":"FeatureCollection","features":[]}');
  495: 
  496:     # Multiple GeoJSON layers with different styles on the same map
  497:     $map->add_geojson(\%country_borders, style => { color => '#333333', fillOpacity => 0 });
  498:     $map->add_geojson(\%river_data,      style => { color => '#0099ff', weight => 1    });
  499: 
  500: =cut
  501: 
  502: sub add_geojson
  503: {
  504: 	my $self   = shift;
  505: 	my $data   = shift;
  506: 	my $params = Params::Get::get_params(undef, \@_) || {};
  507: 
  508: 	# Accept either a pre-parsed structure or a raw JSON string
  509: 	$data = decode_json($data) if !ref($data);
  510: 
  511: 	push @{$self->{geojson}}, { data => $data, opts => $params };
  512: 	return 1;
  513: }
  514: 
  515: =head2 add_heatmap
  516: 
  517: Add a heatmap layer to the map.
  518: 
  519:     $map->add_heatmap([[51.5, -0.1, 0.8], [51.6, -0.2, 0.5]], radius => 25);
  520: 
  521: Each point is C<[$lat, $lon]> or C<[$lat, $lon, $intensity]> (intensity: 0-1).
  522: Requires the Leaflet.heat plugin (C<heatmap_js_url>).
  523: Returns 1 on success.
  524: 
  525: =head3 API SPECIFICATION
  526: 
  527: =head4 INPUT
  528: 
  529:   points : arrayref of ([lat, lon] | [lat, lon, intensity])
  530:   radius : number  default 25 (a value that is not a positive number uses the default)
  531:   blur   : number  default 15 (a value that is not a positive number uses the default)
  532: 
  533: =head4 OUTPUT
  534: 
  535:   { type => integer, value => 1 }
  536: 
  537: =head3 MESSAGES
  538: 
  539:   | Message                                 | Meaning / Resolution              |
  540:   |-----------------------------------------|-----------------------------------|
  541:   | add_heatmap: points must be an arrayref | First argument is not an arrayref |
  542: 
  543: =head3 EXAMPLES
  544: 
  545:     # Basic heatmap - [lat, lon] per point
  546:     $map->add_heatmap([
  547:         [51.5074, -0.1278],
  548:         [51.6000, -0.2000],
  549:         [51.4000,  0.0000],
  550:     ]);
  551: 
  552:     # With intensity values (0..1) and custom radius/blur
  553:     $map->add_heatmap(
  554:         [ [51.5, -0.1, 0.9], [51.6, -0.2, 0.5], [51.4, 0.0, 0.2] ],
  555:         radius => 30,
  556:         blur   => 20,
  557:     );
  558: 
  559: =cut
  560: 
  561: sub add_heatmap

  Mutants (Total: 1, Killed: 1, Survived: 0)
  562: {
  563: 	my $self   = shift;
  564: 	my $points = shift;
  565: 	my $params = Params::Get::get_params(undef, \@_) || {};
  566: 

  Mutants (Total: 3, Killed: 3, Survived: 0)
  567: 	croak 'add_heatmap: points must be an arrayref' unless ref($points) eq 'ARRAY';
  568: 
  569: 	push @{$self->{heatmap_layers}}, { points => $points, opts => $params };
  570: 	return 1;
  571: }
  572: 
  573: =head2 add_gpx
  574: 
  575: Add a GPX track to the map from a URL.
  576: 

  Mutants (Total: 2, Killed: 2, Survived: 0)
  577:     $map->add_gpx('https://example.com/track.gpx');
  578: 
  579: The map view is auto-fitted to the track bounds after loading.
  580: Requires the leaflet-gpx plugin (C<gpx_js_url>).
  581: Returns 1 on success.
  582: 
  583: =head3 API SPECIFICATION
  584: 
  585: =head4 INPUT
  586: 
  587:   url : string  URL of the GPX file (required)
  588: 
  589: =head4 OUTPUT
  590: 
  591:   { type => integer, value => 1 }
  592: 
  593: =head3 MESSAGES
  594: 
  595:   | Message                  | Meaning / Resolution     |
  596:   |--------------------------|--------------------------|
  597:   | add_gpx: url is required | No URL argument supplied |
  598: 
  599: =head3 EXAMPLES
  600: 
  601:     # Add a GPX track from a public URL; the map auto-fits to its bounds
  602:     $map->add_gpx('https://example.com/route.gpx');
  603: 
  604:     # Multiple tracks on the same map
  605:     $map->add_gpx('https://example.com/morning-run.gpx');
  606:     $map->add_gpx('https://example.com/evening-walk.gpx');
  607: 
  608: =cut
  609: 
  610: sub add_gpx
  611: {
  612: 	my $self   = shift;
  613: 	my $params = Params::Get::get_params('url', \@_);
  614: 	my $url    = $params->{'url'};
  615: 
  616: 	croak 'add_gpx: url is required' unless $url;
  617: 
  618: 	push @{$self->{gpx_tracks}}, $url;
  619: 	return 1;
  620: }
  621: 
  622: =head2 add_choropleth
  623: 
  624: Add a choropleth (data-driven colour fill) layer to the map.
  625: 
  626:     $map->add_choropleth(
  627:         \@geojson_features,
  628:         { England => 100, Scotland => 80, Wales => 60 },
  629:         key   => 'name',
  630:         scale => ['#ffffcc', '#a1dab4', '#41b6c4', '#2c7fb8', '#253494'],
  631:     );
  632: 
  633: Colours are pre-computed in Perl and baked into the emitted JavaScript.
  634: No extra browser plugin is required.
  635: Returns 1 on success.

  Mutants (Total: 1, Killed: 1, Survived: 0)
  636: 
  637: =head3 API SPECIFICATION

  Mutants (Total: 1, Killed: 1, Survived: 0)
  638: 
  639: =head4 INPUT
  640: 
  641:   features : arrayref of GeoJSON Feature hashrefs  (required)
  642:   values   : hashref  { feature_property_value => numeric_value }  (required)
  643:   key      : string   feature property to match against values  (default: 'name')
  644:   scale    : arrayref hex-colour strings low-to-high  (default: 5-step YlGnBu)
  645: 
  646: =head4 OUTPUT
  647: 
  648:   { type => integer, value => 1 }
  649: 

  Mutants (Total: 2, Killed: 2, Survived: 0)
  650: =head3 MESSAGES

  Mutants (Total: 2, Killed: 2, Survived: 0)
  651: 
  652:   | Message                                     | Meaning / Resolution              |
  653:   |---------------------------------------------|-----------------------------------|

  Mutants (Total: 2, Killed: 2, Survived: 0)
  654:   | add_choropleth: features must be an arrayref | First argument is not an arrayref |
  655:   | add_choropleth: values must be a hashref     | Second argument is not a hashref  |
  656: 
  657: =head3 EXAMPLES
  658: 
  659:     # Default 5-step YlGnBu scale, key property "name"
  660:     $map->add_choropleth(
  661:         \@geojson_features,
  662:         { England => 100, Scotland => 80, Wales => 60 },
  663:     );
  664: 
  665:     # Custom 3-step scale and a different GeoJSON property as the key
  666:     $map->add_choropleth(
  667:         \@geojson_features,
  668:         { England => 100, Scotland => 80, Wales => 60 },
  669:         key   => 'country',
  670:         scale => ['#f7fbff', '#6baed6', '#08519c'],
  671:     );
  672: 
  673:     # choropleth-only map - center() must be called explicitly
  674:     $map->center([54.0, -2.0]);
  675:     $map->add_choropleth(\@uk_features, \%population_by_region);
  676:     my ($head, $body) = $map->onload_render();
  677: 
  678: =cut
  679: 
  680: sub add_choropleth
  681: {
●682 → 700 → 706  682: 	my $self     = shift;
  683: 	my $features = shift;
  684: 	my $values   = shift;
  685: 	my $params   = Params::Get::get_params(undef, \@_) || {};
  686: 
  687: 	croak 'add_choropleth: features must be an arrayref' unless ref($features) eq 'ARRAY';
  688: 	croak 'add_choropleth: values must be a hashref'     unless ref($values)   eq 'HASH';
  689: 
  690: 	my $key   = $params->{key}   || 'name';
  691: 	my $scale = $params->{scale} || ['#ffffcc', '#a1dab4', '#41b6c4', '#2c7fb8', '#253494'];
  692: 
  693: 	# Compute colour index for each feature in Perl so the browser needs no
  694: 	# extra maths — the resulting lookup object is baked into the JS.
  695: 	my @sorted_vals = sort { $a <=> $b } values %{$values};
  696: 	my ($min, $max) = ($sorted_vals[0] // 0, $sorted_vals[-1] // 0);
  697: 	$max = $min + 1 if $max == $min;    # avoid division by zero for single-value sets
  698: 
  699: 	my %colors;
  700: 	while(my ($k, $v) = each %{$values}) {
  701: 		my $idx = int(($v - $min) / ($max - $min) * $#{$scale});
  702: 		$idx = $#{$scale} if $idx > $#{$scale};

  Mutants (Total: 1, Killed: 1, Survived: 0)
  703: 		$colors{$k} = $scale->[$idx];
  704: 	}
  705: 
  706: 	push @{$self->{choropleth_layers}}, {
  707: 		features => $features,
  708: 		values   => $values,
  709: 		colors   => \%colors,
  710: 		key      => $key,
  711: 	};
  712: 	return 1;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  713: }
  714: 
  715: =head2 center
  716: 
  717: Set the map centre to a given point.
  718: 
  719:     $map->center([40.7128, -74.0060]);
  720:     $map->center($geo_object);
  721:     $map->center('Berlin, Germany');
  722: 
  723: Returns 1 on success, 0 if the point cannot be resolved or is out of range.
  724: An empty address also returns 0.
  725: 
  726: =head3 API SPECIFICATION
  727: 
  728: =head4 INPUT
  729: 
  730:   point : arrayref [lat, lon] | object with latitude()/longitude() | string address
  731: 
  732: =head4 OUTPUT
  733: 
  734:   { type => integer, enum => [0, 1] }
  735: 
  736: =head3 MESSAGES
  737: 
  738:   | Message                                            | Meaning / Resolution            |
  739:   |----------------------------------------------------|---------------------------------|
  740:   | center(): usage: point => [ latitude, longitude ]  | No point argument supplied      |
  741:   | center(): point must have latitude and longitude   | Arrayref has != 2 elements      |
  742:   | center(): unknown point type: TYPE                 | Ref type has no lat/lon methods |
  743:   | Skipping invalid coordinate: (LAT, LON)            | Warning: point is not numeric or is out of range; 0 is returned |
  744: 
  745: =head3 EXAMPLES
  746: 
  747:     # Coordinate array
  748:     $map->center([40.7128, -74.0060]);
  749: 
  750:     # Object that implements latitude()/longitude() (e.g. a Geo::Coder result)
  751:     $map->center($geocoder->geocode('Berlin, Germany'));
  752: 
  753:     # String address resolved via the injected geocoder or Nominatim
  754:     $map->center('Eiffel Tower, Paris, France');
  755: 
  756:     # Required when rendering without point markers (GeoJSON-only, choropleth, etc.)
  757:     $map->center([54.0, -2.0]);
  758:     $map->add_geojson(\%uk_regions, popup => 'name');
  759:     my ($head, $body) = $map->onload_render();
  760: 
  761: =cut
  762: 
  763: sub center
  764: {
●765 → 773 → 789  765: 	my $self   = shift;
  766: 	my $params = Params::Get::get_params('point', \@_);
  767: 	my $point  = $params->{'point'};
  768: 
  769: 	croak 'center(): usage: point => [ latitude, longitude ]' unless defined($point);
  770: 
  771: 	my ($lat, $lon);
  772: 
  773: 	if(ref($point) eq 'ARRAY') {
  774: 		croak 'center(): point must have latitude and longitude'
  775: 			if scalar(@{$point}) != 2;
  776: 		($lat, $lon) = @{$point};
  777: 	} elsif(ref($point) && $point->can('latitude')) {
  778: 		($lat, $lon) = ($point->latitude(), $point->longitude());
  779: 	} elsif(!ref($point)) {
  780: 		# An empty address cannot be resolved
  781: 		return 0 unless length($point);
  782: 		($lat, $lon) = $self->_fetch_coordinates($point);
  783: 	} else {
  784: 		my $msg = 'center(): unknown point type: ' . ref($point);
  785: 		$self->{logger}->error($msg) if $self->{logger};
  786: 		croak $msg;
  787: 	}
  788: 
  789: 	return 0 unless defined($lat) && defined($lon);
  790: 
  791: 	# Store the text form with a '.' decimal point, whatever the locale
  792: 	($lat, $lon) = (_num_str($lat), _num_str($lon));
  793: 	return 0 unless _validate($lat, $lon);
  794: 
  795: 	$self->{'center'} = [$lat, $lon];
  796: 	return 1;
  797: }
  798: 
  799: =head2 zoom
  800: 
  801: Get or set the zoom level (0 = world, 19 = building).
  802: 
  803:     $map->zoom(10);
  804:     my $z = $map->zoom();
  805: 
  806: =head3 API SPECIFICATION
  807: 
  808: =head4 INPUT
  809: 

  Mutants (Total: 1, Killed: 1, Survived: 0)
  810:   { zoom => { type => integer, min => 0, max => 19, optional => 1 } }
  811: 
  812: =head4 OUTPUT
  813: 
  814:   { type => integer, min => 0, max => 19 }
  815: 
  816: =head3 MESSAGES
  817: 
  818:   | Message                      | Meaning / Resolution                      |
  819:   |------------------------------|-------------------------------------------|

  Mutants (Total: 1, Killed: 1, Survived: 0)
  820:   | (Params::Validate::Strict)   | zoom is not an integer or is out of range |
  821: 
  822: =head3 EXAMPLES
  823: 
  824:     # Setter: store the zoom level
  825:     $map->zoom(14);
  826: 
  827:     # Getter: retrieve the current level
  828:     my $level = $map->zoom();
  829:     print "Current zoom: $level\n";    # 14
  830: 
  831:     # Setter return value equals the new level

  Mutants (Total: 1, Killed: 1, Survived: 0)
  832:     my $confirmed = $map->zoom(10);
  833:     die 'unexpected' unless $confirmed == 10;
  834: 
  835:     # Chain: set via new(), read back via zoom()
  836:     my $m = HTML::OSM->new(zoom => 6);

  Mutants (Total: 3, Killed: 3, Survived: 0)
  837:     $m->zoom($m->zoom() + 2);   # nudge up by 2

  Mutants (Total: 3, Killed: 3, Survived: 0)
  838: 

  Mutants (Total: 3, Killed: 3, Survived: 0)
  839: =cut

  Mutants (Total: 3, Killed: 3, Survived: 0)
  840: 
  841: sub zoom
  842: {
●843 → 845 → 855  843: 	my $self = shift;
  844: 
  845: 	if(scalar(@_)) {
  846: 		my $params = Params::Validate::Strict::validate_strict({
  847: 			args   => Params::Get::get_params('zoom', \@_),
  848: 			schema => {
  849: 				zoom => { optional => 1, type => 'integer', min => $ZOOM_MIN, max => $ZOOM_MAX },
  850: 			},
  851: 		});
  852: 		$self->{'zoom'} = $params->{'zoom'} if defined($params->{'zoom'});
  853: 	}

  Mutants (Total: 1, Killed: 1, Survived: 0)
  854: 
  855: 	return $self->{'zoom'};
  856: }
  857: 
  858: =head2 onload_render
  859: 
  860: Render the map and return a two-element list suitable for embedding in HTML.
  861: 
  862:     my ($head_html, $body_html) = $map->onload_render();
  863: 
  864: C<$head_html> contains the Leaflet CSS, JavaScript, and plugin assets.
  865: Place it inside C<< <head>...</head> >>.
  866: 
  867: C<$body_html> contains the search box (unless C<< search => 0 >>), control
  868: buttons, map C<< <div> >>, and the initialisation C<< <script> >>.
  869: Place it inside C<< <body>...</body> >> where the map should appear.
  870: 
  871: The rendered page provides:
  872: 
  873: =over 4
  874: 
  875: =item * A Nominatim-powered search box that adds temporary markers.
  876: Left out when C<< search => 0 >>.
  877: 
  878: =item * A "Clear search markers" button that removes those temporary markers,
  879: leaving static markers (added via C<add_marker>) intact.
  880: Left out when C<< search => 0 >>.
  881: 
  882: =item * A "Reset Map" button that returns the view to the initial centre and zoom.
  883: 
  884: =back
  885: 
  886: Values that reach the object without going through C<new()>'s checks (from a
  887: config file or a clone) are checked again here.  A C<zoom> that is not an

  Mutants (Total: 1, Killed: 1, Survived: 0)
  888: integer from 0 to 19 is replaced by 12, and a C<width> or C<height> that is
  889: not a CSS length (such as C<600px>, C<100%> or C<auto>) is replaced by the
  890: default.  A C<max_zoom> that is not an integer from 0 to 28 is ignored.  Each
  891: replacement gives a warning.
  892: 
  893: =head3 API SPECIFICATION

  Mutants (Total: 1, Killed: 1, Survived: 0)
  894: 
  895: =head4 INPUT
  896: 
  897:   (none - uses object state)
  898: 
  899: =head4 OUTPUT
  900: 
  901:   { type => list, elements => [string, string] }
  902: 
  903: =head3 MESSAGES
  904: 
  905:   | Message                                          | Meaning / Resolution                        |
  906:   |--------------------------------------------------|---------------------------------------------|
  907:   | No map data provided                             | No markers, circle markers, GeoJSON, heatmap, GPX, or choropleth added yet |
  908:   | center() must be called when no point markers are provided | Non-marker-only render needs explicit centre |
  909:   | Skipping invalid coordinate: (LAT, LON)          | Warning: a marker is not numeric or out of range; it is left off the map |
  910:   | onload_render: invalid zoom 'Z', using 12        | Warning: zoom from a config file or clone is out of range |
  911:   | onload_render: invalid max_zoom 'Z', ignoring it | Warning: max_zoom from a config file or clone is not an integer from 0 to 28 |
  912:   | onload_render: invalid width 'W', using 600px    | Warning: width is not a CSS length |
  913:   | onload_render: invalid height 'H', using 400px   | Warning: height is not a CSS length |
  914:   | _fetch_coordinates: failed to decode Nominatim response: ERROR | Warning: Nominatim returned something that is not JSON; the marker is skipped |
  915:   | _fetch_coordinates: unrecognised geocoder result type: TYPE | Warning: the injected geocoder returned an unknown type; the marker is skipped |
  916: 
  917: =head3 EXAMPLES
  918: 
  919:     # Minimal: one marker, embed in a CGI response
  920:     use HTML::OSM;
  921:     my $map = HTML::OSM->new(zoom => 12);

  Mutants (Total: 1, Killed: 1, Survived: 0)
  922:     $map->add_marker([51.5074, -0.1278], html => 'London');
  923:     my ($head, $body) = $map->onload_render();
  924:     print "Content-Type: text/html\n\n";

  Mutants (Total: 1, Killed: 1, Survived: 0)
  925:     print "<html><head>$head</head><body>$body</body></html>\n";
  926: 
  927:     # Mixed layers: markers + GeoJSON, explicit center
  928:     $map->center([51.5, -0.1]);
  929:     $map->add_geojson(\%borough_data, popup => 'name', style => { color => '#333' });
  930:     $map->add_marker([51.5074, -0.1278], html => 'City of London');
  931:     my ($head_html, $body_html) = $map->onload_render();
  932: 
  933:     # Template Toolkit integration
  934:     $tt->process('map.tt', {
  935:         map_head => scalar(($map->onload_render())[0]),
  936:         map_body => scalar(($map->onload_render())[1]),
  937:     });
  938: 
  939: =head3 PSEUDOCODE
  940: 
  941:   1. Gather all data layers; croak if none populated.
  942:   2. Geocode/validate each coordinate tuple; discard invalids with a warning.
  943:      A tuple with no coordinates and no address is discarded.
  944:      Check circle markers the same way.
  945:      Re-check zoom, max_zoom, width and height; fall back with a warning.
  946:   3. Determine map centre: caller-supplied > computed midpoint of the bounds
  947:      of the pin and circle markers.
  948:      Croak if neither is available.
  949:   4. Build <head>: Leaflet CSS + JS; inject cluster/heatmap/GPX plugin assets
  950:      only when the corresponding layer type is present.
  951:   5. Build <body>: search box and clear-search button (when search is on),
  952:      reset button, map <div>.
  953:   6. Initialise Leaflet map, tile layer (with maxZoom when max_zoom is set),
  954:      and the searchMarkers array when search is on.
  955:   7. Emit JS for each pin and circle marker (via one clusterGroup when
  956:      cluster is set).
  957:   8. Emit JS for each GeoJSON, heatmap, GPX, and choropleth layer.
  958:   9. Attach event listeners: reset-view, and when search is on,
  959:      clear-search-markers and search-on-Enter.
  960:   10. Return ($head, $body).
  961: 
  962: =cut
  963: 
  964: sub onload_render
  965: {
●966 → 978 → 987  966: 	my $self = shift;
  967: 
  968: 	my $height            = _css_length('height', $self->{'height'}, $DEFAULT_HEIGHT);
  969: 	my $width             = _css_length('width',  $self->{'width'},  $DEFAULT_WIDTH);
  970: 	my $zoom              = $self->{'zoom'};
  971: 	my $coordinates       = $self->{coordinates}        || [];
  972: 	my $geojson_layers    = $self->{geojson}             || [];
  973: 	my $heatmap_layers    = $self->{heatmap_layers}      || [];
  974: 	my $gpx_tracks        = $self->{gpx_tracks}          || [];
  975: 	my $choropleth_layers = $self->{choropleth_layers}   || [];
  976: 	my $circle_markers    = $self->{circle_markers}      || [];
  977: 
  978: 	unless(@$coordinates || @$geojson_layers || @$heatmap_layers
  979: 	                     || @$gpx_tracks     || @$choropleth_layers
  980: 	                     || @$circle_markers) {
  981: 		$self->{logger}->error('No map data provided') if $self->{logger};
  982: 		croak 'No map data provided';
  983: 	}
  984: 
  985: 	# Config-file and clone values skip new()'s schema, so check zoom again
  986: 	# before it is put into the JavaScript.
●987 → 987 → 993  987: 	if(!defined($zoom) || $zoom !~ /\A[0-9]+\z/ || $zoom < $ZOOM_MIN || $zoom > $ZOOM_MAX) {
  988: 		carp sprintf("onload_render: invalid zoom '%s', using %d", $zoom // 'undef', $DEFAULT_ZOOM);
  989: 		$zoom = $DEFAULT_ZOOM;
  990: 	}
  991: 
  992: 	# Geocode address strings; validate and discard bad numeric pairs.
●993 → 994 → 1011  993: 	my @valid_coordinates;
  994: 	for my $coord (@$coordinates) {
  995: 		my ($lat, $lon, $label, $icon_url) = @$coord;
  996: 		if(!defined $lat || !defined $lon) {
  997: 			# No coordinates and no address: nothing to look up
  998: 			next unless defined($label) && length($label);
  999: 			($lat, $lon) = $self->_fetch_coordinates($label);
 1000: 		}
 1001: 		# Validate ALL coordinates here — including geocoder-returned ones.
 1002: 		# A compromised geocoder or Nominatim response could return a crafted
 1003: 		# lat/lon string that would inject JS if embedded without validation.
 1004: 		next unless defined($lat) && defined($lon);
 1005: 		($lat, $lon) = (_num_str($lat), _num_str($lon));
 1006: 		next unless _validate($lat, $lon);
 1007: 		push @valid_coordinates, [$lat, $lon, $label, $icon_url];
 1008: 	}
 1009: 
 1010: 	# add_circle_marker checked these, but a clone can bring in anything
●1011 → 1012 → 1023 1011: 	my @valid_circles;
 1012: 	for my $circle (@$circle_markers) {
 1013: 		my ($lat, $lon, $label, $radius, $colour) = @$circle;
 1014: 		next unless defined($lat) && defined($lon);
 1015: 		($lat, $lon) = (_num_str($lat), _num_str($lon));
 1016: 		next unless _validate($lat, $lon);
 1017: 		$radius = _positive_number($radius, $DEFAULT_CIRCLE_RADIUS);
 1018: 		$colour = $DEFAULT_CIRCLE_COLOUR unless defined($colour) && !ref($colour) && $colour =~ $HEX_COLOUR;
 1019: 		push @valid_circles, [$lat, $lon, $label, $radius, lc($colour)];
 1020: 	}
 1021: 
 1022: 	# Only an integer in Leaflet's range is put into the tile layer options
●1023 → 1024 → 1028 1023: 	my $max_zoom = $self->{'max_zoom'};
 1024: 	if(defined($max_zoom) && ($max_zoom !~ /\A[0-9]+\z/ || $max_zoom > $MAX_ZOOM_LIMIT)) {
 1025: 		carp "onload_render: invalid max_zoom '$max_zoom', ignoring it";

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1026: 		undef $max_zoom;
 1027: 	}
●1028 → 1036 → 1052 1028: 	my $max_zoom_js = defined($max_zoom) ? ",\n\t\t\t\tmaxZoom: $max_zoom" : '';
 1029: 

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1030: 	# A config file can give the words 'false', 'no' or 'off'
 1031: 	my $search = $self->{'search'};
 1032: 	$search = 0 if defined($search) && $search =~ /\A(?:false|no|off)\z/i;

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1033: 
 1034: 	# Determine map centre: caller-set wins; else compute from marker bounds.
 1035: 	my ($center_lat, $center_lon);
 1036: 	if($self->{'center'}) {
 1037: 		($center_lat, $center_lon) = @{$self->{'center'}};
 1038: 	} elsif(@valid_coordinates || @valid_circles) {
 1039: 		my ($min_lat, $min_lon, $max_lat, $max_lon) = (90, 180, -90, -180);

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1040: 		for my $c (@valid_coordinates, @valid_circles) {
 1041: 			# Convert with _num_val: some perls read '51.5074' as 51 under de_DE
 1042: 			my ($lat, $lon) = (_num_val($c->[0]), _num_val($c->[1]));
 1043: 			$min_lat = $lat if $lat < $min_lat;
 1044: 			$max_lat = $lat if $lat > $max_lat;
 1045: 			$min_lon = $lon if $lon < $min_lon;
 1046: 			$max_lon = $lon if $lon > $max_lon;
 1047: 		}
 1048: 		$center_lat = ($min_lat + $max_lat) / 2;

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1049: 		$center_lon = ($min_lon + $max_lon) / 2;
 1050: 	} else {
 1051: 		croak 'center() must be called when no point markers are provided';
●1052 → 1064 → 1071 1052: 	}
 1053: 	# The midpoint is a new number, so it needs the same treatment as markers
 1054: 	($center_lat, $center_lon) = (_num_str($center_lat), _num_str($center_lon));

  Mutants (Total: 4, Killed: 4, Survived: 0)
 1055: 
 1056: 	# --- <head> ---
 1057: 	my %url = map { $_ => _html_attr($self->{$_}) }
 1058: 		qw(css_url js_url cluster_css_url cluster_default_css_url cluster_js_url heatmap_js_url gpx_js_url);
 1059: 	my $head = qq{
 1060: 		<link rel="stylesheet" href="$url{css_url}" />
 1061: 		<script src="$url{js_url}"></script>
 1062: 	};
 1063: 
 1064: 	if($self->{cluster}) {
 1065: 		$head .= qq{
 1066: 		<link rel="stylesheet" href="$url{cluster_css_url}" />
 1067: 		<link rel="stylesheet" href="$url{cluster_default_css_url}" />

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1068: 		<script src="$url{cluster_js_url}"></script>
 1069: 		};
 1070: 	}
●1071 → 1074 → 1092 1071: 	$head .= qq{\t\t<script src="$url{heatmap_js_url}"></script>\n} if @$heatmap_layers;
 1072: 	$head .= qq{\t\t<script src="$url{gpx_js_url}"></script>\n}     if @$gpx_tracks;

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1073: 
 1074: 	if($search) {
 1075: 		$head .= qq{
 1076: 		<style>
 1077: 			#map { width: $width; height: $height; }

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1078: 			#search-box { margin: 10px; padding: 5px; }
 1079: 			#reset-button, #clear-search-button { margin: 10px; padding: 5px; cursor: pointer; }
 1080: 		</style>
 1081: 		};
 1082: 	} else {
 1083: 		$head .= qq{
 1084: 		<style>
 1085: 			#map { width: $width; height: $height; }
 1086: 			#reset-button { margin: 10px; padding: 5px; cursor: pointer; }
 1087: 		</style>
 1088: 		};
 1089: 	}
 1090: 
 1091: 	# --- <body> ---
●1092 → 1095 → 1100 1092: 	my $tile_url         = _js_string($self->{tile_url});
 1093: 	my $tile_attribution = _js_string($self->{tile_attribution});
 1094: 	my $body = '';
 1095: 	if($search) {
 1096: 		$body .= qq{
 1097: 		<input type="text" id="search-box" placeholder="Enter location">
 1098: 		<button id="clear-search-button">Clear search markers</button>};
 1099: 	}
●1100 → 1114 → 1139 1100: 	$body .= qq{
 1101: 		<button id="reset-button">Reset Map</button>
 1102: 		<div id="map"></div>
 1103: 		<script>
 1104: 			var map = L.map('map').setView([$center_lat, $center_lon], $zoom);

  Mutants (Total: 6, Killed: 6, Survived: 0)
 1105: 			L.tileLayer('$tile_url', {

  Mutants (Total: 6, Killed: 6, Survived: 0)
 1106: 				attribution: '$tile_attribution'$max_zoom_js
 1107: 			}).addTo(map);
 1108: 	};
 1109: 	$body .= "\n\t\t\tvar searchMarkers = [];\n" if $search;
 1110: 
 1111: 	# Point and circle markers — optionally grouped into one cluster layer.

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1112: 	my $clustered = $self->{cluster} && (@valid_coordinates || @valid_circles);
 1113: 	$body .= "\t\t\tvar clusterGroup = L.markerClusterGroup();\n" if $clustered;
 1114: 	if(@valid_coordinates) {
 1115: 
 1116: 		for my $coord (@valid_coordinates) {
 1117: 			my ($lat, $lon, $label, $icon_url) = @$coord;
 1118: 			my $js_label = _js_string($label);
 1119: 			if($icon_url) {
 1120: 				my $js_icon = _js_string($icon_url);
 1121: 				my $add_cmd = $self->{cluster}
 1122: 					? 'clusterGroup.addLayer(m);'
 1123: 					: 'm.addTo(map);';
 1124: 				$body .= qq{

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1125: 			(function() {
 1126: 				var icon = L.icon({ iconUrl: '$js_icon', iconAnchor: [16,32], popupAnchor: [0,-32] });
 1127: 				var m = L.marker([$lat, $lon], { icon: icon }).bindPopup('$js_label');
 1128: 				$add_cmd
 1129: 			})();
 1130: 				};
 1131: 			} elsif($self->{cluster}) {
 1132: 				$body .= "\t\t\tclusterGroup.addLayer(L.marker([$lat, $lon]).bindPopup('$js_label'));\n";
 1133: 			} else {
 1134: 				$body .= "\t\t\tL.marker([$lat, $lon]).addTo(map).bindPopup('$js_label');\n";
 1135: 			}
 1136: 		}
 1137: 	}
 1138: 

  Mutants (Total: 2, Killed: 2, Survived: 0)
●1139 → 1139 → 1152 1139: 	for my $circle (@valid_circles) {
 1140: 		my ($lat, $lon, $label, $radius, $colour) = @$circle;
 1141: 		my $popup = (defined($label) && length($label))
 1142: 			? ".bindPopup('" . _js_string($label) . "')"
 1143: 			: '';
 1144: 		my $circle_js = "L.circleMarker([$lat, $lon], { radius: $radius, color: '$colour', fillColor: '$colour', fillOpacity: 0.7 })$popup";
 1145: 		if($self->{cluster}) {
 1146: 			$body .= "\t\t\tclusterGroup.addLayer($circle_js);\n";
 1147: 		} else {
 1148: 			$body .= "\t\t\t$circle_js.addTo(map);\n";
 1149: 		}
 1150: 	}
 1151: 
●1152 → 1155 → 1171 1152: 	$body .= "\t\t\tmap.addLayer(clusterGroup);\n" if $clustered;
 1153: 
 1154: 	# GeoJSON layers.
 1155: 	for my $layer (@$geojson_layers) {
 1156: 		my $json     = _html_json($layer->{data});
 1157: 		my $opts     = $layer->{opts} || {};
 1158: 		my $style_js = '';
 1159: 		my $popup_js = '';
 1160: 		if(my $style = $opts->{style}) {
 1161: 			$style_js = 'style: ' . _html_json($style) . ',';
 1162: 		}
 1163: 		if(my $prop = $opts->{popup}) {
 1164: 			my $js_prop = _js_string($prop);
 1165: 			$popup_js = "onEachFeature: function(f,l){ if(f.properties && f.properties['$js_prop']){ l.bindPopup(String(f.properties['$js_prop'])); } },";
 1166: 		}
 1167: 		$body .= "\t\t\tL.geoJSON($json, { $style_js $popup_js }).addTo(map);\n";
 1168: 	}
 1169: 
 1170: 	# Heatmap layers.
●1171 → 1171 → 1181 1171: 	for my $layer (@$heatmap_layers) {
 1172: 		my $pts    = _html_json($layer->{points});
 1173: 		my $opts   = $layer->{opts} || {};
 1174: 		# Only plain positive numbers reach the JavaScript
 1175: 		my $radius = _positive_number($opts->{radius}, $DEFAULT_RADIUS);
 1176: 		my $blur   = _positive_number($opts->{blur},   $DEFAULT_BLUR);
 1177: 		$body .= "\t\t\tL.heatLayer($pts, { radius: $radius, blur: $blur }).addTo(map);\n";
 1178: 	}
 1179: 
 1180: 	# GPX tracks — browser fetches the file; fitBounds called on load.
●1181 → 1181 → 1187 1181: 	for my $url (@$gpx_tracks) {
 1182: 		my $js_url = _js_string($url);
 1183: 		$body .= "\t\t\tnew L.GPX('$js_url', { async: true }).on('loaded', function(e){ map.fitBounds(e.target.getBounds()); }).addTo(map);\n";
 1184: 	}
 1185: 
 1186: 	# Choropleth layers — colours are pre-baked; no browser-side scale maths.
●1187 → 1187 → 1215 1187: 	for my $layer (@$choropleth_layers) {
 1188: 		my $fc_json     = _html_json({ type => 'FeatureCollection', features => $layer->{features} });
 1189: 		my $colors_json = _html_json($layer->{colors});
 1190: 		my $values_json = _html_json($layer->{values});
 1191: 		my $js_key      = _js_string($layer->{key});
 1192: 		$body .= qq{
 1193: 			(function() {
 1194: 				var choroplethColors = $colors_json;
 1195: 				var choroplethValues = $values_json;
 1196: 				L.geoJSON($fc_json, {
 1197: 					style: function(f) {
 1198: 						var k = f.properties && f.properties['$js_key'];
 1199: 						return { fillColor: choroplethColors[k] || '#cccccc',
 1200: 						         weight: 2, opacity: 1, color: 'white',
 1201: 						         dashArray: '3', fillOpacity: 0.7 };
 1202: 					},
 1203: 					onEachFeature: function(f, l) {
 1204: 						var k = f.properties && f.properties['$js_key'];
 1205: 						if(k && choroplethValues[k] !== undefined) {
 1206: 							l.bindPopup(k + ': ' + choroplethValues[k]);
 1207: 						}
 1208: 					}
 1209: 				}).addTo(map);
 1210: 			})();
 1211: 		};
 1212: 	}
 1213: 
 1214: 	# Event handlers.
●1215 → 1221 → 1251 1215: 	$body .= qq{
 1216: 			document.getElementById('reset-button').addEventListener('click', function() {
 1217: 				map.setView([$center_lat, $center_lon], $zoom);
 1218: 			});
 1219: 	};
 1220: 
 1221: 	if($search) {
 1222: 		$body .= qq{
 1223: 			document.getElementById('clear-search-button').addEventListener('click', function() {
 1224: 				searchMarkers.forEach(function(m) { map.removeLayer(m); });
 1225: 				searchMarkers = [];
 1226: 			});
 1227: 
 1228: 			document.getElementById('search-box').addEventListener('keyup', function(event) {
 1229: 				if(event.key === 'Enter') {
 1230: 					var query = event.target.value.trim();
 1231: 					if(!query) { alert('Please enter a valid location.'); return; }
 1232: 					fetch('https://nominatim.openstreetmap.org/search?format=json&q=' + encodeURIComponent(query))
 1233: 					.then(function(r) { return r.json(); })
 1234: 					.then(function(data) {
 1235: 						if(data.length > 0) {
 1236: 							var lat = data[0].lat, lon = data[0].lon;
 1237: 							map.setView([lat, lon], 14);
 1238: 							searchMarkers.push(L.marker([lat, lon]).addTo(map).bindPopup(query).openPopup());
 1239: 						} else {
 1240: 							alert('No results found. Try a different location.');
 1241: 						}
 1242: 					})
 1243: 					.catch(function(err) {
 1244: 						console.error('Search error:', err);
 1245: 						alert('Failed to fetch location. Please check your internet connection.');
 1246: 					});
 1247: 				}
 1248: 			});
 1249: 		};
 1250: 	}
 1251: 	$body .= "\t\t</script>\n";
 1252: 
 1253: 	return ($head, $body);
 1254: }
 1255: 
 1256: # _point_args: Split a marker method's arguments into a point and options,
 1257: #          and resolve the point to coordinates.
 1258: # Purpose: add_marker and add_circle_marker take the same kinds of point.
 1259: # Entry:   $self, $caller (method name for messages), then the caller's @_.
 1260: # Exit:    ($lat, $lon, \%params) with dot-decimal, range-checked coordinates;
 1261: #          (undef, undef, \%params) when the point cannot be used.
 1262: # Side Effects: May call the geocoder; croaks on an unknown point type; _validate carps.
 1263: sub _point_args
 1264: {
●1265 → 1268 → 1287 1265: 	my ($self, $caller, @args) = @_;
 1266: 	my ($params, $point);
 1267: 
 1268: 	if(ref($args[0]) eq 'ARRAY') {
 1269: 		$point  = shift @args;
 1270: 		$params = Params::Get::get_params(undef, \@args) || {};
 1271: 		# Single-element arrayref is a wrapped address string
 1272: 		$point  = $point->[0] if scalar(@{$point}) == 1;
 1273: 	} elsif(blessed($args[0]) && $args[0]->can('latitude')) {
 1274: 		# Geo object as first positional arg: extract before Params::Get sees it,
 1275: 		# otherwise Params::Get mistakes the blessed hashref for the params hash.
 1276: 		$point  = shift @args;
 1277: 		$params = Params::Get::get_params(undef, \@args) || {};
 1278: 	} elsif(defined($args[0]) && !ref($args[0]) && scalar(@args) % 2 != 0) {
 1279: 		# Plain string as first positional arg, optionally followed by key-value pairs.
 1280: 		# An odd total count signals a leading positional; even count means all key-value.
 1281: 		$point  = shift @args;
 1282: 		$params = Params::Get::get_params(undef, \@args) || {};
 1283: 	} else {
 1284: 		$params = Params::Get::get_params('point', @args);
 1285: 		$point  = $params->{'point'};
 1286: 	}
●1287 → 1291 → 1306 1287: 	$params ||= {};
 1288: 
 1289: 	my ($lat, $lon);
 1290: 
 1291: 	if(ref($point) eq 'ARRAY') {
 1292: 		return (undef, undef, $params) if scalar(@{$point}) != 2;
 1293: 		($lat, $lon) = @{$point};
 1294: 	} elsif(!ref($point)) {
 1295: 		# An empty or missing address cannot be resolved
 1296: 		return (undef, undef, $params) unless defined($point) && length($point);
 1297: 		($lat, $lon) = $self->_fetch_coordinates($point);
 1298: 	} elsif($point->can('latitude')) {
 1299: 		($lat, $lon) = ($point->latitude(), $point->longitude());
 1300: 	} else {
 1301: 		my $msg = "$caller(): unknown point type: " . ref($point);
 1302: 		$self->{logger}->error($msg) if $self->{logger};
 1303: 		croak $msg;
 1304: 	}
 1305: 
 1306: 	return (undef, undef, $params) unless defined($lat) && defined($lon);
 1307: 
 1308: 	# Store the text form with a '.' decimal point, whatever the locale
 1309: 	($lat, $lon) = (_num_str($lat), _num_str($lon));
 1310: 	return (undef, undef, $params) unless _validate($lat, $lon);
 1311: 
 1312: 	return ($lat, $lon, $params);
 1313: }
 1314: 
 1315: # _fetch_coordinates: Resolve a place-name string to a (lat, lon) pair.
 1316: # Purpose: Centralise all geocoding logic — try the injected geocoder first,
 1317: #          fall back to a direct Nominatim HTTP call with caching and rate-limiting.
 1318: # Entry:   $self, $location (non-empty string).
 1319: # Exit:    ($lat, $lon) strings on success; (undef, undef) on failure.
 1320: # Side Effects: May sleep to honour min_interval; writes to $self->{cache}.
 1321: sub _fetch_coordinates
 1322: {
●1323 → 1328 → 1350 1323: 	my ($self, $location) = @_;
 1324: 
 1325: 	croak 'address not given to _fetch_coordinates' unless $location;
 1326: 
 1327: 	# Prefer an injected geocoder (e.g. Geo::Coder::List) to avoid HTTP.
 1328: 	if(my $geocoder = $self->{'geocoder'}) {
 1329: 		my $rc = $geocoder->geocode($location);
 1330: 		return (undef, undef) unless defined $rc;
 1331: 
 1332: 		if(blessed($rc) && $rc->can('latitude')) {
 1333: 			return ($rc->latitude(), $rc->longitude());
 1334: 		}
 1335: 		if(ref($rc) eq 'HASH') {
 1336: 			return ($rc->{lat}, $rc->{lon})
 1337: 				if defined($rc->{lat}) && defined($rc->{lon});
 1338: 			return ($rc->{geometry}{location}{lat}, $rc->{geometry}{location}{lng})
 1339: 				if defined($rc->{geometry}{location}{lat});
 1340: 		}
 1341: 		# Some geocoders return a flat [lat, lon] arrayref
 1342: 		return @{$rc} if ref($rc) eq 'ARRAY';
 1343: 
 1344: 		# Unrecognised return type — treat as failure
 1345: 		carp '_fetch_coordinates: unrecognised geocoder result type: ' . ref($rc);
 1346: 		return (undef, undef);
 1347: 	}
 1348: 
 1349: 	# Direct Nominatim path: apply caching and rate-limiting.
●1350 → 1351 → 1356 1350: 	my $cache_key = 'osm:' . uri_escape_utf8($location);
 1351: 	if(my $cached = $self->{cache}->get($cache_key)) {
 1352: 		return ($cached->{lat}, $cached->{lon});
 1353: 	}
 1354: 
 1355: 	# Honour the minimum interval between outbound requests.
●1356 → 1357 → 1362 1356: 	my $elapsed = time() - $self->{last_request};
 1357: 	if($elapsed < $self->{min_interval}) {
 1358: 		Time::HiRes::sleep($self->{min_interval} - $elapsed);
 1359: 	}
 1360: 
 1361: 	# Configure only a UA we create; a caller's UA is used as supplied
●1362 → 1363 → 1369 1362: 	my $ua = $self->{'ua'};
 1363: 	if(!$ua) {
 1364: 		$ua = LWP::UserAgent->new(agent => __PACKAGE__ . "/$VERSION");
 1365: 		$ua->default_header(accept_encoding => 'gzip,deflate');
 1366: 		$ua->env_proxy(1);
 1367: 	}
 1368: 
●1369 → 1374 → 1390 1369: 	my $url = 'https://' . $self->{'host'} . '?format=json&q=' . uri_escape_utf8($location);
 1370: 	$url .= '&email=' . uri_escape_utf8($self->{'email'}) if $self->{'email'};
 1371: 	my $response = $ua->get($url);
 1372: 	$self->{'last_request'} = time();
 1373: 
 1374: 	if($response->is_success()) {
 1375: 		# eval guard: Nominatim normally returns valid JSON, but a maintenance
 1376: 		# page or rate-limit response could return HTML with a 200 OK.  Dying
 1377: 		# inside _fetch_coordinates would bubble uncaught to add_marker / onload_render.
 1378: 		my $data = eval { decode_json($response->decoded_content()) };
 1379: 		if($@) {
 1380: 			carp "_fetch_coordinates: failed to decode Nominatim response: $@";
 1381: 			return (undef, undef);
 1382: 		}
 1383: 		$data = $data->[0] if ref($data) eq 'ARRAY';
 1384: 		if(ref($data) eq 'HASH' && defined($data->{lat})) {
 1385: 			$self->{'cache'}->set($cache_key, $data);
 1386: 			return ($data->{lat}, $data->{lon});
 1387: 		}
 1388: 	}
 1389: 
 1390: 	return (undef, undef);
 1391: }
 1392: 
 1393: # _validate: Check that a (lat, lon) pair is numeric and within WGS-84 bounds.
 1394: # Purpose: Single guard point for all coordinate ingestion; emits a carp when
 1395: #          both values are defined but wrong so the caller can log without dying.
 1396: # Entry:   ($lat, $lon) — any scalar, including undef.
 1397: # Exit:    1 if valid, 0 if not.
 1398: # Side Effects: carp when coordinates are defined but out-of-range/non-numeric.
 1399: sub _validate
 1400: {
 1401: 	my ($lat, $lon) = map { _num_str($_) } @_;
 1402: 
 1403: 	# Require at least one digit (rejects empty string — unlike \d* which matches '').
 1404: 	# Leading-decimal notation (e.g. -.5167) is valid per Changes 0.05.
 1405: 	# \z (not $) prevents a trailing \n from sneaking through: $ matches before
 1406: 	# a final newline, which would make "0\n" valid and embed a newline in JS.
 1407: 	my $numeric = qr/^-?(?:\d+(?:\.\d+)?|\.\d+)\z/;
 1408: 
 1409: 	# Range checks use _num_val, which does not depend on the locale
 1410: 	my $ok = defined($lat) && defined($lon)
 1411: 	      && $lat =~ $numeric && $lon =~ $numeric
 1412: 	      && _num_val($lat) >= $LAT_MIN && _num_val($lat) <= $LAT_MAX
 1413: 	      && _num_val($lon) >= $LON_MIN && _num_val($lon) <= $LON_MAX;
 1414: 
 1415: 	carp(sprintf 'Skipping invalid coordinate: (%s, %s)',
 1416: 	     $lat // 'undef', $lon // 'undef')
 1417: 		if !$ok && defined($lat) && defined($lon);
 1418: 
 1419: 	return $ok ? 1 : 0;
 1420: }
 1421: 
 1422: # _html_json: Encode data as JSON and make the result safe for embedding in a
 1423: # <script> block.  JSON encoders do not escape '/' by default, so a value like
 1424: # '</script>' would close the enclosing script tag and allow HTML injection.
 1425: # Escaping every '</' as '<\/' prevents this without altering the decoded value.
 1426: # Encoding runs under the C numeric locale: some encoders print numbers through
 1427: # the C library or Perl's own stringification, and under a locale such as
 1428: # de_DE 0.5 could come out as 0,5, which JSON reads as two numbers.
 1429: # Entry:   Any Perl data structure accepted by encode_json.
 1430: # Exit:    JSON string safe for direct insertion inside a <script> block.
 1431: # Side Effects: LC_NUMERIC is switched to 'C' for the encode and then restored.
 1432: sub _html_json
 1433: {
 1434: 	my $data = shift;
 1435: 
 1436: 	my $saved_error  = $@;
 1437: 	my $saved_locale = setlocale(LC_NUMERIC);
 1438: 	setlocale(LC_NUMERIC, 'C');
 1439: 	my $j   = eval { encode_json($data) };
 1440: 	my $err = $@;
 1441: 	setlocale(LC_NUMERIC, $saved_locale) if defined($saved_locale);
 1442: 	die $err unless defined($j);
 1443: 	$@ = $saved_error;
 1444: 
 1445: 	$j =~ s|</|<\\/|g;
 1446: 	return $j;
 1447: }
 1448: 
 1449: # _js_string: Escape a Perl string for safe embedding in a JS single-quoted literal.
 1450: # Purpose: Prevent JS injection via user-supplied labels, URLs, or property names.
 1451: # Entry:   Any scalar (undef becomes '').
 1452: # Exit:    Escaped string safe for insertion between JS single quotes.
 1453: sub _js_string
 1454: {
 1455: 	my $s = shift // '';
 1456: 	$s =~ s/\\/\\\\/g;    # escape backslash first to avoid double-escaping
 1457: 	$s =~ s/'/\\'/g;      # escape our JS string delimiter
 1458: 	$s =~ s/\r?\n/\\n/g;  # newlines would break the JS string
 1459: 	$s =~ s/\r/\\r/g;     # a lone carriage return also ends a JS string
 1460: 	$s =~ s|</|<\\/|g;    # prevent </script> injection
 1461: 	return $s;
 1462: }
 1463: 
 1464: # _html_attr: Escape a Perl string for safe embedding in a double-quoted HTML attribute.
 1465: # Purpose: Stop a configured CDN URL from closing the attribute or the tag.
 1466: # Entry:   Any scalar (undef becomes '').
 1467: # Exit:    String with &, <, > and " replaced by entities.
 1468: sub _html_attr
 1469: {
 1470: 	my $s = shift // '';
 1471: 	$s =~ s/&/&amp;/g;    # escape ampersand first to avoid double-escaping
 1472: 	$s =~ s/</&lt;/g;
 1473: 	$s =~ s/>/&gt;/g;
 1474: 	$s =~ s/"/&quot;/g;
 1475: 	return $s;
 1476: }
 1477: 
 1478: # _css_length: Check a width or height before it is put into the <style> block.
 1479: # Purpose: Values from a config file or a clone skip new()'s schema, so a value
 1480: #          such as '1px}</style><script>' could otherwise reach the page.
 1481: # Entry:   ($name, $value, $default) - name is used only in the warning.
 1482: # Exit:    $value when it is a CSS length; otherwise $default.
 1483: # Side Effects: carp when a non-empty value is replaced.
 1484: sub _css_length
 1485: {
 1486: 	my ($name, $value, $default) = @_;
 1487: 
 1488: 	return $default unless defined($value) && length($value);
 1489: 	return $value if $value =~ $CSS_LENGTH;
 1490: 
 1491: 	carp "onload_render: invalid $name '$value', using $default";
 1492: 	return $default;
 1493: }
 1494: 
 1495: # _positive_number: Return $value as text when it is a positive number.
 1496: # Purpose: Heatmap options go straight into the JavaScript, so anything that
 1497: #          is not a plain number must not reach it.  The check works on the
 1498: #          text form so it does not depend on the locale (see _num_val).
 1499: # Entry:   ($value, $default).
 1500: # Exit:    $value as a dot-decimal string, or $default when $value is missing,
 1501: #          not a plain decimal number, <= 0 or >= 1e6.
 1502: sub _positive_number
 1503: {
 1504: 	my ($value, $default) = @_;
 1505: 
 1506: 	return $default unless defined($value) && !ref($value);
 1507: 
 1508: 	my $str = _num_str($value);
 1509: 	$str =~ s/\A\s+|\s+\z//g;
 1510: 	# Plain decimals only: rejects signs, exponents, 'Inf' and 'NaN'
 1511: 	return $default unless $str =~ /\A(?:[0-9]+(?:\.[0-9]+)?|\.[0-9]+)\z/;
 1512: 
 1513: 	my $number = _num_val($str);
 1514: 	return $default unless $number > 0 && $number < 1e6;
 1515: 	return _num_str($number);
 1516: }
 1517: 
 1518: # _num_str: Return a number as text with '.' as the decimal point.
 1519: # Purpose: Perl should print numbers with a '.' whatever the locale, but some
 1520: #          builds (seen with Perl 5.38.0 on macOS) use the LC_NUMERIC decimal
 1521: #          point, so 51.5074 prints as '51,5074' under de_DE.  That fails
 1522: #          _validate, and in JavaScript '[51,5074, -0,1278]' is four numbers.
 1523: # Entry:   Any scalar.
 1524: # Exit:    A value Perl holds as a number comes back as text with a '.'
 1525: #          decimal point; anything else (strings, undef, refs) is unchanged.
 1526: sub _num_str
 1527: {
 1528: 	my $value = shift;
 1529: 
 1530: 	return $value if !defined($value) || ref($value);
 1531: 
 1532: 	# Only a value Perl holds as a number can have been printed with a locale
 1533: 	# decimal point; a string such as '51,5' never gets these flags.
 1534: 	my $flags = B::svref_2object(\$value)->FLAGS;
 1535: 	return $value unless $flags & (B::SVf_IOK() | B::SVf_NOK());
 1536: 
 1537: 	my $str   = "$value";
 1538: 	my $radix = (localeconv() || {})->{decimal_point};
 1539: 	$str =~ s/\Q$radix\E/./ if defined($radix) && length($radix) && $radix ne '.';
 1540: 	$str =~ tr/,/./;    # Perl never groups digits, so a comma can only be a decimal point
 1541: 	return $str;
 1542: }
 1543: 
 1544: # _num_val: Convert a decimal string such as '-0.1278' to a number.
 1545: # Purpose: The perls that print numbers with the locale's decimal point also
 1546: #          read them that way, so under de_DE '51.5074' + 0 is 51.  Building
 1547: #          the value from its whole and fractional digit strings uses only
 1548: #          integer conversion, which no locale affects.
 1549: # Entry:   A number, or a string in the form _validate accepts.
 1550: # Exit:    The numeric value.  Anything else falls back to Perl's own conversion.
 1551: sub _num_val
 1552: {
●1553 → 1556 → 1561 1553: 	my $str = _num_str(shift);
 1554: 
 1555: 	my ($sign, $whole, $frac) = $str =~ /\A(-?)([0-9]*)(?:\.([0-9]+))?\z/;
 1556: 	if(!defined($sign) || (!length($whole) && !defined($frac))) {
 1557: 		no warnings 'numeric';
 1558: 		return 0 + $str;
 1559: 	}
 1560: 
 1561: 	my $value = length($whole) ? 0 + $whole : 0;
 1562: 	$value += $frac / (10 ** length($frac)) if defined($frac);
 1563: 	return $sign ? -$value : $value;
 1564: }
 1565: 
 1566: =head1 LIMITATIONS
 1567: 
 1568: =over 4
 1569: 
 1570: =item * B<Per-marker removal>: Markers added via C<add_marker()> cannot yet be
 1571: removed individually by clicking them.  The "Clear search markers" button only
 1572: removes markers added by the in-page Nominatim search box.
 1573: 
 1574: =item * B<Clone validation>: The clone path (C<< $obj->new(%overrides) >>)
 1575: bypasses the Params::Validate::Strict schema so subclasses and internal callers
 1576: can merge arbitrary state.  Callers are responsible for passing valid overrides.
 1577: 
 1578: =item * B<Config-file params unvalidated>: Keys injected by
 1579: L<Object::Configure> from a config file are not re-run through the schema, so
 1580: a malformed config file can introduce invalid types at runtime.
 1581: C<onload_render()> checks C<zoom>, C<max_zoom>, C<width> and C<height> again and
 1582: HTML-escapes the CDN URLs, so a bad value cannot inject markup into the page.
 1583: 
 1584: =item * B<One map per page>: The rendered HTML uses fixed element IDs
 1585: (C<map>, C<search-box>, C<clear-search-button> and C<reset-button>), so two
 1586: maps on the same page will clash.
 1587: 
 1588: =item * B<Clustered circle markers>: With C<< cluster => 1 >>, circle markers
 1589: are grouped with the pin markers, so at low zoom levels a cluster count is
 1590: shown in place of the circles' sizes.  Leave C<cluster> off for a bubble map
 1591: whose sizes should always be visible.
 1592: 
 1593: =item * B<Private-method encapsulation>: C<_fetch_coordinates>, C<_validate>,
 1594: and C<_js_string> are named with a leading underscore by convention only.
 1595: Using L<Sub::Private> in C<enforce> mode would make the contract explicit, but
 1596: that module is not yet listed as a dependency to avoid breaking white-box tests
 1597: in C<t/mock.t>.
 1598: 
 1599: =item * B<Routing>: Turn-by-turn routing (Leaflet Routing Machine / OSRM) is
 1600: explicitly out of scope for this module and will not be added here.
 1601: 
 1602: =back
 1603: 
 1604: =head1 AUTHOR
 1605: 
 1606: Nigel Horne, C<< <njh at nigelhorne.com> >>
 1607: 
 1608: =head1 BUGS
 1609: 
 1610: Please report bugs at L<https://github.com/nigelhorne/HTML-OSM/issues>.
 1611: 
 1612: =head1 SEE ALSO
 1613: 
 1614: =over 4
 1615: 
 1616: =item * L<https://wiki.openstreetmap.org/wiki/API>
 1617: 
 1618: =item * L<HTML::GoogleMaps::V3> - the interface this module mirrors for compatibility.
 1619: 
 1620: =item * L<https://leafletjs.com/>
 1621: 
 1622: =item * L<Configure an Object at Runtime|Object::Configure>
 1623: 
 1624: =item * L<Test Dashboard|https://nigelhorne.github.io/HTML-OSM/coverage/>
 1625: 
 1626: =back
 1627: 
 1628: =head1 SUPPORT
 1629: 
 1630: This module is provided as-is without any warranty.
 1631: 
 1632: Please report problems and ask questions at
 1633: L<https://github.com/nigelhorne/HTML-OSM/issues>.
 1634: 
 1635: You can find documentation for this module with the perldoc command.
 1636: 
 1637:     perldoc HTML::OSM
 1638: 
 1639: You can also look for information at MetaCPAN:
 1640: L<https://metacpan.org/dist/HTML-OSM>.
 1641: 
 1642: =head2 TODO
 1643: 
 1644: Allow per-marker removal via clicking on a marker.
 1645: 
 1646: =encoding utf-8
 1647: 
 1648: =head1 FORMAL SPECIFICATION
 1649: 
 1650: =head2 new
 1651: 
 1652:   HTML_OSM
 1653:     coordinates     : iseq (ℝ x ℝ x S x S)
 1654:     zoom            : Z
 1655:     cluster         : B
 1656:   ----------------------------------------
 1657:     ZOOM_MIN <= zoom <= ZOOM_MAX
 1658: 
 1659:   new ≙
 1660:     params? : Params
 1661:     osm!    : HTML_OSM
 1662:   ----------------------------------------
 1663:     osm!.zoom     = params?.zoom     ∨ 12
 1664:     osm!.cluster  = params?.cluster  ∨ false
 1665: 
 1666: =head2 add_marker
 1667: 
 1668:   AddMarker
 1669:     ΔHTML_OSM
 1670:     point? : (ℝ x ℝ) ∪ S ∪ GeoObject
 1671:     result! : {0, 1}
 1672:   -----------------------------------------
 1673:     result! = 1 ⟺ point? resolves to (lat, lon) ∈ ValidCoord
 1674:     result! = 1 ⟹ coordinates' = coordinates ⌢ ⟨(lat, lon, label, icon)⟩
 1675: 
 1676: =head2 add_geojson
 1677: 
 1678:   AddGeoJSON
 1679:     ΔHTML_OSM
 1680:     data?  : GeoJSONStruct ∪ S
 1681:     style? : StyleMap ∪ {∅}
 1682:     popup? : S ∪ {∅}
 1683:   -----------------------------------------
 1684:     geojson' = geojson ⌢ ⟨{data, style, popup}⟩
 1685: 
 1686: =head2 add_heatmap
 1687: 
 1688:   AddHeatmap
 1689:     ΔHTML_OSM
 1690:     points? : iseq (ℝ x ℝ x [0,1])
 1691:   -----------------------------------------
 1692:     heatmap_layers' = heatmap_layers ⌢ ⟨{points, radius, blur}⟩
 1693: 
 1694: =head2 add_gpx
 1695: 
 1696:   AddGPX
 1697:     ΔHTML_OSM
 1698:     url? : S | url? ≠ ''
 1699:   -----------------------------------------
 1700:     gpx_tracks' = gpx_tracks ⌢ ⟨url?⟩
 1701: 
 1702: =head2 add_choropleth
 1703: 
 1704:   AddChoropleth
 1705:     ΔHTML_OSM
 1706:     features? : iseq GeoFeature
 1707:     values?   : S --> ℝ
 1708:     key?      : S
 1709:     scale?    : iseq S
 1710:   -----------------------------------------
 1711:     Let min = min(ran values?), max = max(ran values?) ∪ {min+1}
 1712:     ∀ k ∈ dom values? •
 1713:       color(k) = scale?[floor((values?(k)-min)/(max-min) * (#scale?-1))]
 1714:     choropleth_layers' = choropleth_layers ⌢ ⟨{features, values, colors, key}⟩
 1715: 
 1716: =head2 center
 1717: 
 1718:   Center
 1719:     ΔHTML_OSM
 1720:     point? : (ℝ x ℝ) ∪ S ∪ GeoObject
 1721:     result! : {0, 1}
 1722:   -----------------------------------------
 1723:     result! = 1 ⟺ point? resolves to (lat, lon) ∈ ValidCoord
 1724:     result! = 1 ⟹ center' = (lat, lon)
 1725: 
 1726: =head2 zoom
 1727: 
 1728:   Zoom
 1729:     ΔHTML_OSM
 1730:     zoom? : Z ∪ {∅}
 1731:     zoom! : Z
 1732:   -----------------------------------------
 1733:     zoom? ≠ ∅ ⟹ ZOOM_MIN <= zoom? <= ZOOM_MAX
 1734:     zoom! = (zoom? ≠ ∅ ∧ zoom' = zoom?) ∨ zoom
 1735: 
 1736: =head2 onload_render
 1737: 
 1738:   OnloadRender
 1739:     HTML_OSM
 1740:     head! : S
 1741:     body! : S
 1742:   -----------------------------------------
 1743:     (#coordinates + #geojson + #heatmap_layers + #gpx_tracks + #choropleth_layers) > 0
 1744:     center ≠ ∅  ∨  ∃ valid ∈ coordinates • valid ∈ ValidCoord
 1745: 
 1746: =head1 LICENSE AND COPYRIGHT
 1747: 
 1748: Copyright 2025-2026 Nigel Horne.
 1749: 
 1750: This program is released under the following licence: GPL2
 1751: If you use it,
 1752: please let me know.
 1753: 
 1754: =cut
 1755: 
 1756: 1;
 1757: 
 1758: __END__