BREAKING CHANGE reorder parameters of write_data_file; more options for data files...

diff --git a/botm_common.pm b/botm_common.pm
index 8d6637eddee2da5cdb50b5fc3a3cae3f860e8dc0..161222fe4eec5d659f6b318fc9b3f8dc1464665b 100644 (file)
--- 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 '') {