Split URL into components.

diff --git a/botm_common.pm b/botm_common.pm
index 5dec1da5e4ba37710e4fcc2463039a082c865d22..3c7a4ad445607b0288923eef6c285f13c32e0b25 100644 (file)
--- a/botm_common.pm
+++ b/botm_common.pm
@@ -25,7 +25,7 @@ use Exporter;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
 # vX.Y.Z:      X YYYZZZ
-$VERSION     = 1.000008;
+$VERSION     = 1.000009;
 @ISA         = qw(Exporter);
 @EXPORT      = ();
 @EXPORT_OK   = (
@@ -361,50 +361,23 @@ 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;
-}
+# URL structure
 
-# 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
+# URL
+#  - scheme
+#  - authority
+#     - userinfo
+#     - host
+#     - port
+#  - path
+#  - query
+#  - fragment
 
+# split_url splits an URL (string) into its components and returns
+# them as a hash.
+# $url is the URL to decompose
+# if $relative is true then
 sub split_url {
        (my $url, my $relative) = @_;
        my %data;
@@ -500,33 +473,90 @@ sub split_url {
        
 }
 
-# # 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 = '';
+sub join_url {
+       (my $data) = @_;
        
-       # if ($scheme ne '') {
-               # if ($scheme !~ /^[A-Za-z][A-Za-z0-9\+\-\.]*$/) {
-                       # return undef;
-               # }
-               # $url .= $scheme . '://';
-       # }
+       my $url = '';
        
-       # my $authority;
-       # if (ref($host)) { # host name as a list, not encoded
-               # $authority = join_url_host($encoding, @$host);
-       # }
-       # # elsif ($host =~ /^[A-Za-z0-9\-\._~
+       if ($data->{'host'} ne '') {
+               $url = $data->{'host'};
+               if ($data->{'port'} ne '') {
+                       $url .= ':' $data->{'port'};
+               }
+               if ($data->{'userinfo'} ne '') {
+                       $url = $data->{'userinfo'} . '@' . $url;
+               }
+       }
+       elsif ($data->{'authority'} ne '') {
+               $url = $data->{'authority'};
+       }
+       
+       if ($data->{'path'} ne '') {
+               if (($data->{'path'} !~ /^\//) and ($url ne '')) {
+                       $url .= '/';
+               }
+               $url .= $data->{'path'};
+       }
        
+       if ($data->{'query'} ne '') {
+               $url .= '?' . $data->{'query'};
+       }
+       
+       if ($data->{'fragment'} ne '') {
+               $url .= '#' . $data->{'fragment'};
+       }
+       
+       if ($data->{'scheme'} ne '') {
+               $url = $data->{'scheme'} . '://' . $url;
+       }
+       
+       return $url;
+}
+
+# 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;
+# }
+
+
 
 ############################
 ##  HTML ENTITY ENCODING  ##