Data-Munge-0.07/0000755000175000001440000000000012231556226012407 5ustar maukeusersData-Munge-0.07/lib/0000755000175000001440000000000012231556226013155 5ustar maukeusersData-Munge-0.07/lib/Data/0000755000175000001440000000000012231556226014026 5ustar maukeusersData-Munge-0.07/lib/Data/Munge.pm0000644000175000001440000001760212231554767015455 0ustar maukeuserspackage Data::Munge; use warnings; use strict; use base qw(Exporter); our $VERSION = '0.07'; our @EXPORT = qw[ list2re byval mapval submatches replace eval_string rec 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) = @_; local *_ = \$x; $f->($_); $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) = @_; $s =~ s/^\s+//; $s =~ s/\s+\z//; $s } sub elem { my ($k, $xs) = @_; if (ref $k) { for my $x (@$xs) { return 1 if ref $x && $k == $x; } } elsif (defined $k) { for my $x (@$xs) { return 1 if defined $x && $k eq $x; } } else { for my $x (@$xs) { return 1 if !defined $x; } } !1 } sub _eval { eval $_[0] } # empty lexical scope sub eval_string { my ($code) = @_; my ($package, $file, $line) = caller; $code = qq{package $package; # eval_string()\n#line $line "$file"\n$code}; my @r = wantarray ? _eval $code : scalar _eval $code; die $@ if $@; wantarray ? @r : $r[0] } if ($] >= 5.016) { eval_string <<'EOT'; use v5.16; sub rec (&) { my ($f) = @_; sub { $f->(__SUB__, @_) } } EOT } elsif (eval { require Scalar::Util } && defined &Scalar::Util::weaken) { *rec = sub (&) { my ($f) = @_; my $w; my $r = $w = sub { $f->($w, @_) }; Scalar::Util::weaken($w); $r }; } else { # slow but always works *rec = sub (&) { my ($f) = @_; sub { $f->(&rec($f), @_) } }; } 'ok' __END__ =head1 NAME Data::Munge - various utility functions =head1 SYNOPSIS use Data::Munge; my $re = list2re qw/foo bar baz/; print byval { s/foo/bar/ } $text; foo(mapval { chomp } @lines); print replace('Apples are round, and apples are juicy.', qr/apples/i, 'oranges', 'g'); print replace('John Smith', qr/(\w+)\s+(\w+)/, '$2, $1'); my $trimmed = trim " a b c "; # "a b c" my $x = 'bar'; if (elem $x, [qw(foo bar baz)]) { ... } eval_string('print "hello world\\n"'); # says hello eval_string('die'); # dies eval_string('{'); # throws a syntax error my $fac = rec { my ($rec, $n) = @_; $n < 2 ? 1 : $n * $rec->($n - 1) }; print $fac->(5); # 120 =head1 DESCRIPTION This module defines a few generally useful utility functions. I got tired of redefining or working around them, so I wrote this module. =head2 Functions =over 4 =item list2re LIST Converts a list of strings to a regex that matches any of the strings. Especially useful in combination with C. Example: my $re = list2re keys %hash; $str =~ s/($re)/$hash{$1}/g; =item byval BLOCK SCALAR Takes a code block and a value, runs the block with C<$_> set to that value, and returns the final value of C<$_>. The global value of C<$_> is not affected. C<$_> isn't aliased to the input value either, so modifying C<$_> in the block will not affect the passed in value. Example: foo(byval { s/!/?/g } $str); # Calls foo() with the value of $str, but all '!' have been replaced by '?'. # $str itself is not modified. =item mapval BLOCK LIST Works like a combination of C and C; i.e. it behaves like C, but C<$_> is a copy, not aliased to the current element, and the return value is taken from C<$_> again (it ignores the value returned by the block). Example: my @foo = mapval { chomp } @bar; # @foo contains a copy of @bar where all elements have been chomp'd. # This could also be written as chomp(my @foo = @bar); but that's not # always possible. =item submatches Returns a list of the strings captured by the last successful pattern match. Normally you don't need this function because this is exactly what C returns in list context. However, C also works in other contexts such as the RHS of C. =item replace STRING, REGEX, REPLACEMENT, FLAG =item replace STRING, REGEX, REPLACEMENT A clone of javascript's C. It works almost the same as C, but with a few important differences. REGEX can be a string or a compiled C object. REPLACEMENT can be a string or a subroutine reference. If it's a string, it can contain the following replacement patterns: =over =item $$ Inserts a '$'. =item $& Inserts the matched substring. =item $` Inserts the substring preceding the match. =item $' Inserts the substring following the match. =item $N (where N is a digit) Inserts the substring matched by the Nth capturing group. =item ${N} (where N is one or more digits) Inserts the substring matched by the Nth capturing group. =back Note that these aren't variables; they're character sequences interpreted by C. If REPLACEMENT is a subroutine reference, it's called with the following arguments: First the matched substring (like C<$&> above), then the contents of the capture buffers (as returned by C), then the offset where the pattern matched (like C<$-[0]>, see L), then the STRING. The return value will be inserted in place of the matched substring. Normally only the first occurrence of REGEX is replaced. If FLAG is present, it must be C<'g'> and causes all occurrences to be replaced. =item trim STRING Returns I with all leading and trailing whitespace removed. =item elem SCALAR, ARRAYREF Returns a boolean value telling you whether I is an element of I or not. Two scalars are considered equal if they're both C, if they're both references to the same thing, or if they're both not references and C to each other. This is implemented as a linear search through I that terminates early if a match is found (i.e. C won't even look at elements C<1 .. 9999>). =item eval_string STRING Evals I just like C but doesn't catch exceptions. =item rec BLOCK Creates an anonymous sub as C would, but supplies the called sub with an extra argument that can be used to recurse: my $code = rec { my ($rec, $n) = @_; $rec->($n - 1) if $n > 0; print $n, "\n"; }; $code->(4); That is, when the sub is called, an implicit first argument is passed in C<$_[0]> (all normal arguments are moved one up). This first argument is a reference to the sub itself. This reference could be used to recurse directly or to register the sub as a handler in an event system, for example. A note on defining recursive anonymous functions: Doing this right is more complicated than it may at first appear. The most straightforward solution using a lexical variable and a closure leaks memory because it creates a reference cycle. Starting with perl 5.16 there is a C<__SUB__> constant that is equivalent to C<$rec> above, and this is indeed what this module uses (if available). However, this module works even on older perls by falling back to either weak references (if available) or a "fake recursion" scheme that dynamically instantiates a new sub for each call instead of creating a cycle. This last resort is slower than weak references but works everywhere. =back =head1 AUTHOR Lukas Mai, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2009-2011, 2013 Lukas Mai. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut Data-Munge-0.07/META.yml0000644000175000001440000000100512231556226013654 0ustar maukeusers--- abstract: 'various utility functions' author: - 'Lukas Mai ' build_requires: Test::More: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Data-Munge no_index: directory: - t - inc requires: Exporter: 0 base: 0 strict: 0 warnings: 0 resources: repository: git://github.com/mauke/Data-Munge.git version: 0.07 Data-Munge-0.07/Makefile.PL0000644000175000001440000000313212231556003014351 0ustar maukeusersuse strict; use warnings; use ExtUtils::MakeMaker; sub merge_key_into { my ($href, $target, $source) = @_; %{$href->{$target}} = (%{$href->{$target}}, %{delete $href->{$source}}); } my %opt = ( NAME => 'Data::Munge', AUTHOR => q{Lukas Mai }, VERSION_FROM => 'lib/Data/Munge.pm', ABSTRACT_FROM => 'lib/Data/Munge.pm', LICENSE => 'perl', PL_FILES => {}, CONFIGURE_REQUIRES => { 'strict' => 0, 'warnings' => 0, 'ExtUtils::MakeMaker' => '6.48', }, BUILD_REQUIRES => {}, TEST_REQUIRES => { 'Test::More' => 0, }, PREREQ_PM => { 'Exporter' => 0, 'base' => 0, 'strict' => 0, 'warnings' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Data-Munge-*' }, META_MERGE => { 'meta-spec' => { version => 2 }, 'resources' => { repository => { url => 'git://github.com/mauke/Data-Munge.git', web => 'https://github.com/mauke/Data-Munge', type => 'git', }, }, }, ); (my $mm_version = ExtUtils::MakeMaker->VERSION($opt{CONFIGURE_REQUIRES}{'ExtUtils::MakeMaker'})) =~ tr/_//d; if ($mm_version < 6.67_04) { # Why? For the glory of satan, of course! no warnings qw(redefine); *ExtUtils::MM_Any::_add_requirements_to_meta_v1_4 = \&ExtUtils::MM_Any::_add_requirements_to_meta_v2; } if ($mm_version < 6.63_03) { merge_key_into \%opt, 'BUILD_REQUIRES', 'TEST_REQUIRES'; } if ($mm_version < 6.55_01) { merge_key_into \%opt, 'CONFIGURE_REQUIRES', 'BUILD_REQUIRES'; } if ($mm_version < 6.51_03) { merge_key_into \%opt, 'PREREQ_PM', 'CONFIGURE_REQUIRES'; } WriteMakefile %opt; Data-Munge-0.07/t/0000755000175000001440000000000012231556226012652 5ustar maukeusersData-Munge-0.07/t/01-compile.t0000644000175000001440000000311712116117725014706 0ustar maukeusers#!perl use Test::More tests => 53; use warnings FATAL => 'all'; use strict; use Data::Munge; { my $str = "abc|bar|baz|foo|\\*\\*|ab|\\!|\\*|a"; is list2re(qw[! a abc ab foo bar baz ** *]), qr/$str/, 'list2re'; } 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 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'; is trim(" a b "), "a b"; is trim(""), ""; is trim(","), ","; is trim(" "), ""; is trim(" "), ""; is trim("\na"), "a"; is trim("b\t"), "b"; is trim("X\nY \n "), "X\nY"; { my $fac = rec { my ($rec, $n) = @_; $n < 2 ? 1 : $n * $rec->($n - 1) }; is $fac->(5), 120; is $fac->(6), 720; } is eval_string('"ab" . "cd"'), 'abcd'; is eval { eval_string('{') }, undef; like $@, qr/Missing right curly/; ok !elem 42, []; ok elem 42, [42]; ok elem "A", [undef, [], "A", "B"]; ok elem "B", [undef, [], "A", "B"]; ok elem undef, [undef, [], "A", "B"]; ok !elem [], [undef, [], "A", "B"]; ok !elem "C", [undef, [], "A", "B"]; for my $ref ([], {}, sub {}) { ok !elem $ref, []; ok !elem $ref, [undef]; ok !elem $ref, ["$ref"]; ok !elem $ref, [[], {}]; ok elem $ref, [$ref]; ok elem $ref, ["A", "B", $ref]; ok elem $ref, ["A", $ref, "B"]; ok elem $ref, [$ref, "A", $ref, $ref]; ok elem $ref, [undef, $ref]; } Data-Munge-0.07/t/pod-coverage.t0000644000175000001440000000104711311521550015402 0ustar maukeusersuse strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); Data-Munge-0.07/t/torgox.t0000644000175000001440000000130111616345477014366 0ustar maukeusers#!perl use warnings; use strict; use Test::More tests => 8; use Data::Munge qw(list2re replace); my $orig = '[acabbdcacab]'; my $re1 = list2re 'a', 'b'; my $good1 = '[XYcXYXYXYdcXYcXYXY]'; is replace($orig, $re1, 'XY', 'g'), $good1; $_ = $orig; s/$re1/XY/g; is $_, $good1; my $re2 = list2re 'a'; my $good2 = '[XYcXYbbdcXYcXYb]'; is replace($orig, $re2, 'XY', 'g'), $good2; $_ = $orig; s/$re2/XY/g; is $_, $good2; my $re3 = list2re; my $good3 = $orig; is replace($orig, $re3, 'XY', 'g'), $good3; $_ = $orig; s/$re3/XY/g; is $_, $good3; my $re4 = list2re ''; my $good4 = 'XY[XYaXYcXYaXYbXYbXYdXYcXYaXYcXYaXYbXY]XY'; is replace($orig, $re4, 'XY', 'g'), $good4; $_ = $orig; s/$re4/XY/g; is $_, $good4; Data-Munge-0.07/t/00-load.t0000644000175000001440000000022211311534714014163 0ustar maukeusers#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'Data::Munge' ); } diag( "Testing Data::Munge $Data::Munge::VERSION, Perl $], $^X" ); Data-Munge-0.07/t/pod.t0000644000175000001440000000035011311521550013605 0ustar maukeusers#!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Data-Munge-0.07/MANIFEST.SKIP0000644000175000001440000000022112231555207014276 0ustar maukeusers\.tar\.gz$ ^Build$ ^Data-Munge- ^GNUmakefile$ ^MANIFEST\.(?!SKIP$) ^MYMETA\. ^Makefile$ ^Makefile\.old$ ^\. ^_build ^blib ^cover_db$ ^pm_to_blib Data-Munge-0.07/MANIFEST0000644000175000001440000000045312231556226013542 0ustar maukeusersChanges MANIFEST MANIFEST.SKIP Makefile.PL README lib/Data/Munge.pm t/00-load.t t/01-compile.t t/pod-coverage.t t/pod.t t/torgox.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Data-Munge-0.07/META.json0000644000175000001440000000206212231556226014030 0ustar maukeusers{ "abstract" : "various utility functions", "author" : [ "Lukas Mai " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Data-Munge", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : {} }, "runtime" : { "requires" : { "Exporter" : "0", "base" : "0", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "git://github.com/mauke/Data-Munge.git", "web" : "https://github.com/mauke/Data-Munge" } }, "version" : "0.07" } Data-Munge-0.07/Changes0000644000175000001440000000130212231554516013676 0ustar maukeusersRevision history for Data-Munge 0.07 2013-10-22 * eval_string() now sets __FILE__ and __LINE__ for the eval'd code. This may or may not make error locations more useful. 0.06 2013-03-07 * add elem 0.05 2013-03-05 * add trim, eval_string, and rec 0.04 2011-08-04 * Fix buggy behavior for list2re('') and list2re() 0.032 2010-01-23 * Fix overly strict test that fails on < 5.10 0.031 2010-01-20 * Also remove Defaults::Mauke from tests (sigh). 0.03 2010-01-19 * Dropped dependency on Defaults::Mauke. * Added submatches/replace. 0.02 2009-12-14 First version, released on an unsuspecting world. Data-Munge-0.07/README0000644000175000001440000000171212231555020013257 0ustar maukeusersData-Munge Various utility functions. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Data::Munge You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-Munge AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Data-Munge CPAN Ratings http://cpanratings.perl.org/d/Data-Munge MetaCPAN https://metacpan.org/module/Data::Munge COPYRIGHT AND LICENCE Copyright (C) 2009-2011, 2013 Lukas Mai This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information.