From 8bd776b17d9733bd81b1ffe3aacac9986677a517 Mon Sep 17 00:00:00 2001
From: b <rowerynaksiezycu@gmail.com>
Date: Fri, 9 Jun 2023 22:10:17 +0000
Subject: [PATCH] Split URL into components.

---
 botm_common.pm | 164 +++++++++++++++++++++++++++++--------------------
 1 file changed, 97 insertions(+), 67 deletions(-)

diff --git a/botm_common.pm b/botm_common.pm
index 5dec1da..3c7a4ad 100644
--- 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  ##
-- 
2.30.2