diff options
author | Norbert Preining <norbert@preining.info> | 2024-03-15 03:06:35 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2024-03-15 03:06:35 +0000 |
commit | 12679ab7d3c2a210f4123163671b532b8b55d5f9 (patch) | |
tree | 0060d13467186ad977f4e73488ee20dd6c0017ab /systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm | |
parent | 62170822e034fdd3f81de7274835d0d3b0467100 (diff) |
CTAN sync 202403150306
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm | 99 |
1 files changed, 92 insertions, 7 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm index b9b70c491d..f39f35749e 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm @@ -6,7 +6,7 @@ use warnings; use URI (); use URI::Escape qw(uri_unescape); -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub query { @@ -51,10 +51,14 @@ sub query_form { $key =~ s/ /+/g; $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals]; for my $val (@$vals) { - $val = '' unless defined $val; - $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; - $val =~ s/ /+/g; - push(@query, "$key=$val"); + if (defined $val) { + $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; + $val =~ s/ /+/g; + push(@query, "$key=$val"); + } + else { + push(@query, $key); + } } } if (@query) { @@ -70,8 +74,8 @@ sub query_form { } return if !defined($old) || !length($old) || !defined(wantarray); return unless $old =~ /=/; # not a form - map { s/\+/ /g; uri_unescape($_) } - map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old); + map { ( defined ) ? do { s/\+/ /g; uri_unescape($_) } : undef } + map { /=/ ? split(/=/, $_, 2) : ($_ => undef)} split(/[&;]/, $old); } # Handle ...?dog+bones type of query @@ -94,4 +98,85 @@ sub query_keywords # Some URI::URL compatibility stuff sub equery { goto &query } +sub query_param { + my $self = shift; + my @old = $self->query_form; + + if (@_ == 0) { + # get keys + my (%seen, $i); + return grep !($i++ % 2 || $seen{$_}++), @old; + } + + my $key = shift; + my @i = grep $_ % 2 == 0 && $old[$_] eq $key, 0 .. $#old; + + if (@_) { + my @new = @old; + my @new_i = @i; + my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_; + + while (@new_i > @vals) { + splice @new, pop @new_i, 2; + } + if (@vals > @new_i) { + my $i = @new_i ? $new_i[-1] + 2 : @new; + my @splice = splice @vals, @new_i, @vals - @new_i; + + splice @new, $i, 0, map { $key => $_ } @splice; + } + if (@vals) { + #print "SET $new_i[0]\n"; + @new[ map $_ + 1, @new_i ] = @vals; + } + + $self->query_form(\@new); + } + + return wantarray ? @old[map $_+1, @i] : @i ? $old[$i[0]+1] : undef; +} + +sub query_param_append { + my $self = shift; + my $key = shift; + my @vals = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_; + $self->query_form($self->query_form, $key => \@vals); # XXX + return; +} + +sub query_param_delete { + my $self = shift; + my $key = shift; + my @old = $self->query_form; + my @vals; + + for (my $i = @old - 2; $i >= 0; $i -= 2) { + next if $old[$i] ne $key; + push(@vals, (splice(@old, $i, 2))[1]); + } + $self->query_form(\@old) if @vals; + return wantarray ? reverse @vals : $vals[-1]; +} + +sub query_form_hash { + my $self = shift; + my @old = $self->query_form; + if (@_) { + $self->query_form(@_ == 1 ? %{shift(@_)} : @_); + } + my %hash; + while (my($k, $v) = splice(@old, 0, 2)) { + if (exists $hash{$k}) { + for ($hash{$k}) { + $_ = [$_] unless ref($_) eq "ARRAY"; + push(@$_, $v); + } + } + else { + $hash{$k} = $v; + } + } + return \%hash; +} + 1; |