"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/site/lib/URI/QueryParam.pm" (10 Mar 2019, 4861 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package URI::QueryParam;
    2 
    3 use strict;
    4 use warnings;
    5 
    6 our $VERSION = '1.76';
    7 
    8 sub URI::_query::query_param {
    9     my $self = shift;
   10     my @old = $self->query_form;
   11 
   12     if (@_ == 0) {
   13     # get keys
   14     my (%seen, $i);
   15     return grep !($i++ % 2 || $seen{$_}++), @old;
   16     }
   17 
   18     my $key = shift;
   19     my @i = grep $_ % 2 == 0 && $old[$_] eq $key, 0 .. $#old;
   20 
   21     if (@_) {
   22     my @new = @old;
   23     my @new_i = @i;
   24     my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
   25 
   26     while (@new_i > @vals) {
   27         splice @new, pop @new_i, 2;
   28     }
   29     if (@vals > @new_i) {
   30         my $i = @new_i ? $new_i[-1] + 2 : @new;
   31         my @splice = splice @vals, @new_i, @vals - @new_i;
   32 
   33         splice @new, $i, 0, map { $key => $_ } @splice;
   34     }
   35     if (@vals) {
   36         #print "SET $new_i[0]\n";
   37         @new[ map $_ + 1, @new_i ] = @vals;
   38     }
   39 
   40     $self->query_form(\@new);
   41     }
   42 
   43     return wantarray ? @old[map $_+1, @i] : @i ? $old[$i[0]+1] : undef;
   44 }
   45 
   46 sub URI::_query::query_param_append {
   47     my $self = shift;
   48     my $key = shift;
   49     my @vals = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_;
   50     $self->query_form($self->query_form, $key => \@vals);  # XXX
   51     return;
   52 }
   53 
   54 sub URI::_query::query_param_delete {
   55     my $self = shift;
   56     my $key = shift;
   57     my @old = $self->query_form;
   58     my @vals;
   59 
   60     for (my $i = @old - 2; $i >= 0; $i -= 2) {
   61     next if $old[$i] ne $key;
   62     push(@vals, (splice(@old, $i, 2))[1]);
   63     }
   64     $self->query_form(\@old) if @vals;
   65     return wantarray ? reverse @vals : $vals[-1];
   66 }
   67 
   68 sub URI::_query::query_form_hash {
   69     my $self = shift;
   70     my @old = $self->query_form;
   71     if (@_) {
   72     $self->query_form(@_ == 1 ? %{shift(@_)} : @_);
   73     }
   74     my %hash;
   75     while (my($k, $v) = splice(@old, 0, 2)) {
   76     if (exists $hash{$k}) {
   77         for ($hash{$k}) {
   78         $_ = [$_] unless ref($_) eq "ARRAY";
   79         push(@$_, $v);
   80         }
   81     }
   82     else {
   83         $hash{$k} = $v;
   84     }
   85     }
   86     return \%hash;
   87 }
   88 
   89 1;
   90 
   91 __END__
   92 
   93 =head1 NAME
   94 
   95 URI::QueryParam - Additional query methods for URIs
   96 
   97 =head1 SYNOPSIS
   98 
   99   use URI;
  100   use URI::QueryParam;
  101 
  102   $u = URI->new("", "http");
  103   $u->query_param(foo => 1, 2, 3);
  104   print $u->query;    # prints foo=1&foo=2&foo=3
  105 
  106   for my $key ($u->query_param) {
  107       print "$key: ", join(", ", $u->query_param($key)), "\n";
  108   }
  109 
  110 =head1 DESCRIPTION
  111 
  112 Loading the C<URI::QueryParam> module adds some extra methods to
  113 URIs that support query methods.  These methods provide an alternative
  114 interface to the $u->query_form data.
  115 
  116 The query_param_* methods have deliberately been made identical to the
  117 interface of the corresponding C<CGI.pm> methods.
  118 
  119 The following additional methods are made available:
  120 
  121 =over
  122 
  123 =item @keys = $u->query_param
  124 
  125 =item @values = $u->query_param( $key )
  126 
  127 =item $first_value = $u->query_param( $key )
  128 
  129 =item $u->query_param( $key, $value,... )
  130 
  131 If $u->query_param is called with no arguments, it returns all the
  132 distinct parameter keys of the URI.  In a scalar context it returns the
  133 number of distinct keys.
  134 
  135 When a $key argument is given, the method returns the parameter values with the
  136 given key.  In a scalar context, only the first parameter value is
  137 returned.
  138 
  139 If additional arguments are given, they are used to update successive
  140 parameters with the given key.  If any of the values provided are
  141 array references, then the array is dereferenced to get the actual
  142 values.
  143 
  144 Please note that you can supply multiple values to this method, but you cannot
  145 supply multiple keys.
  146 
  147 Do this:
  148 
  149     $uri->query_param( widget_id => 1, 5, 9 );
  150 
  151 Do NOT do this:
  152 
  153     $uri->query_param( widget_id => 1, frobnicator_id => 99 );
  154 
  155 =item $u->query_param_append($key, $value,...)
  156 
  157 Adds new parameters with the given
  158 key without touching any old parameters with the same key.  It
  159 can be explained as a more efficient version of:
  160 
  161    $u->query_param($key,
  162                    $u->query_param($key),
  163                    $value,...);
  164 
  165 One difference is that this expression would return the old values
  166 of $key, whereas the query_param_append() method does not.
  167 
  168 =item @values = $u->query_param_delete($key)
  169 
  170 =item $first_value = $u->query_param_delete($key)
  171 
  172 Deletes all key/value pairs with the given key.
  173 The old values are returned.  In a scalar context, only the first value
  174 is returned.
  175 
  176 Using the query_param_delete() method is slightly more efficient than
  177 the equivalent:
  178 
  179    $u->query_param($key, []);
  180 
  181 =item $hashref = $u->query_form_hash
  182 
  183 =item $u->query_form_hash( \%new_form )
  184 
  185 Returns a reference to a hash that represents the
  186 query form's key/value pairs.  If a key occurs multiple times, then the hash
  187 value becomes an array reference.
  188 
  189 Note that sequence information is lost.  This means that:
  190 
  191    $u->query_form_hash($u->query_form_hash);
  192 
  193 is not necessarily a no-op, as it may reorder the key/value pairs.
  194 The values returned by the query_param() method should stay the same
  195 though.
  196 
  197 =back
  198 
  199 =head1 SEE ALSO
  200 
  201 L<URI>, L<CGI>
  202 
  203 =head1 COPYRIGHT
  204 
  205 Copyright 2002 Gisle Aas.
  206 
  207 =cut