From 6cc2a0295896e671fa71946ca6428f0c806a9a77 Mon Sep 17 00:00:00 2001
From: b <rowerynaksiezycu@gmail.com>
Date: Mon, 15 May 2023 21:45:52 +0000
Subject: [PATCH] URL encoding

---
 botm_common.pm | 115 ++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 108 insertions(+), 7 deletions(-)

diff --git a/botm_common.pm b/botm_common.pm
index a2f7abd..300f00a 100644
--- a/botm_common.pm
+++ b/botm_common.pm
@@ -25,10 +25,14 @@ use Exporter;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
 # vX.Y.Z:      X YYYZZZ
-$VERSION     = 1.000002;
+$VERSION     = 1.000003;
 @ISA         = qw(Exporter);
 @EXPORT      = ();
-@EXPORT_OK   = qw(readdatafile writedatafile join_path);
+@EXPORT_OK   = (
+	'read_data_file', 'write_data_file',
+	'url_encode', 'url_decode',
+	'join_path'
+);
 %EXPORT_TAGS = ();
 
 ##################
@@ -66,7 +70,7 @@ $VERSION     = 1.000002;
 # processing done.
 
 
-# readdatafile() reads a data file and returns a hash with the data values.
+# read_data_file() reads a data file and returns a hash with the data values.
 #
 # $file is the path to the file to read.
 # file will be opened, read, and closed.
@@ -82,7 +86,7 @@ $VERSION     = 1.000002;
 #
 # if $no_header is true then it is assumed that file contains just
 # the content and no header.
-sub readdatafile {
+sub read_data_file {
 	(my $file, my $encoding, my $no_header) = @_;
 	my $fh;
 	my %data;
@@ -168,19 +172,19 @@ sub readdatafile {
 # will be written, truncated to new size and not closed afterwards.
 #
 # $encoding is the text encoding of the file to write.
-# if left empty, this will default to "utf8".
+# if left empty, this will default to "UTF-8".
 # encoding of an already opened file will not be changed by this.
 #
 # if $no_header is true then only the content is written and
 # the header not.
 #
 # $data is the reference to the hash containing data to be written.
-sub writedatafile {
+sub write_data_file {
 	(my $file, my $encoding, my $no_header, my $data) = @_;
 	my $fh;
 	
 	if ($encoding eq '') {
-		$encoding = 'utf8';
+		$encoding = 'UTF-8';
 	}
 	
 	# check if $file is actually a path or maybe a filehandle
@@ -227,6 +231,103 @@ sub writedatafile {
 
 
 
+####################
+##  URL ENCODING  ##
+####################
+
+# See https://datatracker.ietf.org/doc/html/rfc3986
+# Here the url-encoding (percent encoding, URI escaping, ...) works
+# like this:
+# The text can consist of 3 types of characters:
+#  - reserved characters:
+#    : / ? # [ ] @ ! $ & ' ( ) * + , ; =
+#  - unreserved characters:
+#    A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
+#    a b c d e f g h i j k l m n o p q r s t u v w x y z
+#    0 1 2 3 4 5 6 7 8 9 - . _ ~
+#  - all other characters.
+# Unreserved characters are always allowed inside an URI
+# and don't need escaping.
+# Reserved characters might need escaping.
+# All other characters are not allowed and need escaping.
+#
+# A character to be escaped is encoded using a specified encoding
+# (the default choice being UTF-8)
+# and then each of the resulting bytes is represented as a 2 digit
+# hexadecimal number (case insensitive ) preceded by the "%" character.
+
+# url_encode() escapes a text using URL-encoding.
+# (any character which is not unreserved will be escaped.)
+# $t is the text to encode.
+# $encoding is the encoding to use
+# (if left empty, UTF-8 is assumed)
+# If $all is true then every character will be escaped
+sub url_encode {
+	(my $t, my $encoding, my $all) = @_;
+	
+	if ($encoding eq '') {
+		$encoding = "UTF-8";
+	}
+
+	if ($all) {
+		s/(.)/url_encode_1ch($1, $encoding)/eg;
+	}
+	else {
+		$t =~ s/([^0-9A-Za-z.~\-_])/url_encode_1ch($1, $encoding)/eg;
+	}
+	return $t;
+}
+
+# url_encode_1ch() escapes a single chatacter using URL-encoding.
+# $ch is the text to encode.
+# $encoding is the encoding to use
+sub url_encode_1ch {
+	(my $ch, my $encoding) = @_;
+	
+	if ($encoding eq '') {
+		$encoding = "UTF-8";
+	}
+	$ch = encode($encoding, $ch);
+	$ch =~ s/(.)/sprintf('%%%02X',ord($1))/eg;
+	return $ch;
+}
+
+# url_decode() decodes a text escaped by URL-encoding
+# $t is the text to decode.
+# $encoding is the encoding to use
+# (if left empty, utf8 is assumed)
+sub url_decode {
+	(my $t, my $encoding) = @_;
+	
+	if ($encoding eq '') {
+		$encoding = "utf8";
+	}
+	$t =~ s/((%[0-9A-Fa-f]{2})+)/url_decode_xch($1)/eg;
+	return $t;
+}
+
+# url_decode_xc() decodes a continuous string of characters escaped
+# $xch is the text to decode - it is assumed without checking
+# that the text is indeed in this format. 
+sub url_decode_xch {
+	(my $xch, my $encoding) = @_;
+	my $y = '';
+	
+	if ($encoding eq '') {
+		$encoding = "utf8";
+	}
+	while ($xch ne '') {
+		$y .= chr(hex(substr($xch, 1, 2)));
+		$xch = substr($xch, 3);
+	};
+	$y = decode($encoding, $y);
+	return $y;
+}
+
+
+
+# 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 {
-- 
2.30.2