File Coverage

blib/lib/Net/SSH/Any/Util.pm

Criterion	Covered	Total	%
statement	23	85	27.0
branch	0	38	0.0
condition	0	11	0.0
subroutine	8	24	33.3
pod			n/a
total	31	158	19.6

package Net::SSH::Any::Util;

BEGIN { *debug = \$Net::SSH::Any::debug }

use strict;
use warnings;
use Carp;
use File::Spec;
use Time::HiRes ();

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw($debug _debug _debugf _debug_dump _debug_hexdump
                 _sub_options _croak_bad_options
                 _first_defined _array_or_scalar_to_list
                 _inc_numbered _gen_wanted
                 _scp_escape_name _scp_unescape_name
                 _warn);

our $debug ||= 0;

sub _warn { warnings::warnif('Net::SSH::Any', join(': ', @_)) }

sub _debug {
    local ($@, $!, $_);
    print STDERR '#', (Time::HiRes::time() - $^T), ': ', (map { defined($_) ? $_ : '' } @_), "\n";
}

sub _debugf {
    my $t = shift;
    _debug sprintf($t, map { defined($_) ? $_ : '' } @_);
}

sub _debug_dump {
    require Data::Dumper;
    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Indent = 0;
    my $head = shift;
    _debug("$head: ", Data::Dumper::Dumper(@_));
}

sub _debug_hexdump {
    no warnings qw(uninitialized);
    my $head = shift;
    local ($@, $!, $_);
    _debugf("%s (%d bytes):", $head, length($_[0]));
    if ($debug & 16384) {
	my $data = shift;
	while ($data =~ /(.{1,32})/smg) {
	    my $line = $1;
	    my @c= (( map { sprintf "%02x",$_ } unpack('C*', $line)),
		    (("  ") x 32))[0..31];
	    $line=~s/(.)/ my $c=$1; unpack("c",$c)>=32 ? $c : '.' /egms;
	    print STDERR "#> ", join(" ", @c, '|', $line), "\n";
	    if (!($debug & 32768) and $data =~ /(=?.)/csmg) {
		print STDERR "#> ...\n";
		last;
	    }
	}
    }
}

sub _first_defined { defined && return $_ for @_; return }

my %good;

sub _sub_options {
    my $sub = shift;
    my $pkg = caller;
    $good{"${pkg}::$sub"} = { map { $_ => 1 } @_ };
}

sub _croak_bad_options (\%) {
    my $opts = shift;
    if (%$opts) {
        my $sub = (caller 1)[3];
        my $good = $good{$sub};
        my @keys = ( $good ? grep !$good->{$_}, keys %$opts : keys %$opts);
        if (@keys) {
            croak "Invalid or bad combination of options ('" . join("', '", @keys) . "')";
        }
    }
}

sub _array_or_scalar_to_list { map { defined($_) ? (ref $_ eq 'ARRAY' ? @$_ : $_ ) : () } @_ }

sub _inc_numbered {
    $_[0] =~ s{^(.*)\((\d+)\)((?:\.[^\.]*)?)$}{"$1(" . ($2+1) . ")$3"}e or
    $_[0] =~ s{((?:\.[^\.]*)?)$}{(1)$1};
    $debug and $debug & 128 and _debug("numbering to: $_[0]");
}

sub _gen_wanted {
    my ($ow, $onw) = my ($w, $nw) = @_;
    if (ref $w eq 'Regexp') {
	$w = sub { $_[0]{remote} =~ $ow }
    }

    if (ref $nw eq 'Regexp') {
	$nw = sub { $_[0]{remote} =~ $onw }
    }

    if (defined $w and defined $nw) {
	return sub { &$nw and not &$w }
    }

    return $w if defined $w;
    return sub { not &$nw } if defined $nw;
    undef;
}

sub _scp_unescape_name {
    s/\\\\|\\\^([@-Z])/$1 ? chr(ord($1) - 64) : '\\'/ge for @_;
}

sub _scp_escape_name {
    for (@_) {
        s/\\/\\\\/;
        s/([\x00-\x1f])/'\\^' . chr(64 + ord($1))/ge;
    }
}

# sub _mkpath {
#     my $path = shift;
#     my @start = File::Spec->splitdir(File::Spec->rel2abs($path));
#     my @end;
#     while (@start) {
# 	my $start = File::Spec->join(@start);
# 	last if -d $start;
# 	push @end, pop @start;
#     }
#     while (@end) {
# 	push @start, pop @end;
# 	my $start = File::Spec->join(@start);
# 	return unless -d $start or mkdir $start;
#     }
#     1;
# }

1;