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',
#
# 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;
}
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;
}
# 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".$';
}
}
$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);
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.
# 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;
# 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;
}
# 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;
}
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 ##
# 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;
}
# 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;
}
}
bicyclesonthemoon.info / projects / botm / common-perl / commitdiff