MDK-Common

 view release on metacpan or  search on metacpan

lib/MDK/Common/DataStructure.pm  view on Meta::CPAN

sub deref { ref($_[0]) eq "ARRAY" ? @{$_[0]} : ref($_[0]) eq "HASH" ? %{$_[0]} : $_[0] }
sub deref_array { ref($_[0]) eq "ARRAY" ? @{$_[0]} : $_[0] }

sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
sub is_empty_hash_ref { my $a = shift; !defined $a || keys(%$a) == 0 }

sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
sub intersection { my (%l, @m); @l{@{shift @_}} = (); foreach (@_) { @m = grep { exists $l{$_} } @$_; %l = (); @l{@m} = () } keys %l }

sub uniq_(&@) {
    my $f = shift;
    my %l;
    $l{$f->($_)} = 1 foreach @_;
    grep { delete $l{$f->($_)} } @_;
}


sub next_val_in_array {
    my ($v, $l) = @_;
    my %l = MDK::Common::Func::mapn(sub { @_ }, $l, [ @$l[1..$#$l], $l->[0] ]);

lib/MDK/Common/File.pm  view on Meta::CPAN

    my ($d, $f) = $_[0] =~ /\*/ ? (dirname($_[0]), basename($_[0])) : ($_[0], '*');

    $d =~ /\*/ and die "glob_: wildcard in directory not handled ($_[0])\n";
    ($f = quotemeta $f) =~ s/\\\*/.*/g;

    $d =~ m|/$| or $d .= '/';
    map { $d eq './' ? $_ : "$d$_" } grep { /^$f$/ } all($d);
}


sub substInFile(&@) {
    my ($f, $file) = @_;
    #FIXME we should follow symlinks, and fail in case of loop
    if (-l $file) {
        my $targetfile = readlink $file;
        $file = $targetfile;
    }
    if (-s $file) {
	local @ARGV = $file;
	local $^I = '.bak';
	local $_;

lib/MDK/Common/Func.pm  view on Meta::CPAN

    wantarray() || @_ <= 1 or die("if_ called in scalar context with more than one argument :\nargs="  . join(", ", @_) . "\ncaller=" . join(":", caller()));
    wantarray() ? @_ : $_[0];
}
sub if__($@) {
    my $b = shift;
    defined $b or return ();
    wantarray() || @_ <= 1 or die("if__ called in scalar context with more than one argument :\nargs="  . join(", ", @_) . "\ncaller=" . join(":", caller()));
    wantarray() ? @_ : $_[0];
}

sub fold_left(&@) {
    my ($f, $initial, @l) = @_;
    local ($::a, $::b);
    $::a = $initial;
    foreach (@l) { $::b = $_; $::a = &$f() }
    $::a;
}

sub smapn {
    my $f = shift;
    my $n = shift;
    my @r;
    for (my $i = 0; $i < $n; $i++) { push @r, &$f(map { $_->[$i] } @_) }
    @r;
}
sub mapn(&@) {
    my $f = shift;
    smapn($f, MDK::Common::Math::min(map { scalar @$_ } @_), @_);
}
sub mapn_(&@) {
    my $f = shift;
    smapn($f, MDK::Common::Math::max(map { scalar @$_ } @_), @_);
}

sub find(&@) {
    my $f = shift;
    $f->($_) and return $_ foreach @_;
    undef;
}
sub any(&@) {
    my $f = shift;
    $f->($_) and return 1 foreach @_;
    0;
}
sub every(&@) {
    my $f = shift;
    $f->($_) or return 0 foreach @_;
    1;
}

sub map_index(&@) {
    my $f = shift;
    my @v; local $::i = 0;
    map { @v = $f->(); $::i++; @v } @_;
}
sub each_index(&@) {
    my $f = shift;
    local $::i = 0;
    foreach (@_) {
	$f->();
	$::i++;
    }
}
sub grep_index(&@) {
    my $f = shift;
    my $v; local $::i = 0;
    grep { $v = $f->(); $::i++; $v } @_;
}
sub find_index(&@) {
    my $f = shift;
    local $_;
    for (my $i = 0; $i < @_; $i++) {
	$_ = $_[$i];
	&$f and return $i;
    }
    die "find_index failed in @_";
}
sub map_each(&%) {
    my ($f, %h) = @_;
    my @l;
    local ($::a, $::b);
    while (($::a, $::b) = each %h) { push @l, &$f($::a, $::b) }
    @l;
}
sub grep_each(&%) {
    my ($f, %h) = @_;
    my %l;
    local ($::a, $::b);
    while (($::a, $::b) = each %h) { $l{$::a} = $::b if &$f($::a, $::b) }
    %l;
}
sub partition(&@) {
    my $f = shift;
    my (@a, @b);
    foreach (@_) {
	$f->($_) ? push(@a, $_) : push(@b, $_);
    }
    \@a, \@b;
}

sub add_f4before_leaving {
    my ($f, $b, $name) = @_;

lib/MDK/Common/Func.pm  view on Meta::CPAN

	no strict 'refs';
	*{"MDK::Common::Func::before_leaving::$name"} = sub {
	    my $f = $MDK::Common::Func::before_leaving::_list->{$_[0]}{$name} or die '';
	    $name eq 'DESTROY' and delete $MDK::Common::Func::before_leaving::_list->{$_[0]};
	    &$f;
	};
    }
}

#- ! the functions are not called in the order wanted, in case of multiple before_leaving :(
sub before_leaving(&) {
    my ($f) = @_;
    my $b = bless {}, 'MDK::Common::Func::before_leaving';
    add_f4before_leaving($f, $b, 'DESTROY');
    $b;
}

sub catch_cdie(&&) {
    my ($f, $catch) = @_;

    local @MDK::Common::Func::cdie_catches;
    unshift @MDK::Common::Func::cdie_catches, $catch;
    &$f();
}

sub cdie {
    my ($err) = @_;
    foreach (@MDK::Common::Func::cdie_catches) {