From 343f03a55f19b101b0c2161d99c842f432aae1fd Mon Sep 17 00:00:00 2001
From: b <rowerynaksiezycu@gmail.com>
Date: Wed, 31 May 2023 22:13:22 +0000
Subject: [PATCH] URL query string encode / decode start work on url joining /
 splitting

---
 botm_common.pm | 139 ++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 109 insertions(+), 30 deletions(-)

diff --git a/botm_common.pm b/botm_common.pm
index 0587fb6..8d607b0 100644
--- 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
-- 
2.30.2