From 8dbd1b461e07f2894c4fcacacd681ab7c34b6bcb Mon Sep 17 00:00:00 2001
From: b <rowerynaksiezycu@gmail.com>
Date: Mon, 8 Jan 2024 23:59:14 +0000
Subject: [PATCH] BREAKING CHANGE reorder parameters of write_data_file; more
 options for data files; preserve URL fragment at merge; ID generation

---
 botm_common.pm | 109 ++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 85 insertions(+), 24 deletions(-)

diff --git a/botm_common.pm b/botm_common.pm
index 8d6637e..161222f 100644
--- a/botm_common.pm
+++ b/botm_common.pm
@@ -26,7 +26,7 @@ use File::Copy;
 
 use Exporter;
 
-our $VERSION     = '1.0.27';
+our $VERSION     = '1.1.0';
 our @ISA         = qw(Exporter);
 our @EXPORT      = ();
 our @EXPORT_OK   = (
@@ -37,7 +37,7 @@ our @EXPORT_OK   = (
 	'url_query_encode', 'url_query_decode',
 	'split_url', 'join_url', 'merge_url',
 	'html_entity_encode_dec', 'html_entity_encode_hex', 'html_entity_encode_name', 'html_entity_decode',
-	'join_path', 'dir_path', 'make_temp_path',
+	'join_path', 'dir_path', 'make_temp_path', 'make_id',
 	'system_encoded', 'exec_encoded',
 	'opendir_encoded', 'readdir_decoded',
 	'_x_encoded', 'stat_encoded',
@@ -97,13 +97,32 @@ sub dir_path {
 	}
 }
 
+sub make_id {
+	(my $base, my $time_first) = @_;
+	
+	state $id = 0;
+	my $r = '';
+	
+	if ($base ne '') {
+		$r = $base.'.';
+	}
+	if ($time_first) {
+		$r .= time().'.'.$$ . '.' . $id;
+	}
+	else {
+		$r .= $$ . '.' . $id . '.' . time();
+	}
+	$id += 1;
+	
+	return $r;
+}
+
 sub make_temp_path {
-	(my $dir, my $basename) = @_;
+	(my $dir, my $basename, my $time_first) = @_;
 	
 	my $filename;
 	my $ext;
 	my $ind = rindex($basename, '.');
-	state $id = 0;
 	
 	if ($ind >= 0) {
 		$filename = substr($basename, 0, $ind);
@@ -113,11 +132,7 @@ sub make_temp_path {
 		$filename = $basename;
 		$ext = '';
 	}
-	if ($filename ne '') {
-		$filename .= '.';
-	}
-	$filename .= $$ . '.' . $id . '.' . time() . $ext;
-	$id++;
+	$filename = make_id($filename, $time_first) . $ext;
 	
 	return join_path('/', $dir, $filename);
 }
@@ -356,8 +371,18 @@ sub open_encoded {
 #
 # if $as_list is true then the content will be an array
 # and not a single string
+# 
+# $file_mode is the mode for opening file.
+# if left empty, it will be '<'.
+#
+# if #$no_fseek is true, there will be no attempt to fseek()
+# to beginning of file.
 sub read_data_file {
-	(my $file, my $encoding, my $no_header, my $header_only, my $as_list) = @_;
+	(
+		my $file, my $encoding,
+		my $no_header, my $header_only, my $as_list,
+		my $file_mode, my $no_fseek,
+	) = @_;
 	my $fh;
 	my %data;
 	my $eoh=0;
@@ -377,12 +402,17 @@ sub read_data_file {
 	# filehandles are references.
 	if (ref($file)) {
 		$fh = $file;
-		unless (seek($fh, 0, 0)) {
-			# return %data;
+		unless ($no_fseek) {
+			unless (seek($fh, 0, 0)) {
+				# return %data;
+			}
 		}
 	}
 	else {
-		unless (open_encoded($fh, "<:encoding($encoding)", $file)) {
+		if ($file_mode eq '') {
+			$file_mode = '<';
+		}
+		unless (open_encoded($fh, "$file_mode:encoding($encoding)", $file)) {
 			return %data;
 		}
 	}
@@ -467,9 +497,18 @@ sub read_data_file {
 # the header not.
 #
 # $data is the reference to the hash containing data to be written.
-# TODO: $header_only, $as_list, REORDER!
+# 
+# $file_mode is the mode for opening file.
+# if left empty, it will be '<'.
+#
+# if #$no_fseek is true, there will be no attempt to fseek()
+# to beginning of file and to truncate after writing.
 sub write_data_file {
-	(my $file, my $encoding, my $no_header, my $data) = @_;
+	(
+		my $file, my $data, my $encoding,
+		my $no_header, my $header_only, my $as_list,
+		my $file_mode, my $no_fseek
+	) = @_;
 	my $fh;
 	
 	if ($encoding eq '') {
@@ -480,12 +519,17 @@ sub write_data_file {
 	# filehandles are references.
 	if (ref($file)) {
 		$fh = $file;
-		unless (seek($fh, 0, 0)) {
-			# return 0;
+		unless ($no_fseek) {
+			unless (seek($fh, 0, 0)) {
+				# return 0;
+			}
 		}
 	}
 	else {
-		unless (open_encoded($fh, ">:encoding($encoding)", $file)) {
+		if ($file_mode eq '') {
+			$file_mode = '>';
+		}
+		unless (open_encoded($fh, "$file_mode:encoding($encoding)", $file)) {
 			return 0;
 		}
 	}
@@ -503,16 +547,27 @@ sub write_data_file {
 			$value =~ s/\r/\n /g;
 			print $fh "$name: $value\n";
 		}
+		print $fh "\n";
+	}
+	unless ($header_only) {
+		if ($as_list) {
+			foreach my $line(@{$data->{'content'}}) {
+				print $fh ($line."\n");
+			}
+		}
+		else {
+			print $fh $data->{'content'};
+		}
 	}
-	print $fh "\n".$data->{'content'};
-	
 	# If argument was a path the file must be closed. 
 	unless (ref($file)) {
 		close ($fh);
 	}
 	else {
 		# cut off any remaining old file content,
-		truncate ($fh , tell($fh));
+		unless ($no_fseek) {
+			truncate ($fh , tell($fh));
+		}
 	}
 	
 	return 1;
@@ -1171,8 +1226,12 @@ sub merge_url {
 		
 		if ($target_data{'path'} ne '') {
 			$final_data{'path'} = join_path('/', $base_data{'path'}, $target_data{'path'});
-			$final_data{'query'} = '';
-			$final_data{'fragment'} = '';
+			unless ($target_data{'preserve_query'}) {
+				$final_data{'query'} = '';
+			}
+			unless ($target_data{'preserve_fragment'}) {
+				$final_data{'fragment'} = '';
+			}
 		}
 		
 		if ($target_data{'query'} ne '') {
@@ -1185,7 +1244,9 @@ sub merge_url {
 			else {
 				$final_data{'query'} = $target_data{'query'};
 			}
-			$final_data{'fragment'} = '';
+			unless ($target_data{'preserve_fragment'}) {
+				$final_data{'fragment'} = '';
+			}
 		}
 		
 		if ($target_data{'fragment'} ne '') {
-- 
2.30.2