view release on metacpan or  search on metacpan

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

=encoding utf-8

=head1 NAME

App::MBUtiny::Util - Internal utilities used by App::MBUtiny module

=head1 VERSION

Version 1.03

=head1 SYNOPSIS

    use App::MBUtiny::Util qw/
            filesize explain hide_password md5sum
            resolv sha1sum
        /;

    my $fsize = filesize( $file );
    print explain( $object );
    print hide_password('http://user:password@example.com');
    my $md5 = md5sum( $file );
    my $name = resolv( $IPv4 );
    my $sha1 = sha1sum( $filename );

=head1 DESCRIPTION

Internal utility functions

=over 8

=item B<explain>

    print explain( $object );

Returns Data::Dumper dump

=item B<filesize>

    my $fsize = filesize( $file );

Returns file size

=item B<hide_password>

    print hide_password('http://user:password@example.com'); # 'http://user:*****@example.com'

Returns specified URL but without password

=item B<md5sum>

    my $md5 = md5sum( $filename );

See L<Digest::MD5>

=item B<node2anode>

    my $anode = node2anode({});

Returns array of nodes

=item B<parse_credentials>

    my ($user, $password) = parse_credentials( 'http://user:password@example.com' );
    my ($user, $password) = parse_credentials( new URI('http://user:password@example.com') );

Returns credentials pair by URL or URI object

=item B<resolv>

    my $name = resolv( $IPv4 );
    my $ip = resolv( $name );

Resolv ip to a hostname or hostname to ip. See L<Sys::Net/"resolv">, L<Socket/"inet_ntoa">
and L<Socket/"inet_aton">

=item B<set2attr>

    my $hash = set2attr({set => ["AttrName Value"]}); # {"AttrName" => "Value"}

Converts attributes from the "set" format to regular hash

=item B<sha1sum>

    my $sha1 = sha1sum( $filename );

See L<Digest::SHA1>

=item B<xcopy>

    xcopy( $src_dir, $dst_dir, [ ... exclude rel. paths ... ] );

Exclusive copying all objects (files/directories) from $src_dir directory into $dst_dir
directory without specified relative paths. The function returns status of work

    xcopy( "/source/folder", "/destination/folder" )
        or die "Can't copy directory";

    # Copying without foo and bar/baz files/directories
    xcopy( "/source/folder", "/destination/folder", [qw( foo bar/baz )] )
        or die "Can't copy directory";

=back

=head1 HISTORY

See C<Changes> file

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<http://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved

=head1 LICENSE

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See C<LICENSE> file and L<https://dev.perl.org/licenses/>

=cut

use vars qw/ $VERSION @EXPORT_OK /;
$VERSION = '1.03';

our $DEBUG = 0;

use Carp;
use URI;
use URI::Escape qw/uri_unescape/;
use File::Find;
use File::Copy;
use Digest::MD5;
use Digest::SHA1;
use Socket qw/inet_ntoa inet_aton AF_INET/;
use Data::Dumper; #$Data::Dumper::Deparse = 1;
use CTK::ConfGenUtil;

use constant {
    DIRMODE => 0777,
};

use base qw/Exporter/;
@EXPORT_OK = qw/
        filesize sha1sum md5sum
        resolv
        explain
        xcopy
        node2anode set2attr
        parse_credentials hide_password
    /;

sub sha1sum {
    my $f = shift;
    my $sha1 = new Digest::SHA1;
    my $sum = '';
    return $sum unless -e $f;
    open( my $sha1_fh, '<', $f) or (carp("Can't open '$f': $!") && return $sum);
    if ($sha1_fh) {
        binmode($sha1_fh);
        $sha1->addfile($sha1_fh);
        $sum = $sha1->hexdigest;
        close($sha1_fh);
    }
    return $sum;
}
sub md5sum {
    my $f = shift;
    my $md5 = new Digest::MD5;
    my $sum = '';
    return $sum unless -e $f;
    open( my $md5_fh, '<', $f) or (carp("Can't open '$f': $!") && return $sum);
    if ($md5_fh) {
        binmode($md5_fh);
        $md5->addfile($md5_fh);
        $sum = $md5->hexdigest;
        close($md5_fh);
    }
    return $sum;
}
sub filesize {
    my $f = shift;
    my $filesize = 0;
    $filesize = (stat $f)[7] if -e $f;
    return $filesize;
}
sub resolv { # Resolving. See Socket::inet_ntoa
    # Original: Sys::Net::resolv
    my $name = shift;
    # resolv ip to a hostname
    if ($name =~ m/^\s*[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\s*$/) {
        return scalar gethostbyaddr(inet_aton($name), AF_INET);
    }
    # resolv hostname to ip
    else {
        return inet_ntoa(scalar gethostbyname($name));
    }
}
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