view release on metacpan or  search on metacpan

bin/fetchware  view on Meta::CPAN

#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;
\nSignal [$sig] received. Cleaning up Fetchware.
EOM
            vmsg <<EOM;
Any temporary files that fetchware may have created will be deleted by
File::Temp's END block.
EOM

            cleanup_tempdir();
        }

        # Exit failure, because fetchware failed to properly install your
        # software while it was running, because the signal it received forced
        # it to exit prematurely making it questionable if fetchware succeeded
        # in properly and completely completing the actions you specified on the
        # command line and/or in a Fetchwarefile.
        exit 1;
    };

    vmsg 'Parsing command line options using Getopt::Long';

    GetOptions(
        # $VERSION is managed by dzil; therefore, I use eval to access it at
        # run time instead of compile time, so that I can test fetchware without
        # running dzil test.
        'version|V' => sub { eval 'say "Fetchware version $fetchware::VERSION"; '; exit 0},
        'help|h|?' => \&cmd_help,
        'verbose|v' => \$verbose,
        'quiet|q' => \$quiet,
        # Expose File::Temp's KEEP_ALL flag, and an easy feature to implement
        # that lets users easily ensure the tempdir stays around when needed.
        'keep-temp|K' => \$File::Temp::KEEP_ALL,
        ###BUGALERT### dry-run functionality is *not* implemented!!!
        #'dry-run|d' => \$dry_run,
    );


    # Getopt::Long is *only* used to determine dash and double dash style options
    # such as -v, --verbose, --help, -h, -?, etc....
    #