view release on metacpan or  search on metacpan

lib/App/MBUtiny/Util.pm  view on Meta::CPAN

}
sub explain {
    my $dumper = new Data::Dumper( [shift] );
    $dumper->Indent(1)->Terse(1);
    $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
    return $dumper->Dump;
}
sub xcopy {
    my $object = shift || ''; # from
    my $target = shift || ''; # to
    my $exclude = shift;      # exclude files

    carp("Source directory not exists: $object") && return
        unless $object && (-e $object and -d $object);

    carp("Target directory not defined: $target") && return
        unless $target;

    if ($exclude && ref($exclude) ne 'ARRAY') {
        carp("The third argument must be reference to array containing list of files for excluding");
        return;
    } else {
        $exclude = [] unless $exclude;
    }

    my $ob = File::Spec->canonpath($object);
    my $tg = File::Spec->canonpath($target);
    my (@exf, @exd);
    foreach (@$exclude) {
        my $tf = File::Spec->canonpath(File::Spec->catfile($ob, $_));
        my $td = File::Spec->canonpath(File::Spec->catdir($ob, $_));
        if (-e $td && -d $td) {
            push @exd, $td;
        } else {
            push @exf, $tf;
        }
    };

    if ($DEBUG) {
        printf("#F: %s\n", $_) for @exf;
        printf("#D: %s\n", $_) for @exd;
    }

    find({
        wanted => sub
            {
                my $f = File::Spec->canonpath($_);
                my $p = File::Spec->abs2rel( $f, $ob );
                if ((-e $f and -f $f) && (grep {$_ eq $f} @exf)) {
                    print ">F [SKIP] $f\n" if $DEBUG;
                    return 1;
                } elsif (@exd && grep {_td($_,$f)} @exd) {
                    print ">D [SKIP] $f\n" if $DEBUG;
                    return 1;
                } else {
                    if (-d $f) {
                        my $end = File::Spec->catdir($tg, $p);
                        print ">D        $f -> $end\n" if $DEBUG;
                        unless (-e $end) {
                            mkdir($end,DIRMODE) or carp(sprintf("Can't create directoy \"%s\": ", $end, $!)) && return;
                            chmod scalar((stat($f))[2]), $end;
                        }
                    } else {
                        my $end = File::Spec->catfile($tg, $p);
                        print ">F        $f -> $end\n" if $DEBUG;
                        unless (-e $end) {
                            copy($f,$end) or carp(sprintf("Copy failed \"%s\" -> \"%s\": %s", $f, $end, $!)) && return;
                            chmod scalar((stat($f))[2]), $end;
                        }
                    }
                }
            },
        no_chdir => 1,
        }, $ob,
    );

    print "\n" if $DEBUG;
    return 1;
}
sub node2anode {
    my $n = shift;
    return [] unless $n && ref($n) =~ /ARRAY|HASH/;
    return [$n] if ref($n) eq 'HASH';
    return $n;
}
sub parse_credentials {
    my $url = shift || return ();
    my $uri = (ref($url) eq 'URI') ? $url : URI->new($url);
    my $info = $uri->userinfo() // "";
    my $user = $info;
    my $pass = $info;
    $user =~ s/:.*//;
    $pass =~ s/^[^:]*://;
    return (uri_unescape($user // ''), uri_unescape($pass // ''));
}
sub hide_password {
    my $url = shift || return "";
    my $full = shift || 0; # 0 - starts, 1 - no_credentials; 2 - user_only
    my $uri = new URI($url);
    my ($u,$p) = parse_credentials($uri);
    return $url unless defined($p) && length($p);
    $uri->userinfo($full ? ($full == 1 ? undef : $u) : sprintf("%s:*****", $u));
    return $uri->canonical->as_string;
}
sub set2attr {
    my $in = shift;
    my $attr = is_array($in) ? $in : array($in => "set");
    my %attrs;
    foreach (@$attr) {
        $attrs{$1} = $2 if $_ =~ /^\s*(\S+)\s+(.+)$/;
    }
    return {%attrs};
}

sub _td { # Test of base directory
    my $d = shift; # exclude directory
    my $o = shift; # test object

    my @t;
    my @sd;
    my $ret = 0;
    my ($volume,$dirs,$file) = File::Spec->splitpath( $o );
    return 0 unless $dirs;
    if (-f $o) {
        @sd = File::Spec->splitdir(File::Spec->catdir($volume, $dirs));
        #print join("#",@sd),"\n";
    } elsif (-d $o) {
        @sd = File::Spec->splitdir($o);