Perl6-Slurp-0.051004/000755 000765 000765 00000000000 12267662041 013430 5ustar00damian000000 000000 Perl6-Slurp-0.051004/Changes000644 000765 000765 00000003332 12267662037 014731 0ustar00damian000000 000000 Revision history for Perl extension Perl6::Slurp. 0.01 Wed Nov 26 21:58:48 2003 - original version; created by h2xs 1.22 with options -A -P -X -f -n Perl6::Slurp 0.02 Tue Mar 9 03:00:44 2004 - Cleaned up some redundant vestigal code (thanks Steffen) - Updated internals to mirror interface changes in Perl6::Export 0.03 Thu Mar 11 04:46:22 2004 - Updated Makefile.PL to note Perl6::Export 0.07 dependency - Added correct behaviour when no source specified 0.005000 Thu Feb 9 07:03:26 2012 - Fixed handling of slurp() - Removed dependency of English locale in errors.t (thanks to all those who reported it) - Tweaked ipc.t to placate Windows (thanks John) - Disabled implicit open failure warnings (thanks Kevin) - Cleaned up code and commented - Improved performance significantly for chomped cases - Updated Makefile.PL and added Build.pl 0.050000 Thu Feb 9 15:30:53 2012 - No feature changes: update to fix version number regression 0.051000 Thu Jun 14 20:52:15 2012 - Tweaked error.t to placate Windows (thanks mascip) 0.051001 Fri Jul 27 07:58:08 2012 - Doc tweak (thanks John) 0.051003 Sat Feb 9 11:59:34 2013 - Documented limitations of C on certain platforms (e.g. no piped opens under Windows). - Allowed layer options to have parenthesized args (Thanks Kevin) - Handle File::Temp filehandles correctly (thanks Kevin) 0.051004 Wed Jan 22 17:24:31 2014 * De-documented spurious dependency on Perl6::Export (thanks, Andrew) * De-typo-ficated source (thanks, dsteinbrunner) * Made file-based tests independent, so they can run in parallel (thanks Kent!) Perl6-Slurp-0.051004/demo/000755 000765 000765 00000000000 12267662041 014354 5ustar00damian000000 000000 Perl6-Slurp-0.051004/lib/000755 000765 000765 00000000000 12267662041 014176 5ustar00damian000000 000000 Perl6-Slurp-0.051004/Makefile.PL000644 000765 000765 00000000641 11714552316 015402 0ustar00damian000000 000000 use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Perl6::Slurp', AUTHOR => 'Damian Conway ', VERSION_FROM => 'lib/Perl6/Slurp.pm', ABSTRACT_FROM => 'lib/Perl6/Slurp.pm', PL_FILES => {}, PREREQ_PM => {}, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Perl6-Slurp-*' }, ); Perl6-Slurp-0.051004/MANIFEST000644 000765 000765 00000000522 12267662041 014560 0ustar00damian000000 000000 Changes Makefile.PL MANIFEST README lib/Perl6/Slurp.pm demo/demo_list_context.pl demo/demo_squeeze.pl t/chomp.t t/errors.t t/filehandle.t t/filename.t t/ioderfile.t t/iofile.t t/ipc.t t/irs.t t/layers.t t/lexfilehandle.t t/string.t t/no_source.t t/filetemp.t META.yml Module meta-data (added by MakeMaker) Perl6-Slurp-0.051004/META.yml000644 000765 000765 00000001044 12267662041 014700 0ustar00damian000000 000000 --- #YAML:1.0 name: Perl6-Slurp version: 0.051004 abstract: Implements the Perl 6 'slurp' built-in author: - Damian Conway license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Perl6-Slurp-0.051004/README000644 000765 000765 00000001111 12267662037 014307 0ustar00damian000000 000000 Perl6::Slurp version 0.051004 ======================= Implements the Perl 6 'slurp' function (see Exegesis 7) =head1 WARNING The syntax and semantics of Perl 6 is still being finalized and consequently is at any time subject to change. That means the same caveat applies to this module. =head1 DEPENDENCIES Requires: Perl 5.8.0 =head1 AUTHOR Damian Conway (damian@conway.org) =head1 COPYRIGHT Copyright (c) 2003-2012, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. Perl6-Slurp-0.051004/t/000755 000765 000765 00000000000 12267662041 013673 5ustar00damian000000 000000 Perl6-Slurp-0.051004/t/chomp.t000755 000765 000765 00000010722 11714551263 015172 0ustar00damian000000 000000 use Test::More "no_plan"; BEGIN {use_ok(Perl6::Slurp)}; my $desc; sub TEST { $desc = $_[0] }; my $line1 = "line 1"; my $line2 = "line 2"; my $line3 = "line 3"; my $line4 = "line 4"; my $para1 = $line1."\n".$line2."\n\n"; my $para2 = $line3."\n".$line4."\n"; my $data = $para1.$para2; TEST "scalar slurp no chomp"; $str = slurp \$data; is $str, $data, $desc; TEST "list slurp no chomp"; @str = slurp \$data; is_deeply \@str, ["$line1\n", "$line2\n", "\n", "$line3\n", "$line4\n"], $desc; # Regular chomp TEST "scalar slurp with chomp"; $str = slurp \$data, {chomp=>1}; is $str, $line1.$line2.$line3.$line4, $desc; TEST "list slurp with chomp"; @str = slurp \$data, {chomp=>1}; is_deeply \@str, [$line1, $line2, "", $line3, $line4], $desc; TEST "scalar slurp with chomp and :irs(\"\\n\")"; $str = slurp \$data, {irs=>"\n", chomp=>1}; is $str, $line1.$line2.$line3.$line4, $desc; TEST "list slurp with chomp :irs(\"\\n\")"; @str = slurp \$data, {irs=>"\n", chomp=>1}; is_deeply \@str, [$line1, $line2, "", $line3, $line4], $desc; TEST "scalar slurp with chomp :irs(\"\\n\\n\")"; $str = slurp \$data, {chomp=>1, irs=>"\n\n"}; is $str, $line1."\n".$line2.$line3."\n".$line4."\n", $desc; TEST "list slurp with chomp :irs(\"\\n\\n\")"; @str = slurp \$data, {chomp=>1, irs=>"\n\n"}; is_deeply \@str, [$line1."\n".$line2, $line3."\n".$line4."\n"], $desc; TEST "scalar slurp with chomp :irs(undef)"; $str = slurp \$data, {chomp=>1, irs=>undef}; is $str, $data, $desc; TEST "list slurp with chomp :irs(undef)"; @str = slurp \$data, {chomp=>1, irs=>undef}; is_deeply \@str, [$data], $desc; TEST "scalar slurp with chomp :irs('ne')"; $str = slurp \$data, {chomp=>1, irs=>'ne'}; is $str, "li 1\nli 2\n\nli 3\nli 4\n", $desc; TEST "list slurp with chomp :irs('ne')"; @str = slurp \$data, {chomp=>1, irs=>'ne'}; is_deeply \@str, [split /ne/, $data], $desc; TEST "scalar slurp with chomp :irs(qr/\\n+|3/)"; $str = slurp \$data, {irs=>qr/\n+|3/, chomp=>1}; is $str, "line 1line 2line line 4", $desc; TEST "list slurp with chomp :irs(qr/\\n+|3/)"; @str = slurp \$data, {irs=>qr/\n+|3/, chomp=>1}; is_deeply \@str, ["line 1","line 2","line ","","line 4"], $desc; # Chomp with substitution TEST "scalar slurp with substitution chomp"; $str = slurp \$data, {chomp=>"foo"}; is $str, $line1."foo".$line2."foofoo".$line3."foo".$line4."foo", $desc; TEST "list slurp with substitution chomp"; @str = slurp \$data, {chomp=>"foo"}; is_deeply \@str, [$line1."foo", $line2."foo", "foo", $line3."foo", $line4."foo"], $desc; TEST "scalar slurp with substitution chomp of '1'"; $str = slurp \$data, {chomp=>"1"}; is $str, $line1."1".$line2."11".$line3."1".$line4."1", $desc; TEST "list slurp with substitution chomp of '1'"; @str = slurp \$data, {chomp=>"1"}; is_deeply \@str, [$line1."1", $line2."1", "1", $line3."1", $line4."1"], $desc; TEST "scalar slurp with substitution chomp and :irs(\"\\n\")"; $str = slurp \$data, {irs=>"\n", chomp=>"foo"}; is $str, $line1."foo".$line2."foofoo".$line3."foo".$line4."foo", $desc; TEST "list slurp with substitution chomp :irs(\"\\n\")"; @str = slurp \$data, {irs=>"\n", chomp=>"foo"}; is_deeply \@str, [$line1."foo", $line2."foo", "foo", $line3."foo", $line4."foo"], $desc; TEST "scalar slurp with substitution chomp :irs(\"\\n\\n\")"; $str = slurp \$data, {chomp=>"foo", irs=>"\n\n"}; is $str, $line1."\n".$line2."foo".$line3."\n".$line4."\n", $desc; TEST "list slurp with substitution chomp :irs(\"\\n\\n\")"; @str = slurp \$data, {chomp=>"foo", irs=>"\n\n"}; is_deeply \@str, [$line1."\n".$line2."foo", $line3."\n".$line4."\n"], $desc; TEST "scalar slurp with substitution chomp :irs(undef)"; $str = slurp \$data, {chomp=>"foo", irs=>undef}; is $str, $data, $desc; TEST "list slurp with substitution chomp :irs(undef)"; @str = slurp \$data, {chomp=>"foo", irs=>undef}; is_deeply \@str, [$data], $desc; TEST "scalar slurp with substitution chomp :irs('ne')"; $str = slurp \$data, {chomp=>"foo", irs=>'ne'}; is $str, "lifoo 1\nlifoo 2\n\nlifoo 3\nlifoo 4\n", $desc; TEST "list slurp with substitution chomp :irs('ne')"; @str = slurp \$data, {chomp=>"foo", irs=>'ne'}; is_deeply \@str, ["lifoo", " 1\nlifoo", " 2\n\nlifoo", " 3\nlifoo", " 4\n"], $desc; TEST "scalar slurp with substitution chomp :irs(qr/\\n+|3/)"; $str = slurp \$data, {irs=>qr/\n+|3/, chomp=>"foo"}; is $str, "line 1fooline 2fooline foofooline 4foo", $desc; TEST "list slurp with substitution chomp :irs(qr/\\n+|3/)"; @str = slurp \$data, {irs=>qr/\n+|3/, chomp=>"foo"}; is_deeply \@str, ["line 1foo","line 2foo","line foo","foo","line 4foo"], $desc; Perl6-Slurp-0.051004/t/errors.t000755 000765 000765 00000001411 11766337311 015376 0ustar00damian000000 000000 use Test::More "no_plan"; BEGIN {use_ok(Perl6::Slurp)}; my $desc; sub TEST { $desc = $_[0] }; TEST "can't slurp in void context"; eval{;slurp $0;1} ? ok 0, $desc : like $@, qr/void context/, $desc; TEST "shouldn't be able to slurp non-existent file"; eval{slurp "non-existent file"} ? ok 0, $desc : like $@, qr/^Can't open 'non-existent file'/, $desc; TEST "shouldn't be able to slurp failed pipe"; if ($^O ne 'MSWin32') { eval{slurp "-|", "non-existent_prog"} ? ok 0, $desc : like $@, qr/^Can't open '-|non-existent_prog'/, $desc; } TEST "shouldn't be able to read from unreadable filehandle"; open *FILE, ">-"; slurp(\*FILE) ? ok 0, $desc : ok 1, $desc; Perl6-Slurp-0.051004/t/filehandle.t000755 000765 000765 00000002057 12267660202 016157 0ustar00damian000000 000000 use Test::More "no_plan"; BEGIN {use_ok(Perl6::Slurp)}; my $FILENAME = 'filehandle.t.data'; my $desc; sub TEST { $desc = $_[0] }; open FH, '>'.$FILENAME or exit; print FH map "data $_\n", 1..20; close FH; open FH, $FILENAME or exit; my $pos = tell *FH; my $data = do { local $/; }; seek *FH, 0, 0; my @data = ; close FH; open FH, $FILENAME or exit; TEST "scalar slurp from filehandle "; $str = slurp \*FH; is $str, $data, $desc; open FH, $FILENAME or exit; TEST "list slurp from filehandle "; @str = slurp \*FH; is_deeply \@str, \@data, $desc; for my $mode (qw( < +< )) { open FH, $FILENAME or exit; TEST "scalar slurp from '$mode', filehandle "; $str = slurp $mode, \*FH; is $str, $data, $desc; TEST "scalar slurp from empty filehandle"; $str = slurp $mode, \*FH; is $str, "", $desc; open FH, $FILENAME or exit; TEST "list slurp from '$mode', filehandle "; @str = slurp $mode, \*FH; is_deeply \@str, \@data, $desc; TEST "list slurp from empty filehandle"; @str = slurp $mode, \*FH; is_deeply \@str, [], $desc; } unlink $FILENAME; Perl6-Slurp-0.051004/t/filename.t000755 000765 000765 00000002721 12267660717 015655 0ustar00damian000000 000000 use Test::More "no_plan"; BEGIN {use_ok(Perl6::Slurp)}; my $FILENAME = 'filename.t.data'; my $desc; sub TEST { $desc = $_[0] }; open FH, '>'.$FILENAME or exit; print FH map "data $_\n", 1..20; close FH; open FH, $FILENAME or exit; my $pos = tell *FH; my $data = do { local $/; }; seek *FH, 0, 0; my @data = ; close FH; TEST "scalar slurp from $FILENAME in main"; $str = slurp $FILENAME; is $str, $data, $desc; TEST "list slurp from $FILENAME in main"; @str = slurp $FILENAME; is_deeply \@str, \@data, $desc; for my $mode (qw( < +< )) { TEST "scalar slurp from '${mode}$FILENAME' in main"; $str = slurp "${mode}$FILENAME"; is $str, $data, $desc; TEST "scalar slurp from '$mode $FILENAME' in main"; $str = slurp "$mode $FILENAME"; is $str, $data, $desc; TEST "scalar slurp from '$mode', $FILENAME' in main"; $str = slurp $mode, $FILENAME; is $str, $data, $desc; TEST "list slurp from '${mode}$FILENAME' in main"; @str = slurp "${mode}$FILENAME"; is_deeply \@str, \@data, $desc; TEST "list slurp from '$mode $FILENAME' in main"; @str = slurp "$mode $FILENAME"; is_deeply \@str, \@data, $desc; TEST "list slurp from '$mode', $FILENAME in main"; @str = slurp $mode, $FILENAME; is_deeply \@str, \@data, $desc; } TEST "scalar slurp from \$_ in main"; for ($FILENAME) { $str = slurp; is $str, $data, $desc; } local $/; @ARGV = ($FILENAME, $FILENAME); TEST "scalar slurp from ARGV in main"; $str = slurp; is $str, $data.$data, $desc; unlink $FILENAME; Perl6-Slurp-0.051004/t/filetemp.t000644 000765 000765 00000000311 12105317114 015645 0ustar00damian000000 000000 use Test::More; plan tests => 1; $SIG{__WARN__} = sub { die @_ }; use Perl6::Slurp 'slurp'; use File::Temp; my $fh = File::Temp->new; my $str = slurp $fh; is $str, q{} => 'Works with File::Temp'; Perl6-Slurp-0.051004/t/ioderfile.t000755 000765 000765 00000002375 12267661126 016037 0ustar00damian000000 000000 use Test::More "no_plan"; BEGIN {use_ok(Perl6::Slurp)}; my $FILENAME = 'ioderfile.t.data'; package IO::DerFile; use base 'IO::File'; package main; my $desc; sub TEST { $desc = $_[0] }; my $FH; $FH = IO::DerFile->new('>'.$FILENAME) or exit; print $FH map "data $_\n", 1..20; close $FH; $FH = IO::DerFile->new($FILENAME) or exit; my $pos = $FH->tell; my $data = do { local $/; <$FH> }; $FH->seek(0, 0); my @data = <$FH>; $FH->close; $FH = IO::DerFile->new($FILENAME) or exit; TEST "scalar slurp from IO::DerFile object "; $str = slurp $FH; is $str, $data, $desc; $FH = IO::DerFile->new($FILENAME) or exit; TEST "list slurp from IO::DerFile object "; @str = slurp $FH; is_deeply \@str, \@data, $desc; for my $mode (qw( < +< )) { $FH = IO::DerFile->new($FILENAME) or exit; TEST "scalar slurp from '$mode', IO::DerFile object "; $str = slurp $mode, $FH; is $str, $data, $desc; TEST "scalar slurp from empty IO::DerFile object"; $str = slurp $mode, $FH; is $str, "", $desc; $FH = IO::DerFile->new($FILENAME) or exit; TEST "list slurp from '$mode', IO::DerFile object "; @str = slurp $mode, $FH; is_deeply \@str, \@data, $desc; TEST "list slurp from empty IO::DerFile object"; @str = slurp $mode, $FH; is_deeply \@str, [], $desc; } unlink $FILENAME; Perl6-Slurp-0.051004/t/iofile.t000755 000765 000765 00000002252 12267661261 015336 0ustar00damian000000 000000 use Test::More "no_plan"; use IO::File; BEGIN {use_ok(Perl6::Slurp)}; my $FILENAME = 'iofile.t.data'; my $desc; sub TEST { $desc = $_[0] }; my $FH; $FH = IO::File->new('>'.$FILENAME) or exit; print $FH map "data $_\n", 1..20; close $FH; $FH = IO::File->new($FILENAME) or exit; my $pos = $FH->tell; my $data = do { local $/; <$FH> }; $FH->seek(0, 0); my @data = <$FH>; $FH->close; $FH = IO::File->new($FILENAME) or exit; TEST "scalar slurp from IO::File object "; $str = slurp $FH; is $str, $data, $desc; $FH = IO::File->new($FILENAME) or exit; TEST "list slurp from IO::File object "; @str = slurp $FH; is_deeply \@str, \@data, $desc; for my $mode (qw( < +< )) { $FH = IO::File->new($FILENAME) or exit; TEST "scalar slurp from '$mode', IO::File object "; $str = slurp $mode, $FH; is $str, $data, $desc; TEST "scalar slurp from empty IO::File object"; $str = slurp $mode, $FH; is $str, "", $desc; $FH = IO::File->new($FILENAME) or exit; TEST "list slurp from '$mode', IO::File object "; @str = slurp $mode, $FH; is_deeply \@str, \@data, $desc; TEST "list slurp from empty IO::File object"; @str = slurp $mode, $FH; is_deeply \@str, [], $desc; } unlink $FILENAME; Perl6-Slurp-0.051004/t/ipc.t000755 000765 000765 00000001250 11766337271 014643 0ustar00damian000000 000000 use Test::More "no_plan"; BEGIN {use_ok(Perl6::Slurp)}; my $desc; sub TEST { $desc = $_[0] }; my $data = "input data\n"; { my $TEST; { local *STDERR; open STDERR, '>', \my $err; open $TEST, "echo $data|" or exit; } $test = <$TEST>; exit unless $test eq $data; ok 1, "test reads from pipe"; } TEST "scalar slurp from 'system command|'"; $str = slurp 'echo input data|'; is $str, $data, $desc; TEST "scalar slurp from '-|', 'system command'"; $str = slurp '-|', 'echo input data'; is $str, $data, $desc; if ($^O ne 'MSWin32') { TEST "scalar slurp from '-|', 'system', 'command', 'etc'"; $str = slurp '-|', qw(echo input data); is $str, $data, $desc; } Perl6-Slurp-0.051004/t/irs.t000755 000765 000765 00000003020 11714546531 014654 0ustar00damian000000 000000 use Test::More "no_plan"; BEGIN {use_ok(Perl6::Slurp)}; my $desc; sub TEST { $desc = $_[0] }; my $line1 = "line 1\n"; my $line2 = "line 2\n"; my $line3 = "line 3\n"; my $line4 = "line 4\n"; my $para1 = $line1.$line2."\n"; my $para2 = $line3.$line4; my $data = $para1.$para2; TEST "scalar slurp no irs"; $str = slurp \$data; is $str, $data, $desc; TEST "list slurp no irs"; @str = slurp \$data; is_deeply \@str, [$line1, $line2, "\n", $line3, $line4], $desc; TEST "scalar slurp :irs(\"\\n\")"; $str = slurp \$data, {irs=>"\n"}; is $str, $data, $desc; TEST "list slurp :irs(\"\\n\")"; @str = slurp \$data, {irs=>"\n"}; is_deeply \@str, [$line1, $line2, "\n", $line3, $line4], $desc; TEST "scalar slurp :irs(\"\\n\\n\")"; $str = slurp \$data, {irs=>"\n\n"}; is $str, $data, $desc; TEST "list slurp :irs(\"\\n\\n\")"; @str = slurp \$data, {irs=>"\n\n"}; is_deeply \@str, [$para1, $para2], $desc; TEST "scalar slurp :irs(undef)"; $str = slurp \$data, {irs=>undef}; is $str, $data, $desc; TEST "list slurp :irs(undef)"; @str = slurp \$data, {irs=>undef}; is_deeply \@str, [$data], $desc; TEST "scalar slurp :irs('ne')"; $str = slurp \$data, {irs=>'ne'}; is $str, $data, $desc; TEST "list slurp :irs('ne')"; @str = slurp \$data, {irs=>'ne'}; is_deeply \@str, [split /(?<=ne)/, $data], $desc; TEST "scalar slurp :irs(qr/\\n+|3/)"; $str = slurp \$data, {irs=>qr/\n+|3/}; is $str, $data, $desc; TEST "list slurp :irs(qr/\\n+|3/)"; @str = slurp \$data, {irs=>qr/\n+|3/}; is_deeply \@str, ["line 1\n","line 2\n\n","line 3","\n","line 4\n"], $desc; Perl6-Slurp-0.051004/t/layers.t000755 000765 000765 00000002631 12267661410 015363 0ustar00damian000000 000000 use Test::More "no_plan"; use utf8; BEGIN {use_ok(Perl6::Slurp)}; my $FILENAME = 'layers.t.data'; my $desc; sub TEST { $desc = $_[0] }; open FH, '>:utf8', $FILENAME or exit; print FH map chr, 0..0x1FF; close FH; undef $/; my @layers = ( qw(:raw :bytes :unix :stdio :perlio :crlf :utf8), ":raw :utf8", ":raw:utf8", ); for my $layer (@layers) { open FH, "<$layer", $FILENAME or exit; $data{$layer} = ; $len{$layer} = length $data{$layer}; close FH; } for my $layer (@layers) { TEST "scalar slurp from '<$layer', $FILENAME"; $str = slurp "<$layer", $FILENAME; is $data{$layer}, $str, $desc; ok length($str) == $len{$layer}, "length of $desc"; TEST "scalar slurp from '< $layer', $FILENAME"; $str = slurp "< $layer", $FILENAME; is $data{$layer}, $str, $desc; ok length($str) == $len{$layer}, "length of $desc"; } %opts = ( ':raw' => [{raw=>1}], ':utf8' => [{utf8=>1}], ':raw :utf8' => [{raw=>1}, {utf8=>1}], ':raw:utf8' => [[raw=>1, utf8=>1]], ); for my $layer (keys %opts) { local $" = ", "; TEST "scalar option slurp from $FILENAME, $layer"; $str = slurp $FILENAME, @{$opts{$layer}}; is $data{$layer}, $str, $desc; ok length($str) == $len{$layer}, "length of $desc"; TEST "scalar option slurp from $layer, $FILENAME"; $str = slurp @{$opts{$layer}}, $FILENAME; is $data{$layer}, $str, $desc; ok length($str) == $len{$layer}, "length of $desc"; } unlink $FILENAME; Perl6-Slurp-0.051004/t/lexfilehandle.t000755 000765 000765 00000002262 12267661510 016671 0ustar00damian000000 000000 use Test::More "no_plan"; BEGIN {use_ok(Perl6::Slurp)}; my $FILENAME = 'lexfilehandle.t.data'; my $desc; sub TEST { $desc = $_[0] }; my $FH; undef $FH; open $FH, '>'.$FILENAME or exit; print $FH map "data $_\n", 1..20; close $FH; undef $FH; open $FH, $FILENAME or exit; my $pos = tell $FH; my $data = do { local $/; <$FH> }; seek $FH, 0, 0; my @data = <$FH>; close $FH; undef $FH; open $FH, $FILENAME or exit; TEST "scalar slurp from lexical filehandle "; $str = slurp $FH; is $str, $data, $desc; undef $FH; open $FH, $FILENAME or exit; TEST "list slurp from lexical filehandle "; @str = slurp $FH; is_deeply \@str, \@data, $desc; for my $mode (qw( < +< )) { undef $FH; open $FH, $FILENAME or exit; TEST "scalar slurp from '$mode', lexical filehandle "; $str = slurp $mode, $FH; is $str, $data, $desc; TEST "scalar slurp from empty lexical filehandle"; $str = slurp $mode, $FH; is $str, "", $desc; undef $FH; open $FH, $FILENAME or exit; TEST "list slurp from '$mode', lexical filehandle "; @str = slurp $mode, $FH; is_deeply \@str, \@data, $desc; TEST "list slurp from empty lexical filehandle"; @str = slurp $mode, $FH; is_deeply \@str, [], $desc; } unlink $FILENAME; Perl6-Slurp-0.051004/t/no_source.t000644 000765 000765 00000001574 12267661606 016071 0ustar00damian000000 000000 use Test::More "no_plan"; use utf8; BEGIN {use_ok(Perl6::Slurp)}; my $FILENAME = 'no_source.t.data'; my $desc; sub TEST { $desc = $_[0] }; open FH, '>:utf8', $FILENAME or exit; print FH map chr, 0..0x1FF; close FH; undef $/; my @layers = ( qw(:raw :bytes :unix :stdio :perlio :crlf :utf8), ":raw :utf8", ":raw:utf8", ); for my $layer (@layers) { open FH, "<$layer", $FILENAME or exit; $data{$layer} = ; $len{$layer} = length $data{$layer}; close FH; } $_ = $FILENAME; %opts = ( ':raw' => [{raw=>1}], ':utf8' => [{utf8=>1}], ':raw :utf8' => [{raw=>1}, {utf8=>1}], ':raw:utf8' => [[raw=>1, utf8=>1]], ); for my $layer (keys %opts) { local $" = ", "; TEST "scalar option slurp from implied \$_, $layer"; $str = slurp @{$opts{$layer}}; is $data{$layer}, $str, $desc; ok length($str) == $len{$layer}, "length of $desc"; } unlink $FILENAME; Perl6-Slurp-0.051004/t/string.t000755 000765 000765 00000001046 11714546531 015373 0ustar00damian000000 000000 use Test::More "no_plan"; BEGIN {use_ok(Perl6::Slurp)}; my $desc; sub TEST { $desc = $_[0] }; @data = map "data $_\n", 1..20; $data = join "", @data; TEST "scalar slurp from string"; $str = slurp \$data; is $str, $data, $desc; TEST "list slurp from string "; @str = slurp \$data; is_deeply \@str, \@data, $desc; for my $mode (qw( < +< )) { TEST "scalar slurp from '$mode', string "; $str = slurp $mode, \$data; is $str, $data, $desc; TEST "list slurp from '$mode', string "; @str = slurp $mode, \$data; is_deeply \@str, \@data, $desc; } Perl6-Slurp-0.051004/lib/Perl6/000755 000765 000765 00000000000 12267662041 015166 5ustar00damian000000 000000 Perl6-Slurp-0.051004/lib/Perl6/Slurp.pm000644 000765 000765 00000033006 12267662037 016640 0ustar00damian000000 000000 package Perl6::Slurp; use warnings; use strict; use 5.008; use Carp; use Scalar::Util 'refaddr'; our $VERSION = '0.051004'; # Exports only the slurp() sub... sub import { no strict 'refs'; *{caller().'::slurp'} = \&slurp; } # Recognize mode arguments... my $mode_pat = qr{ ^ \s* ( (?: < | \+< | \+>>? ) &? ) \s* }x; # Recognize a mode followed by optional layer arguments... my $mode_plus_layers = qr{ (?: $mode_pat | ^ \s* -\| \s* ) ( (?: :[^\W\d]\w* (?: \( .*? \) ?)? \s* )* ) \s* \z }x; # Is this a pure number??? sub is_pure_num { return (~$_[0] & $_[0]) eq 0; # ~ acts differently for numbers and strings } # The magic subroutine that does everything... sub slurp { # Are we in a useful context??? my $list_context = wantarray; croak "Useless use of &slurp in a void context" unless defined $list_context; # Missing args default to $_, so we need to catch that early... my $default = $_; # Remember any I/O layers and other options specified... my @layers_or_options; # Process the argument list... for (my $i=0; $i<@_; $i++) { # Ignore non-reference args... my $type = ref $_[$i] or next; # Hashes indicate extra layers; remove from @_, add them in sequence... if ($type eq 'HASH') { push @layers_or_options, splice @_, $i--, 1 } # Arrays also indicate extra layers; remove from @_, convert to hash # form, and add them in sequence... elsif ($type eq 'ARRAY') { # Splice out the array and unpack it... my @array = @{splice @_, $i--, 1}; # Verify and convert each layer specified to a one-key hash... while (@array) { my ($layer, $value) = splice @array, 0, 2; croak "Incomplete layer specification for :$layer", "\n(did you mean: $layer=>1)\n " unless $value; push @layers_or_options, { $layer=>$value }; } } } # Any remaining args are the read mode, source file, and whatever... my ($mode, $source, @args) = @_; # If no arguments, use defaults... if (!defined $mode) { $mode = defined $default ? $default : @ARGV ? \*ARGV : "<" } # If mode was a reference, it must really have been the source... if (ref $mode) { $source = $mode; $mode = "<"; } # If mode isn't a valid mode, it must actually have been the source... elsif ($mode !~ /$mode_plus_layers/x) { $source = $mode; $mode = $source =~ s/$mode_pat//x ? "$1" : $source =~ s/ \| \s* $//x ? "-|" : "<" ; } # Sources can be references, but only certain kinds of references... my $ref = ref $source; if ($ref) { croak "Can't use $ref as a data source" unless $ref eq 'SCALAR' || $ref eq 'GLOB' || eval { $source->isa('IO::Handle') }; } # slurp() always uses \n as its input record separator (a la Perl 6) local $/ = "\n"; # This track the various options slurp() allows... my ($chomp, $chomp_to, $layers) = (0, "", ""); # Can this slurp be done in an optimized way (assume so initially)??? my $optimized = 1; # Decode the layers and options... for (@layers_or_options) { # Input record separator... if (exists $_->{irs}) { $/ = $_->{irs}; delete $_->{irs}; $optimized &&= !ref($/); # ...can't be optimized if irs is a regex } # Autochomp... if (exists $_->{chomp}) { $chomp = 1; # If the chomp value is a string, that becomes to replacement... if (defined $_->{chomp} && !is_pure_num($_->{chomp})) { $chomp_to = $_->{chomp} } delete $_->{chomp}; $optimized = 0; # ...chomped slurps can't be optimized } # Any other entries are layers... $layers .= join " ", map ":$_", keys %$_; } # Add any layers found to the mode specification... $mode .= " $layers"; # Open the source as a filehandle... my $FH; # Source is a typeglob... if ($ref && $ref ne 'SCALAR') { $FH = $source; } # No source, specified: use *ARGV... elsif (!$source) { no warnings 'io'; open $FH, '<-' or croak "Can't open stdin: $!"; } # Source specified: open it... else { no warnings 'io'; open $FH, $mode, $source, @args or croak "Can't open '$source': $!"; } # Standardize chomp-converter sub... my $chomp_into = ref $chomp_to eq 'CODE' ? $chomp_to : sub{ $chomp_to }; # Optimized slurp if possible in list context... if ($list_context && $optimized) { return <$FH>; } # Acquire data (working around bug between $/ and in magic ARGV)... my $data = refaddr($FH) == \*ARGV ? join("",<>) : do { local $/; <$FH> }; # Prepare input record separator regex... my $irs = ref($/) ? $/ : defined($/) ? qr{\Q$/\E} : qr{(?!)}; # List context may require input record separator processing... if ($list_context) { # No data --> nothing to return... return () unless defined $data; # Split acquired data into lines according to IRS... my @components = split /($irs)/, $data; my @lines; while (@components) { # Extract the next line and separator... my ($line, $sep) = splice @components, 0, 2; # Add the line... push @lines, $line; # Chomp as requested... if (defined $sep && length $sep) { $lines[-1] .= $chomp ? $chomp_into->($sep) : $sep; } } return @lines; } # Scalar context... else { # No data --> nothing to return... return q{} unless defined $data; # Otherwise, do any requested chomp-conversion... if ($chomp) { $data =~ s{($irs)}{$chomp_into->($1)}ge; } return $data; } } 1; __END__ =head1 NAME Perl6::Slurp - Implements the Perl 6 'slurp' built-in =head1 SYNOPSIS use Perl6::Slurp; # Slurp a file by name... $file_contents = slurp 'filename'; $file_contents = slurp 'new('filename'); # Slurp a string... $str_contents = slurp \$string; $str_contents = slurp '<', \$string; # Slurp a pipe (not on Windows, alas)... $str_contents = slurp 'tail -20 $filename |'; $str_contents = slurp '-|', 'tail', -20, $filename; # Slurp with no source slurps from whatever $_ indicates... for (@files) { $contents .= slurp; } # ...or from the entire ARGV list, if $_ is undefined... $_ = undef; $ARGV_contents = slurp; # Specify I/O layers as part of mode... $file_contents = slurp '<:raw', $file; $file_contents = slurp '<:utf8', $file; $file_contents = slurp '<:raw :utf8', $file; # Specify I/O layers as separate options... $file_contents = slurp $file, {raw=>1}; $file_contents = slurp $file, {utf8=>1}; $file_contents = slurp $file, {raw=>1}, {utf8=>1}; $file_contents = slurp $file, [raw=>1, utf8=>1]; # Specify input record separator... $file_contents = slurp $file, {irs=>"\n\n"}; $file_contents = slurp '<', $file, {irs=>"\n\n"}; $file_contents = slurp {irs=>"\n\n"}, $file; # Input record separator can be regex... $file_contents = slurp $file, {irs=>qr/\n+/}; $file_contents = slurp '<', $file, {irs=>qr/\n+|\t{2,}}; # Specify autochomping... $file_contents = slurp $file, {chomp=>1}; $file_contents = slurp {chomp=>1}, $file; $file_contents = slurp $file, {chomp=>1, irs=>"\n\n"}; $file_contents = slurp $file, {chomp=>1, irs=>qr/\n+/}; # Specify autochomping that replaces irs # with another string... $file_contents = slurp $file, {irs=>"\n\n", chomp=>"\n"}; $file_contents = slurp $file, {chomp=>"\n\n"}, {irs=>qr/\n+/}; # Specify autochomping that replaces # irs with a dynamically computed string... my $n = 1; $file_contents = slurp $file, {chomp=>sub{ "\n#line ".$n++."\n"}; # Slurp in a list context... @lines = slurp 'filename'; @lines = slurp $filehandle; @lines = slurp \$string; @lines = slurp '<:utf8', 'filename', {irs=>"\x{2020}", chomp=>"\n"}; =head1 DESCRIPTION C takes: =over =item * a filename, =item * a filehandle, =item * a typeglob reference, =item * an IO::File object, or =item * a scalar reference, =back converts it to an input stream (using C if necessary), and reads in the entire stream. If C fails to set up or read the stream, it throws an exception. If no data source is specified C uses the value of C<$_> as the source. If C<$_> is undefined, C uses the C<@ARGV> list, and magically slurps the contents of I the sources listed in C<@ARGV>. Note that the same magic is also applied if you explicitly slurp <*ARGV>, so the following three input operations: $contents = join "", ; $contents = slurp \*ARGV; $/ = undef; $contents = slurp; are identical in effect. In a scalar context C returns the stream contents as a single string. If the stream is at EOF, it returns an empty string. In a list context, it splits the contents after the appropriate input record separator and returns the resulting list of strings. You can set the input record separator (S<< C<< { irs => $your_irs_here} >> >>) for the input operation. The separator can be specified as a string or a regex. Note that an explicit input record separator has no input-terminating effect in a scalar context; C always reads in the entire input stream, whatever the C<'irs'> value. In a list context, changing the separator can change how the input is broken up within the list that is returned. If an input record separator is not explicitly specified, C defaults to C<"\n"> (I to the current value of C<$/> E since Perl 6 doesn't I a C<$/>); You can also tell C to automagically C the input as it is read in, by specifying: (S<< C<< { chomp => 1 } >> >>) Better still, you can tell C to automagically C the input and I what it chomps with another string, by specifying: (S<< C<< { chomp => "another string" } >> >>) You can also tell C to compute the replacement string on-the-fly by specifying a subroutine as the C value: (S<< C<< { chomp => sub{...} } >> >>). This subroutine is passed the string being chomped off, so for example you could squeeze single newlines to a single space and multiple consecutive newlines to a two newlines with: sub squeeze { my ($removed) = @_; if ($removed =~ tr/\n/\n/ == 1) { return " " } else { return "\n\n"; } } print slurp(\*DATA, {irs=>qr/[ \t]*\n+/, chomp=>\&squeeze}), "\n"; Which would transform: This is the first paragraph This is the second paragraph This, the third This one is the very last to: This is the first paragraph This is the second paragraph This, the third This one is the very last Autochomping works in both scalar and list contexts. In scalar contexts every instance of the input record separator will be removed (or replaced) within the returned string. In list context, each list item returned with its terminating separator removed (or replaced). You can specify I/O layers, either using the Perl 5 notation: slurp "<:layer1 :layer2 :etc", $filename; or as an array of options: slurp $filename, [layer1=>1, layer2=>1, etc=>1]; slurp [layer1=>1, layer2=>1, etc=>1], $filename; or as individual options (each of which must be in a separate hash): slurp $filename, {layer1=>1}, {layer2=>1}, {etc=>1}; slurp {layer1=>1}, {layer2=>1}, {etc=>1}, $filename; (...which, of course, would look much cooler in Perl 6: # Perl 6 only :-( slurp $filename, :layer1 :layer2 :etc; slurp :layer1 :layer2 :etc, $filename; ) A common mistake is to put all the options together in one hash: slurp $filename, {layer1=>1, layer2=>1, etc=>1}; This is almost always a disaster, since the order of I/O layers is usually critical, and placing them all in one hash effectively randomizes that order. Use an array instead: slurp $filename, [layer1=>1, layer2=>1, etc=>1]; =head1 WARNINGS The syntax and semantics of Perl 6 is still being finalized and consequently is at any time subject to change. That means the same caveat applies to this module. When called with a filename or piped shell command, C uses Perl's built- in C to access the file. This means that it is subject to the same platform-specific limitations as C. For example, slurping from piped shell commands may not work under Windows. =head1 DEPENDENCIES Requires: Perl 5.8.0 =head1 AUTHOR Damian Conway (damian@conway.org) =head1 COPYRIGHT Copyright (c) 2003-2012, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. Perl6-Slurp-0.051004/demo/demo_list_context.pl000644 000765 000765 00000000176 11714664031 020435 0ustar00damian000000 000000 use strict; use Perl6::Slurp; for (slurp '/usr/share/dict/words') { next unless /([aeiou])\1.*([aeiou])\2/; print; } Perl6-Slurp-0.051004/demo/demo_squeeze.pl000644 000765 000765 00000000534 11714546614 017403 0ustar00damian000000 000000 use Perl6::Slurp; sub squeeze { my ($removed) = @_; if ($removed =~ tr/\n/\n/ == 1) { return " " } else { return "\n\n"; } } print slurp(\*DATA, {irs=>qr/[ \t]*\n+/, chomp=>\&squeeze}), "\n"; __END__ This is the first paragraph This is the second paragraph This, the third This one is the very last