HTML-OSM
view release on metacpan or search on metacpan
t/integration.t view on Meta::CPAN
my $with_zoom = HTML::OSM->new(config_file => $path, zoom => 14);
is($from_cfg->zoom(), 7, 'config file zoom overrides programmatic default (12)');
is($with_zoom->zoom(), 7, 'config file zoom wins over constructor param');
};
subtest 'config file: YAML css_url appears in rendered head' => sub {
my ($fh, $path) = tempfile(SUFFIX => '.yml', UNLINK => 1);
print $fh "---\ncss_url: https://mycdn.example.com/leaflet.css\n";
close $fh;
my $m = HTML::OSM->new(config_file => $path);
$m->add_marker([$C{LAT_LONDON}, $C{LON_LONDON}]);
my ($head) = $m->onload_render();
like($head, qr{mycdn\.example\.com/leaflet\.css}, 'config css_url in head');
};
# ─────────────────────────────────────────────────────────────────────────────
# Integration 7: Multi-step state transitions
# State accumulated across many method calls must be coherent at render time.
# ─────────────────────────────────────────────────────────────────────────────
subtest 'state: final zoom after multiple setter calls' => sub {
my $m = HTML::OSM->new();
$m->zoom(3);
$m->zoom(8);
$m->zoom(16);
$m->add_marker([$C{LAT_LONDON}, $C{LON_LONDON}]);
my (undef, $body) = $m->onload_render();
like($body, qr/setView\([^)]+,\s*16\)/, 'final zoom 16 in setView');
unlike($body, qr/setView\([^)]+,\s*3\)/, 'initial zoom 3 not present');
};
subtest 'state: second center() call wins over first' => sub {
my $m = HTML::OSM->new();
$m->center([$C{LAT_LONDON}, $C{LON_LONDON}]);
$m->center([$C{LAT_NYC}, $C{LON_NYC}]);
$m->add_geojson({ type => 'FeatureCollection', features => [] });
my (undef, $body) = $m->onload_render();
like($body, qr/setView\(\[$C{LAT_NYC}/, 'second center used');
unlike($body, qr/setView\(\[$C{LAT_LONDON}/, 'first center discarded');
};
subtest 'state: sequential add_* calls all visible in single render' => sub {
my $m = HTML::OSM->new();
$m->add_marker([$C{LAT_LONDON}, $C{LON_LONDON}], html => 'L1');
$m->add_geojson({ type => 'FeatureCollection', features => [] },
style => { color => '#aabbcc' });
$m->add_heatmap([[$C{LAT_PARIS}, $C{LON_PARIS}]], radius => 30);
my (undef, $body) = $m->onload_render();
like($body, qr/L1/, 'marker label present');
like($body, qr/#aabbcc/, 'GeoJSON colour present');
like($body, qr/radius:\s*30/, 'heatmap custom radius present');
};
# ─────────────────────────────────────────────────────────────────────────────
# Integration 8: JS escaping pipeline — end-to-end injection attack vectors
# Every user-supplied string that reaches the rendered JS must be escaped.
# ─────────────────────────────────────────────────────────────────────────────
subtest 'XSS: </script> injection in popup label neutralised' => sub {
my $m = HTML::OSM->new();
$m->add_marker([$C{LAT_LONDON}, $C{LON_LONDON}],
html => '</script><script>alert(1)</script>');
my (undef, $body) = $m->onload_render();
unlike($body, qr|</script><script>|, 'raw </script> absent');
like($body, qr|<\\/script>|, 'escaped form present');
};
subtest 'XSS: backslash + single-quote combo fully escaped in popup' => sub {
# Input: C:\path\' — backslash then quote
my $m = HTML::OSM->new();
$m->add_marker([$C{LAT_LONDON}, $C{LON_LONDON}], html => "C:\\path\\'s");
my (undef, $body) = $m->onload_render();
like($body, qr/C:\\\\path/, 'backslash doubled');
};
subtest 'XSS: newline in popup label converted to literal \\n in JS' => sub {
my $m = HTML::OSM->new();
$m->add_marker([$C{LAT_LONDON}, $C{LON_LONDON}], html => "Line1\nLine2");
my (undef, $body) = $m->onload_render();
unlike($body, qr/Line1\nLine2/, 'raw newline absent');
like($body, qr/Line1\\nLine2/, 'escaped \\n present');
};
subtest 'XSS: GPX URL with single quote JS-escaped end-to-end' => sub {
my $m = HTML::OSM->new();
$m->add_marker([$C{LAT_LONDON}, $C{LON_LONDON}]);
$m->add_gpx("https://example.com/user's%20track.gpx");
my (undef, $body) = $m->onload_render();
unlike($body, qr|user's%20track|, 'raw single quote absent from GPX URL');
like($body, qr|user\\'s%20track|, 'escaped quote present');
};
# ─────────────────────────────────────────────────────────────────────────────
# Integration 9: Center computation strategies
# POD pseudocode step 3: caller-supplied center > midpoint of marker bounds.
# ─────────────────────────────────────────────────────────────────────────────
subtest 'center strategy: single marker is its own center' => sub {
my $m = HTML::OSM->new();
$m->add_marker([$C{LAT_LONDON}, $C{LON_LONDON}]);
my (undef, $body) = $m->onload_render();
like($body, qr/setView\(\[$C{LAT_LONDON}/, 'single-marker center is the marker itself');
};
subtest 'center strategy: four markers — midpoint computed correctly' => sub {
# min_lat=10 max_lat=20 → 15; min_lon=30 max_lon=50 → 40.
my $m = HTML::OSM->new();
$m->add_marker([10, 30]);
$m->add_marker([10, 50]);
$m->add_marker([20, 30]);
$m->add_marker([20, 50]);
my (undef, $body) = $m->onload_render();
like($body, qr/setView\(\[15, 40\]/, 'midpoint (15, 40) used');
};
subtest 'center strategy: explicit center beats midpoint' => sub {
my $m = HTML::OSM->new();
$m->add_marker([10, 10]);
$m->add_marker([-10, -10]); # midpoint would be (0, 0)
$m->center([$C{LAT_NYC}, $C{LON_NYC}]);
my (undef, $body) = $m->onload_render();
like($body, qr/setView\(\[$C{LAT_NYC}/, 'explicit center wins');
unlike($body, qr/setView\(\[0, 0\]/, 'midpoint (0,0) NOT used');
};
subtest 'center strategy: no markers + no explicit center → croak' => sub {
my $m = HTML::OSM->new();
$m->add_geojson({ type => 'FeatureCollection', features => [] });
throws_ok { $m->onload_render() }
qr/center\(\) must be called when no point markers are provided/,
'croak when center cannot be determined';
};
# ─────────────────────────────────────────────────────────────────────────────
# Integration 10: Clustering pipeline
# cluster => 1 must wrap every marker in L.markerClusterGroup.
# ─────────────────────────────────────────────────────────────────────────────
subtest 'clustering: three markers wrapped in one clusterGroup' => sub {
my $m = HTML::OSM->new(cluster => 1);
$m->add_marker([$C{LAT_LONDON}, $C{LON_LONDON}], html => 'London');
$m->add_marker([$C{LAT_PARIS}, $C{LON_PARIS}], html => 'Paris');
$m->add_marker([$C{LAT_NYC}, $C{LON_NYC}], html => 'NYC');
my ($head, $body) = $m->onload_render();
like($head, qr/markercluster.*\.js/i, 'cluster JS in head');
like($head, qr/MarkerCluster\.css/, 'cluster CSS in head');
like($head, qr/MarkerCluster\.Default\.css/, 'cluster default CSS in head');
my @adds = ($body =~ /clusterGroup\.addLayer/g);
is(scalar @adds, 3, 'three addLayer calls for three markers');
like($body, qr/map\.addLayer\(clusterGroup\)/, 'clusterGroup added to map');
# No individual addTo(map) for static numeric-coord markers when clustering is active.
# The search-handler template also emits L.marker([lat,lon]).addTo(map) with JS
# variable names; restrict the match to numeric literals to avoid false positives.
unlike($body, qr/L\.marker\(\[-?\d[^;]*addTo\(map\)/, 'no direct addTo(map) for individual markers');
};
subtest 'clustering: icon marker uses clusterGroup.addLayer in IIFE' => sub {
my $m = HTML::OSM->new(cluster => 1);
$m->add_marker([$C{LAT_LONDON}, $C{LON_LONDON}],
html => 'London', icon => 'https://ex.com/pin.png');
my (undef, $body) = $m->onload_render();
like($body, qr/L\.icon/, 'L.icon call present');
like($body, qr/clusterGroup\.addLayer\(m\)/, 'icon marker via clusterGroup');
};
# ─────────────────────────────────────────────────────────────────────────────
# Integration 11: Choropleth full pipeline
# Verify that colours computed in Perl land in the rendered JS lookup object.
# ─────────────────────────────────────────────────────────────────────────────
subtest 'choropleth: five-feature graduated scale ends up in rendered body' => sub {
my @feats = map {
{ type => 'Feature', properties => { name => "R$_" },
geometry => { type => 'Point', coordinates => [0,0] } }
} 1..5;
my $m = HTML::OSM->new();
$m->center([$C{LAT_LONDON}, $C{LON_LONDON}]);
$m->add_choropleth(\@feats,
{ R1 => 10, R2 => 20, R3 => 30, R4 => 40, R5 => 50 },
scale => ['#col0', '#col1', '#col2', '#col3', '#col4'],
);
my (undef, $body) = $m->onload_render();
like($body, qr/#col0/, 'low-end colour in body');
like($body, qr/#col4/, 'high-end colour in body');
like($body, qr/fillColor/, 'fillColor property emitted');
like($body, qr/choroplethValues/, 'value lookup emitted');
};
subtest 'choropleth: popup template binds key and value' => sub {
my $m = HTML::OSM->new();
$m->center([$C{LAT_LONDON}, $C{LON_LONDON}]);
$m->add_choropleth(\@FEATURES, { England => 100, Scotland => 50 });
my (undef, $body) = $m->onload_render();
# Emitted JS: k + ': ' + choroplethValues[k]
like($body, qr/choroplethValues\[k\]/, 'value lookup present in popup template');
};
subtest 'choropleth: multiple layers all rendered in body' => sub {
my $m = HTML::OSM->new();
$m->center([$C{LAT_LONDON}, $C{LON_LONDON}]);
$m->add_choropleth(\@FEATURES, { England => 100 });
$m->add_choropleth(\@FEATURES, { England => 200 });
my (undef, $body) = $m->onload_render();
my @decls = ($body =~ /var choroplethColors/g);
is(scalar @decls, 2, 'two choroplethColors declarations emitted');
};
# ─────────────────────────────────────────────────────────────────────────────
# Integration 12: Rate-limiting interaction
# min_interval > 0 must cause Time::HiRes::sleep when a request follows too
# soon after the previous one. We spy on sleep without real sleeping.
# ─────────────────────────────────────────────────────────────────────────────
subtest 'rate limiting: sleep called when elapsed < min_interval' => sub {
my $sleep_calls = 0;
my $slept_for = 0;
# Spy on sleep so no real wall time is consumed.
mock 'Time::HiRes::sleep' => sub { $sleep_calls++; $slept_for = $_[0] };
# Fix time() inside HTML::OSM to a constant so elapsed = 0.
mock 'HTML::OSM::time' => sub { 1_000_000 };
my $json = '[{"lat":"51.5","lon":"-0.1"}]';
my $resp = bless {}, 'RLResp';
mock 'RLResp::is_success' => sub { 1 };
mock 'RLResp::decoded_content' => sub { $json };
my $ua = bless {}, 'RLUA';
mock 'RLUA::default_header' => sub { };
mock 'RLUA::env_proxy' => sub { };
mock 'RLUA::get' => sub { $resp };
my $m = HTML::OSM->new(min_interval => $C{MIN_INTERVAL}, ua => $ua);
# Simulate: a request was made "just now" so elapsed = 0 < 2.
$m->{last_request} = 1_000_000;
$m->add_marker('London');
ok($sleep_calls > 0, 'sleep was called');
cmp_ok($slept_for, '>', 0, 'slept for positive duration');
cmp_ok($slept_for, '<=', $C{MIN_INTERVAL}, 'slept at most min_interval');
diag("sleep_calls=$sleep_calls slept_for=$slept_for") if $ENV{TEST_VERBOSE};
};
subtest 'rate limiting: no sleep when min_interval is 0' => sub {
my $sleep_calls = 0;
mock 'Time::HiRes::sleep' => sub { $sleep_calls++ };
my $json = '[{"lat":"51.5","lon":"-0.1"}]';
my $resp = bless {}, 'RL0Resp';
mock 'RL0Resp::is_success' => sub { 1 };
mock 'RL0Resp::decoded_content' => sub { $json };
my $ua = bless {}, 'RL0UA';
mock 'RL0UA::default_header' => sub { };
( run in 1.381 second using v1.01-cache-2.11-cpan-364913b4093 )