From 6b4b21b9139670faf83bb894ec378d49ecc6acdc Mon Sep 17 00:00:00 2001 From: b Date: Sat, 6 Jan 2024 13:04:41 +0000 Subject: [PATCH] more choice in data file reading / writing --- botm_common.pm | 177 ++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 159 insertions(+), 18 deletions(-) diff --git a/botm_common.pm b/botm_common.pm index b42a531..8d6637e 100644 --- a/botm_common.pm +++ b/botm_common.pm @@ -26,11 +26,12 @@ use File::Copy; use Exporter; -our $VERSION = '1.0.26'; +our $VERSION = '1.0.27'; our @ISA = qw(Exporter); our @EXPORT = (); our @EXPORT_OK = ( 'read_data_file', 'write_data_file', 'write_postdata_file', + 'read_list_file', 'write_list_file', 'read_header_file', 'read_header_env', 'url_encode', 'url_decode', 'url_query_encode', 'url_query_decode', @@ -350,23 +351,32 @@ sub open_encoded { # # if $no_header is true then it is assumed that file contains just # the content and no header. +# +# if $header_only is true then only the reader will be read +# +# if $as_list is true then the content will be an array +# and not a single string sub read_data_file { - (my $file, my $encoding, my $no_header) = @_; + (my $file, my $encoding, my $no_header, my $header_only, my $as_list) = @_; my $fh; my %data; my $eoh=0; + my @list; if ($encoding eq '') { $encoding = 'utf8'; } if ($no_header) { - $eoh=1; + if ($header_only) { + return %data; + } + $eoh = 1; } # check if $file is actually a path or maybe a filehandle # filehandles are references. - if(ref($file)) { - $fh=$file; + if (ref($file)) { + $fh = $file; unless (seek($fh, 0, 0)) { # return %data; } @@ -386,9 +396,16 @@ sub read_data_file { my $name=''; my $value=''; - if ($eoh){ + if ($eoh) { unless($line eq'') { - $data{'content'} = $data{'content'}.$line; + if ($as_list) { + $line =~ s/\n$//gs; + $line =~ s/\r$//gs; + push @list, $line; + } + else { + $data{'content'} = $data{'content'}.$line; + } } next; } @@ -398,12 +415,15 @@ sub read_data_file { # Empty line - end of header. if ($line eq ''){ + if ($header_only) { + last; + } $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 '') { + elsif ($line =~ /^[ \t]/){ + if ($lastname ne '') { $data{$lastname} .= "\n".$'; } } @@ -417,6 +437,9 @@ sub read_data_file { $lastname = $name; } } + if ($as_list && ! $header_only) { + $data{'content'} = [@list]; + } # If argument was a path the file must be closed. unless (ref($file)) { close ($fh); @@ -425,7 +448,7 @@ sub read_data_file { return %data; } -# writedatafile() writes a data file, +# write_data_file() writes a data file, # returns 1 on success, 0 on failure # # $file is the path to the file to write. @@ -444,6 +467,7 @@ 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! sub write_data_file { (my $file, my $encoding, my $no_header, my $data) = @_; my $fh; @@ -454,8 +478,8 @@ sub write_data_file { # check if $file is actually a path or maybe a filehandle # filehandles are references. - if(ref($file)) { - $fh=$file; + if (ref($file)) { + $fh = $file; unless (seek($fh, 0, 0)) { # return 0; } @@ -505,8 +529,8 @@ sub write_postdata_file { # check if $file is actually a path or maybe a filehandle # filehandles are references. - if(ref($file)) { - $fh=$file; + if (ref($file)) { + $fh = $file; unless (seek($fh, 0, 0)) { # return 0; } @@ -533,6 +557,123 @@ sub write_postdata_file { return 1; } +# read_list_file() reads a list file and returns an arral with the data values. +# +# $file is the path to the file to read. +# file will be opened, read, and closed. +# +# alternatively, $file can be an filehandle for already opened file +# (or STDIN). +# in this case a fseek to the beginning will be attempted and file +# will be read and not closed afterwards. +# +# $encoding is the text encoding of the file to read. +# if left empty, this will default to "utf8". +# encoding of an already opened file will not be changed by this. +# +# $limit is the nmaximal number of lines to read. +# if left empty, there will be no limit. + +sub read_list_file { + (my $file, my $encoding, my $limit) = @_; + my $fh; + my @data; + + if ($encoding eq '') { + $encoding = 'utf8'; + } + if ($limit ne '0') { + $limit = int($limit)-1; + unless ($limit >= 0) { + return @data; + } + } + + # check if $file is actually a path or maybe a filehandle + # filehandles are references. + if (ref($file)) { + $fh = $file; + unless (seek($fh, 0, 0)) { + # return @data; + } + } + else { + unless (open_encoded($fh, "<:encoding($encoding)", $file)) { + return @data; + } + } + + for (my $i=0; defined(my $line = <$fh>); $i+=1) { + $line =~ s/\n$//gs; + $line =~ s/\r$//gs; + + push @data, $line; + + if (($limit ne '') && ($i >= $limit)) { + last; + } + } + # If argument was a path the file must be closed. + unless (ref($file)) { + close ($fh); + } +} + +# write_list_file() writes a list file, +# returns 1 on success, 0 on failure +# +# $file is the path to the file to write. +# file will be opened or created, written, and closed. +# +# alternatively, $file can be an filehandle for already opened file +# (or STDOUT). +# in this case a fseek to the beginning will be attempted and file +# will be written, truncated to new size and not closed afterwards. +# +# $encoding is the text encoding of the file to write. +# if left empty, this will default to "UTF-8". +# encoding of an already opened file will not be changed by this. +# +# $data is the reference to the array containing data to be written. + +sub write_list_file { + (my $file, my $encoding, my $data) = @_; + my $fh; + + if ($encoding eq '') { + $encoding = 'UTF-8'; + } + + # check if $file is actually a path or maybe a filehandle + # filehandles are references. + if (ref($file)) { + $fh = $file; + unless (seek($fh, 0, 0)) { + # return 0; + } + } + else { + unless (open_encoded($fh, ">:encoding($encoding)", $file)) { + return 0; + } + } + + foreach my $line (@$data) { + print $fh $line."\n"; + } + + # 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)); + } + + return 1; +} + ################### ## HTTP HEADER ## @@ -573,8 +714,8 @@ sub read_header_file { # check if $file is actually a path or maybe a filehandle # filehandles are references. - if(ref($file)) { - $fh=$file; + if (ref($file)) { + $fh = $file; unless (seek($fh, 0, 0)) { # return %data; } @@ -613,8 +754,8 @@ sub read_header_file { # Line starts with LWS. It's a continuation of the previous line. # Concatenate the field value. - elsif($line =~ /^[ \t]+([^ \t](.*[^ \t])?)[ \t]*$/) { - if($lastname ne '') { + elsif ($line =~ /^[ \t]+([^ \t](.*[^ \t])?)[ \t]*$/) { + if ($lastname ne '') { $data{$lastname} .= $1; } } -- 2.30.2