From 8dbd1b461e07f2894c4fcacacd681ab7c34b6bcb Mon Sep 17 00:00:00 2001 From: b 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