From: Uri Guttman Date: Sun, 11 May 2014 15:01:34 +0000 (-0400) Subject: 3 new versions checked in finally. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=HEAD;p=urisagit%2FFile-Slurp.git 3 new versions checked in finally. added edit_file and edit_file_lines subs and related stuff some optimizations and bug fixes added hash ref support for options see Changes for more details --- diff --git a/Changes b/Changes index bf524a3..379f9c9 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,28 @@ Revision history File::Slurp +9999.19 Tue Jun 7 04:06:06 EDT 2011 + - Fixed use line in t/edit_file.t to import :edit first + Thanks to paul + - read_file and write_file work even when interrupted by signals + this includes a test for read_file interrupt + Thanks to Andrew Danforth + - Fixed bugs in the config synopsis example + +9999.18 Fri May 13 02:30:05 EDT 2011 + - Added :std and :edit export tags + - Cleaned up EXPORT vars + - Documented importing edit_file and edit_file_lines + - Fixed some pod spelling + +9999.17 Wed Apr 27 02:20:03 EDT 2011 + - Requiring Perl 5.6.2 (first time older Perls were dropped) + This is because of use of the re 'taint' pragma + - Added major new features: edit_file and edit_file_lines + - Speed up of tainted slurp with return of lines + - Added chomp option to read_file + - Added prefix option to read_dir + - Fixed optimization of reading small files. + 9999.16 Wed Apr 13 03:47:26 EDT 2011 - Added support for read_file options to be a hash reference. - Added support for read_dir options to be a hash reference. diff --git a/MANIFEST b/MANIFEST index e5d4e98..f4c0506 100644 --- a/MANIFEST +++ b/MANIFEST @@ -7,8 +7,10 @@ TODO t/TestDriver.pm t/append_null.t t/binmode.t +t/chomp.t t/data_list.t t/data_scalar.t +t/edit_file.t t/error.t t/error_mode.t t/file_object.t @@ -22,15 +24,15 @@ t/paragraph.t t/perms.t t/pod.t t/pod_coverage.t +t/prepend_file.t t/pseudo.t t/read_dir.t +t/signal.t t/slurp.t t/stdin.t t/stringify.t t/tainted.t t/write_file_win32.t -experiment/prepend.pl -experiment/edit_file.pl extras/slurp_bench.pl extras/FileSlurp_12.pm extras/slurp_article.pod diff --git a/Makefile b/Makefile index d6ab385..9ac36ef 100644 --- a/Makefile +++ b/Makefile @@ -56,11 +56,11 @@ DIRFILESEP = / DFSEP = $(DIRFILESEP) NAME = File::Slurp NAME_SYM = File_Slurp -VERSION = 9999.16 +VERSION = 9999.19 VERSION_MACRO = VERSION -VERSION_SYM = 9999_16 +VERSION_SYM = 9999_19 DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" -XS_VERSION = 9999.16 +XS_VERSION = 9999.19 XS_VERSION_MACRO = XS_VERSION XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" INST_ARCHLIB = blib/arch @@ -181,13 +181,10 @@ PERL_ARCHIVE = PERL_ARCHIVE_AFTER = -TO_INST_PM = lib/File/Slurp.pm \ - lib/File/Slurp.pm.new +TO_INST_PM = lib/File/Slurp.pm PM_TO_BLIB = lib/File/Slurp.pm \ - blib/lib/File/Slurp.pm \ - lib/File/Slurp.pm.new \ - blib/lib/File/Slurp.pm.new + blib/lib/File/Slurp.pm # --- MakeMaker platform_constants section: @@ -254,7 +251,7 @@ RCS_LABEL = rcs -Nv$(VERSION_SYM): -q DIST_CP = best DIST_DEFAULT = tardist DISTNAME = File-Slurp -DISTVNAME = File-Slurp-9999.16 +DISTVNAME = File-Slurp-9999.19 # --- MakeMaker macro section: @@ -422,17 +419,11 @@ manifypods : pure_all \ # --- MakeMaker subdirs section: -# The default clean, realclean and test targets in this Makefile -# have automatically been given entries for each subdir. - - -subdirs :: - $(NOECHO) cd File-Slurp-9999.15 && $(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) all $(PASTHRU) - +# none # --- MakeMaker clean_subdirs section: clean_subdirs : - $(ABSPERLRUN) -e 'chdir '\''File-Slurp-9999.15'\''; system '\''$(MAKE) clean'\'' if -f '\''$(FIRST_MAKEFILE)'\'';' -- + $(NOECHO) $(NOOP) # --- MakeMaker clean section: @@ -452,10 +443,10 @@ clean :: clean_subdirs $(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \ core.[0-9][0-9][0-9][0-9][0-9] *perl.core \ core.*perl.*.? $(MAKE_APERL_FILE) \ - $(BASEEXT).def perl \ + perl $(BASEEXT).def \ core.[0-9][0-9][0-9] mon.out \ - lib$(BASEEXT).def perl.exe \ - perlmain.c so_locations \ + lib$(BASEEXT).def perlmain.c \ + perl.exe so_locations \ $(BASEEXT).exp - $(RM_RF) \ blib @@ -464,8 +455,7 @@ clean :: clean_subdirs # --- MakeMaker realclean_subdirs section: realclean_subdirs : - - $(ABSPERLRUN) -e 'chdir '\''File-Slurp-9999.15'\''; system '\''$(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) realclean'\'' if -f '\''$(MAKEFILE_OLD)'\'';' -- - - $(ABSPERLRUN) -e 'chdir '\''File-Slurp-9999.15'\''; system '\''$(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) realclean'\'' if -f '\''$(FIRST_MAKEFILE)'\'';' -- + $(NOECHO) $(NOOP) # --- MakeMaker realclean section: @@ -482,8 +472,8 @@ metafile : create_distdir $(NOECHO) $(ECHO) Generating META.yml $(NOECHO) $(ECHO) '--- #YAML:1.0' > META_new.yml $(NOECHO) $(ECHO) 'name: File-Slurp' >> META_new.yml - $(NOECHO) $(ECHO) 'version: 9999.16' >> META_new.yml - $(NOECHO) $(ECHO) 'abstract: Simple and Efficient Reading/Writing of Complete Files' >> META_new.yml + $(NOECHO) $(ECHO) 'version: 9999.19' >> META_new.yml + $(NOECHO) $(ECHO) 'abstract: Simple and Efficient Reading/Writing/Modifying of Complete Files' >> META_new.yml $(NOECHO) $(ECHO) 'license: perl' >> META_new.yml $(NOECHO) $(ECHO) 'author: ' >> META_new.yml $(NOECHO) $(ECHO) ' - Uri Guttman ' >> META_new.yml @@ -728,7 +718,7 @@ $(MAP_TARGET) :: static $(MAKE_APERL_FILE) $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) $(NOECHO) $(PERLRUNINST) \ - Makefile.PL DIR=File-Slurp-9999.15 \ + Makefile.PL DIR= \ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= @@ -748,9 +738,6 @@ test :: $(TEST_TYPE) subdirs-test subdirs-test :: $(NOECHO) $(NOOP) -subdirs-test :: - $(NOECHO) cd File-Slurp-9999.15 && $(MAKE) test $(PASTHRU) - test_dynamic :: pure_all PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) @@ -767,9 +754,9 @@ testdb_static :: testdb_dynamic # --- MakeMaker ppd section: # Creates a PPD (Perl Package Description) for a binary distribution. ppd : - $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd $(NOECHO) $(ECHO) ' $(DISTNAME)' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' Simple and Efficient Reading/Writing of Complete Files' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' Simple and Efficient Reading/Writing/Modifying of Complete Files' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' Uri Guttman <uri@stemsystems.com>' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd @@ -787,8 +774,7 @@ ppd : pm_to_blib : $(TO_INST_PM) $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' -- \ - lib/File/Slurp.pm blib/lib/File/Slurp.pm \ - lib/File/Slurp.pm.new blib/lib/File/Slurp.pm.new + lib/File/Slurp.pm blib/lib/File/Slurp.pm $(NOECHO) $(TOUCH) pm_to_blib diff --git a/extras/slurp_bench.pl b/extras/slurp_bench.pl old mode 100755 new mode 100644 diff --git a/lib/File/Slurp.pm b/lib/File/Slurp.pm old mode 100755 new mode 100644 index 63df851..151b1d1 --- a/lib/File/Slurp.pm +++ b/lib/File/Slurp.pm @@ -1,6 +1,6 @@ package File::Slurp; -use 5.6.2 ; +use 5.006002 ; use strict; use warnings ; @@ -9,29 +9,54 @@ use Carp ; use Exporter ; use Fcntl qw( :DEFAULT ) ; use POSIX qw( :fcntl_h ) ; +use Errno ; #use Symbol ; use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION ) ; @ISA = qw( Exporter ) ; -$VERSION = '9999.17'; +$VERSION = '9999.20'; -@EXPORT_OK = qw( - slurp - prepend_file - edit_file - edit_file_lines -) ; - -%EXPORT_TAGS = ( 'all' => [ qw( +my @std_export = qw( read_file write_file overwrite_file append_file - read_dir ), - @EXPORT_OK -] ) ; -@EXPORT = ( @{ $EXPORT_TAGS{'all'} } ); + read_dir +) ; + +my @edit_export = qw( + edit_file + edit_file_lines +) ; + +my @ok_export = qw( +) ; + +my @abbrev_export = qw( + rf + wf + ef + efl +) ; + +@EXPORT_OK = ( + @edit_export, + @abbrev_export, + qw( + slurp + prepend_file + ), +) ; + +%EXPORT_TAGS = ( + 'all' => [ @std_export, @edit_export, @abbrev_export, @EXPORT_OK ], + 'edit' => [ @edit_export ], + 'std' => [ @std_export ], + 'abr' => [ @abbrev_export ], +) ; + +@EXPORT = @std_export ; my $max_fast_slurp_size = 1024 * 100 ; @@ -87,6 +112,7 @@ BEGIN { *slurp = \&read_file ; +*rf = \&read_file ; sub read_file { @@ -208,6 +234,11 @@ sub read_file { my $read_cnt = sysread( $read_fh, ${$buf_ref}, $size_left, length ${$buf_ref} ) ; +# since we're using sysread Perl won't automatically restart the call +# when interrupted by a signal. + + next if $!{EINTR}; + unless ( defined $read_cnt ) { @_ = ( $opts, "read_file '$file_name' - loop sysread: $!"); @@ -342,6 +373,8 @@ ERR } +*wf = \&write_file ; + sub write_file { my $file_name = shift ; @@ -485,6 +518,11 @@ sub write_file { my $write_cnt = syswrite( $write_fh, ${$buf_ref}, $size_left, $offset ) ; +# since we're using syswrite Perl won't automatically restart the call +# when interrupted by a signal. + + next if $!{EINTR}; + unless ( defined $write_cnt ) { @_ = ( $opts, "write_file '$file_name' - syswrite: $!"); @@ -605,6 +643,8 @@ sub prepend_file { # edit a file as a scalar in $_ +*ef = \&edit_file ; + sub edit_file(&$;$) { my( $edit_code, $file_name, $opts ) = @_ ; @@ -658,6 +698,8 @@ sub edit_file(&$;$) { return $write_result ; } +*efl = \&edit_file_lines ; + sub edit_file_lines(&$;$) { my( $edit_code, $file_name, $opts ) = @_ ; @@ -806,8 +848,8 @@ File::Slurp - Simple and Efficient Reading/Writing/Modifying of Complete Files # Here is a simple and fast way to load and save a simple config file # made of key=value lines. - my %conf = read_file( $file_name ) =~ /^(\w+)=(\.*)$/mg ; - write_file( $file_name, {atomic => 1}, map "$_=$conf{$_}\n", keys %conf ; + my %conf = read_file( $file_name ) =~ /^(\w+)=(.*)$/mg ; + write_file( $file_name, {atomic => 1}, map "$_=$conf{$_}\n", keys %conf ) ; # insert text at the beginning of a file prepend_file( 'filename', $text ) ; @@ -947,7 +989,7 @@ an already open handle (like \*STDIN). It defaults to 1MB. You can use this option to control how read_file behaves when an error occurs. This option defaults to 'croak'. You can set it to 'carp' or to -'quiet to have no special error handling. This code wants to carp and +'quiet' to have no special error handling. This code wants to carp and then read another file if it fails. my $text_ref = read_file( $file, err_mode => 'carp' ) ; @@ -956,7 +998,7 @@ then read another file if it fails. # read a different file but croak if not found $text_ref = read_file( $another_file ) ; } - + # process ${$text_ref} =head2 B @@ -1125,8 +1167,12 @@ them is that C reads the whole file into $_ and calls the code block one time. With C each line is read into $_ and the code is called for each line. In both cases the code should modify $_ if desired and it will be written back out. These subs are -the equivilent of the -pi command line options of Perl but you can -call them from inside your program and not fork out a process. +the equivalent of the -pi command line options of Perl but you can +call them from inside your program and not fork out a process. They +are in @EXPORT_OK so you need to request them to be imported on the +use line or you can import both of them with: + + use File::Slurp qw( :edit ) ; The first argument to C and C is a code block or a code reference. The code block is not followed by a comma @@ -1141,16 +1187,17 @@ C call has the C option set so you will always have a consistant file. See above for more about those options. Each group of calls below show a Perl command line instance and the -equivilent calls to C and C. +equivalent calls to C and C. perl -0777 -pi -e 's/foo/bar/g' filename - use File::Slurp ; + use File::Slurp qw( edit_file ) ; edit_file { s/foo/bar/g } 'filename' ; edit_file sub { s/foo/bar/g }, 'filename' ; edit_file \&replace_foo, 'filename' ; sub replace_foo { s/foo/bar/g } - perl -pi -e '$_ = '' if /foo/' filename + perl -pi -e '$_ = "" if /foo/' filename + use File::Slurp qw( edit_file_lines ) ; use File::Slurp ; edit_file_lines { $_ = '' if /foo/ } 'filename' ; edit_file_lines sub { $_ = '' if /foo/ }, 'filename' ; @@ -1196,8 +1243,19 @@ of entries when opening themn. =head2 EXPORT + These are exported by default or with + use File::Slurp qw( :std ) ; + read_file write_file overwrite_file append_file read_dir + These are exported with + use File::Slurp qw( :edit ) ; + + edit_file edit_file_lines + + You can get all subs in the module exported with + use File::Slurp qw( :all ) ; + =head2 LICENSE Same as Perl. diff --git a/slurp_talk/Slurp.pm b/slurp_talk/Slurp.pm old mode 100755 new mode 100644 diff --git a/slurp_talk/slurp_bench.pl b/slurp_talk/slurp_bench.pl old mode 100755 new mode 100644 diff --git a/t/TestDriver.pm b/t/TestDriver.pm index e802d2d..274e5d3 100644 --- a/t/TestDriver.pm +++ b/t/TestDriver.pm @@ -4,16 +4,19 @@ use Test::More ; BEGIN { *CORE::GLOBAL::syswrite = - sub(*\$$;$) { my( $h, $b, $s ) = @_; CORE::syswrite $h, $b, $s } ; + sub($$$;$) { my( $h, $b, $s, $o ) = @_; CORE::syswrite $h, $b, $s, $o} ; +# sub(*\$$;$) { my( $h, $b, $s, $o ) = @_; CORE::syswrite $h, $b, $s, $o } ; *CORE::GLOBAL::sysread = - sub(*\$$;$) { my( $h, $b, $s ) = @_; CORE::sysread $h, $b, $s } ; + sub($$$;$) { my( $h, $b, $s, $o ) = @_; CORE::sysread $h, $b, $s, $o } ; +# sub(*\$$;$) { my( $h, $b, $s, $o ) = @_; CORE::sysread $h, $b, $s, $o } ; *CORE::GLOBAL::rename = sub($$) { my( $old, $new ) = @_; CORE::rename $old, $new } ; *CORE::GLOBAL::sysopen = - sub(*$$;$) { my( $h, $n, $m, $p ) = @_; CORE::sysopen $h, $n, $m, $p } ; + sub($$$;$) { my( $h, $n, $m, $p ) = @_; CORE::sysopen $h, $n, $m, $p } ; +# sub(*$$;$) { my( $h, $n, $m, $p ) = @_; CORE::sysopen $h, $n, $m, $p } ; } sub test_driver { diff --git a/t/inode.t b/t/inode.t index 377b32c..c477baf 100644 --- a/t/inode.t +++ b/t/inode.t @@ -9,16 +9,13 @@ use Socket ; use Symbol ; use Test::More ; - -BEGIN{ - +BEGIN { if( $^O =~ '32' ) { plan skip_all => 'skip inode test on windows'; exit ; } - else { - plan tests => 2 ; - } + + plan tests => 2 ; } my $data = < - 'Test::Pod 1.14 required for testing PODe' if $@ ; + 'Test::Pod 1.14 required for testing POD' if $@ ; all_pod_files_ok( # { diff --git a/t/prepend_file b/t/prepend_file deleted file mode 100644 index 0f9b615..0000000 --- a/t/prepend_file +++ /dev/null @@ -1,3 +0,0 @@ -partial lineline 1 -line 2 -more diff --git a/t/read_dir.t b/t/read_dir.t index 9cc939c..d04351f 100644 --- a/t/read_dir.t +++ b/t/read_dir.t @@ -1,7 +1,7 @@ #!/usr/bin/perl -w -I. use strict ; -use Test::More tests => 8 ; +use Test::More tests => 9 ; use File::Slurp ; @@ -52,6 +52,11 @@ my $dir_entries_ref = read_dir( $test_dir ) ; ok( eq_array( $dir_entries_ref, \@expected_entries ), "dir in array ref" ) ; +my @prefixed_entries = read_dir( $test_dir, {prefix => 1} ) ; +@prefixed_entries = sort @prefixed_entries ; +ok( eq_array( \@prefixed_entries, [map "$test_dir/$_", @dir_entries] ), + 'prefix option' ) ; + # clean up unlink map "$test_dir/$_", @dir_entries ;