Devscripts/URI.pm

   1 # This module is stolen from debbugs until the real
   2 # URI::query_form properly handles ; and is released
   3 # under the terms of the GPL version 2, or any later
   4 # version at your option.
   5 # See the file README and COPYING for more information.
   6 #
   7 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
   8 # query_form is
   9 # Copyright 1995-2003 Gisle Aas.
  10 # Copyright 1995 Martijn Koster.
  11
  12
  13 package Devscripts::URI;
  14
  15 =head1 NAME
  16
  17 Devscripts::URI -- Derivative of URI which overrides the query_param
  18  method to use ';' instead of '&' for separators.
  19
  20 =head1 SYNOPSIS
  21
  22 use Devscripts::URI;
  23
  24 =head1 DESCRIPTION
  25
  26 See L<URI> for more information.
  27
  28 =head1 BUGS
  29
  30 None known.
  31
  32 =cut
  33
  34 use warnings;
  35 use strict;
  36 use base qw(URI URI::_query);
  37
  38 =head2 query_param
  39
  40      $uri->query_form( $key1 => $val1, $key2 => $val2, ... )
  41
  42 Exactly like query_param in L<URI> except query elements are joined by
  43 ; instead of &.
  44
  45 =cut
  46
  47 {
  48
  49      package URI::_query;
  50
  51      no warnings 'redefine';
  52      # Handle ...?foo=bar&bar=foo type of query
  53      sub URI::_query::query_form {
  54           my $self = shift;
  55           my $old = $self->query;
  56           if (@_) {
  57                # Try to set query string
  58                my @new = @_;
  59                if (@new == 1) {
  60                     my $n = $new[0];
  61                     if (ref($n) eq "ARRAY") {
  62                          @new = @$n;
  63                     }
  64                     elsif (ref($n) eq "HASH") {
  65                          @new = %$n;
  66                     }
  67                }
  68                my @query;
  69                while (my($key,$vals) = splice(@new, 0, 2)) {
  70                     $key = '' unless defined $key;
  71                     $key =~ s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/g;
  72                     $key =~ s/ /+/g;
  73                     $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals];
  74                     for my $val (@$vals) {
  75                          $val = '' unless defined $val;
  76                          $val =~ s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/g;
  77                          $val =~ s/ /+/g;
  78                          push(@query, "$key=$val");
  79                     }
  80                }
  81                # We've changed & to a ; here.
  82                $self->query(@query ? join(';', @query) : undef);
  83           }
  84           return if !defined($old) || !length($old) || !defined(wantarray);
  85           return unless $old =~ /=/; # not a form
  86           map { s/\+/ /g; uri_unescape($_) }
  87                # We've also changed the split here to split on ; as well as &
  88                map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old);
  89      }
  90 }
  91
  92
  93
  94
  95
  96
  97 1;
  98
  99
 100 __END__
 101
 102
 103
 104
 105
 106