view release on metacpan or  search on metacpan

bin/fetchware  view on Meta::CPAN

#!/usr/bin/perl
# I know lowercase names are reserved for pragma's, but other programs do this
# such as perlbrew and dzil. It makes loading this program for testing very easy
# with C<use lib 'bin'; require fetchware; fetchware->import();>, and it
# bypasses a limitation in dzil regarding creating the POD properly.

package fetchware;
our $VERSION = '1.016'; # VERSION: generated by DZP::OurPkgVersion
# ABSTRACT: Fetchware is a package manager for source code distributions.
use strict;
use warnings;

# 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;

# Must change umask to prevent group and other from having writer permissions to
# files created by fetchware, because it's stupid to have fetchware potentially
# create files that it can't read back in, because they fail fetchware's
# security checks. It's also a potential security risk.
umask 0022;

# Use Getopt::Long for options parsing beyond fetchware's simple commands such
# as install, new, uninstall, help, and so on.
use Getopt::Long qw(:config bundling pass_through);
###BUGALERT### This breaks App::Fetchware's encapsulation, and screws up its API
#fix this bug by extracting the fetchwarefile without relying on start() having
#already created the temp directory!!!!!!
use App::Fetchware qw(parse_directory_listing);
use App::Fetchware::Config qw(config __clear_CONFIG config_replace);
use App::Fetchware::Util qw(:UTIL);
use Test::Fetchware 'create_test_fetchwarefile';
use App::Fetchware::Fetchwarefile;
use Archive::Tar;
use File::Copy qw(mv cp);
use File::Spec::Functions qw(curdir catdir catfile catpath tmpdir splitpath
    splitdir rel2abs abs2rel updir file_name_is_absolute);
use Cwd 'cwd';
use File::Path qw(make_path remove_tree);
use Term::UI;
use Term::ReadLine;
use Perl::OSType 'is_os_type';
use File::HomeDir;
use File::Find 'find';
use File::Temp 'tempfile';
use Fcntl qw(SEEK_SET);
use Path::Class;
use Text::Wrap 'wrap';
use Data::Dumper;
use Fcntl ':flock';
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use Sub::Mage;
use URI::Split qw(uri_split uri_join);
use Scalar::Util 'blessed';
use Module::Load 'load';

# Setup exports, which are only meant to ease testing.
use Exporter 'import';
our %EXPORT_TAGS  = (
    TESTING => [qw(
        parse_fetchwarefile    
        create_fetchware_package
        fetchware_database_path
        determine_fetchware_package_path
        extract_fetchwarefile
        copy_fpkg_to_fpkg_database
        cmd_install
        cmd_uninstall
        cmd_look
        cmd_list
        cmd_upgrade
        cmd_upgrade_all
        cmd_new
        cmd_clean
        run
    )]
);
our @EXPORT_OK = @{$EXPORT_TAGS{TESTING}};

our $verbose = 0;
our $quiet = 0;
our $dry_run = 0;

# Be a modulino, so I can "use fetchware" in my test suite, so I can test
# bin/fetchware normally like any other perl module.
###BUGALERT## Add a test suite for run(), and also one that directly calls
#bin/fetchware to test its command line options.
run() unless caller();

sub run {
    # Set up a %SIG handler for CTRL-C or CTRL-Z on Windows.
    # And a %SIG handler for QUIT, which is CTRL-\
    #
    # Define a $parent_pid, so I can compare it to $$ (the current pid) to
    # see if I'm the child or the parent inside the sig handler to act
    # accordingly.
    my $parent_pid = $$;
    #
    # Be sure to prepend the first message that's printed with a newline to
    # ensure that it's printed on a brand new fresh line.
    @SIG{qw(INT TERM QUIT)} = sub {
        my $sig = shift;
        # Avoid a silly race condition where both the parent and the child both
        # try to run this code at the same time resulting in the one closing the
        # file and deleting the tempdir() before the other one resulting in
        # strange undefined warnings.
        #
        if ($parent_pid == $$) {
            msg <<EOM;