From 22fdeb550fd5ea8fce3836b157ed671cccb0b9d5 Mon Sep 17 00:00:00 2001
From: b <rowerynaksiezycu@gmail.com>
Date: Sun, 24 Sep 2023 22:04:42 +0000
Subject: [PATCH] add function reading HTTP header from ENV (CGI)

---
 botm_common.pm | 51 +++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 42 insertions(+), 9 deletions(-)

diff --git a/botm_common.pm b/botm_common.pm
index a479feb..19e4ff8 100644
--- a/botm_common.pm
+++ b/botm_common.pm
@@ -25,12 +25,12 @@ use Encode ('encode', 'decode');
 
 use Exporter;
 
-our $VERSION     = '1.0.18';
+our $VERSION     = '1.0.19';
 our @ISA         = qw(Exporter);
 our @EXPORT      = ();
 our @EXPORT_OK   = (
 	'read_data_file', 'write_data_file', 'write_postdata_file',
-	'read_header_file',
+	'read_header_file', 'read_header_env',
 	'url_encode', 'url_decode',
 	'url_query_encode', 'url_query_decode',
 	'split_url', 'join_url', 'merge_url',
@@ -484,6 +484,40 @@ sub read_header_file {
 	return %data;
 }
 
+# NOTE: !at this point I don't know if the ENV has the HTTP header
+# data encoded or decoded. But doesn't really matter as the header
+# shouldn't have non-ASCII data anyway
+sub read_header_env {
+	(my $env) = @_;
+	
+	my %data;
+	
+	foreach my $key (keys %$env) {
+		my $name = '';
+		my $value= '';
+		
+		if ($key =~ /^HTTP_([A-Z0-9_]+)$/) {
+			$name=$1;
+		}
+		elsif ($key =~ /^(CONTENT_[A-Z0-9_]+)$/) {
+			$name=$1;
+		}
+		else{
+			next;
+		}
+		$name =~ s/_/-/g;
+		$name = lc($name);
+		if ($$env{$key} =~ /^([\x20-\x7e]*)$/) {
+			$value=$1;
+		}
+		else {
+			next;
+		}
+		$data{$name}=$value;
+	}
+	return %data;
+}
+
 ###########
 ##  URL  ##
 ###########
@@ -521,7 +555,7 @@ sub url_encode {
 	(my $t, my $encoding, my $all) = @_;
 	
 	if ($encoding eq '') {
-		$encoding = "UTF-8";
+		$encoding = 'UTF-8';
 	}
 
 	if ($all) {
@@ -540,7 +574,7 @@ sub url_encode_1ch {
 	(my $ch, my $encoding) = @_;
 	
 	if ($encoding eq '') {
-		$encoding = "UTF-8";
+		$encoding = 'UTF-8';
 	}
 	$ch = encode($encoding, $ch);
 	$ch =~ s/(.)/sprintf('%%%02X',ord($1))/egs;
@@ -555,7 +589,7 @@ sub url_decode {
 	(my $t, my $encoding) = @_;
 	
 	if ($encoding eq '') {
-		$encoding = "utf8";
+		$encoding = 'utf8';
 	}
 	$t =~ s/((%[0-9A-Fa-f]{2})+)/url_decode_xch($1)/egs;
 	return $t;
@@ -569,7 +603,7 @@ sub url_decode_xch {
 	my $y = '';
 	
 	if ($encoding eq '') {
-		$encoding = "utf8";
+		$encoding = 'utf8';
 	}
 	while ($xch ne '') {
 		$y .= chr(hex(substr($xch, 1, 2)));
@@ -819,6 +853,8 @@ sub url_query_decode {
 	(my $query, my $encoding) = @_;
 	my %data;
 	
+	$query =~ s/\n$//s;
+	$query =~ s/\r$//s;
 	my @list = split('&', $query);
 	foreach my $entry (@list) {
 		(my $name, my $value) = split('=', $entry, 2);
@@ -3335,7 +3371,4 @@ sub html_entity_decode_1en {
 	}
 }
 
-
-
-
 1
-- 
2.30.2