The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
Changes 011
META.json 22
META.yml 22
Makefile.PL 03
lib/Data/Munge.pm 60109
t/01-compile.t 219
6 files changed (This is a version diff) 66146
@@ -1,5 +1,16 @@
 Revision history for Data-Munge
 
+0.092   2014-11-25
+        * Work around some parser bug in perl 5.6.
+
+0.091   2014-11-19
+        * Work around regex bug (#115242) in perls < 5.18 that causes spurious
+          test failures.
+
+0.09    2014-11-18
+        * Add slurp.
+        * Don't leave $VERSION and @EXPORT in scope for eval_string.
+
 0.08    2014-09-15
         * Make trim(undef) return undef without warnings.
 
@@ -4,7 +4,7 @@
       "Lukas Mai <l.mai@web.de>"
    ],
    "dynamic_config" : 1,
-   "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640",
+   "generated_by" : "ExtUtils::MakeMaker version 7.02, CPAN::Meta::Converter version 2.143240",
    "license" : [
       "perl_5"
    ],
@@ -53,5 +53,5 @@
          "web" : "https://github.com/mauke/Data-Munge"
       }
    },
-   "version" : "0.08"
+   "version" : "0.092"
 }
@@ -10,7 +10,7 @@ configure_requires:
   strict: '0'
   warnings: '0'
 dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640'
+generated_by: 'ExtUtils::MakeMaker version 7.02, CPAN::Meta::Converter version 2.143240'
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -27,4 +27,4 @@ requires:
   warnings: '0'
 resources:
   repository: git://github.com/mauke/Data-Munge.git
-version: '0.08'
+version: '0.092'
@@ -34,6 +34,9 @@ my %opt = (
         'warnings' => 0,
     },
 
+    depend => {
+        Makefile => '$(VERSION_FROM)',
+    },
     dist  => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
     clean => { FILES    => 'Data-Munge-*' },
 
@@ -1,28 +1,24 @@
 package Data::Munge;
 
-use warnings;
 use strict;
+use warnings;
 use base qw(Exporter);
 
-our $VERSION = '0.08';
-our @EXPORT = qw[
-    list2re
+sub _eval { eval $_[0] }  # empty lexical scope
+
+our $VERSION = '0.092';
+our @EXPORT = qw(
     byval
-    mapval
-    submatches
-    replace
+    elem
     eval_string
+    list2re
+    mapval
     rec
+    replace
+    slurp
+    submatches
     trim
-    elem
-];
-
-sub list2re {
-    @_ or return qr/(?!)/;
-    my $re = join '|', map quotemeta, sort {length $b <=> length $a || $a cmp $b } @_;
-    $re eq '' and $re = '(?#)';
-    qr/$re/
-}
+);
 
 sub byval (&$) {
     my ($f, $x) = @_;
@@ -31,46 +27,6 @@ sub byval (&$) {
     $x
 }
 
-sub mapval (&@) {
-    my $f = shift;
-    my @xs = @_;
-    map { $f->($_); $_ } @xs
-}
-
-sub submatches {
-    no strict 'refs';
-    map $$_, 1 .. $#+
-}
-
-sub replace {
-    my ($str, $re, $x, $g) = @_;
-    my $f = ref $x ? $x : sub {
-        my $r = $x;
-        $r =~ s{\$([\$&`'0-9]|\{([0-9]+)\})}{
-            $+ eq '$' ? '$' :
-            $+ eq '&' ? $_[0] :
-            $+ eq '`' ? substr($_[-1], 0, $_[-2]) :
-            $+ eq "'" ? substr($_[-1], $_[-2] + length $_[0]) :
-            $_[$+]
-        }eg;
-        $r
-    };
-    if ($g) {
-        $str =~ s{$re}{ $f->(substr($str, $-[0], $+[0] - $-[0]), submatches, $-[0], $str) }eg;
-    } else {
-        $str =~ s{$re}{ $f->(substr($str, $-[0], $+[0] - $-[0]), submatches, $-[0], $str) }e;
-    }
-    $str
-}
-
-sub trim {
-    my ($s) = @_;
-    return undef if !defined $s;
-    $s =~ s/^\s+//;
-    $s =~ s/\s+\z//;
-    $s
-}
-
 sub elem {
     my ($k, $xs) = @_;
     if (ref $k) {
@@ -89,8 +45,6 @@ sub elem {
     !1
 }
 
-sub _eval { eval $_[0] }  # empty lexical scope
-
 sub eval_string {
     my ($code) = @_;
     my ($package, $file, $line) = caller;
@@ -100,6 +54,19 @@ sub eval_string {
     wantarray ? @r : $r[0]
 }
 
+sub list2re {
+    @_ or return qr/(?!)/;
+    my $re = join '|', map quotemeta, sort {length $b <=> length $a || $a cmp $b } @_;
+    $re eq '' and $re = '(?#)';
+    qr/$re/
+}
+
+sub mapval (&@) {
+    my $f = shift;
+    my @xs = @_;
+    map { $f->($_); $_ } @xs
+}
+
 if ($] >= 5.016) {
     eval_string <<'EOT';
 use v5.16;
@@ -124,6 +91,45 @@ EOT
     };
 }
 
+sub replace {
+    my ($str, $re, $x, $g) = @_;
+    my $f = ref $x ? $x : sub {
+        my $r = $x;
+        $r =~ s{\$([\$&`'0-9]|\{([0-9]+)\})}{
+            $+ eq '$' ? '$' :
+            $+ eq '&' ? $_[0] :
+            $+ eq '`' ? substr($_[-1], 0, $_[-2]) :
+            $+ eq "'" ? substr($_[-1], $_[-2] + length $_[0]) :
+            $_[$+]
+        }eg;
+        $r
+    };
+    if ($g) {
+        $str =~ s{$re}{ $f->(substr($str, $-[0], $+[0] - $-[0]), submatches(), $-[0], $str) }eg;
+    } else {
+        $str =~ s{$re}{ $f->(substr($str, $-[0], $+[0] - $-[0]), submatches(), $-[0], $str) }e;
+    }
+    $str
+}
+
+sub slurp {
+    local $/;
+    scalar readline $_[0]
+}
+
+sub submatches {
+    no strict 'refs';
+    map $$_, 1 .. $#+
+}
+
+sub trim {
+    my ($s) = @_;
+    return undef if !defined $s;
+    $s =~ s/^\s+//;
+    $s =~ s/\s+\z//;
+    $s
+}
+
 'ok'
 
 __END__
@@ -136,13 +142,19 @@ Data::Munge - various utility functions
 
  use Data::Munge;
  
- my $re = list2re qw/foo bar baz/;
+ my $re = list2re qw/f ba foo bar baz/;
+ # $re = qr/bar|baz|foo|ba|f/;
  
  print byval { s/foo/bar/ } $text;
+ # print do { my $tmp = $text; $tmp =~ s/foo/bar/; $tmp };
+ 
  foo(mapval { chomp } @lines);
+ # foo(map { my $tmp = $_; chomp $tmp; $_ } @lines);
  
  print replace('Apples are round, and apples are juicy.', qr/apples/i, 'oranges', 'g');
+ # "oranges are round, and oranges are juicy."
  print replace('John Smith', qr/(\w+)\s+(\w+)/, '$2, $1');
+ # "Smith, John"
  
  my $trimmed = trim "  a b c "; # "a b c"
  
@@ -166,7 +178,7 @@ redefining or working around them, so I wrote this module.
 
 =head2 Functions
 
-=over 4
+=over
 
 =item list2re LIST
 
@@ -176,6 +188,29 @@ Especially useful in combination with C<keys>. Example:
  my $re = list2re keys %hash;
  $str =~ s/($re)/$hash{$1}/g;
 
+This function takes special care to get several edge cases right:
+
+=over
+
+=item *
+
+Empty list: An empty argument list results in a regex that doesn't match
+anything.
+
+=item *
+
+Empty string: An argument list consisting of a single empty string results in a
+regex that matches the empty string (and nothing else).
+
+=item *
+
+Prefixes: The input strings are sorted by descending length to ensure longer
+matches are tried before shorter matches. Otherwise C<list2re('ab', 'abcd')>
+would generate C<qr/ab|abcd/>, which (on its own) can never match C<abcd>
+(because C<ab> is tried first, and it always succeeds where C<abcd> could).
+
+=back
+
 =item byval BLOCK SCALAR
 
 Takes a code block and a value, runs the block with C<$_> set to that value,
@@ -187,6 +222,12 @@ in the block will not affect the passed in value. Example:
  # Calls foo() with the value of $str, but all '!' have been replaced by '?'.
  # $str itself is not modified.
 
+Since perl 5.14 you can also use the C</r> flag:
+
+ foo($str =~ s/!/?/gr);
+
+But C<byval> works on all versions of perl and is not limited to C<s///>.
+
 =item mapval BLOCK LIST
 
 Works like a combination of C<map> and C<byval>; i.e. it behaves like
@@ -276,6 +317,14 @@ at elements C<1 .. 9999>).
 
 Evals I<STRING> just like C<eval> but doesn't catch exceptions.
 
+=item slurp FILEHANDLE
+
+Reads and returns all remaining data from I<FILEHANDLE> as a string, or
+C<undef> if it hits end-of-file. (Interaction with non-blocking filehandles is
+currently not well defined.)
+
+C<slurp $handle> is equivalent to C<do { local $/; scalar readline $handle }>.
+
 =item rec BLOCK
 
 Creates an anonymous sub as C<sub BLOCK> would, but supplies the called sub
@@ -1,6 +1,6 @@
 #!perl
 
-use Test::More tests => 55;
+use Test::More tests => 61;
 use Test::Warnings;
 
 use warnings FATAL => 'all';
@@ -13,12 +13,17 @@ use Data::Munge;
 }
 
 is +(byval { s/foo/bar/ } 'foo-foo'), 'bar-foo', 'byval';
-is_deeply [mapval { tr[a-d][1-4] } qw[foo bar baz]], [qw[foo 21r 21z]], 'mapval';
+is_deeply [mapval { tr[a-d][1-4] } 'foo', 'bar', 'baz'], [qw[foo 21r 21z]], 'mapval';
 
 is replace('Apples are round, and apples are juicy.', qr/apples/i, 'oranges', 'g'), 'oranges are round, and oranges are juicy.', 'replace g';
 is replace('John Smith', qr/(\w+)\s+(\w+)/, '$2, $1'), 'Smith, John', 'replace';
 is replace('97653 foo bar 42', qr/(\d)(\d)/, sub { $_[1] + $_[2] }, 'g'), '16113 foo bar 6', 'replace fun g';
 
+"foo bar" =~ /(\w+) (\w+)/ or die;
+is_deeply [submatches], [qw(foo bar)];
+"" =~ /^/ or die;
+is_deeply [submatches], [];
+
 is trim("  a  b  "), "a  b";
 is trim(""), "";
 is trim(","), ",";
@@ -41,6 +46,8 @@ is trim(undef), undef;
 is eval_string('"ab" . "cd"'), 'abcd';
 is eval { eval_string('{') }, undef;
 like $@, qr/Missing right curly/;
+is eval { eval_string '$VERSION' }, undef;
+like $@, qr/Global symbol "\$VERSION"/;
 
 ok !elem 42, [];
 ok elem 42, [42];
@@ -60,3 +67,13 @@ for my $ref ([], {}, sub {}) {
     ok elem $ref, [$ref, "A", $ref, $ref];
     ok elem $ref, [undef, $ref];
 }
+
+my $source = slurp \*DATA;
+like $source, qr/\AThis is the beginning\.\n/;
+like $source, qr/\nThis is the end\.\Z/;
+
+__DATA__
+This is the beginning.
+stuff
+etc.
+This is the end.