URL query string encode / decode

start work on url joining / splitting

diff --git a/botm_common.pm b/botm_common.pm
index 0587fb667f159682f7f0e1511b4c229b057589fc..8d607b0e3269ed32f373c92ae673a32bb10ce0bf 100644 (file)
--- a/botm_common.pm
+++ b/botm_common.pm
@@ -25,17 +25,49 @@ use Exporter;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
 # vX.Y.Z:      X YYYZZZ
-$VERSION     = 1.000006;
+$VERSION     = 1.000007;
 @ISA         = qw(Exporter);
 @EXPORT      = ();
 @EXPORT_OK   = (
        'read_data_file', 'write_data_file',
        'url_encode', 'url_decode',
-       'join_path',
+       'url_query_encode', 'url_query_decode',=
        'html_entity_encode_dec', 'html_entity_encode_hex', 'html_entity_encode_name', 'html_entity_decode',
+       'join_path',
 );
 %EXPORT_TAGS = ();
 
+
+
+# path stuff
+
+# join_path() builds a path (or url) from individual segments
+# that there will be 1 path separator brtween (and not 2 or 0).
+sub join_path {
+       (my $joiner, my @segments) = @_;
+       
+       my $path = '';
+       foreach my $segment (@segments) {
+               if ($path eq '') {
+                       $path = $segment;
+               }
+               else {
+                       unless (substr ($path, -1) eq $joiner) {
+                               $path .= $joiner;
+                       }
+                       if (substr ($segment, 0, 1) eq $joiner) {
+                               $path = $segment;
+                       }
+                       else {
+                               $path .= $segment;
+                       }
+               }
+       }
+       return $path;
+}
+
+
+
 ##################
 ##  DATA FILES  ##
 ##################
@@ -233,9 +265,11 @@ sub write_data_file {
 
 
 
-####################
-##  URL ENCODING  ##
-####################
+###########
+##  URL  ##
+###########
+
+# URL encoding:
 
 # See https://datatracker.ietf.org/doc/html/rfc3986
 # Here the url-encoding (percent encoding, URI escaping, ...) works
@@ -326,7 +360,77 @@ sub url_decode_xch {
        return $y;
 }
 
+# URL query string
 
+sub url_query_encode {
+       (my $data, my $encoding) = @_;
+       my $query = '';
+       
+       foreach my $ind (keys %$data) {
+               if ($query ne '') {
+                       $query .= '&';
+               }
+               $query .= url_encode($ind, $encoding) . '=' . url_encode($data->{$ind}, $encoding);
+       }
+       return $query;
+}
+
+sub url_query_decode {
+       (my $query, my $encoding) = @_;
+       my %data;
+       
+       my @list = split('&', $query);
+       foreach my $entry (@list) {
+               (my $name, my $value) = split('=', $entry, 2);
+               $name = url_decode($name, $encoding);
+               $value = url_decode($value, $encoding);
+               $data{$name} = $value;
+       }
+       return %data;
+}
+
+# sub join_url_host {
+       # (my $encoding, my @segments) = @_;
+       
+       # my $host = '';
+       
+       # foreach my $segment (@segments) {
+               # if ($host ne '') {
+                       # $host = '.'.$host;
+               # }
+               # $host = url_encode($segment, $encoding).$host;
+       # }
+       # return $host;
+# }
+       
+
+# # https://datatracker.ietf.org/doc/html/rfc3986#section-3
+# sub join_url {
+       # (
+               # my $encoding,
+               # my $scheme,
+               # my $userinfo,
+               # my $host,
+               # my $port,
+               # my $path,
+               # my $query,
+               # my $fragment
+       # ) = @_;
+       # my $url = '';
+       
+       # if ($scheme ne '') {
+               # if ($scheme !~ /^[A-Za-z][A-Za-z0-9\+\-\.]*$/) {
+                       # return undef;
+               # }
+               # $url .= $scheme . '://';
+       # }
+       
+       # my $authority;
+       # if (ref($host)) { # host name as a list, not encoded
+               # $authority = join_url_host($encoding, @$host);
+       # }
+       # # elsif ($host =~ /^[A-Za-z0-9\-\._~
+       
 
 ############################
 ##  HTML ENTITY ENCODING  ##
@@ -2788,30 +2892,5 @@ sub html_entity_decode_1en {
 
 
 
-# path stuff
 
-# join_path() builds a path (or url) from individual segments
-# that there will be 1 path separator brtween (and not 2 or 0).
-sub join_path {
-       (my $joiner, my @segments) = @_;
-       
-       my $path = '';
-       foreach my $segment (@segments) {
-               if ($path eq '') {
-                       $path = $segment;
-               }
-               else {
-                       unless (substr ($path, -1) eq $joiner) {
-                               $path .= $joiner;
-                       }
-                       if (substr ($segment, 0, 1) eq $joiner) {
-                               $path = $segment;
-                       }
-                       else {
-                               $path .= $segment;
-                       }
-               }
-       }
-       return $path;
-}
 1