Data::Dumper results from the CPAN

App-Fetchware

package App::Fetchware::Util;
our $VERSION = '1.016'; # VERSION: generated by DZP::OurPkgVersion
# ABSTRACT: Miscelaneous functions for App::Fetchware.
###BUGALERT### Uses die instead of croak. croak is the preferred way of throwing
#exceptions in modules. croak says that the caller was the one who caused the
#error not the specific code that actually threw the error.
use strict;
use warnings;

use File::Spec::Functions qw(catfile catdir splitpath splitdir rel2abs
    file_name_is_absolute rootdir tmpdir);
use Path::Class;
use Net::FTP;
use HTTP::Tiny;
use Perl::OSType 'is_os_type';
use Cwd;
use App::Fetchware::Config ':CONFIG';
use File::Copy 'cp';
use File::Temp 'tempdir';
use File::stat;
use Fcntl qw(S_ISDIR :flock S_IMODE);
# Privileges::Drop only works on Unix, so only load it on Unix.
use if is_os_type('Unix'), 'Privileges::Drop';
use POSIX '_exit';
use Sub::Mage;
use URI::Split qw(uri_split uri_join);
use Text::ParseWords 'quotewords';
use Data::Dumper;

# Enable Perl 6 knockoffs, and use 5.10.1, because smartmatching and other
# things in 5.10 were changed in 5.10.1+.
use 5.010001;

# Set up Exporter to bring App::Fetchware::Util's API to everyone who use's it.
use Exporter qw( import );

our %EXPORT_TAGS = (
    UTIL => [qw(
        msg
        vmsg
        run_prog
        no_mirror_download_dirlist
        download_dirlist
        ftp_download_dirlist
        http_download_dirlist
        file_download_dirlist
        no_mirror_download_file
        download_file
        download_ftp_url
        download_http_url
        download_file_url
        do_nothing
        safe_open
        drop_privs
        write_dropprivs_pipe
        read_dropprivs_pipe
        create_tempdir
        original_cwd
        cleanup_tempdir
    )],
);

#        create_config_options

# *All* entries in @EXPORT_TAGS must also be in @EXPORT_OK.
our @EXPORT_OK = map {@{$_}} values %EXPORT_TAGS;








###BUGALERT### Add Test::Wrap support to msg() and vmsg() so that they will
#inteligently rewrap any text they receive so newly filled in variables won't
#screw up the wrapping.
sub msg (@) {

    # If fetchware was not run in quiet mode, -q.
    unless (defined $fetchware::quiet and $fetchware::quiet > 0) {
        # print are arguments. Use say if the last one doesn't end with a
        # newline. $#_ is the last subscript of the @_ variable.
        if ($_[$#_] =~ /\w*\n\w*\z/) {
            print @_;
        } else {
            say @_;
        }

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

    my $ftp_url = shift;
    $ftp_url =~ m!^ftp://([-a-z,A-Z,0-9,\.]+)(/.*)?!;
    my $site = $1;
    my $path = $2;

    # Add debugging later based on fetchware commandline args.
    # for debugging: $ftp = Net::FTP->new('$site','Debug' => 10);
    # open a connection and log in!
    my $ftp;
    $ftp = Net::FTP->new($site)
        or die <<EOD;
App-Fetchware: run-time error. fetchware failed to connect to the ftp server at
domain [$site]. The system error was [$@].
See man App::Fetchware.
EOD

    $ftp->login("anonymous",'-anonymous@')
        or die <<EOD;
App-Fetchware: run-time error. fetchware failed to log in to the ftp server at
domain [$site]. The ftp error was [@{[$ftp->message]}]. See man App::Fetchware.
EOD


    my @dir_listing = $ftp->dir($path)
        or die <<EOD;
App-Fetchware: run-time error. fetchware failed to get a long directory listing
of [$path] on server [$site]. The ftp error was [@{[$ftp->message]}]. See man App::Fetchware.
EOD

    $ftp->quit();

    return \@dir_listing;
}



sub http_download_dirlist {
    my $http_url = shift;

    # Forward any other options over to HTTP::Tiny. This is used mostly to
    # support changing user agent strings, but why not support them all.
    my %opts = @_ if @_ % 2 == 0;

    # Append user_agent if specified.
    $opts{agent} = config('user_agent') if config('user_agent');

    my $http = HTTP::Tiny->new(%opts);
    ###BUGALERT### Should use request() instead of get, because request can
    #directly write the chunks of the file to disk as they are downloaded. get()
    #just uses RAM, so a 50Meg file takes up 50 megs of ram, and so on.
    ###BUGALERT### Also, if you use request instead, and get chunks of bytes
    #instead of just writing them to disk, you could also use a
    #Term::ProgressBar to print a cool progress bar during the download!
    #This could also be added to the ftp downloaders too, but probably not the
    #local file:// downloaders though.
    my $response = $http->get($http_url);

    die <<EOD unless $response->{success};
App-Fetchware: run-time error. HTTP::Tiny failed to download a directory listing
of your provided lookup_url. HTTP status code [$response->{status} $response->{reason}]
HTTP headers [@{[Data::Dumper::Dumper($response)]}].
See man App::Fetchware.
EOD


    while (my ($k, $v) = each %{$response->{headers}}) {
        for (ref $v eq 'ARRAY' ? @$v : $v) {
        }
    }

    die <<EOD unless length $response->{content};
App-Fetchware: run-time error. The lookup_url you provided downloaded nothing.
HTTP status code [$response->{status} $response->{reason}]
HTTP headers [@{[Data::Dumper::Dumper($response)]}].
See man App::Fetchware.
EOD
    return $response->{content};
}



sub file_download_dirlist {
    my $local_lookup_url = shift;

    $local_lookup_url =~ s!^file://!!; # Strip scheme garbage.

    # Prepend original_cwd() if $local_lookup_url is a relative path.
    unless (file_name_is_absolute($local_lookup_url)) {
        $local_lookup_url =  catdir(original_cwd(), $local_lookup_url);
    }

    # Throw an exception if called with a directory that does not exist.
    die <<EOD if not -e $local_lookup_url;
App-Fetchware-Util: The directory that fetchware is trying to use to determine
if a new version of the software is available does not exist. This directory is
[$local_lookup_url], and the OS error is [$!].
EOD


    my @file_listing;
    opendir my $dh, $local_lookup_url or die <<EOD;
App-Fetchware-Util: The directory that fetchware is trying to use to determine
if a new version of the software is availabe cannot be opened. This directory is
[$local_lookup_url], and the OS error is [$!].
EOD
    while (my $filename = readdir($dh)) {
        # Trim the useless '.' and '..' Unix convention fake files from the listing.
        unless ($filename eq '.' or $filename eq '..') {
            # Turn the relative filename into a full pathname.
            #
            # Full pathnames are required, because lookup()'s
            # file_parse_filelist() stat()s each file using just their filename,
            # and if it's relative instead of absolute these stat() checks will
            # fail.
            my $full_path = catfile($local_lookup_url, $filename);
            push @file_listing, $full_path;
        }
    }

    closedir $dh;

    # Throw another exception if the directory contains nothing.
    # Awesome, clever, and simple Path::Class based "is dir empty" test courtesy
    # of tobyinc on PerlMonks (http://www.perlmonks.org/?node_id=934482).
    my $pc_local_lookup_url = dir($local_lookup_url);
    die <<EOD if $pc_local_lookup_url->stat() && !$pc_local_lookup_url->children();
App-Fetchware-Util: The directory that fetchware is trying to use to determine
if a new version of the software is available is empty. This directory is
[$local_lookup_url].
EOD

    return \@file_listing;
}

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


    # change the directory on the ftp site
    $ftp->cwd($directories)
        or die <<EOD;
App-Fetchware: run-time error. fetchware failed to cwd() to [$path] on site
[$site]. The ftp error was [@{[$ftp->message]}]. See perldoc App::Fetchware.
EOD


    # Download the file to the current directory. The start() subroutine should
    # have cd()d to a tempdir for fetchware to use.
    $ftp->get($file)
        or die <<EOD;
App-Fetchware: run-time error. fetchware failed to download the file [$file]
from path [$path] on server [$site]. The ftp error message was
[@{[$ftp->message]}]. See perldoc App::Fetchware.
EOD

    # ftp done!
    $ftp->quit;

    # The caller needs the $filename to determine the $package_path later.
    return $file;
}



sub download_http_url {
    my $http_url = shift;

    # Forward any other options over to HTTP::Tiny. This is used mostly to
    # support changing user agent strings, but why not support them all.
    my %opts = @_ if @_ % 2 == 0;

    # Append user_agent if specified.
    $opts{agent} = config('user_agent') if config('user_agent');

    my $http = HTTP::Tiny->new(%opts);
    ###BUGALERT### Should use request() instead of get, because request can
    #directly write the chunks of the file to disk as they are downloaded. get()
    #just uses RAM, so a 50Meg file takes up 50 megs of ram, and so on.
    my $response = $http->get($http_url);

#use Test::More;
#diag("RESPONSE OBJECT[");
#diag explain $response->{status};
#diag explain $response->{headers};
#diag explain $response->{url};
#diag explain $response->{reason};
#diag explain $response->{success};
## Should be commented out to avoid borking the terminal, but is needed when
## HTTP::Tiny has internal 599 errors, because the error message is in the
## content.
##diag explain $response->{content}; 
#diag("]");

    die <<EOD unless $response->{success};
App-Fetchware: run-time error. HTTP::Tiny failed to download a file or directory
listingfrom your provided url [$http_url]. HTTP status code
[$response->{status} $response->{reason}] HTTP headers
[@{[Data::Dumper::Dumper($response->{headers})]}].
See man App::Fetchware.
EOD

    # In this case the content is binary, so it will mess up your terminal.
    #diag($response->{content}) if length $response->{content};
    die <<EOD unless length $response->{content};
App-Fetchware: run-time error. The url [$http_url] you provided downloaded
nothing.  HTTP status code [$response->{status} $response->{reason}]
HTTP headers [@{[Data::Dumper::Dumper($response)]}].
See man App::Fetchware.
EOD

    # Must convert the worthless $response->{content} variable into a real file
    # on the filesystem. Note: start() should have cd()d us into a suitable
    # tempdir.
    my $path = $http_url;
    $path =~ s!^http://!!;
    # Determine filename from the $path.
    my ($volume, $directories, $filename) = splitpath($path);
    # If $filename is empty string, then its probably a index directory listing.
    $filename ||= 'index.html';
    ###BUGALERT### Need binmode() on Windows???
    ###BUGALERT### Switch to safe_open()????
    open(my $fh, '>', $filename) or die <<EOD;
App-Fetchware: run-time error. Fetchware failed to open a file necessary for
fetchware to store HTTP::Tiny's output. Os error [$!]. See perldoc
App::Fetchware.
EOD
    # Write HTTP::Tiny's downloaded file to a real file on the filesystem.
    print $fh $response->{content};
    close $fh
        or die <<EOS;
App-Fetchware: run-time error. Fetchware failed to close the file it created to
save the content it downloaded from HTTP::Tiny. This file was [$filename]. OS
error [$!]. See perldoc App::Fetchware.
EOS

    # The caller needs the $filename to determine the $package_path later.
    return $filename;
}




sub download_file_url {
    my $url = shift;

    $url =~ s!^file://!!; # Strip useless URL scheme.
    
    # Prepend original_cwd() only if the $url is *not* absolute, which will mess
    # it up.
    $url = catdir(original_cwd(), $url) unless file_name_is_absolute($url);

    # Download the file:// URL to the current directory, which should already be
    # in $temp_dir, because of start()'s chdir().
    #
    # Don't forget to clear taint. Fetchware does *not* run in taint mode, but
    # for some reason, bug?, File::Copy checks if data is tainted, and then
    # retaints it if it is already tainted, but for some reason I get "Insecure
    # dependency" taint failure exceptions when drop priving. The fix is to
    # always untaint my data as done below.
    ###BUGALERT### Investigate this as a possible taint bug in perl or just
    #File::Copy. Perhaps the cause is using File::Copy::cp(copy) after drop
    #priving with data from root?
    $url =~ /(.*)/;
    my $untainted_url = $1;
    my $cwd = cwd();
    $cwd =~ /(.*)/;
    my $untainted_cwd = $1;

( run in 0.530 second using v1.01-cache-2.11-cpan-39bf76dae61 )