From: b <rowerynaksiezycu@gmail.com>
Date: Sat, 6 Jan 2024 13:04:41 +0000 (+0000)
Subject: more choice in data file reading / writing
X-Git-Tag: v1.0.27
X-Git-Url: http://bicyclesonthemoon.info/git-projects/?a=commitdiff_plain;h=6b4b21b9139670faf83bb894ec378d49ecc6acdc;p=botm%2Fcommon-perl

more choice in data file reading / writing
---

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;
 			}
 		}