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   5 use strict;
  1         2  
  1         30  
4 1     1   3 use warnings;
  1         2  
  1         43  
5 1     1   4 use utf8;
  1         1  
  1         5  
6 1     1   28 use feature 'signatures';
  1         1  
  1         130  
7 1     1   4 no warnings 'experimental::signatures';
  1         1  
  1         446  
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 12 sub new ($class, $query = '') {
  8         12  
  8         13  
  8         7  
35 8   100     23 $query //= '';
36 8         18 $query =~ s/\A\?//;
37 8         9 my %values;
38 8         32 for my $pair (split /[&;]/, $query) {
39 5 50       13 next if $pair eq '';
40 5         15 my ($key, $val) = split /=/, $pair, 2;
41 5         11 $key = _decode($key);
42 5 50       14 $val = defined $val ? _decode($val) : '';
43 5         8 push @{ $values{$key} }, $val;
  5         21  
44             }
45 8         40 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 519 sub get ($self, $key) {
  6         7  
  6         9  
  6         8  
54 6         12 my $vals = $self->{values}{$key};
55 6 100 66     23 return undef unless $vals && @$vals;
56 3         12 return $vals->[0];
57             }
58              
59 10     10   14 sub _decode ($s) {
  10         13  
  10         12  
60 10   50     17 $s //= '';
61 10         16 $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         21 $s =~ s/%([0-9A-Fa-f]{2})/chr hex $1/ge;
  3         16  
67 10         25 utf8::decode($s);
68 10         18 return $s;
69             }
70              
71             1;