File Coverage

blib/lib/Data/Munge.pm

Criterion	Covered	Total	%
statement	69	69	100.0
branch	28	36	77.7
condition	9	9	100.0
subroutine	18	18	100.0
pod	10	10	100.0
total	134	142	94.3

package Data::Munge;

use strict;
use warnings;
use base qw(Exporter);

sub _eval { eval $_[0] }  # empty lexical scope

our $VERSION = '0.096';
our @EXPORT = qw(
    byval
    elem
    eval_string
    list2re
    mapval
    rec
    replace
    slurp
    submatches
    trim
);

sub byval (&$) {
    my ($f, $x) = @_;
    local *_ = \$x;
    $f->($_);
    $x
}

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 && !ref $x && $k eq $x;
        }
    } else {
        for my $x (@$xs) {
            return 1 if !defined $x;
        }
    }
    !1
}

sub eval_string {
    my ($code) = @_;
    my ($package, $file, $line) = caller;
    local $Data::Munge::_err = $@;
    $code = qq{\$\@ = \$Data::Munge::_err; package $package; # eval_string()\n#line $line "$file"\n$code};
    my @r = wantarray ? _eval $code : scalar _eval $code;
    die $@ if $@;
    $@ = $Data::Munge::_err;
    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;
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), @_) }
    };
}

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__