From: Uri Guttman Date: Fri, 24 Oct 2008 00:53:48 +0000 (-0400) Subject: initial commit X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=635c78763e1e35be98a878800a6bc89fe4869389;p=urisagit%2FFile-Slurp.git initial commit --- 635c78763e1e35be98a878800a6bc89fe4869389 diff --git a/Changes b/Changes new file mode 100644 index 0000000..8728426 --- /dev/null +++ b/Changes @@ -0,0 +1,104 @@ +Revision history for Perl extension File::FastSlurp. + +9999.13 Tue Oct 10 02:04:51 EDT 2006 + - Refactored the extras/slurp_bench.pl script. It has options, + a key the benchmarks, help and more benchmarks. + - Reordered changes so recent entries are first + +9999.12 Thu Feb 2 02:26:31 EST 2006 + - Fixed bug on windows with classic slurping and File::Slurp not + agreeing on newline conversion. + - Added t/newline.t test to check for that fix. + - When passing text data by scalar reference to write_file under + windows, the buffer is copied so the newline conversion won't + modify the caller's data. + - Thanks to Johan Lodin for a test script which + I modified into t/newline.t + +9999.11 Fri Jan 20 01:24:00 EDT 2005 + - Quick release to remove code that forced the faked SEEK_* + values to be used. Showed up when tested on OSX which doesn't + need that backport. + +9999.10 Thu Jan 19 11:38:00 EDT 2005 + - t/*.t modules don't use Fcntl.pm + - using POSIX qw( :fcntl_h ) instead of Fcntl qw( :seek ) for + backwards compatiblity to 5.00503 + - added conditional definitions of SEEK_* and O_* subs as they are not + defined in perl 5.004 + - File::Slurp now runs on perl 5.004 and newer (see BUGS section) + All of the above thanks to Smylers , + Piers Kent and + John Alden + - Added pod.t and pod_coverage.t tests. This is to pass all + the CPANTS tests. + +9999.09 Tue Apr 19 01:21:55 EDT 2005 + - t/original.t and read_dir.t no longer search for tempdirs. they just + use the current dir which should be in the build directory + - t/readdir.t renamed to read_dir.t for consistancy + - write_file return values are docuemented + Thanks to Adam Kennedy + - added no_clobber option to write_file and t/no_clobber.t test for it + Thanks to + - fixed bug when appending a null string to a file which then + truncates it. seems to be an odd way for linux and OS X to + handle O_APPEND mode on sysopen. they don't seek to the end of + the file so it gets truncated. fixed by adding a seek to the + end if in append mode.n + Thanks to Chris Dolan + + +9999.08 Sat Apr 16 01:01:27 EDT 2005 + - read_dir returns an array ref in scalar context + - read_dir keeps . and .. if keep_dot_dot option is set. + Thanks to John Alden + - slurp() is an optional exported alias to read_file + Thanks to Damian Conway + + + +9999.07 Tue Jan 25 01:33:11 EST 2005 + - Slurping in pseudo files (as in /proc) which show a size of 0 + but actually have data works. This seems to be the case on + linux but on Solaris those files show their proper size. + Thanks to Juerd Waalboer + + +9999.06 Mon Sep 20 01:57:00 EDT 2004 + - Slurping the DATA handle now works without the workaround. + tests are in t/data_scalar.t and t/data_list.t + - Paragraph mode in read_file is supported. As with <> when $/ + (input record separator) is set to '', then the input file is + split on multiple newlines (/\n\n+/). + Thanks to Geoffrey Leach + + +9999.05 Tue Feb 24 21:14:55 EST 2004 + - skip handle tests where socketpair is not supported (pre 5.8 + on windows) + Thanks to Mike Arms + + +9999.04 Mon Feb 23 14:20:52 EST 2004 + - fixed DATA handle bug in t/handle.t (not seen on most OS's) + Thanks to James Willmore + + +9999.03 Mon Dec 22 01:44:43 EST 2003 + - fixed DATA handle bugs in t/handle.t on osx (should be fixed + on BSD as well) + - added more comments to code + +9999.02 Wed Dec 17 03:40:49 EST 2003 + - skip DATA test in handle.t on OSX (bug in perl with sysread on DATA) + - changed checking if file handle from fileno to ref + from Randal Schwartz + - added support for atomic spewing + - added new test stdin.t for the fileno/ref change + - added new test inode.t to test atomic spewing + +9999.01 Mon Sep 1 00:20:56 2003 + - original version; created by h2xs 1.21 with options + -AX -n File::FastSlurp + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..fa58954 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,25 @@ +Changes +lib/File/Slurp.pm +Makefile.PL +MANIFEST +README +t/error.t +t/large.t +t/handle.t +t/data_scalar.t +t/data_list.t +t/paragraph.t +t/original.t +t/stdin.t +t/inode.t +t/pseudo.t +t/read_dir.t +t/slurp.t +t/no_clobber.t +t/append_null.t +t/newline.t +t/pod.t +t/pod_coverage.t +extras/slurp_bench.pl +extras/slurp_article.pod +META.yml Module meta-data (added by MakeMaker) diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..69b59e3 --- /dev/null +++ b/META.yml @@ -0,0 +1,10 @@ +# http://module-build.sourceforge.net/META-spec.html +#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# +name: File-Slurp +version: 9999.12 +version_from: lib/File/Slurp.pm +installdirs: site +requires: + +distribution_type: module +generated_by: ExtUtils::MakeMaker version 6.17 diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..4bb3b9b --- /dev/null +++ b/Makefile @@ -0,0 +1,764 @@ +# This Makefile is for the File::Slurp extension to perl. +# +# It was generated automatically by MakeMaker version +# 6.17 (Revision: 1.133) from the contents of +# Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker ARGV: () +# +# MakeMaker Parameters: + +# ABSTRACT_FROM => q[lib/File/Slurp.pm] +# AUTHOR => q[Uri Guttman ] +# NAME => q[File::Slurp] +# PREREQ_PM => { } +# VERSION_FROM => q[lib/File/Slurp.pm] + +# --- MakeMaker post_initialize section: + + +# --- MakeMaker const_config section: + +# These definitions are from config.sh (via /usr/local/lib/perl5/5.8.6/sun4-solaris/Config.pm) + +# They may have been overridden via Makefile.PL or on the command line +AR = ar +CC = gcc +CCCDLFLAGS = -fPIC +CCDLFLAGS = +DLEXT = so +DLSRC = dl_dlopen.xs +LD = gcc +LDDLFLAGS = -G -L/usr/local/lib +LDFLAGS = -L/usr/local/lib +LIBC = /lib/libc.so +LIB_EXT = .a +OBJ_EXT = .o +OSNAME = solaris +OSVERS = 2.9 +RANLIB = : +SITELIBEXP = /usr/local/lib/perl5/site_perl/5.8.6 +SITEARCHEXP = /usr/local/lib/perl5/site_perl/5.8.6/sun4-solaris +SO = so +EXE_EXT = +FULL_AR = /usr/ccs/bin/ar +VENDORARCHEXP = +VENDORLIBEXP = + + +# --- MakeMaker constants section: +AR_STATIC_ARGS = cr +DIRFILESEP = / +NAME = File::Slurp +NAME_SYM = File_Slurp +VERSION = 9999.12 +VERSION_MACRO = VERSION +VERSION_SYM = 9999_12 +DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" +XS_VERSION = 9999.12 +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" +INST_ARCHLIB = blib/arch +INST_SCRIPT = blib/script +INST_BIN = blib/bin +INST_LIB = blib/lib +INST_MAN1DIR = blib/man1 +INST_MAN3DIR = blib/man3 +MAN1EXT = 1 +MAN3EXT = 3 +INSTALLDIRS = site +DESTDIR = +PREFIX = +PERLPREFIX = /usr/local +SITEPREFIX = /usr/local +VENDORPREFIX = +INSTALLPRIVLIB = $(PERLPREFIX)/lib/perl5/5.8.6 +DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) +INSTALLSITELIB = $(SITEPREFIX)/lib/perl5/site_perl/5.8.6 +DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) +INSTALLVENDORLIB = +DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) +INSTALLARCHLIB = $(PERLPREFIX)/lib/perl5/5.8.6/sun4-solaris +DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) +INSTALLSITEARCH = $(SITEPREFIX)/lib/perl5/site_perl/5.8.6/sun4-solaris +DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) +INSTALLVENDORARCH = +DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) +INSTALLBIN = $(PERLPREFIX)/bin +DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) +INSTALLSITEBIN = $(SITEPREFIX)/bin +DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) +INSTALLVENDORBIN = +DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) +INSTALLSCRIPT = $(PERLPREFIX)/bin +DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) +INSTALLMAN1DIR = $(PERLPREFIX)/man/man1 +DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) +INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1 +DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) +INSTALLVENDORMAN1DIR = +DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) +INSTALLMAN3DIR = $(PERLPREFIX)/man/man3 +DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) +INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3 +DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) +INSTALLVENDORMAN3DIR = +DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) +PERL_LIB = /usr/local/lib/perl5/5.8.6 +PERL_ARCHLIB = /usr/local/lib/perl5/5.8.6/sun4-solaris +LIBPERL_A = libperl.a +FIRST_MAKEFILE = Makefile +MAKEFILE_OLD = $(FIRST_MAKEFILE).old +MAKE_APERL_FILE = $(FIRST_MAKEFILE).aperl +PERLMAINCC = $(CC) +PERL_INC = /usr/local/lib/perl5/5.8.6/sun4-solaris/CORE +PERL = /usr/local/bin/perl +FULLPERL = /usr/local/bin/perl +ABSPERL = $(PERL) +PERLRUN = $(PERL) +FULLPERLRUN = $(FULLPERL) +ABSPERLRUN = $(ABSPERL) +PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +PERL_CORE = 0 +PERM_RW = 644 +PERM_RWX = 755 + +MAKEMAKER = /usr/local/lib/perl5/5.8.6/ExtUtils/MakeMaker.pm +MM_VERSION = 6.17 +MM_REVISION = 1.133 + +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +FULLEXT = File/Slurp +BASEEXT = Slurp +PARENT_NAME = File +DLBASE = $(BASEEXT) +VERSION_FROM = lib/File/Slurp.pm +OBJECT = +LDFROM = $(OBJECT) +LINKTYPE = dynamic + +# Handy lists of source code files: +XS_FILES = +C_FILES = +O_FILES = +H_FILES = +MAN1PODS = +MAN3PODS = Slurp.pm \ + lib/File/Slurp.pm \ + slurp_article.pod + +# Where is the Config information that we are using/depend on +CONFIGDEP = $(PERL_ARCHLIB)$(DIRFILESEP)Config.pm $(PERL_INC)$(DIRFILESEP)config.h + +# Where to build things +INST_LIBDIR = $(INST_LIB)/File +INST_ARCHLIBDIR = $(INST_ARCHLIB)/File + +INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) +INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) + +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = + +# Extra linker info +EXPORT_LIST = +PERL_ARCHIVE = +PERL_ARCHIVE_AFTER = + + +TO_INST_PM = Slurp.pm \ + carp.pl \ + lib/File/Slurp.pm \ + seek.pl \ + slurp_article.pod \ + slurp_bench.pl \ + split.pl \ + sysread.pl + +PM_TO_BLIB = Slurp.pm \ + $(INST_LIB)/File/Slurp.pm \ + carp.pl \ + $(INST_LIB)/File/carp.pl \ + lib/File/Slurp.pm \ + blib/lib/File/Slurp.pm \ + seek.pl \ + $(INST_LIB)/File/seek.pl \ + split.pl \ + $(INST_LIB)/File/split.pl \ + sysread.pl \ + $(INST_LIB)/File/sysread.pl \ + slurp_article.pod \ + $(INST_LIB)/File/slurp_article.pod \ + slurp_bench.pl \ + $(INST_LIB)/File/slurp_bench.pl + + +# --- MakeMaker platform_constants section: +MM_Unix_VERSION = 1.42 +PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc + + +# --- MakeMaker tool_autosplit section: +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(PERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)' + + + +# --- MakeMaker tool_xsubpp section: + + +# --- MakeMaker tools_other section: +SHELL = /bin/sh +CHMOD = chmod +CP = cp +MV = mv +NOOP = $(SHELL) -c true +NOECHO = @ +RM_F = rm -f +RM_RF = rm -rf +TEST_F = test -f +TOUCH = touch +UMASK_NULL = umask 0 +DEV_NULL = > /dev/null 2>&1 +MKPATH = $(PERLRUN) "-MExtUtils::Command" -e mkpath +EQUALIZE_TIMESTAMP = $(PERLRUN) "-MExtUtils::Command" -e eqtime +ECHO = echo +ECHO_N = echo -n +UNINST = 0 +VERBINST = 0 +MOD_INSTALL = $(PERLRUN) -MExtUtils::Install -e 'install({@ARGV}, '\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');' +DOC_INSTALL = $(PERLRUN) "-MExtUtils::Command::MM" -e perllocal_install +UNINSTALL = $(PERLRUN) "-MExtUtils::Command::MM" -e uninstall +WARN_IF_OLD_PACKLIST = $(PERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist + + +# --- MakeMaker makemakerdflt section: +makemakerdflt: all + $(NOECHO) $(NOOP) + + +# --- MakeMaker dist section: +TAR = tar +TARFLAGS = cvf +ZIP = zip +ZIPFLAGS = -r +COMPRESS = gzip --best +SUFFIX = .gz +SHAR = shar +PREOP = $(NOECHO) $(NOOP) +POSTOP = $(NOECHO) $(NOOP) +TO_UNIX = $(NOECHO) $(NOOP) +CI = ci -u +RCS_LABEL = rcs -Nv$(VERSION_SYM): -q +DIST_CP = best +DIST_DEFAULT = tardist +DISTNAME = File-Slurp +DISTVNAME = File-Slurp-9999.12 + + +# --- MakeMaker macro section: + + +# --- MakeMaker depend section: + + +# --- MakeMaker cflags section: + + +# --- MakeMaker const_loadlibs section: + + +# --- MakeMaker const_cccmd section: + + +# --- MakeMaker post_constants section: + + +# --- MakeMaker pasthru section: + +PASTHRU = LIB="$(LIB)"\ + LIBPERL_A="$(LIBPERL_A)"\ + LINKTYPE="$(LINKTYPE)"\ + PREFIX="$(PREFIX)"\ + OPTIMIZE="$(OPTIMIZE)"\ + PASTHRU_DEFINE="$(PASTHRU_DEFINE)"\ + PASTHRU_INC="$(PASTHRU_INC)" + + +# --- MakeMaker special_targets section: +.SUFFIXES: .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) + +.PHONY: all config static dynamic test linkext manifest + + + +# --- MakeMaker c_o section: + + +# --- MakeMaker xs_c section: + + +# --- MakeMaker xs_o section: + + +# --- MakeMaker top_targets section: +all :: pure_all manifypods + $(NOECHO) $(NOOP) + + +pure_all :: config pm_to_blib subdirs linkext + $(NOECHO) $(NOOP) + +subdirs :: $(MYEXTLIB) + $(NOECHO) $(NOOP) + +config :: $(FIRST_MAKEFILE) $(INST_LIBDIR)$(DIRFILESEP).exists + $(NOECHO) $(NOOP) + +config :: $(INST_ARCHAUTODIR)$(DIRFILESEP).exists + $(NOECHO) $(NOOP) + +config :: $(INST_AUTODIR)$(DIRFILESEP).exists + $(NOECHO) $(NOOP) + +$(INST_AUTODIR)/.exists :: /usr/local/lib/perl5/5.8.6/sun4-solaris/CORE/perl.h + $(NOECHO) $(MKPATH) $(INST_AUTODIR) + $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.8.6/sun4-solaris/CORE/perl.h $(INST_AUTODIR)/.exists + + -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_AUTODIR) + +$(INST_LIBDIR)/.exists :: /usr/local/lib/perl5/5.8.6/sun4-solaris/CORE/perl.h + $(NOECHO) $(MKPATH) $(INST_LIBDIR) + $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.8.6/sun4-solaris/CORE/perl.h $(INST_LIBDIR)/.exists + + -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_LIBDIR) + +$(INST_ARCHAUTODIR)/.exists :: /usr/local/lib/perl5/5.8.6/sun4-solaris/CORE/perl.h + $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) + $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.8.6/sun4-solaris/CORE/perl.h $(INST_ARCHAUTODIR)/.exists + + -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR) + +config :: $(INST_MAN3DIR)$(DIRFILESEP).exists + $(NOECHO) $(NOOP) + + +$(INST_MAN3DIR)/.exists :: /usr/local/lib/perl5/5.8.6/sun4-solaris/CORE/perl.h + $(NOECHO) $(MKPATH) $(INST_MAN3DIR) + $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.8.6/sun4-solaris/CORE/perl.h $(INST_MAN3DIR)/.exists + + -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_MAN3DIR) + +help: + perldoc ExtUtils::MakeMaker + + +# --- MakeMaker linkext section: + +linkext :: $(LINKTYPE) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dlsyms section: + + +# --- MakeMaker dynamic section: + +dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dynamic_bs section: + +BOOTSTRAP = + + +# --- MakeMaker dynamic_lib section: + + +# --- MakeMaker static section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make static" +static :: $(FIRST_MAKEFILE) $(INST_STATIC) + $(NOECHO) $(NOOP) + + +# --- MakeMaker static_lib section: + + +# --- MakeMaker manifypods section: + +POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" +POD2MAN = $(POD2MAN_EXE) + + +manifypods : pure_all \ + Slurp.pm \ + lib/File/Slurp.pm \ + slurp_article.pod \ + Slurp.pm \ + lib/File/Slurp.pm \ + slurp_article.pod + $(NOECHO) $(POD2MAN) --section=3 --perm_rw=$(PERM_RW)\ + Slurp.pm $(INST_MAN3DIR)/File::Slurp.$(MAN3EXT) \ + lib/File/Slurp.pm $(INST_MAN3DIR)/File::Slurp.$(MAN3EXT) \ + slurp_article.pod $(INST_MAN3DIR)/File::slurp_article.$(MAN3EXT) + + + + +# --- MakeMaker processPL section: + + +# --- MakeMaker installbin section: + + +# --- MakeMaker subdirs section: + +# none + +# --- MakeMaker clean_subdirs section: +clean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker clean section: + +# Delete temporary files but do not touch installed files. We don't delete +# the Makefile here so a later make realclean still has a makefile to use. + +clean :: clean_subdirs + -$(RM_RF) ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all $(INST_ARCHAUTODIR)/extralibs.ld perlmain.c tmon.out mon.out so_locations pm_to_blib *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT) $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def lib$(BASEEXT).def $(BASEEXT).exp $(BASEEXT).x core core.*perl.*.? *perl.core core.[0-9] core.[0-9][0-9] core.[0-9][0-9][0-9] core.[0-9][0-9][0-9][0-9] core.[0-9][0-9][0-9][0-9][0-9] + -$(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) + + +# --- MakeMaker realclean_subdirs section: +realclean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker realclean section: + +# Delete temporary files (via clean) and also delete installed files +realclean purge :: clean realclean_subdirs + $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR) + $(RM_RF) $(DISTVNAME) + $(RM_F) $(INST_LIB)/File/slurp_article.pod $(INST_LIB)/File/seek.pl blib/lib/File/Slurp.pm $(MAKEFILE_OLD) $(INST_LIB)/File/split.pl $(INST_LIB)/File/slurp_bench.pl $(INST_LIB)/File/Slurp.pm + $(RM_F) $(INST_LIB)/File/sysread.pl $(FIRST_MAKEFILE) $(INST_LIB)/File/carp.pl + + +# --- MakeMaker metafile section: +metafile : + $(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > META.yml + $(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#' >> META.yml + $(NOECHO) $(ECHO) 'name: File-Slurp' >> META.yml + $(NOECHO) $(ECHO) 'version: 9999.12' >> META.yml + $(NOECHO) $(ECHO) 'version_from: lib/File/Slurp.pm' >> META.yml + $(NOECHO) $(ECHO) 'installdirs: site' >> META.yml + $(NOECHO) $(ECHO) 'requires:' >> META.yml + $(NOECHO) $(ECHO) '' >> META.yml + $(NOECHO) $(ECHO) 'distribution_type: module' >> META.yml + $(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.17' >> META.yml + + +# --- MakeMaker metafile_addtomanifest section: +metafile_addtomanifest: + $(NOECHO) $(PERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' + + +# --- MakeMaker dist_basics section: +distclean :: realclean distcheck + $(NOECHO) $(NOOP) + +distcheck : + $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck + +skipcheck : + $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck + +manifest : + $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest + +veryclean : realclean + $(RM_F) *~ *.orig */*~ */*.orig + + + +# --- MakeMaker dist_core section: + +dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE) + $(NOECHO) $(PERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \ + -e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' + +tardist : $(DISTVNAME).tar$(SUFFIX) + $(NOECHO) $(NOOP) + +uutardist : $(DISTVNAME).tar$(SUFFIX) + uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +zipdist : $(DISTVNAME).zip + $(NOECHO) $(NOOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +shdist : distdir + $(PREOP) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) + $(POSTOP) + + +# --- MakeMaker distdir section: +distdir : metafile metafile_addtomanifest + $(RM_RF) $(DISTVNAME) + $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ + -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" + + + +# --- MakeMaker dist_test section: + +disttest : distdir + cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL + cd $(DISTVNAME) && $(MAKE) $(PASTHRU) + cd $(DISTVNAME) && $(MAKE) test $(PASTHRU) + + +# --- MakeMaker dist_ci section: + +ci : + $(PERLRUN) "-MExtUtils::Manifest=maniread" \ + -e "@all = keys %{ maniread() };" \ + -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \ + -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});" + + +# --- MakeMaker install section: + +install :: all pure_install doc_install + +install_perl :: all pure_perl_install doc_perl_install + +install_site :: all pure_site_install doc_site_install + +install_vendor :: all pure_vendor_install doc_vendor_install + +pure_install :: pure_$(INSTALLDIRS)_install + +doc_install :: doc_$(INSTALLDIRS)_install + +pure__install : pure_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +doc__install : doc_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +pure_perl_install :: + $(NOECHO) $(MOD_INSTALL) \ + read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLPRIVLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \ + $(INST_BIN) $(DESTINSTALLBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(SITEARCHEXP)/auto/$(FULLEXT) + + +pure_site_install :: + $(NOECHO) $(MOD_INSTALL) \ + read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLSITELIB) \ + $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \ + $(INST_BIN) $(DESTINSTALLSITEBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(PERL_ARCHLIB)/auto/$(FULLEXT) + +pure_vendor_install :: + $(NOECHO) $(MOD_INSTALL) \ + read $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLVENDORARCH)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLVENDORLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \ + $(INST_BIN) $(DESTINSTALLVENDORBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) + +doc_perl_install :: + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) + -$(NOECHO) $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLPRIVLIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLARCHLIB)/perllocal.pod + +doc_site_install :: + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) + -$(NOECHO) $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLSITELIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLARCHLIB)/perllocal.pod + +doc_vendor_install :: + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) + -$(NOECHO) $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLVENDORLIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLARCHLIB)/perllocal.pod + + +uninstall :: uninstall_from_$(INSTALLDIRS)dirs + +uninstall_from_perldirs :: + $(NOECHO) $(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist + +uninstall_from_sitedirs :: + $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist + +uninstall_from_vendordirs :: + $(NOECHO) $(UNINSTALL) $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist + + +# --- MakeMaker force section: +# Phony target to force checking subdirectories. +FORCE: + $(NOECHO) $(NOOP) + + +# --- MakeMaker perldepend section: + + +# --- MakeMaker makefile section: + +# We take a very conservative approach here, but it's worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) + $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" + $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." + $(NOECHO) $(RM_F) $(MAKEFILE_OLD) + $(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) + -$(MAKE) -f $(MAKEFILE_OLD) clean $(DEV_NULL) || $(NOOP) + $(PERLRUN) Makefile.PL + $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" + $(NOECHO) $(ECHO) "==> Please rerun the make command. <==" + false + + + +# --- MakeMaker staticmake section: + +# --- MakeMaker makeaperl section --- +MAP_TARGET = perl +FULLPERL = /usr/local/bin/perl + +$(MAP_TARGET) :: static $(MAKE_APERL_FILE) + $(MAKE) -f $(MAKE_APERL_FILE) $@ + +$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) + $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) + $(NOECHO) $(PERLRUNINST) \ + Makefile.PL DIR= \ + MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ + MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= + + +# --- MakeMaker test section: + +TEST_VERBOSE=0 +TEST_TYPE=test_$(LINKTYPE) +TEST_FILE = test.pl +TEST_FILES = t/*.t +TESTDB_SW = -d + +testdb :: testdb_$(LINKTYPE) + +test :: $(TEST_TYPE) + +test_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) + +testdb_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) + +test_ : test_dynamic + +test_static :: test_dynamic +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)' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' Efficient Reading/Writing of Complete Files' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' Uri Guttman <uri@stemsystems.com>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) '' >> $(DISTNAME).ppd + + +# --- MakeMaker pm_to_blib section: + +pm_to_blib: $(TO_INST_PM) + $(NOECHO) $(PERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')'\ + Slurp.pm $(INST_LIB)/File/Slurp.pm \ + carp.pl $(INST_LIB)/File/carp.pl \ + lib/File/Slurp.pm blib/lib/File/Slurp.pm \ + seek.pl $(INST_LIB)/File/seek.pl \ + split.pl $(INST_LIB)/File/split.pl \ + sysread.pl $(INST_LIB)/File/sysread.pl \ + slurp_article.pod $(INST_LIB)/File/slurp_article.pod \ + slurp_bench.pl $(INST_LIB)/File/slurp_bench.pl + $(NOECHO) $(TOUCH) $@ + +# --- MakeMaker selfdocument section: + + +# --- MakeMaker postamble section: + + +# End. diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..07a60d5 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,11 @@ +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::Slurp', + 'VERSION_FROM' => 'lib/File/Slurp.pm', # finds $VERSION + 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'lib/File/Slurp.pm', # retrieve abstract from module + AUTHOR => 'Uri Guttman ') : ()), +); diff --git a/Makefile.old b/Makefile.old new file mode 100644 index 0000000..811e0f6 --- /dev/null +++ b/Makefile.old @@ -0,0 +1,700 @@ +# This Makefile is for the File::Slurp extension to perl. +# +# It was generated automatically by MakeMaker version +# 5.45 (Revision: 1.222) from the contents of +# Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker ARGV: () +# +# MakeMaker Parameters: + +# ABSTRACT_FROM => q[lib/File/Slurp.pm] +# AUTHOR => q[Uri Guttman ] +# NAME => q[File::Slurp] +# PREREQ_PM => { } +# VERSION_FROM => q[lib/File/Slurp.pm] + +# --- MakeMaker post_initialize section: + + +# --- MakeMaker const_config section: + +# These definitions are from config.sh (via /usr/local/lib/perl5/5.6.1/sun4-solaris/Config.pm) + +# They may have been overridden via Makefile.PL or on the command line +AR = ar +CC = gcc +CCCDLFLAGS = -fPIC +CCDLFLAGS = +DLEXT = so +DLSRC = dl_dlopen.xs +LD = gcc +LDDLFLAGS = -G -L/usr/local/lib +LDFLAGS = -L/usr/local/lib +LIBC = /lib/libc.so +LIB_EXT = .a +OBJ_EXT = .o +OSNAME = solaris +OSVERS = 2.7 +RANLIB = : +SO = so +EXE_EXT = +FULL_AR = /usr/ccs/bin/ar + + +# --- MakeMaker constants section: +AR_STATIC_ARGS = cr +NAME = File::Slurp +DISTNAME = File-Slurp +NAME_SYM = File_Slurp +VERSION = 9999.03 +VERSION_SYM = 9999_03 +XS_VERSION = 9999.03 +INST_BIN = blib/bin +INST_EXE = blib/script +INST_LIB = blib/lib +INST_ARCHLIB = blib/arch +INST_SCRIPT = blib/script +PREFIX = /usr/local +INSTALLDIRS = site +INSTALLPRIVLIB = $(PREFIX)/lib/perl5/5.6.1 +INSTALLARCHLIB = $(PREFIX)/lib/perl5/5.6.1/sun4-solaris +INSTALLSITELIB = $(PREFIX)/lib/perl5/site_perl/5.6.1 +INSTALLSITEARCH = $(PREFIX)/lib/perl5/site_perl/5.6.1/sun4-solaris +INSTALLBIN = $(PREFIX)/bin +INSTALLSCRIPT = $(PREFIX)/bin +PERL_LIB = /usr/local/lib/perl5/5.6.1 +PERL_ARCHLIB = /usr/local/lib/perl5/5.6.1/sun4-solaris +SITELIBEXP = /usr/local/lib/perl5/site_perl/5.6.1 +SITEARCHEXP = /usr/local/lib/perl5/site_perl/5.6.1/sun4-solaris +LIBPERL_A = libperl.a +FIRST_MAKEFILE = Makefile +MAKE_APERL_FILE = Makefile.aperl +PERLMAINCC = $(CC) +PERL_INC = /usr/local/lib/perl5/5.6.1/sun4-solaris/CORE +PERL = /usr/local/bin/perl +FULLPERL = /usr/local/bin/perl +FULL_AR = /usr/ccs/bin/ar + +VERSION_MACRO = VERSION +DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" +PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc + +MAKEMAKER = /usr/local/lib/perl5/5.6.1/ExtUtils/MakeMaker.pm +MM_VERSION = 5.45 + +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!! +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +FULLEXT = File/Slurp +BASEEXT = Slurp +PARENT_NAME = File +DLBASE = $(BASEEXT) +VERSION_FROM = lib/File/Slurp.pm +OBJECT = +LDFROM = $(OBJECT) +LINKTYPE = dynamic + +# Handy lists of source code files: +XS_FILES= +C_FILES = +O_FILES = +H_FILES = +HTMLLIBPODS = +HTMLSCRIPTPODS = +MAN1PODS = +MAN3PODS = lib/File/Slurp.pm \ + slurp_article.pod +HTMLEXT = html +INST_MAN1DIR = blib/man1 +INSTALLMAN1DIR = $(PREFIX)/man/man1 +MAN1EXT = 1 +INST_MAN3DIR = blib/man3 +INSTALLMAN3DIR = $(PREFIX)/man/man3 +MAN3EXT = 3 +PERM_RW = 644 +PERM_RWX = 755 + +# work around a famous dec-osf make(1) feature(?): +makemakerdflt: all + +.SUFFIXES: .xs .c .C .cpp .cxx .cc $(OBJ_EXT) + +# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that +# some make implementations will delete the Makefile when we rebuild it. Because +# we call false(1) when we rebuild it. So make(1) is not completely wrong when it +# does so. Our milage may vary. +# .PRECIOUS: Makefile # seems to be not necessary anymore + +.PHONY: all config static dynamic test linkext manifest + +# Where is the Config information that we are using/depend on +CONFIGDEP = $(PERL_ARCHLIB)/Config.pm $(PERL_INC)/config.h + +# Where to put things: +INST_LIBDIR = $(INST_LIB)/File +INST_ARCHLIBDIR = $(INST_ARCHLIB)/File + +INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) +INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) + +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = + +EXPORT_LIST = + +PERL_ARCHIVE = + +PERL_ARCHIVE_AFTER = + +TO_INST_PM = carp.pl \ + lib/File/Slurp.pm \ + lib/File/Slurp.pm.~1.15.~ \ + slurp_article.pod \ + slurp_bench.pl \ + split.pl \ + sysread.pl + +PM_TO_BLIB = slurp_article.pod \ + $(INST_LIBDIR)/slurp_article.pod \ + carp.pl \ + $(INST_LIBDIR)/carp.pl \ + lib/File/Slurp.pm.~1.15.~ \ + $(INST_LIB)/File/Slurp.pm.~1.15.~ \ + split.pl \ + $(INST_LIBDIR)/split.pl \ + sysread.pl \ + $(INST_LIBDIR)/sysread.pl \ + lib/File/Slurp.pm \ + $(INST_LIB)/File/Slurp.pm \ + slurp_bench.pl \ + $(INST_LIBDIR)/slurp_bench.pl + + +# --- MakeMaker tool_autosplit section: + +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;' + + +# --- MakeMaker tool_xsubpp section: + + +# --- MakeMaker tools_other section: + +SHELL = /bin/sh +CHMOD = chmod +CP = cp +LD = gcc +MV = mv +NOOP = $(SHELL) -c true +RM_F = rm -f +RM_RF = rm -rf +TEST_F = test -f +TOUCH = touch +UMASK_NULL = umask 0 +DEV_NULL = > /dev/null 2>&1 + +# The following is a portable way to say mkdir -p +# To see which directories are created, change the if 0 to if 1 +MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath + +# This helps us to minimize the effect of the .exists files A yet +# better solution would be to have a stable file in the perl +# distribution with a timestamp of zero. But this solution doesn't +# need any changes to the core distribution and works with older perls +EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime + +# Here we warn users that an old packlist file was found somewhere, +# and that they should call some uninstall routine +WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \ +-e 'print "WARNING: I have found an old package in\n";' \ +-e 'print "\t$$ARGV[0].\n";' \ +-e 'print "Please make sure the two installations are not conflicting\n";' + +UNINST=0 +VERBINST=0 + +MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \ +-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');" + +DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \ +-e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", $$arg=shift, "|", $$arg, ">";' \ +-e 'print "=over 4";' \ +-e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \ +-e 'print "=back";' + +UNINSTALL = $(PERL) -MExtUtils::Install \ +-e 'uninstall($$ARGV[0],1,1); print "\nUninstall is deprecated. Please check the";' \ +-e 'print " packlist above carefully.\n There may be errors. Remove the";' \ +-e 'print " appropriate files manually.\n Sorry for the inconveniences.\n"' + + +# --- MakeMaker dist section: + +DISTVNAME = $(DISTNAME)-$(VERSION) +TAR = tar +TARFLAGS = cvf +ZIP = zip +ZIPFLAGS = -r +COMPRESS = gzip --best +SUFFIX = .gz +SHAR = shar +PREOP = @$(NOOP) +POSTOP = @$(NOOP) +TO_UNIX = @$(NOOP) +CI = ci -u +RCS_LABEL = rcs -Nv$(VERSION_SYM): -q +DIST_CP = best +DIST_DEFAULT = tardist + + +# --- MakeMaker macro section: + + +# --- MakeMaker depend section: + + +# --- MakeMaker cflags section: + + +# --- MakeMaker const_loadlibs section: + + +# --- MakeMaker const_cccmd section: + + +# --- MakeMaker post_constants section: + + +# --- MakeMaker pasthru section: + +PASTHRU = LIB="$(LIB)"\ + LIBPERL_A="$(LIBPERL_A)"\ + LINKTYPE="$(LINKTYPE)"\ + PREFIX="$(PREFIX)"\ + OPTIMIZE="$(OPTIMIZE)" + + +# --- MakeMaker c_o section: + + +# --- MakeMaker xs_c section: + + +# --- MakeMaker xs_o section: + + +# --- MakeMaker top_targets section: + +#all :: config $(INST_PM) subdirs linkext manifypods + +all :: pure_all htmlifypods manifypods + @$(NOOP) + +pure_all :: config pm_to_blib subdirs linkext + @$(NOOP) + +subdirs :: $(MYEXTLIB) + @$(NOOP) + +config :: Makefile $(INST_LIBDIR)/.exists + @$(NOOP) + +config :: $(INST_ARCHAUTODIR)/.exists + @$(NOOP) + +config :: $(INST_AUTODIR)/.exists + @$(NOOP) + +$(INST_AUTODIR)/.exists :: /usr/local/lib/perl5/5.6.1/sun4-solaris/CORE/perl.h + @$(MKPATH) $(INST_AUTODIR) + @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.1/sun4-solaris/CORE/perl.h $(INST_AUTODIR)/.exists + + -@$(CHMOD) $(PERM_RWX) $(INST_AUTODIR) + +$(INST_LIBDIR)/.exists :: /usr/local/lib/perl5/5.6.1/sun4-solaris/CORE/perl.h + @$(MKPATH) $(INST_LIBDIR) + @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.1/sun4-solaris/CORE/perl.h $(INST_LIBDIR)/.exists + + -@$(CHMOD) $(PERM_RWX) $(INST_LIBDIR) + +$(INST_ARCHAUTODIR)/.exists :: /usr/local/lib/perl5/5.6.1/sun4-solaris/CORE/perl.h + @$(MKPATH) $(INST_ARCHAUTODIR) + @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.1/sun4-solaris/CORE/perl.h $(INST_ARCHAUTODIR)/.exists + + -@$(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR) + +config :: $(INST_MAN3DIR)/.exists + @$(NOOP) + + +$(INST_MAN3DIR)/.exists :: /usr/local/lib/perl5/5.6.1/sun4-solaris/CORE/perl.h + @$(MKPATH) $(INST_MAN3DIR) + @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.1/sun4-solaris/CORE/perl.h $(INST_MAN3DIR)/.exists + + -@$(CHMOD) $(PERM_RWX) $(INST_MAN3DIR) + +help: + perldoc ExtUtils::MakeMaker + +Version_check: + @$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + -MExtUtils::MakeMaker=Version_check \ + -e "Version_check('$(MM_VERSION)')" + + +# --- MakeMaker linkext section: + +linkext :: $(LINKTYPE) + @$(NOOP) + + +# --- MakeMaker dlsyms section: + + +# --- MakeMaker dynamic section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make dynamic" +#dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM) +dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) + @$(NOOP) + + +# --- MakeMaker dynamic_bs section: + +BOOTSTRAP = + + +# --- MakeMaker dynamic_lib section: + + +# --- MakeMaker static section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make static" +#static :: Makefile $(INST_STATIC) $(INST_PM) +static :: Makefile $(INST_STATIC) + @$(NOOP) + + +# --- MakeMaker static_lib section: + + +# --- MakeMaker htmlifypods section: + +htmlifypods : pure_all + @$(NOOP) + + +# --- MakeMaker manifypods section: +POD2MAN_EXE = /usr/local/bin/pod2man +POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \ +-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "Makefile";' \ +-e 'print "Manifying $$m{$$_}\n";' \ +-e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\047t install $$m{$$_}\n";' \ +-e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}' + +manifypods : pure_all slurp_article.pod \ + lib/File/Slurp.pm + @$(POD2MAN) \ + slurp_article.pod \ + $(INST_MAN3DIR)/File::slurp_article.$(MAN3EXT) \ + lib/File/Slurp.pm \ + $(INST_MAN3DIR)/File::Slurp.$(MAN3EXT) + +# --- MakeMaker processPL section: + + +# --- MakeMaker installbin section: + + +# --- MakeMaker subdirs section: + +# none + +# --- MakeMaker clean section: + +# Delete temporary files but do not touch installed files. We don't delete +# the Makefile here so a later make realclean still has a makefile to use. + +clean :: + -rm -rf ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core core.*perl.*.? *perl.core so_locations pm_to_blib *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp + -mv Makefile Makefile.old $(DEV_NULL) + + +# --- MakeMaker realclean section: + +# Delete temporary files (via clean) and also delete installed files +realclean purge :: clean + rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR) + rm -f $(INST_LIBDIR)/slurp_article.pod $(INST_LIBDIR)/carp.pl + rm -f $(INST_LIB)/File/Slurp.pm.~1.15.~ $(INST_LIBDIR)/split.pl + rm -f $(INST_LIBDIR)/sysread.pl $(INST_LIB)/File/Slurp.pm $(INST_LIBDIR)/slurp_bench.pl + rm -rf Makefile Makefile.old + + +# --- MakeMaker dist_basics section: + +distclean :: realclean distcheck + +distcheck : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \ + -e fullcheck + +skipcheck : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \ + -e skipcheck + +manifest : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \ + -e mkmanifest + +veryclean : realclean + $(RM_F) *~ *.orig */*~ */*.orig + + +# --- MakeMaker dist_core section: + +dist : $(DIST_DEFAULT) + @$(PERL) -le 'print "Warning: Makefile possibly out of date with $$vf" if ' \ + -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "Makefile";' + +tardist : $(DISTVNAME).tar$(SUFFIX) + +zipdist : $(DISTVNAME).zip + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +uutardist : $(DISTVNAME).tar$(SUFFIX) + uuencode $(DISTVNAME).tar$(SUFFIX) \ + $(DISTVNAME).tar$(SUFFIX) > \ + $(DISTVNAME).tar$(SUFFIX)_uu + +shdist : distdir + $(PREOP) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) + $(POSTOP) + + +# --- MakeMaker dist_dir section: + +distdir : + $(RM_RF) $(DISTVNAME) + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \ + -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" + + +# --- MakeMaker dist_test section: + +disttest : distdir + cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL + cd $(DISTVNAME) && $(MAKE) + cd $(DISTVNAME) && $(MAKE) test + + +# --- MakeMaker dist_ci section: + +ci : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \ + -e "@all = keys %{ maniread() };" \ + -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \ + -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");' + + +# --- MakeMaker install section: + +install :: all pure_install doc_install + +install_perl :: all pure_perl_install doc_perl_install + +install_site :: all pure_site_install doc_site_install + +install_ :: install_site + @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +pure_install :: pure_$(INSTALLDIRS)_install + +doc_install :: doc_$(INSTALLDIRS)_install + @echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod + +pure__install : pure_site_install + @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +doc__install : doc_site_install + @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +pure_perl_install :: + @$(MOD_INSTALL) \ + read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \ + write $(INSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(INSTALLPRIVLIB) \ + $(INST_ARCHLIB) $(INSTALLARCHLIB) \ + $(INST_BIN) $(INSTALLBIN) \ + $(INST_SCRIPT) $(INSTALLSCRIPT) \ + $(INST_HTMLLIBDIR) $(INSTALLHTMLPRIVLIBDIR) \ + $(INST_HTMLSCRIPTDIR) $(INSTALLHTMLSCRIPTDIR) \ + $(INST_MAN1DIR) $(INSTALLMAN1DIR) \ + $(INST_MAN3DIR) $(INSTALLMAN3DIR) + @$(WARN_IF_OLD_PACKLIST) \ + $(SITEARCHEXP)/auto/$(FULLEXT) + + +pure_site_install :: + @$(MOD_INSTALL) \ + read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \ + write $(INSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(INSTALLSITELIB) \ + $(INST_ARCHLIB) $(INSTALLSITEARCH) \ + $(INST_BIN) $(INSTALLBIN) \ + $(INST_SCRIPT) $(INSTALLSCRIPT) \ + $(INST_HTMLLIBDIR) $(INSTALLHTMLSITELIBDIR) \ + $(INST_HTMLSCRIPTDIR) $(INSTALLHTMLSCRIPTDIR) \ + $(INST_MAN1DIR) $(INSTALLMAN1DIR) \ + $(INST_MAN3DIR) $(INSTALLMAN3DIR) + @$(WARN_IF_OLD_PACKLIST) \ + $(PERL_ARCHLIB)/auto/$(FULLEXT) + +doc_perl_install :: + -@$(MKPATH) $(INSTALLARCHLIB) + -@$(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLPRIVLIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(INSTALLARCHLIB)/perllocal.pod + +doc_site_install :: + -@$(MKPATH) $(INSTALLARCHLIB) + -@$(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLSITELIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(INSTALLARCHLIB)/perllocal.pod + + +uninstall :: uninstall_from_$(INSTALLDIRS)dirs + +uninstall_from_perldirs :: + @$(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist + +uninstall_from_sitedirs :: + @$(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist + + +# --- MakeMaker force section: +# Phony target to force checking subdirectories. +FORCE: + @$(NOOP) + + +# --- MakeMaker perldepend section: + + +# --- MakeMaker makefile section: + +# We take a very conservative approach here, but it\'s worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +Makefile : Makefile.PL $(CONFIGDEP) + @echo "Makefile out-of-date with respect to $?" + @echo "Cleaning current config before rebuilding Makefile..." + -@$(RM_F) Makefile.old + -@$(MV) Makefile Makefile.old + -$(MAKE) -f Makefile.old clean $(DEV_NULL) || $(NOOP) + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL + @echo "==> Your Makefile has been rebuilt. <==" + @echo "==> Please rerun the make command. <==" + false + +# To change behavior to :: would be nice, but would break Tk b9.02 +# so you find such a warning below the dist target. +#Makefile :: $(VERSION_FROM) +# @echo "Warning: Makefile possibly out of date with $(VERSION_FROM)" + + +# --- MakeMaker staticmake section: + +# --- MakeMaker makeaperl section --- +MAP_TARGET = perl +FULLPERL = /usr/local/bin/perl + +$(MAP_TARGET) :: static $(MAKE_APERL_FILE) + $(MAKE) -f $(MAKE_APERL_FILE) $@ + +$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) + @echo Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) + @$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + Makefile.PL DIR= \ + MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ + MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= + + +# --- MakeMaker test section: + +TEST_VERBOSE=0 +TEST_TYPE=test_$(LINKTYPE) +TEST_FILE = test.pl +TEST_FILES = t/*.t +TESTDB_SW = -d + +testdb :: testdb_$(LINKTYPE) + +test :: $(TEST_TYPE) + +test_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' $(TEST_FILES) + +testdb_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERL) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE) + +test_ : test_dynamic + +test_static :: test_dynamic +testdb_static :: testdb_dynamic + + +# --- MakeMaker ppd section: +# Creates a PPD (Perl Package Description) for a binary distribution. +ppd: + @$(PERL) -e "print qq{\n}. qq{\tFile-Slurp\n}. qq{\tEfficient Reading/Writing of Complete Files\n}. qq{\tUri Guttman <uri\@stemsystems.com>\n}. qq{\t\n}. qq{\t\t\n}. qq{\t\t\n}. qq{\t\t\n}. qq{\t\n}. qq{\n}" > File-Slurp.ppd + +# --- MakeMaker pm_to_blib section: + +pm_to_blib: $(TO_INST_PM) + @$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ + "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ + -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'$(INST_LIB)/auto','$(PM_FILTER)')" + @$(TOUCH) $@ + + +# --- MakeMaker selfdocument section: + + +# --- MakeMaker postamble section: + + +# End. diff --git a/README b/README new file mode 100644 index 0000000..1a7a9d4 --- /dev/null +++ b/README @@ -0,0 +1,41 @@ +File::Slurp.pm version 0.04 +=========================== + +This module provides subroutines to read or write entire files with a +simple call. It also has a subroutine for reading the list of filenames +in a directory. + +In the extras/ directory you can read an article (slurp_article.pod) +about file slurping and also run a benchmark (slurp_bench.pl) that +compares many ways of slurping/spewing files. + +This module was first written and owned by David Muir Sharnoff (MUIR on +CPAN). I checked out his module and decided to write a new version +which would be faster, and with many more features. To that end, David +graciously transfered the namespace to me. + +Since then, I discovered and fixed a bug in the original module's test +script (which had only 7 tests), which is included now as t/original.t. +This module now has 164 tests in 7 test scripts, and passes on Windows, +Linux, Solaris and Mac OS X. + +There have been some comments about the somewhat unusual version number. +The problem was that David used a future date (2004.0904) in his version +number, and the only way I could get CPAN to index my new module was to +make it have a version number higher than the old one, so I chose the +9999 prefix and appended the real revision number to it. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +COPYRIGHT AND LICENCE + +Copyright (C) 2003 Uri Guttman + +Licensed the same as Perl. diff --git a/Slurp.pm b/Slurp.pm new file mode 100755 index 0000000..74d73a7 --- /dev/null +++ b/Slurp.pm @@ -0,0 +1,745 @@ +package File::Slurp; + +use strict; + +use Carp ; +use Fcntl qw( :DEFAULT ) ; +use POSIX qw( :fcntl_h ) ; +use Symbol ; + +use base 'Exporter' ; +use vars qw( %EXPORT_TAGS @EXPORT_OK $VERSION @EXPORT ) ; + +%EXPORT_TAGS = ( 'all' => [ + qw( read_file write_file overwrite_file append_file read_dir ) ] ) ; + +@EXPORT = ( @{ $EXPORT_TAGS{'all'} } ); +@EXPORT_OK = qw( slurp ) ; + +$VERSION = '9999.13'; + +my $is_win32 = $^O =~ /win32/i ; + +# Install subs for various constants that aren't set in older perls +# (< 5.005). Fcntl on old perls uses Exporter to define subs without a +# () prototype These can't be overridden with the constant pragma or +# we get a prototype mismatch. Hence this less than aesthetically +# appealing BEGIN block: + +BEGIN { + unless( eval { defined SEEK_SET() } ) { + *SEEK_SET = sub { 0 }; + *SEEK_CUR = sub { 1 }; + *SEEK_END = sub { 2 }; + } + + unless( eval { defined O_BINARY() } ) { + *O_BINARY = sub { 0 }; + *O_RDONLY = sub { 0 }; + *O_WRONLY = sub { 1 }; + } + + unless ( eval { defined O_APPEND() } ) { + + if ( $^O =~ /olaris/ ) { + *O_APPEND = sub { 8 }; + *O_CREAT = sub { 256 }; + *O_EXCL = sub { 1024 }; + } + elsif ( $^O =~ /inux/ ) { + *O_APPEND = sub { 1024 }; + *O_CREAT = sub { 64 }; + *O_EXCL = sub { 128 }; + } + elsif ( $^O =~ /BSD/i ) { + *O_APPEND = sub { 8 }; + *O_CREAT = sub { 512 }; + *O_EXCL = sub { 2048 }; + } + } +} + +# print "OS [$^O]\n" ; + +# print "O_BINARY = ", O_BINARY(), "\n" ; +# print "O_RDONLY = ", O_RDONLY(), "\n" ; +# print "O_WRONLY = ", O_WRONLY(), "\n" ; +# print "O_APPEND = ", O_APPEND(), "\n" ; +# print "O_CREAT ", O_CREAT(), "\n" ; +# print "O_EXCL ", O_EXCL(), "\n" ; + + +*slurp = \&read_file ; + +sub read_file { + + my( $file_name, %args ) = @_ ; + +# set the buffer to either the passed in one or ours and init it to the null +# string + + my $buf ; + my $buf_ref = $args{'buf_ref'} || \$buf ; + ${$buf_ref} = '' ; + + my( $read_fh, $size_left, $blk_size ) ; + +# check if we are reading from a handle (glob ref or IO:: object) + + if ( ref $file_name ) { + +# slurping a handle so use it and don't open anything. +# set the block size so we know it is a handle and read that amount + + $read_fh = $file_name ; + $blk_size = $args{'blk_size'} || 1024 * 1024 ; + $size_left = $blk_size ; + +# DEEP DARK MAGIC. this checks the UNTAINT IO flag of a +# glob/handle. only the DATA handle is untainted (since it is from +# trusted data in the source file). this allows us to test if this is +# the DATA handle and then to do a sysseek to make sure it gets +# slurped correctly. on some systems, the buffered i/o pointer is not +# left at the same place as the fd pointer. this sysseek makes them +# the same so slurping with sysread will work. + + eval{ require B } ; + + if ( $@ ) { + + @_ = ( \%args, <IO->IoFLAGS & 16 ) { + +# set the seek position to the current tell. + + sysseek( $read_fh, tell( $read_fh ), SEEK_SET ) || + croak "sysseek $!" ; + } + } + else { + +# a regular file. set the sysopen mode + + my $mode = O_RDONLY ; + $mode |= O_BINARY if $args{'binmode'} ; + +#printf "RD: BINARY %x MODE %x\n", O_BINARY, $mode ; + +# open the file and handle any error + + $read_fh = gensym ; + unless ( sysopen( $read_fh, $file_name, $mode ) ) { + @_ = ( \%args, "read_file '$file_name' - sysopen: $!"); + goto &_error ; + } + +# get the size of the file for use in the read loop + + $size_left = -s $read_fh ; + + unless( $size_left ) { + + $blk_size = $args{'blk_size'} || 1024 * 1024 ; + $size_left = $blk_size ; + } + } + +# infinite read loop. we exit when we are done slurping + + while( 1 ) { + +# do the read and see how much we got + + my $read_cnt = sysread( $read_fh, ${$buf_ref}, + $size_left, length ${$buf_ref} ) ; + + if ( defined $read_cnt ) { + +# good read. see if we hit EOF (nothing left to read) + + last if $read_cnt == 0 ; + +# loop if we are slurping a handle. we don't track $size_left then. + + next if $blk_size ; + +# count down how much we read and loop if we have more to read. + $size_left -= $read_cnt ; + last if $size_left <= 0 ; + next ; + } + +# handle the read error + + @_ = ( \%args, "read_file '$file_name' - sysread: $!"); + goto &_error ; + } + +# fix up cr/lf to be a newline if this is a windows text file + + ${$buf_ref} =~ s/\015\012/\n/g if $is_win32 && !$args{'binmode'} ; + +# this is the 5 returns in a row. each handles one possible +# combination of caller context and requested return type + + my $sep = $/ ; + $sep = '\n\n+' if defined $sep && $sep eq '' ; + +# caller wants to get an array ref of lines + +# this split doesn't work since it tries to use variable length lookbehind +# the m// line works. +# return [ split( m|(?<=$sep)|, ${$buf_ref} ) ] if $args{'array_ref'} ; + return [ length(${$buf_ref}) ? ${$buf_ref} =~ /(.*?$sep|.+)/sg : () ] + if $args{'array_ref'} ; + +# caller wants a list of lines (normal list context) + +# same problem with this split as before. +# return split( m|(?<=$sep)|, ${$buf_ref} ) if wantarray ; + return length(${$buf_ref}) ? ${$buf_ref} =~ /(.*?$sep|.+)/sg : () + if wantarray ; + +# caller wants a scalar ref to the slurped text + + return $buf_ref if $args{'scalar_ref'} ; + +# caller wants a scalar with the slurped text (normal scalar context) + + return ${$buf_ref} if defined wantarray ; + +# caller passed in an i/o buffer by reference (normal void context) + + return ; +} + +sub write_file { + + my $file_name = shift ; + +# get the optional argument hash ref from @_ or an empty hash ref. + + my $args = ( ref $_[0] eq 'HASH' ) ? shift : {} ; + + my( $buf_ref, $write_fh, $no_truncate, $orig_file_name, $data_is_ref ) ; + +# get the buffer ref - it depends on how the data is passed into write_file +# after this if/else $buf_ref will have a scalar ref to the data. + + if ( ref $args->{'buf_ref'} eq 'SCALAR' ) { + +# a scalar ref passed in %args has the data +# note that the data was passed by ref + + $buf_ref = $args->{'buf_ref'} ; + $data_is_ref = 1 ; + } + elsif ( ref $_[0] eq 'SCALAR' ) { + +# the first value in @_ is the scalar ref to the data +# note that the data was passed by ref + + $buf_ref = shift ; + $data_is_ref = 1 ; + } + elsif ( ref $_[0] eq 'ARRAY' ) { + +# the first value in @_ is the array ref to the data so join it. + + ${$buf_ref} = join '', @{$_[0]} ; + } + else { + +# good old @_ has all the data so join it. + + ${$buf_ref} = join '', @_ ; + } + +# see if we were passed a open handle to spew to. + + if ( ref $file_name ) { + +# we have a handle. make sure we don't call truncate on it. + + $write_fh = $file_name ; + $no_truncate = 1 ; + } + else { + +# spew to regular file. + + if ( $args->{'atomic'} ) { + +# in atomic mode, we spew to a temp file so make one and save the original +# file name. + $orig_file_name = $file_name ; + $file_name .= ".$$" ; + } + +# set the mode for the sysopen + + my $mode = O_WRONLY | O_CREAT ; + $mode |= O_BINARY if $args->{'binmode'} ; + $mode |= O_APPEND if $args->{'append'} ; + $mode |= O_EXCL if $args->{'no_clobber'} ; + +#printf "WR: BINARY %x MODE %x\n", O_BINARY, $mode ; + +# open the file and handle any error. + + $write_fh = gensym ; + unless ( sysopen( $write_fh, $file_name, $mode ) ) { + @_ = ( $args, "write_file '$file_name' - sysopen: $!"); + goto &_error ; + } + } + + sysseek( $write_fh, 0, SEEK_END ) if $args->{'append'} ; + + +#print 'WR before data ', unpack( 'H*', ${$buf_ref}), "\n" ; + +# fix up newline to write cr/lf if this is a windows text file + + if ( $is_win32 && !$args->{'binmode'} ) { + +# copy the write data if it was passed by ref so we don't clobber the +# caller's data + $buf_ref = \do{ my $copy = ${$buf_ref}; } if $data_is_ref ; + ${$buf_ref} =~ s/\n/\015\012/g ; + } + +#print 'after data ', unpack( 'H*', ${$buf_ref}), "\n" ; + +# get the size of how much we are writing and init the offset into that buffer + + my $size_left = length( ${$buf_ref} ) ; + my $offset = 0 ; + +# loop until we have no more data left to write + + do { + +# do the write and track how much we just wrote + + my $write_cnt = syswrite( $write_fh, ${$buf_ref}, + $size_left, $offset ) ; + + unless ( defined $write_cnt ) { + +# the write failed + @_ = ( $args, "write_file '$file_name' - syswrite: $!"); + goto &_error ; + } + +# track much left to write and where to write from in the buffer + + $size_left -= $write_cnt ; + $offset += $write_cnt ; + + } while( $size_left > 0 ) ; + +# we truncate regular files in case we overwrite a long file with a shorter file +# so seek to the current position to get it (same as tell()). + + truncate( $write_fh, + sysseek( $write_fh, 0, SEEK_CUR ) ) unless $no_truncate ; + + close( $write_fh ) ; + +# handle the atomic mode - move the temp file to the original filename. + + rename( $file_name, $orig_file_name ) if $args->{'atomic'} ; + + return 1 ; +} + +# this is for backwards compatibility with the previous File::Slurp module. +# write_file always overwrites an existing file + +*overwrite_file = \&write_file ; + +# the current write_file has an append mode so we use that. this +# supports the same API with an optional second argument which is a +# hash ref of options. + +sub append_file { + +# get the optional args hash ref + my $args = $_[1] ; + if ( ref $args eq 'HASH' ) { + +# we were passed an args ref so just mark the append mode + + $args->{append} = 1 ; + } + else { + +# no args hash so insert one with the append mode + + splice( @_, 1, 0, { append => 1 } ) ; + } + +# magic goto the main write_file sub. this overlays the sub without touching +# the stack or @_ + + goto &write_file +} + +# basic wrapper around opendir/readdir + +sub read_dir { + + my ($dir, %args ) = @_; + +# this handle will be destroyed upon return + + local(*DIRH); + +# open the dir and handle any errors + + unless ( opendir( DIRH, $dir ) ) { + + @_ = ( \%args, "read_dir '$dir' - opendir: $!" ) ; + goto &_error ; + } + + my @dir_entries = readdir(DIRH) ; + + @dir_entries = grep( $_ ne "." && $_ ne "..", @dir_entries ) + unless $args{'keep_dot_dot'} ; + + return @dir_entries if wantarray ; + return \@dir_entries ; +} + +# error handling section +# +# all the error handling uses magic goto so the caller will get the +# error message as if from their code and not this module. if we just +# did a call on the error code, the carp/croak would report it from +# this module since the error sub is one level down on the call stack +# from read_file/write_file/read_dir. + + +my %err_func = ( + 'carp' => \&carp, + 'croak' => \&croak, +) ; + +sub _error { + + my( $args, $err_msg ) = @_ ; + +# get the error function to use + + my $func = $err_func{ $args->{'err_mode'} || 'croak' } ; + +# if we didn't find it in our error function hash, they must have set +# it to quiet and we don't do anything. + + return unless $func ; + +# call the carp/croak function + + $func->($err_msg) ; + +# return a hard undef (in list context this will be a single value of +# undef which is not a legal in-band value) + + return undef ; +} + +1; +__END__ + +=head1 NAME + +File::Slurp - Efficient Reading/Writing of Complete Files + +=head1 SYNOPSIS + + use File::Slurp; + + my $text = read_file( 'filename' ) ; + my @lines = read_file( 'filename' ) ; + + write_file( 'filename', @lines ) ; + + use File::Slurp qw( slurp ) ; + + my $text = slurp( 'filename' ) ; + + +=head1 DESCRIPTION + +This module provides subs that allow you to read or write entire files +with one simple call. They are designed to be simple to use, have +flexible ways to pass in or get the file contents and to be very +efficient. There is also a sub to read in all the files in a +directory other than C<.> and C<..> + +These slurp/spew subs work for files, pipes and +sockets, and stdio, pseudo-files, and DATA. + +=head2 B + +This sub reads in an entire file and returns its contents to the +caller. In list context it will return a list of lines (using the +current value of $/ as the separator including support for paragraph +mode when it is set to ''). In scalar context it returns the entire +file as a single scalar. + + my $text = read_file( 'filename' ) ; + my @lines = read_file( 'filename' ) ; + +The first argument to C is the filename and the rest of the +arguments are key/value pairs which are optional and which modify the +behavior of the call. Other than binmode the options all control how +the slurped file is returned to the caller. + +If the first argument is a file handle reference or I/O object (if ref +is true), then that handle is slurped in. This mode is supported so +you slurp handles such as C, C. See the test handle.t +for an example that does C and child process spews data +to the parant which slurps it in. All of the options that control how +the data is returned to the caller still work in this case. + +NOTE: as of version 9999.06, read_file works correctly on the C +handle. It used to need a sysseek workaround but that is now handled +when needed by the module itself. + +You can optionally request that C is exported to your code. This +is an alias for read_file and is meant to be forward compatible with +Perl 6 (which will have slurp() built-in). + +The options are: + +=head3 binmode + +If you set the binmode option, then the file will be slurped in binary +mode. + + my $bin_data = read_file( $bin_file, binmode => ':raw' ) ; + +NOTE: this actually sets the O_BINARY mode flag for sysopen. It +probably should call binmode and pass its argument to support other +file modes. + +=head3 array_ref + +If this boolean option is set, the return value (only in scalar +context) will be an array reference which contains the lines of the +slurped file. The following two calls are equivalent: + + my $lines_ref = read_file( $bin_file, array_ref => 1 ) ; + my $lines_ref = [ read_file( $bin_file ) ] ; + +=head3 scalar_ref + +If this boolean option is set, the return value (only in scalar +context) will be an scalar reference to a string which is the contents +of the slurped file. This will usually be faster than returning the +plain scalar. + + my $text_ref = read_file( $bin_file, scalar_ref => 1 ) ; + +=head3 buf_ref + +You can use this option to pass in a scalar reference and the slurped +file contents will be stored in the scalar. This can be used in +conjunction with any of the other options. + + my $text_ref = read_file( $bin_file, buf_ref => \$buffer, + array_ref => 1 ) ; + my @lines = read_file( $bin_file, buf_ref => \$buffer ) ; + +=head3 blk_size + +You can use this option to set the block size used when slurping from an already open handle (like \*STDIN). It defaults to 1MB. + + my $text_ref = read_file( $bin_file, blk_size => 10_000_000, + array_ref => 1 ) ; + +=head3 err_mode + +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 error handling. This code wants to carp and then +read abother file if it fails. + + my $text_ref = read_file( $file, err_mode => 'carp' ) ; + unless ( $text_ref ) { + + # read a different file but croak if not found + $text_ref = read_file( $another_file ) ; + } + + # process ${$text_ref} + +=head2 B + +This sub writes out an entire file in one call. + + write_file( 'filename', @data ) ; + +The first argument to C is the filename. The next argument +is an optional hash reference and it contains key/values that can +modify the behavior of C. The rest of the argument list is +the data to be written to the file. + + write_file( 'filename', {append => 1 }, @data ) ; + write_file( 'filename', {binmode => ':raw' }, $buffer ) ; + +As a shortcut if the first data argument is a scalar or array +reference, it is used as the only data to be written to the file. Any +following arguments in @_ are ignored. This is a faster way to pass in +the output to be written to the file and is equivilent to the +C option. These following pairs are equivilent but the pass +by reference call will be faster in most cases (especially with larger +files). + + write_file( 'filename', \$buffer ) ; + write_file( 'filename', $buffer ) ; + + write_file( 'filename', \@lines ) ; + write_file( 'filename', @lines ) ; + +If the first argument is a file handle reference or I/O object (if ref +is true), then that handle is slurped in. This mode is supported so +you spew to handles such as \*STDOUT. See the test handle.t for an +example that does C and child process spews data to the +parant which slurps it in. All of the options that control how the +data is passes into C still work in this case. + +C returns 1 upon successfully writing the file or undef if +it encountered an error. + +The options are: + +=head3 binmode + +If you set the binmode option, then the file will be written in binary +mode. + + write_file( $bin_file, {binmode => ':raw'}, @data ) ; + +NOTE: this actually sets the O_BINARY mode flag for sysopen. It +probably should call binmode and pass its argument to support other +file modes. + +=head3 buf_ref + +You can use this option to pass in a scalar reference which has the +data to be written. If this is set then any data arguments (including +the scalar reference shortcut) in @_ will be ignored. These are +equivilent: + + write_file( $bin_file, { buf_ref => \$buffer } ) ; + write_file( $bin_file, \$buffer ) ; + write_file( $bin_file, $buffer ) ; + +=head3 atomic + +If you set this boolean option, the file will be written to in an +atomic fashion. A temporary file name is created by appending the pid +($$) to the file name argument and that file is spewed to. After the +file is closed it is renamed to the original file name (and rename is +an atomic operation on most OS's). If the program using this were to +crash in the middle of this, then the file with the pid suffix could +be left behind. + +=head3 append + +If you set this boolean option, the data will be written at the end of +the current file. + + write_file( $file, {append => 1}, @data ) ; + +C croaks if it cannot open the file. It returns true if it +succeeded in writing out the file and undef if there was an +error. (Yes, I know if it croaks it can't return anything but that is +for when I add the options to select the error handling mode). + +=head3 no_clobber + +If you set this boolean option, an existing file will not be overwritten. + + write_file( $file, {no_clobber => 1}, @data ) ; + +=head3 err_mode + +You can use this option to control how C behaves when an +error occurs. This option defaults to 'croak'. You can set it to +'carp' or to 'quiet' to have no error handling other than the return +value. If the first call to C fails it will carp and then +write to another file. If the second call to C fails, it +will croak. + + unless ( write_file( $file, { err_mode => 'carp', \$data ) ; + + # write a different file but croak if not found + write_file( $other_file, \$data ) ; + } + +=head2 overwrite_file + +This sub is just a typeglob alias to write_file since write_file +always overwrites an existing file. This sub is supported for +backwards compatibility with the original version of this module. See +write_file for its API and behavior. + +=head2 append_file + +This sub will write its data to the end of the file. It is a wrapper +around write_file and it has the same API so see that for the full +documentation. These calls are equivilent: + + append_file( $file, @data ) ; + write_file( $file, {append => 1}, @data ) ; + +=head2 read_dir + +This sub reads all the file names from directory and returns them to +the caller but C<.> and C<..> are removed by default. + + my @files = read_dir( '/path/to/dir' ) ; + +It croaks if it cannot open the directory. + +In a list context C returns a list of the entries in the +directory. In a scalar context it returns an array reference which has +the entries. + +=head3 keep_dot_dot + +If this boolean option is set, C<.> and C<..> are not removed from the +list of files. + + my @all_files = read_dir( '/path/to/dir', keep_dot_dot => 1 ) ; + +=head2 EXPORT + + read_file write_file overwrite_file append_file read_dir + +=head2 SEE ALSO + +An article on file slurping in extras/slurp_article.pod. There is +also a benchmarking script in extras/slurp_bench.pl. + +=head2 BUGS + +If run under Perl 5.004, slurping from the DATA handle will fail as +that requires B.pm which didn't get into core until 5.005. + +=head1 AUTHOR + +Uri Guttman, Euri@stemsystems.comE + +=cut diff --git a/TODO b/TODO new file mode 100644 index 0000000..ea70a25 --- /dev/null +++ b/TODO @@ -0,0 +1,27 @@ + +optimize read_file for smaller scalar slurps with no options + +prepend_file() + + options: lock file? + +edit_file() + + options: lock file? + +edit_file_lines() + + options: lock file? + +add options to read_dir + prepend_dir + grep filter qr or code ref + + +BUGS: + +restart sysread/write after a signal (or check i/o count) + +fix SEEK stuff + + diff --git a/experiment/DATA_taint_check b/experiment/DATA_taint_check new file mode 100644 index 0000000..f7b933a --- /dev/null +++ b/experiment/DATA_taint_check @@ -0,0 +1,5 @@ + +# DATA handle is always untainted but all other handles are tainted + +use B +svref_2object($foo)->IoFLAGS & 16 diff --git a/experiment/carp.pl b/experiment/carp.pl new file mode 100644 index 0000000..3e2dce5 --- /dev/null +++ b/experiment/carp.pl @@ -0,0 +1,10 @@ +#!/usr/local/bin/perl + + +use Carp ; + +$carp = shift ; + +( ( $carp eq 'carp' ) ? \&carp : \&croak )->( "can't open file\n ) ; + +print "ok\n" ; diff --git a/experiment/seek.pl b/experiment/seek.pl new file mode 100644 index 0000000..159d269 --- /dev/null +++ b/experiment/seek.pl @@ -0,0 +1,12 @@ +#!/usr/local/bin/perl + +use Fcntl qw( :seek ) ; +my $tell = tell( \*DATA ); +my $sysseek = sysseek( \*DATA, 0, SEEK_CUR ) ; + +print "TELL $tell SYSSEEK $sysseek\n" ; + +__DATA__ +foo +bar + diff --git a/experiment/split.pl b/experiment/split.pl new file mode 100644 index 0000000..3c4db00 --- /dev/null +++ b/experiment/split.pl @@ -0,0 +1,42 @@ +#!/usr/local/bin/perl + +use strict ; + +use Benchmark qw( timethese cmpthese ) ; + +my $dur = shift || -2 ; + +my $data = 'abc' x 30 . "\n" x 1000 ; + +my $sep = $/ ; + +# my $result = timethese( $dur, { +# split => 'my @lines = splitter()', +# regex => 'my @lines = regex()', +# damian => 'my @lines = damian()', +# } ) ; + +# cmpthese( $result ) ; + +$data = "abcdefgh\n\n\n" x 5 ; +$data = "abcdefgh\n" x 2 . 'z' ; + +$data = '' ; + +#$sep = '\n\n+' ; +$sep = '\n' ; + +my @paras ; + +@paras = regex() ; +print "REG\n", map "[$_]\n", @paras ; + +#@paras = damian() ; +#print "DAM\n", map "[$_]\n", @paras ; + +sub splitter { split( m|(?<=$sep)|, $data ) } +sub regex { $data =~ /(.*?$sep|.*)/sg } +sub damian { $data =~ /.*?(?:$sep|\Z)/gs } + + +exit ; diff --git a/experiment/sysread.pl b/experiment/sysread.pl new file mode 100644 index 0000000..dc40a49 --- /dev/null +++ b/experiment/sysread.pl @@ -0,0 +1,28 @@ +#!/usr/local/bin/perl + +print tell(\*DATA), "\n" ; +print sysseek(\*DATA, 0, 1), "\n" ; + +my $read_cnt = sysread( \*DATA, $buf, 1000 ) ; +print "CNT $read_cnt\n[$buf]\n" ; + +my $read_cnt = sysread( *DATA, $buf, 1000 ) ; +print "CNT $read_cnt\n[$buf]\n" ; + +open( FOO, "<&DATA" ) || die "reopen $!" ; + + +my $read_cnt = sysread( \*FOO, $buf, 1000 ) ; +print "CNT $read_cnt\n[$buf]\n" ; + +my $read_cnt = read( \*FOO, $buf, 1000 ) ; +print "CNT $read_cnt\n[$buf]\n" ; + +@lines = ; +print "lines [@lines]\n" ; + + +__END__ +line 1 +foo bar + diff --git a/extras/new_text b/extras/new_text new file mode 100644 index 0000000..169e9b4 --- /dev/null +++ b/extras/new_text @@ -0,0 +1,148 @@ +Somewhere along the line, I learned about a way to slurp files faster +than by setting $/ to undef. The method is very simple, you do a single +read call with the size of the file (which the -s operator provides). +This bypasses the I/O loop inside perl that checks for EOF and does all +sorts of processing. I then decided to experiment and found that +sysread is even faster as you would expect. sysread bypasses all of +Perl's stdio and reads the file from the kernel buffers directly into a +Perl scalar. This is why the slurp code in File::Slurp uses +sysopen/sysread/syswrite. All the rest of the code is just to support +the various options and data passing techniques. + + +Benchmarks can be enlightening, informative, frustrating and +deceiving. It would make no sense to create a new and more complex slurp +module unless it also gained signifigantly in speed. So I created a +benchmark script which compares various slurp methods with differing +file sizes and calling contexts. This script can be run from the main +directory of the tarball like this: + + perl -Ilib extras/slurp_bench.pl + +If you pass in an argument on the command line, it will be passed to +timethese() and it will control the duration. It defaults to -2 which +makes each benchmark run to at least 2 seconds of cpu time. + +The following numbers are from a run I did on my 300Mhz sparc. You will +most likely get much faster counts on your boxes but the relative speeds +shouldn't change by much. If you see major differences on your +benchmarks, please send me the results and your Perl and OS +versions. Also you can play with the benchmark script and add more slurp +variations or data files. + +The rest of this section will be discussing the results of the +benchmarks. You can refer to extras/slurp_bench.pl to see the code for +the individual benchmarks. If the benchmark name starts with cpan_, it +is either from Slurp.pm or File::Slurp.pm. Those starting with new_ are +from the new File::Slurp.pm. Those that start with file_contents_ are +from a client's code base. The rest are variations I created to +highlight certain aspects of the benchmarks. + +The short and long file data is made like this: + + my @lines = ( 'abc' x 30 . "\n") x 100 ; + my $text = join( '', @lines ) ; + + @lines = ( 'abc' x 40 . "\n") x 1000 ; + $text = join( '', @lines ) ; + +So the short file is 9,100 bytes and the long file is 121,000 +bytes. + +=head3 Scalar Slurp of Short File + + file_contents 651/s + file_contents_no_OO 828/s + cpan_read_file 1866/s + cpan_slurp 1934/s + read_file 2079/s + new 2270/s + new_buf_ref 2403/s + new_scalar_ref 2415/s + sysread_file 2572/s + +=head3 Scalar Slurp of Long File + + file_contents_no_OO 82.9/s + file_contents 85.4/s + cpan_read_file 250/s + cpan_slurp 257/s + read_file 323/s + new 468/s + sysread_file 489/s + new_scalar_ref 766/s + new_buf_ref 767/s + +The primary inference you get from looking at the mumbers above is that +when slurping a file into a scalar, the longer the file, the more time +you save by returning the result via a scalar reference. The time for +the extra buffer copy can add up. The new module came out on top overall +except for the very simple sysread_file entry which was added to +highlight the overhead of the more flexible new module which isn't that +much. The file_contents entries are always the worst since they do a +list slurp and then a join, which is a classic newbie and cargo culted +style which is extremely slow. Also the OO code in file_contents slows +it down even more (I added the file_contents_no_OO entry to show this). +The two CPAN modules are decent with small files but they are laggards +compared to the new module when the file gets much larger. + +=head3 List Slurp of Short File + + cpan_read_file 589/s + cpan_slurp_to_array 620/s + read_file 824/s + new_array_ref 824/s + sysread_file 828/s + new 829/s + new_in_anon_array 833/s + cpan_slurp_to_array_ref 836/s + +=head3 List Slurp of Long File + + cpan_read_file 62.4/s + cpan_slurp_to_array 62.7/s + read_file 92.9/s + sysread_file 94.8/s + new_array_ref 95.5/s + new 96.2/s + cpan_slurp_to_array_ref 96.3/s + new_in_anon_array 97.2/s + + +=head3 Scalar Spew of Short File + + cpan_write_file 1035/s + print_file 1055/s + syswrite_file 1135/s + new 1519/s + print_join_file 1766/s + new_ref 1900/s + syswrite_file2 2138/s + +=head3 Scalar Spew of Long File + + cpan_write_file 164/s 20 + print_file 211/s 26 + syswrite_file 236/s 25 + print_join_file 277/s 2 + new 295/s 2 + syswrite_file2 428/s 25 + new_ref 608/s 2 + + +=head3 List Spew of Short File + + cpan_write_file 794/s + syswrite_file 1000/s + print_file 1013/s + new 1399/s + print_join_file 1557/s + +=head3 List Spew of Long File + + cpan_write_file 112/s 12 + print_file 179/s 21 + syswrite_file 181/s 19 + print_join_file 205/s 2 + new 228/s 2 + diff --git a/extras/slurp2.pod b/extras/slurp2.pod new file mode 100644 index 0000000..264c174 --- /dev/null +++ b/extras/slurp2.pod @@ -0,0 +1,516 @@ +=head1 Perl Slurp Ease + +=head2 Introduction + + +One of the common Perl idioms is processing text files line by line + + while( ) { + do something with $_ + } + +This idiom has several variants but the key point is that it reads in +only one line from the file in each loop iteration. This has several +advantages including limiting memory use to one line, the ability to +handle any size file (including data piped in via STDIN), and it is +easily taught and understood to Perl newbies. In fact newbies are the +ones who do silly things like this: + + while( ) { + push @lines, $_ ; + } + + foreach ( @lines ) { + do something with $_ + } + +Line by line processing is fine but it isn't the only way to deal with +reading files. The other common style is reading the entire file into a +scalar or array and that is commonly known as slurping. Now slurping has +somewhat of a poor reputation and this article is an attempt at +rehabilitating it. Slurping files has advantages and limitations and is +not something you should just do when line by line processing is fine. +It is best when you need the entire file in memory for processing all at +once. Slurping with in memory processing can be faster and lead to +simpler code than line by line if done properly. + +The biggest issue to watch for with slurping is file size. Slurping very +large files or unknown amounts of data from STDIN can be disastrous to +your memory usage and cause swap disk thrashing. I advocate slurping +only disk files and only when you know their size is reasonable and you +have a real reason to process the file as a whole. Note that reasonable +size these days is larger than the bad old days of limited RAM. Slurping +in a megabyte size file is not an issue on most systems. But most of the +files I tend to slurp in are much smaller than that. Typical files that +work well with slurping are configuration files, (mini)language scripts, +some data (especially binary) files, and other files of known sizes +which need fast processing. + +Another major win for slurping over line by line is speed. Perl's IO +system (like many others) is slow. Calling <> for each line requires a +check for the end of line, checks for EOF, copying a line, munging the +internal handle structure, etc. Plenty of work for each line read +in. Whereas slurping, if done correctly, will usually involve only one +IO call and no extra data copying. The same is true for writing files to +disk and we will cover that as well (even though the term slurping is +traditionally a read operation, I use the term slurp for the concept of +doing IO with an entire file in one operation). + +Finally, when you have slurped the entire file into memory, you can do +operations on the data that are not possible or easily done with line by +line processing. These include global search/replace (without regard for +newlines), grabbing all matches with one call of m//g, complex parsing +(which in many cases must ignore newlines), processing *ML (where line +endings are just white space) and performing complex transformations +such as template expansion. + +=head2 Global Operations + +Here are some simple global operations that can be done quickly and +easily on an entire file that has been slurped in. They could also be +done with line by line processing but that would be slower and require +more code. + +A common problem is reading in a file with key/value pairs. There are +modules which do this but who needs them for simple formats? Just slurp +in the file and do a single parse to grab all the key/value pairs. + + my $text = read_file( $file ) ; + my %config = $test =~ /^(\w+)=(.+)$/mg ; + +That matches a key which starts a line (anywhere inside the string +because of the /m modifier), the '=' char and the text to the end of the +line (again /m makes that work). In fact the ending $ is not even needed +since . will not normally match a newline. Since the key and value are +grabbed and the m// is in list context with the /g modifier, it will +grab all key/value pairs and return them. The %config hash will be +assigned this list and now you have the file fully parsed into a hash. + +Various projects I have worked on needed some simple templating and I +wasn't in the mood to use a full module (please,no flames about your +favorite template module :-). So I rolled my own by slurping in the +template file, setting up a template hash and doing this one line: + + $text =~ s/<%(.+?)%>/$template{$1}/g ; + +That only works if the entire file was slurped in. With a little +extra work it can handle chunks of text to be expanded: + + $text =~ s/<%(\w+)_START%>(.+)<%\1_END%>/ template($1, $2)/sge ; + +Just supply a template sub to expand the text between the markers and +you have yourself a simple system with minimal code. Note that this will +work and grab over multiple lines due the the /s modifier. This is +something that is much trickier with line by line processing. + +Note that this is a very simple templating system and it can't directly +handle nested tags and other complex features. But even if you use one +of the myriad of template modules on the CPAN, you will gain by having +speedier ways to read/write files. + +Slurping in a file into an array also offers some useful advantages. + + +=head2 Traditional Slurping + +Perl has always supported slurping files with minimal code. Slurping of +a file to a list of lines is trivial, just call the <> operator in a +list context: + + my @lines = ; + +and slurping to a scalar isn't much more work. Just set the built in +variable $/ (the input record separator to the undefined value and read +in the file with <>: + + { + local( $/, *FH ) ; + open( FH, $file ) or die "sudden flaming death\n" + $text = + } + +Notice the use of local(). It sets $/ to undef for you and when the +scope exits it will revert $/ back to its previous value (most likely +"\n"). Here is a Perl idiom that allows the $text variable to be +declared and there is no need for a tightly nested block. The do block +will execute the in a scalar context and slurp in the file which is +assigned to $text. + + local( *FH ) ; + open( FH, $file ) or die "sudden flaming death\n" + my $text = do { local( $/ ) ; } ; + +Both of those slurps used localized filehandles to be compatible with +5.005. Here they are with 5.6.0 lexical autovivified handles: + + { + local( $/ ) ; + open( my $fh, $file ) or die "sudden flaming death\n" + $text = <$fh> + } + + open( my $fh, $file ) or die "sudden flaming death\n" + my $text = do { local( $/ ) ; <$fh> } ; + +And this is a variant of that idiom that removes the need for the open +call: + + my $text = do { local( @ARGV, $/ ) = $file ; <> } ; + +The filename in $file is assigned to a localized @ARGV and the null +filehandle is used which reads the data from the files in @ARGV. + +Instead of assigning to a scalar, all the above slurps can assign to an +array and it will get the file but split into lines (using $/ as the end +of line marker). + +There is one common variant of those slurps which is very slow and not +good code. You see it around and it is almost always cargo cult code: + + my $text = join( '', ) ; + +That needlessly splits the input file into lines (join provides a list +context to ) and then joins up those lines again. The original coder +of this idiom obviously never read perlvar and learned how to use $/ to +allow scalar slurping. + +=head2 Write Slurping + +While reading in entire files at one time is common, writing out entire +files is also done. We call it slurping when we read in files but there +is no commonly accepted term for the write operation. I asked some Perl +colleagues and got two interesting nominations. Peter Scott said to call +it burping (rhymes with slurping and the noise is the opposite +direction). Others suggested spewing which has a stronger visual image +:-) Tell me your favorite or suggest your own. I will use both in this +section so you can see how they work for you. + +Spewing a file is a much simpler operation than slurping. You don't have +context issues to worry about and there is no efficiency problem with +returning a buffer. Here is a simple burp sub: + + sub burp { + my( $file_name ) = shift ; + open( my $fh, ">$file_name" ) || + die "can't create $file_name $!" ; + print $fh @_ ; + } + +Note that it doesn't copy the input text but passes @_ directly to +print. We will look at faster variations of that later on. + +=head2 Slurp on the CPAN + +As you would expect there are modules in the CPAN that will slurp files +for you. The two I found are called Slurp.pm (by Rob Casey - ROBAU on +CPAN) and File::Slurp.pm (by David Muir Sharnoff - MUIR on CPAN). + +Here is the code from Slurp.pm: + + sub slurp { + local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ ); + return ; + } + + sub to_array { + my @array = slurp( @_ ); + return wantarray ? @array : \@array; + } + + sub to_scalar { + my $scalar = slurp( @_ ); + return $scalar; + } + +The sub slurp uses the magic undefined value of $/ and the magic file +handle ARGV to support slurping into a scalar or array. It also provides +two wrapper subs that allow the caller to control the context of the +slurp. And the to_array sub will return the list of slurped lines or a +anonymous array of them according to its caller's context by checking +wantarray. It has 'slurp' in @EXPORT and all three subs in @EXPORT_OK. +A final point is that Slurp.pm is poorly named and it shouldn't be in +the top level namespace. + +File::Slurp.pm has this code: + +sub read_file +{ + my ($file) = @_; + + local($/) = wantarray ? $/ : undef; + local(*F); + my $r; + my (@r); + + open(F, "<$file") || croak "open $file: $!"; + @r = ; + close(F) || croak "close $file: $!"; + + return $r[0] unless wantarray; + return @r; +} + +This module provides several subs including read_file (more on the +others later). read_file behaves simularly to Slurp::slurp in that it +will slurp a list of lines or a single scalar depending on the caller's +context. It also uses the magic undefined value of $/ for scalar +slurping but it uses an explicit open call rather than using a localized +@ARGV and the other module did. Also it doesn't provide a way to get an +anonymous array of the lines but that can easily be rectified by calling +it inside an anonymous array constuctor []. + +Both of these modules make it easier for Perl coders to slurp in +files. They both use the magic $/ to slurp in scalar mode and the +natural behavior of <> in list context to slurp as lines. But neither is +optmized for speed nor can they handle binmode to support binary or +unicode files. See below for more on slurp features and speedups. + +=head2 Slurping API Design + +The slurp modules on CPAN are have a very simple API and don't support +binmode. This section will cover various API design issues such as +efficient return by reference, binmode and calling variations. + +Let's start with the call variations. Slurped files can be returned in +four formats, as a single scalar, as a reference to a scalar, as a list +of lines and as an anonymous array of lines. But the caller can only +provide two contexts, scalar or list. So we have to either provide an +API with more than one sub as Slurp.pm did or just provide one sub which +only returns a scalar or a list (no anonymous array) as File::Slurp.pm +does. + +I have used my own read_file sub for years and it has the same API as +File::Slurp.pm, a single sub which returns a scalar or a list of lines +depending on context. But I recognize the interest of those that want an +anonymous array for line slurping. For one thing it is easier to pass +around to other subs and another it eliminates the extra copying of the +lines via return. So my module will support multiple subs with one that +returns the file based on context and the other returns only lines +(either as a list or as an anonymous array). So this API is in between +the two CPAN modules. There is no need for a specific slurp in as a +scalar sub as the general slurp will do that in scalar context. If you +wanted to slurp a scalar into an array, just select the desired array +element and that will provide scalar context to the read_file sub. + +The next area to cover is what to name these subs. I will go with +read_file and read_file_lines. They are descriptive, simple and don't +use the 'slurp' nickname (though that nick is in the module name). + +Another critical area when designing APIs is how to pass in +arguments. The read_file subs takes one required argument which is the +file name. To support binmode we need another optional argument. And a +third optional argument is needed to support returning a slurped scalar +by reference. My first thought was to design the API with 3 positional +arguments - file name, buffer reference and binmode. But if you want to +set the binmode and not pass in a buffer reference, you have to fill the +second argument with undef and that is ugly. So I decided to make the +filename argument positional and the other two are pass by name. +The sub will start off like this: + + sub read_file { + + my( $file_name, %args ) = @_ ; + + my $buf ; + my $buf_ref = $args{'buf'} || \$buf ; + +The binmode argument will be handled later (see code below). + +The other sub read_file_lines will only take an optional binmode (so you +can read files with binary delimiters). It doesn't need a buffer +reference argument since it can return an anonymous array if the called +in a scalar context. So this sub could use positional arguments but to +keep its API similar to the API of read_file, it will also use pass by +name for the optional arguments. This also means that new optional +arguments can be added later without breaking any legacy code. A bonus +with keeping the API the same for both subs will be seen how the two +subs are optimized to work together. + +Write slurping (or spewing or burping :-) needs to have its API designed +as well. The biggest issue is not only needing to support optional +arguments but a list of arguments to be written is needed. Perl 6 can +handle that with optional named arguments and a final slurp +argument. Since this is Perl 5 we have to do it using some +cleverness. The first argument is the file name and it will be +positional as with the read_file sub. But how can we pass in the +optional arguments and also a list of data? The solution lies in the +fact that the data list should never contain a reference. +Burping/spewing works only on plain data. So if the next argument is a +hash reference, we can assume it is the optional arguments and the rest +of the arguments is the data list. So the write_file sub will start off +like this: + + sub write_file { + + my $file_name = shift ; + + my $args = ( ref $_[0] eq 'HASH' ) ? shift : {} ; + +Whether or not optional arguments are passed in, we leave the data list +in @_ to minimize any more copying. You call write_file like this: + + write_file( 'foo', { binmode => ':raw' }, @data ) ; + write_file( 'junk', { append => 1 }, @more_junk ) ; + write_file( 'bar', @spew ) ; + +=head2 Fast Slurping + + +=head2 Benchmarks + + +=head2 Error Handling + +Slurp subs are subject to conditions such as not being able to open the +file or I/O errors. How these errors are handled and what the caller +will see are important aspects of the design of an API. The classic +error handling for slurping has been to call die or even better, +croak. But sometimes you want to either the slurp to either warn/carp +and allow your code to handle the error. Sure, this can be done by +wrapping the slurp in a eval block to catch a fatal error, but not +everyone wants all that extra code. So I have added another option to +all the subs which selects the error handling. If the 'err_mode' option +is 'croak' (which is also the default, the called sub will croak. If set +to 'carp' then carp will be called. Set to any other string (use 'quiet' +by convention) and no error handler call is made. Then the caller can +use the error status from the call. + +C doesn't use the return value for data so it can return a +false status value in-band to mark an error. C does use its +return value for data but we can still make it pass back the error +status. A successful read in any scalar mode will return either a +defined data string or a (scalar or array) reference. So a bare return +would work here. But if you slurp in lines by calling it in a list +context, a bare return will return an empty list which is the same value +it would from from an existing but empty file. So now, C will +do something I strongly advocate against, which is returning a call to +undef. In the scalar contexts this still returns a error and now in list +context, the returned first value will be undef and that is not legal +data for the first element. So the list context also gets a error status +it can detect: + + my @lines = read_file( $file_name, err_mode => 'quiet' ) ; + your_handle_error( "$file_name can't be read\n" ) unless + @lines && defined $lines[0] ; + + +=head2 File::FastSlurp + + sub read_file { + + my( $file_name, %args ) = @_ ; + + my $buf ; + my $buf_ref = $args{'buf_ref'} || \$buf ; + + my $mode = O_RDONLY ; + $mode |= O_BINARY if $args{'binmode'} ; + + local( *FH ) ; + sysopen( FH, $file_name, $mode ) or + carp "Can't open $file_name: $!" ; + + my $size_left = -s FH ; + + while( $size_left > 0 ) { + + my $read_cnt = sysread( FH, ${$buf_ref}, + $size_left, length ${$buf_ref} ) ; + + unless( $read_cnt ) { + + carp "read error in file $file_name: $!" ; + last ; + } + + $size_left -= $read_cnt ; + } + + # handle void context (return scalar by buffer reference) + + return unless defined wantarray ; + + # handle list context + + return split m|?<$/|g, ${$buf_ref} if wantarray ; + + # handle scalar context + + return ${$buf_ref} ; + } + + + sub read_file_lines { + + # handle list context + + return &read_file if wantarray ;; + + # otherwise handle scalar context + + return [ &read_file ] ; + } + + + sub write_file { + + my $file_name = shift ; + + my $args = ( ref $_[0] eq 'HASH' ) ? shift : {} ; + my $buf = join '', @_ ; + + + my $mode = O_WRONLY ; + $mode |= O_BINARY if $args->{'binmode'} ; + $mode |= O_APPEND if $args->{'append'} ; + + local( *FH ) ; + sysopen( FH, $file_name, $mode ) or + carp "Can't open $file_name: $!" ; + + my $size_left = length( $buf ) ; + my $offset = 0 ; + + while( $size_left > 0 ) { + + my $write_cnt = syswrite( FH, $buf, + $size_left, $offset ) ; + + unless( $write_cnt ) { + + carp "write error in file $file_name: $!" ; + last ; + } + + $size_left -= $write_cnt ; + $offset += $write_cnt ; + } + + return ; + } + +=head2 Slurping in Perl 6 + +As usual with Perl 6, much of the work in this article will be put to +pasture. Perl 6 will allow you to set a 'slurp' property on file handles +and when you read from such a handle, the file is slurped. List and +scalar context will still be supported so you can slurp into lines or a + ) { + do something with $_ + } + +This idiom has several variants, but the key point is that it reads in +only one line from the file in each loop iteration. This has several +advantages, including limiting memory use to one line, the ability to +handle any size file (including data piped in via STDIN), and it is +easily taught and understood to Perl newbies. In fact newbies are the +ones who do silly things like this: + + while( ) { + push @lines, $_ ; + } + + foreach ( @lines ) { + do something with $_ + } + +Line by line processing is fine, but it isn't the only way to deal with +reading files. The other common style is reading the entire file into a +scalar or array, and that is commonly known as slurping. Now, slurping has +somewhat of a poor reputation, and this article is an attempt at +rehabilitating it. Slurping files has advantages and limitations, and is +not something you should just do when line by line processing is fine. +It is best when you need the entire file in memory for processing all at +once. Slurping with in memory processing can be faster and lead to +simpler code than line by line if done properly. + +The biggest issue to watch for with slurping is file size. Slurping very +large files or unknown amounts of data from STDIN can be disastrous to +your memory usage and cause swap disk thrashing. You can slurp STDIN if +you know that you can handle the maximum size input without +detrimentally affecting your memory usage. So I advocate slurping only +disk files and only when you know their size is reasonable and you have +a real reason to process the file as a whole. Note that reasonable size +these days is larger than the bad old days of limited RAM. Slurping in a +megabyte is not an issue on most systems. But most of the +files I tend to slurp in are much smaller than that. Typical files that +work well with slurping are configuration files, (mini-)language scripts, +some data (especially binary) files, and other files of known sizes +which need fast processing. + +Another major win for slurping over line by line is speed. Perl's IO +system (like many others) is slow. Calling C<< <> >> for each line +requires a check for the end of line, checks for EOF, copying a line, +munging the internal handle structure, etc. Plenty of work for each line +read in. Whereas slurping, if done correctly, will usually involve only +one I/O call and no extra data copying. The same is true for writing +files to disk, and we will cover that as well (even though the term +slurping is traditionally a read operation, I use the term ``slurp'' for +the concept of doing I/O with an entire file in one operation). + +Finally, when you have slurped the entire file into memory, you can do +operations on the data that are not possible or easily done with line by +line processing. These include global search/replace (without regard for +newlines), grabbing all matches with one call of C, complex parsing +(which in many cases must ignore newlines), processing *ML (where line +endings are just white space) and performing complex transformations +such as template expansion. + +=head2 Global Operations + +Here are some simple global operations that can be done quickly and +easily on an entire file that has been slurped in. They could also be +done with line by line processing but that would be slower and require +more code. + +A common problem is reading in a file with key/value pairs. There are +modules which do this but who needs them for simple formats? Just slurp +in the file and do a single parse to grab all the key/value pairs. + + my $text = read_file( $file ) ; + my %config = $text =~ /^(\w+)=(.+)$/mg ; + +That matches a key which starts a line (anywhere inside the string +because of the C modifier), the '=' char and the text to the end of the +line (again, C makes that work). In fact the ending C<$> is not even needed +since C<.> will not normally match a newline. Since the key and value are +grabbed and the C is in list context with the C modifier, it will +grab all key/value pairs and return them. The C<%config>hash will be +assigned this list and now you have the file fully parsed into a hash. + +Various projects I have worked on needed some simple templating and I +wasn't in the mood to use a full module (please, no flames about your +favorite template module :-). So I rolled my own by slurping in the +template file, setting up a template hash and doing this one line: + + $text =~ s/<%(.+?)%>/$template{$1}/g ; + +That only works if the entire file was slurped in. With a little +extra work it can handle chunks of text to be expanded: + + $text =~ s/<%(\w+)_START%>(.+?)<%\1_END%>/ template($1, $2)/sge ; + +Just supply a C