This is an automated email from the git hooks/post-receive script. js pushed a commit to branch master in repository libfile-data-perl.
commit dd683a2aea0c152bf4622b8e04ec4d88e5a08268 Author: Jonas Smedegaard <d...@jones.dk> Date: Sat Jun 18 11:55:49 2016 +0200 Imported Upstream version 1.20 --- META.json | 12 +- META.yml | 17 +- Makefile.PL | 13 +- lib/File/Data.pm | 1376 +++++++++++++++++++++++++++--------------------------- t/test.t | 116 +++-- 5 files changed, 782 insertions(+), 752 deletions(-) diff --git a/META.json b/META.json index 9cde391..3964b7d 100644 --- a/META.json +++ b/META.json @@ -4,7 +4,7 @@ "unknown" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921", + "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.150005", "license" : [ "unknown" ], @@ -31,9 +31,15 @@ } }, "runtime" : { - "requires" : {} + "requires" : { + "Carp" : "1.3301", + "Data::Dumper" : "2.151", + "Fcntl" : "1.11", + "FileHandle" : "2.02" + } } }, "release_status" : "stable", - "version" : "1.18" + "version" : "1.20", + "x_serialization_backend" : "JSON::PP version 2.27203" } diff --git a/META.yml b/META.yml index 1a1b745..9903c46 100644 --- a/META.yml +++ b/META.yml @@ -3,19 +3,24 @@ abstract: unknown author: - unknown build_requires: - ExtUtils::MakeMaker: 0 + ExtUtils::MakeMaker: '0' configure_requires: - ExtUtils::MakeMaker: 0 + ExtUtils::MakeMaker: '0' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921' +generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.150005' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 + version: '1.4' name: File-Data no_index: directory: - t - inc -requires: {} -version: 1.18 +requires: + Carp: '1.3301' + Data::Dumper: '2.151' + Fcntl: '1.11' + FileHandle: '2.02' +version: '1.20' +x_serialization_backend: 'CPAN::Meta::YAML version 0.012' diff --git a/Makefile.PL b/Makefile.PL index 11aadc9..75bc03e 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,8 +1,15 @@ use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. + WriteMakefile( - 'NAME' => 'File::Data', - 'VERSION_FROM' => 'lib/File/Data.pm', # finds $VERSION - 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 + 'NAME' => 'File::Data', + 'VERSION_FROM' => 'lib/File/Data.pm', + 'PREREQ_PM' => { + Carp => 1.3301, + 'Data::Dumper' => 2.151, + Fcntl => 1.11, + FileHandle => 2.02, + }, + 'PM' => { 'lib/File/Data.pm' => '$(INST_LIBDIR)/File/Data.pm' }, ); diff --git a/lib/File/Data.pm b/lib/File/Data.pm index 893a336..01c34e8 100644 --- a/lib/File/Data.pm +++ b/lib/File/Data.pm @@ -10,7 +10,7 @@ use FileHandle; # use Tie::File; # <- todo # use File::stat; use vars qw(@ISA $VERSION $AUTOLOAD); -$VERSION = do { my @r = (q$Revision: 1.18 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$VERSION = do { my @r = (q$Revision: 1.20 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; $| = 1; =head1 NAME @@ -30,32 +30,32 @@ See L<new()> =over 4 - use strict; + use strict; - use File::Data; + use File::Data; - my $o_dat = File::Data->new('./t/example'); + my $o_dat = File::Data->new('./t/example'); - $o_dat->write("complete file contents\n"); + $o_dat->write("complete file contents\n"); - $o_dat->prepend("first line\n"); # line 0 + $o_dat->prepend("first line\n"); # line 0 - $o_dat->append("original second (last) line\n"); + $o_dat->append("original second (last) line\n"); - $o_dat->insert(2, "new second line\n"); # inc. zero! + $o_dat->insert(2, "new second line\n"); # inc. zero! - $o_dat->replace('line', 'LINE'); + $o_dat->replace('line', 'LINE'); - print $o_dat->READ; + print $o_dat->READ; Or, perhaps more seriously :-} - my $o_sgm = File::Data->new('./sgmlfile'); + my $o_sgm = File::Data->new('./sgmlfile'); - print "new SGML data: ".$o_sgm->REPLACE( - '\<\s*((?i)tag)\s*\>\s*((?s).*)\s*\<\s*((?i)\s*\/\s*tag)\s*\>', - qq|<tag>key="val"</tag>|, - ) if $o_sgm; + print "new SGML data: ".$o_sgm->REPLACE( + '\<\s*((?i)tag)\s*\>\s*((?s).*)\s*\<\s*((?i)\s*\/\s*tag)\s*\>', + qq|<tag>key="val"</tag>|, + ) if $o_sgm; See L<METHODS> and L<EXAMPLES>. @@ -65,11 +65,11 @@ See L<METHODS> and L<EXAMPLES>. lowercase method calls return the object itself, so you can chain calls. - my $o_obj = $o_dat->read; # ! <= object ! + my $o_obj = $o_dat->read; # ! <= object ! UPPERCASE method calls return the data relevant to the operation. - my @data = $o_dat->READ; # ! <= data ! + my @data = $o_dat->READ; # ! <= data ! While this may occasionally be frustrating, using the B<principle of least surprise>, it is at least consistent. @@ -90,7 +90,7 @@ Approaches to opening and working with files vary so much, where one person may wish to know if a file exists, another wishes to know whether the target is a file, or if it is readable, or writable and so on. Sometimes, in production code even (horror), file's are opened without any -checks of whether the open was succesful. Then there's a loop through +checks of whether the open was successful. Then there's a loop through each line to find the first or many patterns to read and/or replace. With a failure, normally the only message is 'permission denied', is that read or write access, does the file even exist? etc. @@ -105,15 +105,27 @@ same data. Theoretically you can mix and match your read and writes so long as you don't open read-only. - my $o_dat = File::Data->new($file); + my $o_dat = File::Data->new($file); - my $i_snrd = $o_dat->append($append)->REPLACE($search, $replace); + my $i_snrd = $o_dat->append($append)->REPLACE($search, $replace); - print $o_dat->READ; + print $o_dat->READ; + +If you want to apply the same regex, or insert/prepend/replacement/whatever +mechanism, to many different files, then the neatest solution may be to do +something like the following: + + foreach my $file ( @list_of_file_names ) { + my $o_dat = File::Data->new($file); + + my $i_snrd = $o_dat->append($append)->REPLACE($search, $replace); + + print $o_dat->READ; + } One last thing - I'm sure this could be made more efficient, and I'd be -receptive to any suggestions to that effect. Note though that the intention -has been to create a simple and consistent interface, rather than a complicated +receptive to any suggestions to that effect. Note though that the intention has +been to create a simple and consistent interface, rather than a complicated one. =back @@ -134,9 +146,9 @@ my $_METHODS = join('|', @_METHODS); Create a new File::Data object (default read-write). - my $o_rw = File::Data->new($filename); # read-write + my $o_rw = File::Data->new($filename); # read-write - my $o_ro = File::Data->new($filename, 'ro'); # read-only + my $o_ro = File::Data->new($filename, 'ro'); # read-only Each file should have it's own discrete object. @@ -144,7 +156,7 @@ Note that if you open a file read-only and then attempt to write to it, that will be regarded as an error, even if you change the permissions in the meantime. -Further: The file B<must> exist before succesful use of this method +Further: The file B<must> exist before successful use of this method is possible. This is B<not> a replacement for modules which create and delete files, this is purely designed as an interface to the B<data> of existing files. A B<create> function is a future possibility. @@ -155,229 +167,229 @@ to the B<new()> method =cut sub new { - my $class = shift; - my $file = shift; - my $perms = shift || $File::Data::PERMISSIONS; - my $h_err = shift || {}; - - my $self = bless({ - '_err' => {}, - '_var' => { - 'backup' => 0, - 'limbo' => '', - 'state' => 'init', - 'writable' => 0, - }, - }, $class); - - $self->_debug("file($file), perm($perms), h_err($h_err)") if $File::Data::DEBUG; - my $i_ok = $self->_init($file, $perms, $h_err); - - return $i_ok == 1 ? $self : undef; + my $class = shift; + my $file = shift; + my $perms = shift || $File::Data::PERMISSIONS; + my $h_err = shift || {}; + + my $self = bless({ + '_err' => {}, + '_var' => { + 'backup' => 0, + 'limbo' => '', + 'state' => 'init', + 'writable' => 0, + }, + }, $class); + + $self->_debug("file($file), perm($perms), h_err($h_err)") if $File::Data::DEBUG; + my $i_ok = $self->_init($file, $perms, $h_err); + + return $i_ok == 1 ? $self : undef; } =item read Read all data from file - $o_dat = $o_dat->read; # ! + $o_dat = $o_dat->read; # ! - my @data = $o_dat->READ; + my @data = $o_dat->READ; =cut sub READ { - my $self = shift; + my $self = shift; - $self->_enter('read'); - $self->_debug('in: ') if $File::Data::DEBUG; + $self->_enter('read'); + $self->_debug('in: ') if $File::Data::DEBUG; - my @ret = $self->_read; + my @ret = $self->_read; - $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; - $self->_leave('read'); + $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; + $self->_leave('read'); - return @ret; + return @ret; }; =item _internal read - does this... + does this... =cut sub _read { # - my $self = shift; + my $self = shift; - my $FH = $self->_fh; - $FH->seek(0, 0); - # - my @ret = <$FH>; + my $FH = $self->_fh; + $FH->seek(0, 0); + # + my @ret = <$FH>; - return ($File::Data::REFERENCE) ? \@ret : @ret; + return ($File::Data::REFERENCE) ? \@ret : @ret; }; =item write Write data to file - my $o_dat = $o_dat->WRITE; # ! + my $o_dat = $o_dat->WRITE; # ! - my @written = $o_dat->write; + my @written = $o_dat->write; =cut sub WRITE { - my $self = shift; - my @args = @_; - my @ret = (); + my $self = shift; + my @args = @_; + my @ret = (); - $self->_enter('write'); - $self->_debug('in: '.Dumper(\@args)) if $File::Data::DEBUG; + $self->_enter('write'); + $self->_debug('in: '.Dumper(\@args)) if $File::Data::DEBUG; - if ($self->_writable) { - my $FH = $self->_fh; - $FH->truncate(0); - $FH->seek(0, 0); - @ret = $self->_write(@args); - } + if ($self->_writable) { + my $FH = $self->_fh; + $FH->truncate(0); + $FH->seek(0, 0); + @ret = $self->_write(@args); + } - $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; - $self->_leave('write'); + $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; + $self->_leave('write'); - return ($File::Data::REFERENCE) ? \@ret : @ret; + return ($File::Data::REFERENCE) ? \@ret : @ret; }; sub _write { # - my $self = shift; - my @ret = (); - - my $FH = $self->_fh; - my $pos = $FH->tell; - $self->_debug("writing at curpos: $pos") if $File::Data::DEBUG; - foreach (@_) { - push(@ret, $_) if print $FH $_; + my $self = shift; + my @ret = (); + + my $FH = $self->_fh; + my $pos = $FH->tell; + $self->_debug("writing at curpos: $pos") if $File::Data::DEBUG; + foreach (@_) { + push(@ret, $_) if print $FH $_; $self->_debug("wrote -->$_<--") if $File::Data::DEBUG; - } + } - return ($File::Data::REFERENCE) ? \@ret : @ret; + return ($File::Data::REFERENCE) ? \@ret : @ret; }; =item prepend Prepend to file - my $o_dat = $o_dat->prepen(\@lines); # ! + my $o_dat = $o_dat->prepen(\@lines); # ! - my @prepended = $o_dat->prepend(\@lines); + my @prepended = $o_dat->prepend(\@lines); =cut sub PREPEND { - my $self = shift; - my @ret = (); - - $self->_enter('prepend'); - $self->_debug('in: '.Dumper(@_)) if $File::Data::DEBUG; - - if ($self->_writable) { - my $FH = $self->_fh; - $FH->seek(0, 0); - my @data = <$FH>; - $FH->truncate(0); - $FH->seek(0, 0); - @ret = @_ if $self->_write(@_, @data); - } + my $self = shift; + my @ret = (); + + $self->_enter('prepend'); + $self->_debug('in: '.Dumper(@_)) if $File::Data::DEBUG; + + if ($self->_writable) { + my $FH = $self->_fh; + $FH->seek(0, 0); + my @data = <$FH>; + $FH->truncate(0); + $FH->seek(0, 0); + @ret = @_ if $self->_write(@_, @data); + } - $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; - $self->_leave('prepend'); + $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; + $self->_leave('prepend'); - return ($File::Data::REFERENCE) ? \@ret : @ret; + return ($File::Data::REFERENCE) ? \@ret : @ret; }; =item insert Insert data at line number, starting from '0' - my $o_dat = $o_dat->insert($i_lineno, \@lines); # ! + my $o_dat = $o_dat->insert($i_lineno, \@lines); # ! - my @inserted = $o_dat->INSERT($i_lineno, \@lines); + my @inserted = $o_dat->INSERT($i_lineno, \@lines); =cut sub INSERT { - my $self = shift; - my $line = shift; - my @ret = (); - - $self->_enter('insert'); - $self->_debug('in: '.Dumper(\@_)) if $File::Data::DEBUG; - - if ($line !~ /^\d+$/) { - $self->_error("can't go to non-numeric line($line)"); - } else { - if ($self->_writable) { - my $FH = $self->_fh; - $FH->seek(0, 0); - my $i_cnt = -1; - my @pre = (); - my @post = (); - while (<$FH>) { - $i_cnt++; # 0..n - my $pos = $FH->tell; - if ($i_cnt < $line) { - push(@pre, $_); - } elsif ($i_cnt >= $line) { - push(@post, $_); - } - } - $i_cnt++; - if (!($i_cnt >= $line)) { - my $s = ($i_cnt == 1) ? '' : 's'; - $self->_error("couldn't insert($line, ...) while only $i_cnt line$s in file"); - } else { - $FH->truncate(0); - $FH->seek(0, 0); - @ret = @_ if $self->_write(@pre, @_, @post); - } - } - } - - $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; - $self->_leave('insert'); - - return ($File::Data::REFERENCE) ? \@ret : @ret; + my $self = shift; + my $line = shift; + my @ret = (); + + $self->_enter('insert'); + $self->_debug('in: '.Dumper(\@_)) if $File::Data::DEBUG; + + if ($line !~ /^\d+$/) { + $self->_error("can't go to non-numeric line($line)"); + } else { + if ($self->_writable) { + my $FH = $self->_fh; + $FH->seek(0, 0); + my $i_cnt = -1; + my @pre = (); + my @post = (); + while (<$FH>) { + $i_cnt++; # 0..n + my $pos = $FH->tell; + if ($i_cnt < $line) { + push(@pre, $_); + } elsif ($i_cnt >= $line) { + push(@post, $_); + } + } + $i_cnt++; + if (!($i_cnt >= $line)) { + my $s = ($i_cnt == 1) ? '' : 's'; + $self->_error("couldn't insert($line, ...) while only $i_cnt line$s in file"); + } else { + $FH->truncate(0); + $FH->seek(0, 0); + @ret = @_ if $self->_write(@pre, @_, @post); + } + } + } + + $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; + $self->_leave('insert'); + + return ($File::Data::REFERENCE) ? \@ret : @ret; } =item append Append to file - my $o_dat = $o_dat->append(\@lines); # ! + my $o_dat = $o_dat->append(\@lines); # ! - my @appended = $o_dat->APPEND(\@lines); + my @appended = $o_dat->APPEND(\@lines); =cut sub APPEND { - my $self = shift; - my @ret = (); + my $self = shift; + my @ret = (); - $self->_enter('append'); - $self->_debug('in: '.Dumper(\@_)) if $File::Data::DEBUG; + $self->_enter('append'); + $self->_debug('in: '.Dumper(\@_)) if $File::Data::DEBUG; - if ($self->_writable) { - my $FH = $self->_fh; - $FH->seek(0, 2); - @ret = @_ if $self->_write(@_); - } + if ($self->_writable) { + my $FH = $self->_fh; + $FH->seek(0, 2); + @ret = @_ if $self->_write(@_); + } - $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; - $self->_leave('append'); + $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; + $self->_leave('append'); - return ($File::Data::REFERENCE) ? \@ret : @ret; + return ($File::Data::REFERENCE) ? \@ret : @ret; }; =item search @@ -386,65 +398,66 @@ Retrieve data out of a file, simple list of all matches found are returned. Note - you must use capturing parentheses for this to work! - my $o_dat = $o_dat->search('/^(.*\@.*)$/'); # ! + my $o_dat = $o_dat->search('^(.*\@.*)$'); # ! - my @addrs = $o_dat->SEARCH('/^(.*\@.*)$/'); + my @addrs = $o_dat->SEARCH('^(.*\@.*)$'); - my @names = $o_dat->SEARCH('/^(?:[^:]:){4}([^:]+):/'); + my @names = $o_dat->SEARCH('^(?:[^:]:){4}([^:]+):'); =cut sub SEARCH { - my $self = shift; - my $search = shift; - my @ret = (); - - $self->_enter('search'); - $self->_debug("in: $search") if $File::Data::DEBUG; - - if ($search !~ /.+/) { - $self->_error("no search($search) given"); - } else { - my $file = $self->_var('filename'); - my $FH = $self->_fh; - $FH->seek(0, 0); - my $i_cnt = 0; - if ($File::Data::STRING) { # default - my $orig = $/; $/ = undef; # slurp - my $data = <$FH>; $/ = $orig; - $self->_debug("looking at data($data)") if $File::Data::DEBUG; - @ret = ($data =~ /$search/g); - $i_cnt = ($data =~ tr/\n/\n/); - } else { - while (<$FH>) { - $self->_debug("looking at line($_)") if $File::Data::DEBUG; - my $line = $_; - push(@ret, ($line =~ /$search/)); - $i_cnt++; - } - } - if (scalar(@ret) >= 1) { - $self->_debug("search($search) failed(@ret) in file($file) lines($i_cnt)"); - } - } - - $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; - $self->_leave('search'); - - return ($File::Data::REFERENCE) ? \@ret : @ret; + my $self = shift; + my $search = shift; + my @ret = (); + + $self->_enter('search'); + $self->_debug("in: $search") if $File::Data::DEBUG; + + if ($search !~ /.+/) { + $self->_error("no search($search) given"); + } else { + my $file = $self->_var('filename'); + my $FH = $self->_fh; + $FH->seek(0, 0); + my $i_cnt = 0; + if ($File::Data::STRING) { # default + my $orig = $/; $/ = undef; # slurp + my $data = <$FH>; $/ = $orig; + $self->_debug("looking at data($data)") if $File::Data::DEBUG; + @ret = ($data =~ /$search/g); + $i_cnt = ($data =~ tr/\n/\n/); + } else { + while (<$FH>) { + $self->_debug("looking at line($_)") if $File::Data::DEBUG; + my $line = $_; + # push(@ret, ($line =~ /$search/)); + push(@ret, $line) if ($line =~ /$search/); + $i_cnt++; + } + } + if (scalar(@ret) >= 1) { + $self->_debug("search($search) in file($file) lines($i_cnt) result(@ret)"); + } + } + + $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; + $self->_leave('search'); + + return ($File::Data::REFERENCE) ? \@ret : @ret; } =item replace Replace data in a 'search and replace' manner, returns the final data. - my $o_dat = $o_dat->replace($search, $replace); # ! + my $o_dat = $o_dat->replace($search, $replace); # ! - my @data = $o_dat->REPLACE($search, $replace); + my @data = $o_dat->REPLACE($search, $replace); - my @data = $o_dat->REPLACE( - q|\<a href=(['"])([^$1]+)?$1| => q|'my.sales.com'|, - ); + my @data = $o_dat->REPLACE( + q|\<a href=(['"])([^$1]+)?$1| => q|'my.sales.com'|, + ); This is B<simple>, in that you can do almost anything in the B<search> side, but the B<replace> side is a bit more restricted, as we can't effect the @@ -455,56 +468,56 @@ If you really need this, perhaps B<(?{})> can help? =cut sub REPLACE { - my $self = shift; - my %args = @_; - my @ret = (); - - $self->_enter('replace'); - $self->_debug('in: '.Dumper(\%args)) if $File::Data::DEBUG; - - if ($self->_writable) { - my $file = $self->_var('filename'); - my $FH = $self->_fh; - $FH->seek(0, 0); - my $i_cnt = 0; - SEARCH: - foreach my $search (keys %args) { - my $replace = $args{$search}; - if ($File::Data::STRING) { # default - my $orig = $/; $/ = undef; # slurp - my $data = <$FH>; $/ = $orig; - $self->_debug("initial ($data)") if $File::Data::DEBUG; - if (($i_cnt = ($data =~ s/$search/$replace/g))) { - @ret = $data; - } else { - print "unable($i_cnt) to search($search) and replace($replace)\n"; - } - } else { - while (<$FH>) { - $self->_debug("initial line($_)") if $File::Data::DEBUG; - my $line = $_; - if ($line =~ s/$search/$replace/) { - $i_cnt++; - } - push(@ret, $line); - } - } + my $self = shift; + my %args = @_; + my @ret = (); + + $self->_enter('replace'); + $self->_debug('in: '.Dumper(\%args)) if $File::Data::DEBUG; + + if ($self->_writable) { + my $file = $self->_var('filename'); + my $FH = $self->_fh; + $FH->seek(0, 0); + my $i_cnt = 0; + SEARCH: + foreach my $search (keys %args) { + my $replace = $args{$search}; + if ($File::Data::STRING) { # default + my $orig = $/; $/ = undef; # slurp + my $data = <$FH>; $/ = $orig; + $self->_debug("initial ($data)") if $File::Data::DEBUG; + if (($i_cnt = ($data =~ s/$search/$replace/g))) { + @ret = $data; + } else { + print "unable($i_cnt) to search($search) and replace($replace)\n"; + } + } else { + while (<$FH>) { + $self->_debug("initial line($_)") if $File::Data::DEBUG; + my $line = $_; + if ($line =~ s/$search/$replace/) { + $i_cnt++; + } + push(@ret, $line); + } + } if (scalar(@ret) >= 1) { $FH->seek(0, 0); $FH->truncate(0); $FH->seek(0, 0); @ret = $self->_write(@ret); } - if (!($i_cnt >= 1)) { - $self->_debug("nonfulfilled search($search) and replace($replace) in file($file)"); - } - } - } + if (!($i_cnt >= 1)) { + $self->_debug("nonfulfilled search($search) and replace($replace) in file($file)"); + } + } + } - $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; - $self->_leave('replace'); + $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; + $self->_leave('replace'); - return ($File::Data::REFERENCE) ? \@ret : @ret; + return ($File::Data::REFERENCE) ? \@ret : @ret; } =item xreturn @@ -520,17 +533,17 @@ Returns the product of the given (or last) B<do()>, undef on failure. =cut sub RETURN { - my $self = shift; - my $call = uc(shift) || $self->_var('last'); - - if ((defined($self->{'_var'}{$call}) && - ref($self->{'_var'}{$call}) eq 'ARRAY' - )) { - return @{$self->_var($call)}; - } else { - $self->_debug("not returning invalid call($call) ref($self->{'_var'}{$call})"); - return undef; - } + my $self = shift; + my $call = uc(shift) || $self->_var('last'); + + if ((defined($self->{'_var'}{$call}) && + ref($self->{'_var'}{$call}) eq 'ARRAY' + )) { + return @{$self->_var($call)}; + } else { + $self->_debug("not returning invalid call($call) ref($self->{'_var'}{$call})"); + return undef; + } } =item create @@ -540,11 +553,11 @@ placeholder - unsupported =cut sub create { - my $self = shift; + my $self = shift; - $self->_error("unsupported call: __FILE__(@_)"); + $self->_error("unsupported call: __FILE__(@_)"); - return (); + return (); } =item delete @@ -554,25 +567,25 @@ placeholder - unsupported =cut sub delete { - my $self = shift; + my $self = shift; - $self->_error("unsupported call: __FILE__(@_)"); + $self->_error("unsupported call: __FILE__(@_)"); - return (); + return (); } =item close Close the file - my $i_closed = $o_dat->close; # 1|0 + my $i_closed = $o_dat->close; # 1|0 =cut sub close { - my $self = shift; + my $self = shift; - return $self->_close; + return $self->_close; } @@ -584,47 +597,47 @@ placeholder - unsupported # Returns File::stat object for the file. -# print 'File size: '.$o_dat->stat->size; +# print 'File size: '.$o_dat->stat->size; sub xFSTAT { - my $self = shift; - my $file = shift || '_'; + my $self = shift; + my $file = shift || '_'; - # print "file($file) stat: ".Dumper(stat($file)); + # print "file($file) stat: ".Dumper(stat($file)); - # return stat($file); + # return stat($file); - return (); + return (); } sub xfstat { - my $self = shift; - my $file = shift || '_'; + my $self = shift; + my $file = shift || '_'; - # print "file($file) stat: ".Dumper(stat($file)); + # print "file($file) stat: ".Dumper(stat($file)); - # stat($file); + # stat($file); - return (); + return (); } sub dummy { - my $self = shift; - my %args = @_; - my @ret = (); + my $self = shift; + my %args = @_; + my @ret = (); - $self->_enter('dummy'); - $self->_debug('in: '.Dumper(\%args)) if $File::Data::DEBUG; + $self->_enter('dummy'); + $self->_debug('in: '.Dumper(\%args)) if $File::Data::DEBUG; - # if ($self->_writable) { - # - # $FH->seek(0, 2); - # } + # if ($self->_writable) { + # + # $FH->seek(0, 2); + # } - $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; - $self->_leave('dummy'); + $self->_debug('out: '.Dumper(\@ret)) if $File::Data::DEBUG; + $self->_leave('dummy'); - return ($File::Data::REFERENCE) ? \@ret : @ret; + return ($File::Data::REFERENCE) ? \@ret : @ret; } =back @@ -643,11 +656,11 @@ Various variables may be set affecting the behaviour of the module. Set to 0 (default) or 1 for debugging information to be printed on STDOUT. - $File::Data::DEBUG = 1; + $File::Data::DEBUG = 1; Alternatively set to a regex of any of the prime methods to debug them individually. - $File::Data::DEBUG = '(ap|pre)pend'; + $File::Data::DEBUG = '(ap|pre)pend'; =cut @@ -660,7 +673,7 @@ Will die if there is any failure in accessing the file, or reading the data. Default = 0 (don't die - just warn); - $File::Data::FATAL = 1; # die + $File::Data::FATAL = 1; # die =cut @@ -673,11 +686,11 @@ Will return a reference, not a list, useful with large files. Default is 0, ie; methods normally returns a list. There may be an argument to make returns work with references by default, feedback will decide. - $File::Data::REFERENCE = 1; + $File::Data::REFERENCE = 1; - my $a_ref = $o_dat->search('.*'); + my $a_ref = $o_dat->search('.*'); - print "The log: \n".@{ $a_ref }; + print "The log: \n".@{ $a_ref }; =cut @@ -688,7 +701,7 @@ $File::Data::REFERENCE ||= $ENV{'File_Data_REFERENCE'} || 0; Set to something other than zero if you don't want error messages ?-\ - $File::Data::SILENT = 0; # per line + $File::Data::SILENT = 0; # per line =cut @@ -702,7 +715,7 @@ single scalar string, so that, for example, B<(?ms:...)> matches are effective. Unset if you don't want this behaviour. - $File::Data::STRING = 0; # per line + $File::Data::STRING = 0; # per line =cut @@ -719,11 +732,11 @@ We don't support fancy permission sets, just read or write. Read-only permissions may be explicitly set using one of these B<keys>: - $File::Data::PERMISSIONS = 'ro'; # or readonly or < + $File::Data::PERMISSIONS = 'ro'; # or readonly or < Or, equivalently, for read-write (default): - $File::Data::PERMISSIONS = 'rw'; # or readwrite or +< + $File::Data::PERMISSIONS = 'rw'; # or readwrite or +< Note that it makes no sense to have an 'append only' command (>>), we'd have to disable all of write, search and replace, and insert, @@ -751,7 +764,7 @@ $File::Data::PERMISSIONS ||= $ENV{'File_Data_PERMISSIONS'} || '+<'; Any unrecognised function will be passed to the FileHandle object for final consideration, behaviour is then effectively 'o_dat ISA FileHandle'. - $o_dat->truncate; + $o_dat->truncate; =cut @@ -760,20 +773,20 @@ sub AUTOLOAD { return if $AUTOLOAD =~ /::DESTROY$/o; # protection my $meth = $AUTOLOAD; - $meth =~ s/.+::([^:]+)$/$1/; + $meth =~ s/.+::([^:]+)$/$1/; - if ($meth =~ /^($_METHODS)$/io) { # convenience - $self->_debug("rerouting: $meth(@_)"); - return $self->do(uc($meth), @_); # <- + if ($meth =~ /^($_METHODS)$/io) { # convenience + $self->_debug("rerouting: $meth(@_)"); + return $self->do(uc($meth), @_); # <- # return $self->do(lc($meth), @_); - } else { # or fallback - my $FH = $self->_fh; - if ($FH->can($meth)) { - return $FH->$meth(@_); # <- - } else { - $DB::single=2; # - return $self->_error("no such method($meth)!"); # <- - } + } else { # or fallback + my $FH = $self->_fh; + if ($FH->can($meth)) { + return $FH->$meth(@_); # <- + } else { + $DB::single=2; # + return $self->_error("no such method($meth)!"); # <- + } } } @@ -787,29 +800,29 @@ sub AUTOLOAD { Typical construction examples: - my $o_rw = File::Data->new($filename, 'rw'); + my $o_rw = File::Data->new($filename, 'rw'); - my $o_ro = File::Data->new($filename, 'ro'); + my $o_ro = File::Data->new($filename, 'ro'); =over 4 =item complete - my $o_dat = File::Data->new('./jabber'); + my $o_dat = File::Data->new('./jabber'); - $o_dat->write(" Bewxre the Jabberwock my son,\n"); + $o_dat->write(" Bewxre the Jabberwock my son,\n"); - $o_dat->prepend("The Jxbberwock by Lewis Cxrroll:\n"); + $o_dat->prepend("The Jxbberwock by Lewis Cxrroll:\n"); - $o_dat->append(" the claws thxt snxtch,\n ...\n"); + $o_dat->append(" the claws thxt snxtch,\n ...\n"); - $o_dat->insert(2, " the jaws which bite.\n"); + $o_dat->insert(2, " the jaws which bite.\n"); - $o_dat->replace('x', 'a'); + $o_dat->replace('x', 'a'); - print $o_dat->SEARCH('The.+\n')->REPLACE("The.+\n", '')->return('search'); + print $o_dat->SEARCH('The.+\n')->REPLACE("The.+\n", '')->return('search'); - print $o_dat->READ; + print $o_dat->READ; =item error @@ -821,25 +834,25 @@ special B<init> call for initial file opening and general setting up. Create a read-write object with a callback for all errors: - my $o_rw = File::Data->new($filename, 'ro', { - 'error' => \&myerror, - }); + my $o_rw = File::Data->new($filename, 'ro', { + 'error' => \&myerror, + }); Create a read-only object with a separate object handler for each error type: - my $o_rw = File::Data->new($filename, 'rw', { - 'error' => $o_generic->error_handler, - 'insert' => $o_handler->insert_error, - 'open' => $o_open_handler, - 'read' => \&carp, - 'write' => \&write_error, - }); + my $o_rw = File::Data->new($filename, 'rw', { + 'error' => $o_generic->error_handler, + 'insert' => $o_handler->insert_error, + 'open' => $o_open_handler, + 'read' => \&carp, + 'write' => \&write_error, + }); =item commandline From the command line: - C<perl -MFile::Data -e "File::Data->new('./test.txt')->write('some stuff')"> + C<perl -MFile::Data -e "File::Data->new('./test.txt')->write('some stuff')"> And (very non-obfuscated) @@ -855,8 +868,8 @@ And (very non-obfuscated) > If you still have problems, mail me the output of - - make test TEST_VERBOSE=1 + + make test TEST_VERBOSE=1 =cut @@ -868,85 +881,85 @@ If you still have problems, mail me the output of # Variable get/set method # -# my $get = $o_dat->_var($key); # get +# my $get = $o_dat->_var($key); # get # -# my $set = $o_dat->_var($key, $val); # set +# my $set = $o_dat->_var($key, $val); # set # @_METHODS, qw(append insert prepend read replace return search write); my $_VARS = join('|', @_METHODS, qw( - backup error errors filename filehandle last limbo permissions state writable + backup error errors filename filehandle last limbo permissions state writable )); sub _var { - my $self = shift; - my $key = shift; - my $val = shift; - my $ret = ''; - - # if (!(grep(/^_$key$/, keys %{$self{'_var'}}))) { - if ($key !~ /^($_VARS)$/io) { - $self->_error("No such key($key) val($val)!"); - } else { - if (defined($val)) { - $self->{'_var'}{$key} = $val; - # {"$File::Data::$key"} = $val; - $self->_debug("set key($key) => val($val)"); - } - $ret = $self->{'_var'}{$key}; - } - - return $ret; + my $self = shift; + my $key = shift; + my $val = shift; + my $ret = ''; + + # if (!(grep(/^_$key$/, keys %{$self{'_var'}}))) { + if ($key !~ /^($_VARS)$/io) { + $self->_error("No such key($key) val($val)!"); + } else { + if (defined($val)) { + $self->{'_var'}{$key} = $val; + # {"$File::Data::$key"} = $val; + $self->_debug("set key($key) => val($val)"); + } + $ret = $self->{'_var'}{$key}; + } + + return $ret; } # Print given args on STDOUT # -# $o_dat->_debug($msg) if $File::Data::DEBUG; +# $o_dat->_debug($msg) if $File::Data::DEBUG; sub _debug { - my $self = shift; + my $self = shift; - my $state = $self->{'_var'}{'state'}; # ahem - my $debug = $File::Data::DEBUG; + my $state = $self->{'_var'}{'state'}; # ahem + my $debug = $File::Data::DEBUG; - if (($debug =~ /^(\d+)$/o && $1 >= 1) || - $debug =~ /^(.+)$/o && $state =~ /$debug/ - ) { - print ("$state: ", @_, "\n"); - } + if (($debug =~ /^(\d+)$/o && $1 >= 1) || + $debug =~ /^(.+)$/o && $state =~ /$debug/ + ) { + print ("$state: ", @_, "\n"); + } - return (); + return (); } # Return dumped env and object B<key> and B<values> # -# print $o_dat->_vars; +# print $o_dat->_vars; sub _vars { - my $self = shift; - my $h_ret = $self; - - no strict 'refs'; - foreach my $key (keys %{File::Data::}) { - next unless $key =~ /^[A-Z]+$/o; - next if $key =~ /^(BEGIN|EXPORT)/o; - my $var = "File::Data::$key"; - $$h_ret{'_pck'}{$key} = $$var; - } - - return Dumper($h_ret); + my $self = shift; + my $h_ret = $self; + + no strict 'refs'; + foreach my $key (keys %{File::Data::}) { + next unless $key =~ /^[A-Z]+$/o; + next if $key =~ /^(BEGIN|EXPORT)/o; + my $var = "File::Data::$key"; + $$h_ret{'_pck'}{$key} = $$var; + } + + return Dumper($h_ret); } # Get/set error handling methods/objects # -# my $c_sub = $o_dat->_err('insert'); # or default +# my $c_sub = $o_dat->_err('insert'); # or default sub _err { - my $self = shift; - my $state = shift || $self->_var('state'); + my $self = shift; + my $state = shift || $self->_var('state'); - my $err = $self->{'_err'}{$state} || $self->{'_err'}{'default'}; + my $err = $self->{'_err'}{$state} || $self->{'_err'}{'default'}; - return $err; + return $err; } # By default prints error to STDERR, will B<croak> if B<File::Data::FATAL> set, @@ -954,361 +967,361 @@ sub _err { # handlers in. sub _error { - my $self = shift; - my @err = @_; - my @ret = (); - - my $state = $self->_var('state'); - my $c_ref = $self->_err($state ); - my $error = $self->_var('error'); - unshift(@err, "$state ERROR: "); - my $ref = $self->_var('errors', join("\n", @err)); - - # $self->_debug($self->_vars) if $File::Data::DEBUG; - - if (ref($c_ref) eq 'CODE') { - eval { @ret = &$c_ref(@err) }; - if ($@) { - $File::Data::FATAL >= 1 - ? croak("$0 failed: $c_ref(@err)") - : carp("$0 failed: $c_ref(@err)") - ; - } - } elsif (ref($c_ref) && $c_ref->can($state)) { - eval { @ret = $c_ref->$state(@err) }; - if ($@) { - $File::Data::FATAL >= 1 - ? croak("$0 failed: $c_ref(@err)") - : carp("$0 failed: $c_ref(@err)") - ; - } - } else { - unless ($File::Data::SILENT) { - ($File::Data::FATAL >= 1) ? croak(@err) : carp(@err); - } - } - - return (); # + my $self = shift; + my @err = @_; + my @ret = (); + + my $state = $self->_var('state'); + my $c_ref = $self->_err($state ); + my $error = $self->_var('error'); + unshift(@err, "$state ERROR: "); + my $ref = $self->_var('errors', join("\n", @err)); + + # $self->_debug($self->_vars) if $File::Data::DEBUG; + + if (ref($c_ref) eq 'CODE') { + eval { @ret = &$c_ref(@err) }; + if ($@) { + $File::Data::FATAL >= 1 + ? croak("$0 failed: $c_ref(@err)") + : carp("$0 failed: $c_ref(@err)") + ; + } + } elsif (ref($c_ref) && $c_ref->can($state)) { + eval { @ret = $c_ref->$state(@err) }; + if ($@) { + $File::Data::FATAL >= 1 + ? croak("$0 failed: $c_ref(@err)") + : carp("$0 failed: $c_ref(@err)") + ; + } + } else { + unless ($File::Data::SILENT) { + ($File::Data::FATAL >= 1) ? croak(@err) : carp(@err); + } + } + + return (); # } -# my $file = $o_dat->_mapfile($filename); +# my $file = $o_dat->_mapfile($filename); sub _mapfile { - my $self = shift; - my $file = shift || ''; - - $file =~ s/^\s*//o; - $file =~ s/\s*$//o; - - unless ($file =~ /\w+/o) { - $file = ''; - $self->_error("inappropriate filename($file)"); - } else { - my $xfile = $self->_var('filename') || ''; - if ($xfile =~ /.+/o) { - $file = ''; - $self->_error("can't reuse ".ref($self)." object($xfile) for another file($file)"); - } - } - - return $file; + my $self = shift; + my $file = shift || ''; + + $file =~ s/^\s*//o; + $file =~ s/\s*$//o; + + unless ($file =~ /\w+/o) { + $file = ''; + $self->_error("inappropriate filename($file)"); + } else { + my $xfile = $self->_var('filename') || ''; + if ($xfile =~ /.+/o) { + $file = ''; + $self->_error("can't reuse ".ref($self)." object($xfile) for another file($file)"); + } + } + + return $file; } # Maps given permissions to appropriate form for B<FileHandle> # -# my $perms = $o_dat->_mapperms('+<'); +# my $perms = $o_dat->_mapperms('+<'); sub _mapperms { - my $self = shift; - my $args = shift || ''; + my $self = shift; + my $args = shift || ''; - $args =~ s/^\s*//o; - $args =~ s/\s*$//o; + $args =~ s/^\s*//o; + $args =~ s/\s*$//o; - my %map = ( # we only recognise - 'ro' => '<', - 'readonly' => '<', - 'rw' => '+<', - 'readwrite' => '+<', - ); - my $ret = $map{$args} || $args; + my %map = ( # we only recognise + 'ro' => '<', + 'readonly' => '<', + 'rw' => '+<', + 'readwrite' => '+<', + ); + my $ret = $map{$args} || $args; - $self->_error("Inappropriate permissions($args) - use this: ".Dumper(\%map)) - unless $ret =~ /.+/o; + $self->_error("Inappropriate permissions($args) - use this: ".Dumper(\%map)) + unless $ret =~ /.+/o; - return $ret; + return $ret; } # Map error handlers, if given # -# my $h_errs = $o_dat->_maperrs(\%error_handlers); +# my $h_errs = $o_dat->_maperrs(\%error_handlers); sub _mapperrs { - my $self = shift; - my $h_errs = shift || {}; - - if (ref($h_errs) ne 'HASH') { - $self->_error("invalid error_handlers($h_errs)"); - } else { - foreach my $key (%{$h_errs}) { - $self->{'_err'}{$key} = $$h_errs{$key}; - } - } - - return $self->{'_err'}; + my $self = shift; + my $h_errs = shift || {}; + + if (ref($h_errs) ne 'HASH') { + $self->_error("invalid error_handlers($h_errs)"); + } else { + foreach my $key (%{$h_errs}) { + $self->{'_err'}{$key} = $$h_errs{$key}; + } + } + + return $self->{'_err'}; } # Mark the entering of a special section, or state # -# my $entered = $o_dat->enter('search'); +# my $entered = $o_dat->enter('search'); sub _enter { - my $self = shift; - my $sect = shift; - - my $last = $self->_var('state'); - $self->_var('last' => $last) unless $last eq 'limbo'; - my $next = $self->_var('state' => $sect); + my $self = shift; + my $sect = shift; + + my $last = $self->_var('state'); + $self->_var('last' => $last) unless $last eq 'limbo'; + my $next = $self->_var('state' => $sect); - # $self->_debug("vars") if $File::Data::DEBUG; + # $self->_debug("vars") if $File::Data::DEBUG; - return $next; + return $next; } # Mark the leaving of a special section, or state # -# my $left = $o_dat->_leave('search'); +# my $left = $o_dat->_leave('search'); sub _leave { - my $self = shift; - my $sect = shift; - - my $last = $self->_var('state'); - $self->_var('last' => $last) unless $last eq 'limbo'; - my $next = $self->_var('state' => 'limbo'); + my $self = shift; + my $sect = shift; + + my $last = $self->_var('state'); + $self->_var('last' => $last) unless $last eq 'limbo'; + my $next = $self->_var('state' => 'limbo'); - # $self->_debug("leaving state($last) => next($next)") if $File::Data::DEBUG; + # $self->_debug("leaving state($last) => next($next)") if $File::Data::DEBUG; - return $last; + return $last; } # Get and set B<FileHandle>. Returns undef otherwise. # -# my $FH = $o_dat->_fh($FH); +# my $FH = $o_dat->_fh($FH); sub _fh { - my $self = shift; - my $arg = shift; + my $self = shift; + my $arg = shift; - my $FH = (defined($arg) - ? $self->_var('filehandle', $arg) - : $self->_var('filehandle') - ); - $self->_error("no filehandle($FH)") unless $FH; + my $FH = (defined($arg) + ? $self->_var('filehandle', $arg) + : $self->_var('filehandle') + ); + $self->_error("no filehandle($FH)") unless $FH; - return $FH; + return $FH; } # ================================================================ # Return values: # -# 1 = success +# 1 = success # -# 0 = failure +# 0 = failure # Setup object, open a file, with permissions. # -# my $i_ok = $o_dat->_init( $file, $perm, $h_errs ); +# my $i_ok = $o_dat->_init( $file, $perm, $h_errs ); sub _init { - my $self = shift; - my $file = shift; - my $perm = shift; - my $h_err= shift; - my $i_ok = 0; - - # $self->_enter('init'); - $self->_debug("in: file($file), perm($perm), h_err($h_err)") if $File::Data::DEBUG; - - $file = $self->_mapfile($file ); - $perm = $self->_mapperms($perm ) if $file; - $h_err = $self->_mapperrs($h_err) if $file; # if $perm - - if ($file) { # unless $h_err - $i_ok = $self->_check_access($file, $perm); - if ($i_ok == 1) { - $file = $self->_var('filename', $file); - $perm = $self->_var('permissions', $perm); - $i_ok = $self->_open($file, $perm); - $i_ok = $self->_backup() if $i_ok && $self->_var('backup'); - } - } - # $self->_error("failed for file($file) and perm($perm)") unless $i_ok == 1; - - $self->_debug("out: $i_ok") if $File::Data::DEBUG; - $self->_leave('init'); - - return $i_ok; + my $self = shift; + my $file = shift; + my $perm = shift; + my $h_err= shift; + my $i_ok = 0; + + # $self->_enter('init'); + $self->_debug("in: file($file), perm($perm), h_err($h_err)") if $File::Data::DEBUG; + + $file = $self->_mapfile($file ); + $perm = $self->_mapperms($perm ) if $file; + $h_err = $self->_mapperrs($h_err) if $file; # if $perm + + if ($file) { # unless $h_err + $i_ok = $self->_check_access($file, $perm); + if ($i_ok == 1) { + $file = $self->_var('filename', $file); + $perm = $self->_var('permissions', $perm); + $i_ok = $self->_open($file, $perm); + $i_ok = $self->_backup() if $i_ok && $self->_var('backup'); + } + } + # $self->_error("failed for file($file) and perm($perm)") unless $i_ok == 1; + + $self->_debug("out: $i_ok") if $File::Data::DEBUG; + $self->_leave('init'); + + return $i_ok; } # Checks the args for existence and appropriate permissions etc. # -# my $i_isok = $o_dat->_check_access($filename, $permissions); +# my $i_isok = $o_dat->_check_access($filename, $permissions); sub _check_access { - my $self = shift; - my $file = shift; - my $perm = shift; - my $i_ok = 0; - - if (!($file =~ /.+/o && $perm =~ /.+/o)) { - $self->_error("no filename($file) or permissions($perm) given!"); - } else { - stat($file); # just once - if (! -e _) { - $self->_error("target($file) does not exist!"); - } else { - if (! -f _) { - $self->_error("target($file) is not a file!"); - } else { - if (!-r _) { - $self->_error("file($file) cannot be read by effective uid($>) or gid($))!"); - } else { - if ($perm =~ /^<$/o) { # readable - $i_ok++; - } else { - if (! -w $file) { - $self->_error("file($file) cannot be written by effective uid($>) or gid($))!"); - } else { # writable - $self->_var('writable' => 1); - $i_ok++; - } - } - } - } - } - } - - return $i_ok; + my $self = shift; + my $file = shift; + my $perm = shift; + my $i_ok = 0; + + if (!($file =~ /.+/o && $perm =~ /.+/o)) { + $self->_error("no filename($file) or permissions($perm) given!"); + } else { + stat($file); # just once + if (! -e _) { + $self->_error("target($file) does not exist!"); + } else { + if (! -f _) { + $self->_error("target($file) is not a file!"); + } else { + if (!-r _) { + $self->_error("file($file) cannot be read by effective uid($>) or gid($))!"); + } else { + if ($perm =~ /^<$/o) { # readable + $i_ok++; + } else { + if (! -w $file) { + $self->_error("file($file) cannot be written by effective uid($>) or gid($))!"); + } else { # writable + $self->_var('writable' => 1); + $i_ok++; + } + } + } + } + } + } + + return $i_ok; } # Open the file # -# my $i_ok = $o_dat->_open; +# my $i_ok = $o_dat->_open; sub _open { - my $self = shift; - my $file = $self->_var('filename'); - my $perm = $self->_var('permissions'); - my $i_ok = 0; - - my $open = "$perm $file"; - $self->_debug("using open($open)"); - - my $FH = FileHandle->new("$perm $file") || ''; - my @file = (); - # my $FH = tie(@file, 'Tie::File', $file) or ''; - if (!$FH) { - $self->_error("Can't get handle($FH) for file($file) with permissions($perm)! $!"); - } else { - # $FH = $self->_fh(\@file); - $FH = $self->_fh($FH); - if ($FH) { - $i_ok++; - $i_ok = $self->_lock(); # if $self->_writable; - } - $self->_debug("FH($FH) => i_ok($i_ok)"); - } - - return $i_ok; + my $self = shift; + my $file = $self->_var('filename'); + my $perm = $self->_var('permissions'); + my $i_ok = 0; + + my $open = "$perm $file"; + $self->_debug("using open($open)"); + + my $FH = FileHandle->new("$perm $file") || ''; + my @file = (); + # my $FH = tie(@file, 'Tie::File', $file) or ''; + if (!$FH) { + $self->_error("Can't get handle($FH) for file($file) with permissions($perm)! $!"); + } else { + # $FH = $self->_fh(\@file); + $FH = $self->_fh($FH); + if ($FH) { + $i_ok++; + $i_ok = $self->_lock(); # if $self->_writable; + } + $self->_debug("FH($FH) => i_ok($i_ok)"); + } + + return $i_ok; }; # Lock the file # -# my $i_ok = $o_dat->_lock; +# my $i_ok = $o_dat->_lock; sub _lock { - my $self = shift; - my $FH = $self->_fh; - my $i_ok = 0; - - if ($FH) { - my $file = $self->_var('filename'); - if ($self->_writable) { - # if ($FH->flock(LOCK_EX | LOCK_NB)) { - if (flock($FH, LOCK_EX | LOCK_NB)) { - $i_ok++; - } else { - $self->_error("Can't overlock file($file) handle($FH)!"); - } - } else { - # if ($FH->flock(LOCK_SH | LOCK_NB)) { - if (flock($FH, LOCK_SH | LOCK_NB)) { - $i_ok++; - } else { - $self->_error("Can't lock shared file($file) handle($FH)!"); - } - } - } - - return $i_ok; + my $self = shift; + my $FH = $self->_fh; + my $i_ok = 0; + + if ($FH) { + my $file = $self->_var('filename'); + if ($self->_writable) { + # if ($FH->flock(LOCK_EX | LOCK_NB)) { + if (flock($FH, LOCK_EX | LOCK_NB)) { + $i_ok++; + } else { + $self->_error("Can't overlock file($file) handle($FH)!"); + } + } else { + # if ($FH->flock(LOCK_SH | LOCK_NB)) { + if (flock($FH, LOCK_SH | LOCK_NB)) { + $i_ok++; + } else { + $self->_error("Can't lock shared file($file) handle($FH)!"); + } + } + } + + return $i_ok; }; # Unlock the file # -# my $i_ok = $o_dat->_unlock; +# my $i_ok = $o_dat->_unlock; sub _unlock { - my $self = shift; - my $FH = $self->_fh; - my $i_ok = 0; - - if ($FH) { - # if (flock($FH, LOCK_UN)) { apparently there's a race, perl does it better - see close :) } - $i_ok++; - } else { - my $file = $self->_var('filename'); - $self->_error("Can't unlock file($file) handle($FH)!"); - } - - return $i_ok; + my $self = shift; + my $FH = $self->_fh; + my $i_ok = 0; + + if ($FH) { + # if (flock($FH, LOCK_UN)) { apparently there's a race, perl does it better - see close :) } + $i_ok++; + } else { + my $file = $self->_var('filename'); + $self->_error("Can't unlock file($file) handle($FH)!"); + } + + return $i_ok; } # Close the filehandle # -# my $i_ok = $o_dat->_close; +# my $i_ok = $o_dat->_close; sub _close { - my $self = shift; - my $FH = $self->_fh if $self->_var('filehandle'); - my $i_ok = 0; - - if ($FH) { - # $FH->untie; - if ($FH->close) { # perl unlocks it better than we can (race) - $i_ok++; - } else { - $DB::single=2; # - my $file = $self->_var('filename'); - $self->_error("Can't close file($file) handle($FH)!"); - } - } - - return $i_ok; + my $self = shift; + my $FH = $self->_fh if $self->_var('filehandle'); + my $i_ok = 0; + + if ($FH) { + # $FH->untie; + if ($FH->close) { # perl unlocks it better than we can (race) + $i_ok++; + } else { + $DB::single=2; # + my $file = $self->_var('filename'); + $self->_error("Can't close file($file) handle($FH)!"); + } + } + + return $i_ok; } sub _writable { - my $self = shift; + my $self = shift; - my $i_ok = $self->_var('writable'); + my $i_ok = $self->_var('writable'); - if ($i_ok != 1) { - my $file = $self->_var('filename'); - my $perms = $self->_var('permissions'); - $self->_debug("$file not writable($i_ok) with permissions($perms)"); - } + if ($i_ok != 1) { + my $file = $self->_var('filename'); + my $perms = $self->_var('permissions'); + $self->_debug("$file not writable($i_ok) with permissions($perms)"); + } - return $i_ok; + return $i_ok; } =item do @@ -1337,34 +1350,34 @@ L<return()> =cut sub DO { - my $self = shift; - my $call = shift; - my @res = (); - - $self->_enter('do'); - $self->_debug('in: '.Dumper([$call, @_])) if $File::Data::DEBUG; - - if ($call !~ /^($_METHODS)$/io) { - $self->_error("unsupported method($call)"); - } else { - $call = uc($call); - $self->_var($call => []); - my @res = $self->$call(@_); - $self->_var($call => (ref($res[0]) ? $res[0] : \@res)); - } - - $self->_debug('out: $self') if $File::Data::DEBUG; - $self->_leave('do'); - - return @res; + my $self = shift; + my $call = shift; + my @res = (); + + $self->_enter('do'); + $self->_debug('in: '.Dumper([$call, @_])) if $File::Data::DEBUG; + + if ($call !~ /^($_METHODS)$/io) { + $self->_error("unsupported method($call)"); + } else { + $call = uc($call); + $self->_var($call => []); + my @res = $self->$call(@_); + $self->_var($call => (ref($res[0]) ? $res[0] : \@res)); + } + + $self->_debug('out: $self') if $File::Data::DEBUG; + $self->_leave('do'); + + return @res; } sub do { - my $self = shift; + my $self = shift; - $self->DO(@_); + $self->DO(@_); - return $self; + return $self; } =back @@ -1374,13 +1387,20 @@ sub do { # ================================================================ sub DESTROY { - my $self = shift; - $self->_close; + my $self = shift; + $self->_close; } =head1 AUTHOR -"Richard Foley" <file.d...@rfi.net> +Richard Foley <file.d...@rfi.net> + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2016 by Richard Foley + +This is free software; you can redistribute it and/or modify it under the same +terms as the Perl 5 programming language system itself. =cut diff --git a/t/test.t b/t/test.t index 1297602..aa2a421 100644 --- a/t/test.t +++ b/t/test.t @@ -1,16 +1,15 @@ use Data::Dumper; use lib qw( lib ); use File::Data; -use Test; +use Test::More; use strict; -plan('tests' => 16); - my $i_test = 0; my $i_errs = 0; $File::Data::FATAL=0; $File::Data::REFERENCE=0; +$File::Data::DEBUG=0; my $rj = './t/japh'; my $ro = './t/read'; @@ -25,22 +24,23 @@ $i_test++; # 1 $i_errs = 0; foreach my $perm (qw(ro > <)) { - my $o_ro = File::Data->new($ro, $perm); # read + my $o_ro = File::Data->new($ro, $perm); # read unless (ref($o_ro)) { $i_errs++; - print "[$i_test] failed read-only file($ro, $perm) => o_ro($o_ro)\n"; + print "[$i_test] failed read-only file($ro, $perm) => o_ro($o_ro)\n"; } } -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'read' ); foreach my $perm ('', qw(rw +< +>)) { my $o_rw = File::Data->new($rw, $perm); # write unless (ref($o_rw)) { $i_errs++; - print "[$i_test] failed read-write file($rw, $perm) => o_rw($o_rw)\n"; + print "[$i_test] failed read-write file($rw, $perm) => o_rw($o_rw)\n"; } } -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'write' ); + # ============================================================================= # $o_rx = undef; # how to close the file @@ -56,17 +56,18 @@ $i_errs = 0; 'read' => File::Data->new($ro, 'ro'), 'write' => File::Data->new($rw), ); - foreach my $key (sort keys %file) { # cannot read/write twice + foreach my $key (sort keys %file) { # cannot read/write twice my $orig = $file{$key}->_var('filename'); my $o_new = File::Data->new($orig); if ($o_new) { $i_errs++; - print "[$i_test] re-read($orig) => o_new($o_new)!\n"; + print "[$i_test] re-read($orig) => o_new($o_new)!\n"; } } $File::Data::SILENT=0; } -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'locked' ); + # ============================================================================= # PERM (issions) _check_access @@ -78,14 +79,14 @@ $i_errs = 0; { $File::Data::SILENT=1; foreach my $file ('', $rt, qw()) { - my $o_rp = File::Data->new('', '<'); # invalid filename + my $o_rp = File::Data->new('', '<'); # invalid filename if ($o_rp) { - $i_errs++; + $i_errs++; print "[$i_test] invalid file() => o_rp($o_rp)\n"; } } } -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'invalid filename' ); # invalid permissions { # things that _might_ look like valid permissions to someone else @@ -93,11 +94,11 @@ $i_errs = 0; my $o_rp = File::Data->new($rp, $perms); # invalid perms if ($o_rp) { $i_errs++; - print "[$i_test] invalid permissions($perms) accepted => o_rp($o_rp)\n"; + print "[$i_test] invalid permissions($perms) accepted => o_rp($o_rp)\n"; } } } -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'invalid permissions' ); # directory { @@ -105,35 +106,35 @@ $i_errs = 0; my $o_rp = File::Data->new($dir); # dirs if ($o_rp) { $i_errs++; - print "[$i_test] invalid directory(t) accepted => o_rp($o_rp)\n"; + print "[$i_test] invalid directory(t) accepted => o_rp($o_rp)\n"; } } } -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'directory checks' ); # permissions { # $File::Data::SILENT=1; my $root = !$<; # - foreach my $perm ('0000'..'0777') { # + foreach my $perm ('0000'..'0777') { # next if $perm =~ /[89]/; # :-\ my $i_cnt = chmod oct($perm), $rp; if ($i_cnt != 1) { $i_errs++; - print "[$i_test] failed($i_cnt) to chmod($perm, $rp)\n"; + print "[$i_test] failed($i_cnt) to chmod($perm, $rp)\n"; } else { my $o_rp = File::Data->new($rp); # perms - unless ((!$o_rp && $perm <= '0577' || - $o_rp && $root) || + unless ((!$o_rp && $perm <= '0577' || + $o_rp && $root) || ( $o_rp && $perm >= '0600')) { $i_errs++; - print "[$i_test] invalid file($rp) perm($perm) => o_rp($o_rp)\n"; + print "[$i_test] invalid file($rp) perm($perm) => o_rp($o_rp)\n"; } } } # $File::Data::SILENT=0; } -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'set permissions' ); # ============================================================================= # READ (only) @@ -156,11 +157,10 @@ $i_errs = 0; my $i_RO = my @READ = File::Data->new($ro, 'ro')->read('.+')->RETURN('read'); unless ($i_RO >= 3) { $i_errs++; - print "[$i_test] READ contains $i_RO lines\n".Dumper(\@READ); + print "[$i_test] READ contains $i_RO lines\n".Dumper(\@READ); } } - -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'read only' ); # ============================================================================= # WRITE @@ -177,24 +177,22 @@ $i_errs = 0; my $i_wr = my @writ = File::Data->new($rw)->WRITE(@write); unless ($i_wr == 4) { $i_errs++; - print "[$i_test] write contains $i_wr lines(@writ)\n"; + print "[$i_test] write contains $i_wr lines(@writ)\n"; } my $i_WR = my @WRIT = File::Data->new($rx)->write('xyz')->write(@write)->RETURN('write'); unless ($i_WR == 4) { $i_errs++; - print "[$i_test] WRITE contains $i_WR lines(@WRIT)\n"; + print "[$i_test] WRITE contains $i_WR lines(@WRIT)\n"; } } - -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'write' ); # ============================================================================= # ACCESS (write to read-only) # ============================================================================= $i_test++; # 6 $i_errs = 0; - { $File::Data::SILENT=1; my $o_ro = File::Data->new($ro, 'ro'); @@ -207,8 +205,7 @@ $i_errs = 0; } $File::Data::SILENT=0; } - -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'write to read-only' ); # ============================================================================= # PREPEND @@ -221,67 +218,62 @@ $i_errs = 0; my $i_pre = my @pre = $o_rw->PREPEND($pre); unless ($pre[0] eq $pre) { $i_errs++; - print "[$i_test] prepend(@pre)\n"; + print "[$i_test] prepend(@pre)\n"; } my $o_rx = File::Data->new($rx); my $i_PRE = my @PRE = $o_rx->prepend($pre)->RETURN('prepend'); unless ($PRE[0] eq $pre) { $i_errs++; - print "[$i_test] prepend(@PRE)\n"; + print "[$i_test] prepend(@PRE)\n"; } } - -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'prepend' ); # ============================================================================= # INSERT # ============================================================================= $i_test++; # 8 $i_errs = 0; - { my $o_rw = File::Data->new($rw); my $ins = "inserted some stuff at line 2\n"; - my $i_ins = my @ins = $o_rw->INSERT(2, $ins); + my $i_ins = my @ins = $o_rw->INSERT(2, $ins); unless ($ins[0] eq $ins) { $i_errs++; print "[$i_test] insert(@ins)\n"; } my $o_rx = File::Data->new($rx); - my $i_INS = my @INS = $o_rx->insert(2, $ins)->RETURN('insert'); + my $i_INS = my @INS = $o_rx->insert(2, $ins)->RETURN('insert'); unless ($INS[0] eq $ins) { $i_errs++; - print "[$i_test] INSERT(@INS)\n"; + print "[$i_test] INSERT(@INS)\n"; } } - -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'insert' ); # ============================================================================= # APPEND # ============================================================================= $i_test++; # 9 $i_errs = 0; - { my $o_rw = File::Data->new($rw); my $app = "appended that stuff\n"; my $i_app = my @app = $o_rw->APPEND($app); unless ($app[0] eq $app) { $i_errs++; - print "[$i_test] append(@app)\n"; - } + print "[$i_test] append(@app)\n"; + } my $o_rx = File::Data->new($rx); my $i_APP = my @APP = $o_rx->append($app)->RETURN('append'); unless ($APP[0] eq $app) { $i_errs++; - print "[$i_test] APPEND(@APP)\n"; + print "[$i_test] APPEND(@APP)\n"; } } - -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'append' ); # ============================================================================= # SEARCH @@ -293,9 +285,9 @@ $i_errs = 0; my $o_rw = File::Data->new($rw); my $str0 = 'ed\s*(\w+\s*\w{2})uff'; my $i_str0 = my @str0 = $o_rw->SEARCH($str0); - unless ($str0[1] eq 'some st') { + unless ($str0[1] =~ /inserted some stuff/) { $i_errs++; - print "str0($str0): err($i_errs) ".Dumper(\@str0); + print "str0($str0): err($i_errs) ".Dumper(\@str0); } $File::Data::STRING = 1; @@ -303,12 +295,11 @@ $i_errs = 0; my $i_str1 = my @str1 = $o_rw->SEARCH($str1); unless ($str1[0] == 2 && $str1[1] eq 'test') { $i_errs++; - print "str1($str1): err($i_errs) ".Dumper(\@str1); + print "str1($str1): err($i_errs) ".Dumper(\@str1); } } # todo - SEARCH - -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'search' ); # ============================================================================= # REPLACE @@ -330,15 +321,13 @@ $i_errs = 0; my $i_sea1 = my @snr1 = $o_rw->REPLACE($sea1 => $rep1); unless ($snr1[0] =~ /insertEd some stuff at line 2/s) { $i_errs++; - print "sea1($sea1) rep($rep1): i($i_sea1) err($i_errs) ".Dumper(\@snr1); + print "sea1($sea1) rep($rep1): i($i_sea1) err($i_errs) ".Dumper(\@snr1); } } -# todo - REPLACE - -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'replace' ); # ============================================================================= -# Feedback +# Feedback # ============================================================================= $i_test++; # 12 $i_errs = 0; @@ -346,9 +335,11 @@ $i_errs = 0; my $o_rw = File::Data->new($rw); print $o_rw->_vars if $File::Data::DEBUG; } -($i_errs == 0) ? ok(1) : ok(0); +ok( !$i_errs, 'debug' ); # ============================================================================= +done_testing(); + package File::Data::Test; sub new { return bless({}, shift); } @@ -419,9 +410,10 @@ $i_errs++ unless ref($o_rp); print "[$i_test] perms file($rp) => o_rp($o_rp)\n" if $i_errs; # my $i_stat = my @stat = File::Data->new($ro)->FSTAT('_'); -# $i_errs++ unless $i_stat >= 3; # +# $i_errs++ unless $i_stat >= 3; # # print "[$i_test] stat(@stat): ".Dumper(\@stat) if $i_errs; ($i_errs == 0) ? ok(1) : ok(0); # ============================================================================= =cut + -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libfile-data-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits