File Coverage

lib/BarefootJS/SearchParams.pm
Criterion Covered Total %
statement 46 46 100.0
branch 4 6 66.6
condition 5 7 71.4
subroutine 8 8 100.0
pod 0 2 0.0
total 63 69 91.3


line stmt bran cond sub pod time code
1             package BarefootJS::SearchParams;
2             our $VERSION = "0.14.0";
3 1     1   9 use strict;
  1         3  
  1         47  
4 1     1   6 use warnings;
  1         8  
  1         87  
5 1     1   8 use utf8;
  1         2  
  1         7  
6 1     1   48 use feature 'signatures';
  1         2  
  1         193  
7 1     1   7 no warnings 'experimental::signatures';
  1         2  
  1         726  
8              
9             # Request-scoped SSR view of the query string behind the reactive
10             # `searchParams()` environment signal (router v0.5, #1922). The framework
11             # integration builds one per request from the request URL and threads it into
12             # the template scope as `$searchParams` (the camelCase JS name the adapters
13             # keep, like every other signal/prop var); the compiled template reads it via
14             # `$searchParams->get('key')` (Mojo) / `$searchParams.get('key')` (Xslate).
15             #
16             # This runtime is template-engine- and framework-agnostic (core Perl only),
17             # matching the rest of BarefootJS.pm, so it can ship in the standalone
18             # @barefootjs/perl distribution.
19             #
20             # Semantics mirror the browser's URLSearchParams.get exactly under the
21             # adapters' `?? → //` lowering: get() returns the first value for a key, or
22             # `undef` when the key is absent. Perl's `//` (defined-or) coalesces only
23             # `undef`, so an absent key falls back to the author's default while a
24             # present-but-empty value (`?sort=`) keeps the empty string — the same
25             # distinction JS `??` draws between `null` and `''`. (This is a closer match
26             # than the Go adapter, whose `or` lowering also coalesces the empty string.)
27              
28             # new($class, $query = '')
29             #
30             # Parse a raw query string into the reader. A leading '?' is tolerated, '+'
31             # decodes to a space, and %XX escapes are decoded — mirroring URLSearchParams's
32             # application/x-www-form-urlencoded parsing. A malformed pair never dies; it
33             # simply contributes nothing, matching the browser's lenient parsing.
34 8     8 0 16 sub new ($class, $query = '') {
  8         15  
  8         14  
  8         15  
35 8   100     29 $query //= '';
36 8         43 $query =~ s/\A\?//;
37 8         14 my %values;
38 8         44 for my $pair (split /[&;]/, $query) {
39 5 50       16 next if $pair eq '';
40 5         22 my ($key, $val) = split /=/, $pair, 2;
41 5         16 $key = _decode($key);
42 5 50       21 $val = defined $val ? _decode($val) : '';
43 5         9 push @{ $values{$key} }, $val;
  5         29  
44             }
45 8         61 return bless { values => \%values }, $class;
46             }
47              
48             # get($self, $key)
49             #
50             # First value for $key, or `undef` when the key is absent (see the package
51             # docstring for why `undef` — not '' — is the right "missing" sentinel under
52             # the `//` lowering). A present-but-empty value returns ''.
53 6     6 0 920 sub get ($self, $key) {
  6         11  
  6         12  
  6         11  
54 6         21 my $vals = $self->{values}{$key};
55 6 100 66     35 return undef unless $vals && @$vals;
56 3         18 return $vals->[0];
57             }
58              
59 10     10   17 sub _decode ($s) {
  10         18  
  10         16  
60 10   50     26 $s //= '';
61 10         22 $s =~ tr/+/ /;
62             # %XX → raw octet, then interpret the octet stream as UTF-8 (what
63             # URLSearchParams does). `utf8::decode` is a core builtin — no CPAN URI /
64             # URI::Escape dependency, keeping this runtime core-Perl-only. A byte run
65             # that isn't valid UTF-8 is left as-is rather than dying (lenient parsing).
66 10         28 $s =~ s/%([0-9A-Fa-f]{2})/chr hex $1/ge;
  3         15  
67 10         35 utf8::decode($s);
68 10         24 return $s;
69             }
70              
71             1;