add writedatafile() and explanation

diff --git a/botm_common.pm b/botm_common.pm
index a94f6645541dcb19663a335c0e88cec9ab051116..f882aad7d6b6dfdc146c659a10f836b5cd691279 100644 (file)
--- a/botm_common.pm
+++ b/botm_common.pm
@@ -24,35 +24,87 @@ use Encode qw(encode decode);
 use Exporter;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
-$VERSION     = 1.000000;
+# vX.Y.Z:      X YYYZZZ
+$VERSION     = 1.000001;
 @ISA         = qw(Exporter);
 @EXPORT      = ();
-@EXPORT_OK   = qw(readdatafile);
+@EXPORT_OK   = qw(readdatafile writedatafile);
 %EXPORT_TAGS = ();
 
+##################
+##  DATA FILES  ##
+##################
+
+# Data file has a similar format to a HTTP header.
+#
+# line in the format:
+# name: value
+# or
+# name=value
+#
+# the name must start at the beginning of the line.
+# the name can contain any printable ASCII character except ":" and "=".
+# the name is not case ensitive.
+# 
+# the separator can be ": ", ":\t" or ": ".
+# 
+# value can be anything.
+#
+# line starting with " " or "\t" is considered a continuation of value
+# from previous line.
+#
+# example:
+# 
+# name: value1
+#  value2
+#  value3
+#
+# this encodes "value1\nvalue2\nvalue3"
+#
+# an empty line is the end of header.
+# all next lines form a single value with the name "content" with no
+# processing done.
+
+
+# readdatafile() reads a data file and returns a hash 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.
+#
+# if $no_header is true then it is assumed that file contains just
+# the content and no header.
 sub readdatafile {
-       (my $path, my $encoding, my $content_only) = @_;
-       my $file;
+       (my $file, my $encoding, my $no_header) = @_;
+       my $fh;
        my %data;
        my $eoh=0;
        
        if ($encoding eq '') {
                $encoding = 'utf8';
        }
-       if ($content_only) {
+       if ($no_header) {
                $eoh=1;
        }
        
-       # check if $path is actually a path or maybe a filehandle
+       # check if $file is actually a path or maybe a filehandle
        # filehandles are references.
-       if(ref($path)) {
-               $file=$path;
-               unless (seek($file, 0, 0)) {
+       if(ref($file)) {
+               $fh=$file;
+               unless (seek($fh, 0, 0)) {
                        # return %data;
                }
        }
        else {
-               unless (open ($file, "<:$encoding", $path)) {
+               unless (open ($fh, "<:$encoding", $file)) {
                        return %data;
                }
        }
@@ -61,7 +113,7 @@ sub readdatafile {
        # occupy multiple lines.
        my $lastname='';
        
-       while (defined(my $line = <$file>)) {
+       while (defined(my $line = <$fh>)) {
                # $line = decode($encoding, $line);
                my $name='';
                my $value='';
@@ -97,11 +149,81 @@ sub readdatafile {
                }
        }
        # If argument was a path the file must be closed. 
-       unless (ref($path)) {
-               close ($file);
+       unless (ref($file)) {
+               close ($fh);
        }
        
        return %data;
 }
 
+# writedatafile() writes a data 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 "utf8".
+# encoding of an already opened file will not be changed by this.
+#
+# if $no_header is true then only the content is written and
+# the header not.
+#
+# $data is the reference to the hash containing data to be written.
+sub writedatafile {
+       (my $file, my $encoding, my $no_header, my $data) = @_;
+       my $fh;
+       
+       if ($encoding eq '') {
+               $encoding = 'utf8';
+       }
+       
+       # 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 ($fh, ">:$encoding", $file)) {
+                       return 0;
+               }
+       }
+       
+       unless ($no_header) {
+               foreach my $ind (keys %$data) {
+                       my $name = lc($ind);
+                       # content is not part of header
+                       if ($name eq 'content') {
+                               next;
+                       }
+                       my $value = $data->{$ind};
+                       # convert newlines - add spaces at continuation line
+                       $value =~ s/\r//g;
+                       $value =~ s/\n/\n /g;
+                       print $fh "$name: $value\n";
+               }
+       }
+       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));
+       }
+       
+       return 1;
+}
+
+
 1