From: b <rowerynaksiezycu@gmail.com>
Date: Fri, 29 Sep 2023 17:18:47 +0000 (+0000)
Subject: drop redundant functions
X-Git-Tag: v1.0.0~60
X-Git-Url: http://bicyclesonthemoon.info/git-projects/?a=commitdiff_plain;h=5c40deb38f89f53ac1589dcaccd8860c1a2de939;p=botm%2Foldlogs

drop redundant functions
---

diff --git a/botm-common b/botm-common
index 22fdeb5..6881684 160000
--- a/botm-common
+++ b/botm-common
@@ -1 +1 @@
-Subproject commit 22fdeb550fd5ea8fce3836b157ed671cccb0b9d5
+Subproject commit 6881684b6dcb50d6d9e77584aadf3eaa47dd096c
diff --git a/bsta_lib.1.pm b/bsta_lib.1.pm
index d9b53ce..eca8565 100644
--- a/bsta_lib.1.pm
+++ b/bsta_lib.1.pm
@@ -38,14 +38,18 @@ our @EXPORT_OK   = (
 	'readdatafile', 'writedatafile', 'printdatafile',
 	'printdatafileht', # TO REMOVE ???
 	'urlencode', # TO REMOVE
-	'linehtml',
+	'linehtml', # TO REMOVE
 	'bb2ht', 'bb2bb'
 );
 
 ###PERL_LIB: use lib /botm/lib/bsta
 use botm_common (
+	'url_query_decode', 'url_query_encode',
+	'url_decode', 'url_encode',
 	'html_entity_encode_dec',
-	'merge_url', 'url_query_encode'
+	'merge_url',
+	'read_header_env',
+	'read_data_file', 'write_data_file'
 );
 
 ###PERL_CGI_GOTO_PATH:      CGI_GOTO_PATH      = /bsta/g
@@ -448,13 +452,7 @@ sub fail_content_type
 # function to encode entities, decimal, 
 sub entityencode {
 	(my $t, my $all) = @_;
-	if ($all) {
-		$t =~ s/(.)/sprintf('\&#%02hu;',ord($1))/eg;
-	}
-	else {
-		$t =~ s/([\"=><\&])/sprintf('&#%02hu;',ord($1))/eg;
-	}
-	return $t;
+	return html_entity_encode_dec($t, 1, $all);
 }
 
 # TO REMOVE
@@ -463,58 +461,20 @@ sub entityencode {
 sub gethttpheader {
 	(my $env) = @_;
 	
-	my %http;
-	
-	foreach my $ind (keys %$env) {
-		my $name = '';
-		my $value= '';
-		
-		if ($ind =~ /^HTTP_([A-Z0-9_]+)$/) {
-			$name=$1;
-		}
-		elsif ($ind =~ /^(CONTENT_[A-Z0-9_]+)$/) {
-			$name=$1;
-		}
-		else{
-			next;
-		}
-		$name =~ s/_/-/g;
-		$name = lc($name);
-		if ($$env{$ind} =~ /^([\x20-\x7e]*)$/) {
-			$value=$1;
-		}
-		else {
-			next;
-		}
-		$http{$name}=$value;
-	}
-	return %http;
+	return read_header_env($env);
 }
 
 # TO REMOVE
 # The function to get CGI parameters from string.
 # Format is: name=url_encoded_value&name=url_encoded_value& ... &name=url_encoded_value
 sub getcgi {
-	my $arg;
-	my $val;
-	my %cgi;
-	my $i = $_[0];
-	$i =~ s/[\r\n]//g;
-	my @s = split('&',$i);
-	foreach my $l ( @s) {
-		($arg,$val)=split('=',$l);
-		$cgi{$arg}=urldecode($val);
-	}
-	return %cgi;
+	return url_query_decode($_[0]);
 }
 
 # TO REMOVE
 # Function for decoding URL-encoded text
 sub urldecode {
-	my $t = $_[0];
-	$t =~ s/\+/ /g;
-	$t =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg;
-	return $t;
+	return url_decode($_[0]);
 }
 
 # TO REMOVE
@@ -554,69 +514,8 @@ sub urldecode {
 # 
 sub readdatafile {
 	(my $datapath) = @_;
-	my $datafile;
-	my %data;
-	my $eoh=0;
-	
-	# check if $datapath is actually a path or maybe a filehandle
-	# filehandles are references.
-	if(ref($datapath)) {
-		$datafile=$datapath;
-		unless (seek($datafile, 0, 0)) {
-			return %data;
-		}
-	}
-	else {
-		unless (open ($datafile, "<", $datapath)) {
-			return %data;
-		}
-	}
-
-	# The name of header field in previous line. Required for header fields that
-	# occupy multiple lines.
-	my $lastname='';
-	
-	while (defined(my $line = <$datafile>)) {
-		my $name='';
-		my $value='';
-		
-		if ($eoh){
-			unless($line eq'') {
-				$data{'content'} = $data{'content'}.$line;
-			}
-			next;
-		}
-		
-		$line =~ s/[\n]$//g;
-		
-		# Empty line - end of header.
-		if ($line eq ''){
-			$eoh=1;
-		}
-		# Line starts with whitespace. It's a continuation of the previous line.
-		# Concatenate the field value, separated by newline.
-		elsif($line =~ /^[ \t](.*)$/){
-			if($lastname ne '') {
-				$data{$lastname}.="\n".$1;
-			}
-		}
-		# Line starts with a name followed by colon/equal sign. Save the value
-		elsif ($line =~ /^([^:=]+)((:[ \t])|=)(.*)$/) {
-			$name = lc($1);
-			$value = $4;
-			
-			$data{$name}=$value;
-			
-			$lastname = $name;
-		}
-	}
-	
-	# If argument was a path the file must be closed. 
-	unless (ref($datapath)) {
-		close ($datafile);
-	}
 	
-	return %data;
+	return read_data_file($datapath);
 }
 
 # TO REMOVE
@@ -631,39 +530,8 @@ sub readdatafile {
 #
 sub writedatafile {
 	(my $headerpath, my %header) = @_;
-	my $headerfile;
 	
-	if(ref($headerpath)) {
-		$headerfile=$headerpath;
-		unless (seek($headerfile, 0, 0)) {
-			return 0;
-		}
-	}
-	else {
-		unless (open ($headerfile, ">", $headerpath)) {
-			return 0;
-		}
-	}
-	
-	foreach my $ind (keys %header) {
-		unless($ind eq 'content') {
-			my $headname = $ind;
-			my $headval = $header{$ind};
-			$headval =~ s/\r//g;
-			$headval =~ s/\n/\n /g;
-			print $headerfile "$headname: $headval\n";
-		}
-	}
-	print $headerfile "\n".$header{'content'};
-	
-	unless (ref($headerpath)) {
-		close ($headerfile);
-	}
-	else {
-		truncate ($headerfile , tell($headerfile));
-	}
-	
-	return 1;
+	return write_data_file($headerpath, '', 0, \%header);
 }
 
 # TO REMOVE
@@ -674,21 +542,10 @@ sub writedatafile {
 sub printdatafile {
 	(my %header) = @_;
 	
-	foreach my $ind (keys %header) {
-		unless($ind eq 'content') {
-			my $headname = $ind;
-			my $headval = $header{$ind};
-			$headval =~ s/\r//g;
-			$headval =~ s/\n/\n /g;
-			print "$headname: $headval\n";
-		}
-	}
-	print "\n".$header{'content'};
-	
-	return 1;
+	return write_data_file(\*STDOUT, '', 0, \%header);
 }
 
-# TO REMOVE ???
+# TO REMOVE
 # the function to print data to stdout as html (see readdatafile() description)
 #
 # On success returns 1.
@@ -696,17 +553,7 @@ sub printdatafile {
 sub printdatafileht {
 	(my %header) = @_;
 	
-	foreach my $ind (keys %header) {
-		unless($ind eq 'content') {
-			my $headname = $ind;
-			my $headval = $header{$ind};
-			$headval =~ s/\r//g;
-			$headval =~ s/\n/\n /g;
-			print linehtml("$headname: $headval\n");
-		}
-	}
-	print linehtml("\n".$header{'content'});
-	
+	print_html_data(\*STDOUT, \%header);
 	return 1;
 }
 
@@ -714,13 +561,7 @@ sub printdatafileht {
 # TO REMOVE
 sub urlencode {
 	(my $t, my $all) = @_;
-	if ($all) {
-		$t =~ s/(.)/sprintf('%%%02hX',ord($1))/eg;
-	}
-	else {
-		$t =~ s/([^0-9A-Za-z.~\-_])/sprintf('%%%02hX',ord($1))/eg;
-	}
-	return $t;
+	return url_encode($t, '', $all);
 }
 
 #analyse bbcode text to build tag tree #TODO make [/*] optional!
@@ -844,7 +685,7 @@ sub convtree {
 		#normal text
 		if($bbtree{$ind.'.t'} eq 'tx') {
 			$debug .= debug($printdebug, "text: ".$bbtree{$ind.'.v'});
-			$ht = $ht.($escape?(linehtml($bbtree{$ind.'.v'})):($bbtree{$ind.'.v'}));
+			$ht .= $escape ? (html_encode_line($bbtree{$ind.'.v'})) : ($bbtree{$ind.'.v'});
 			
 			{do{
 				$ind =~ s/\.([0-9]+)$//;
@@ -924,7 +765,7 @@ sub convtree {
 				}
 				else {
 					$debug .= debug($printdebug, "unclosed tag: [".$bbtree{$ind.'.n'}."]");
-					$ht = $ht.'['.($escape?linehtml($bbtree{$ind.'.n'}):$bbtree{$ind.'.n'}).']';
+					$ht .= '['.($escape?html_encode_line($bbtree{$ind.'.n'}):$bbtree{$ind.'.n'}).']';
 				}
 				if($bbtree{$ind.'.e'}>0) {
 					$ind = $ind.'.0';
@@ -1004,7 +845,7 @@ sub bb2ht {
 		# $debug .= debug($printdebug, "[$level:$ind:".int($bbtree{$ind.'.e'})."]");
 		# if($bbtree{$ind.'.t'} eq 'tx') {
 			# $debug .= debug($printdebug, "text: ".$bbtree{$ind.'.v'});
-			# $ht = $ht.linehtml($bbtree{$ind.'.v'});
+			# $ht = $ht.html_encode_line($bbtree{$ind.'.v'});
 			
 			# {do{
 				# $ind =~ s/\.([0-9]+)$//;
@@ -1039,7 +880,7 @@ sub bb2ht {
 					# $ht = $ht.'</i>';
 				# }
 				# else { #unimpl.
-					# $ht = $ht.'['.linehtml($bbtree{$ind.'.n'}).']';
+					# $ht = $ht.'['.html_encode_line($bbtree{$ind.'.n'}).']';
 					# $debug .= debug($printdebug, "[unknown!]");
 				# }
 				# $ind =~ s/\.([0-9]+)$//;
@@ -1092,13 +933,13 @@ sub bb2ht {
 						# $ht = $ht.'<a href="'.entityencode($bbtree{$ind.'.v'}).'">';
 					# }
 					# else { #unimpl.
-						# $ht = $ht.'['.linehtml($bbtree{$ind.'.n'}).(($bbtree{$ind.'.v'} ne '' )?entityencode($bbtree{$ind.'.v'}):'').']';
+						# $ht = $ht.'['.html_encode_line($bbtree{$ind.'.n'}).(($bbtree{$ind.'.v'} ne '' )?entityencode($bbtree{$ind.'.v'}):'').']';
 						# $debug .= debug($printdebug, "[unknown!]");
 					# }
 				# }
 				# else {
 					# $debug .= debug($printdebug, "unclosed tag: [".$bbtree{$ind.'.n'}."]");
-					# $ht = $ht.'['.linehtml($bbtree{$ind.'.n'}).']';
+					# $ht = $ht.'['.html_encode_line($bbtree{$ind.'.n'}).']';
 				# }
 				# if($bbtree{$ind.'.e'}>0) {
 					# $ind = $ind.'.0';
@@ -1333,27 +1174,33 @@ sub bb2bb {
 	
 }
 
-sub linehtml {
-	(my $ht) = @_;
-	my $esc;
+
+sub html_encode_line {
+	(my $text, my $non_ascii, my $all) = @_;
+	my $html;
 	my $ind;
 	
-	$ht =~ s/\r\n/\n/g;
-	$ht =~ s/\r/\n/g;
+	$text =~ s/\r\n/\n/gs;
+	$text =~ s/\r/\n/gs;
 	
-	while ($ht ne '') {
-		$ind = index($ht,"\n");
-		if($ind>=0){
-			$esc = $esc.entityencode(substr($ht,0,$ind))."<br>\n";
-			$ht=substr($ht,$ind+1);
+	while ($text ne '') {
+		$ind = index($text, "\n");
+		if ($ind >= 0) {
+			$html .= html_entity_encode_dec(substr($text, 0, $ind), $non_ascii, $all)."<br>\n";
+			$text = substr($text, $ind+1);
 		}
 		else
 		{
-			$esc = $esc.entityencode($ht);
-			$ht = '';
+			$html .= html_entity_encode_dec($text, 1);
+			$text = '';
 		}
 	}
-	return $esc;
+	return $html;
+}
+
+# TO REMOVE
+sub linehtml {
+	return html_encode_line($_[0], 1);
 }
 
 # TO REMOVE ???
@@ -1411,10 +1258,11 @@ sub print_html_data {
 	foreach my $key (keys %$data) {
 		unless ($key eq 'content') {
 			my $val = $data->{'ind'};
-			$val =~ s/(\r)?\n/\n /gs;
-			
+			$val =~ s/(\r)?\n/\n /gs; # does the space make sense in HTML anyway?
+			print $fh html_encode_line("$key: $val\n", 1);
 		}
 	}
+	print $fh html_encode_line("\n".$data->{'content'});
 }
 
 sub print_viewer_page {