@@ -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.