File Coverage

blib/lib/App/Fetchware.pm

Criterion	Covered	Total	%
statement	493	983	50.1
branch	202	466	43.3
condition	17	78	21.7
subroutine	94	121	77.6
pod	76	76	100.0
total	882	1724	51.1

package App::Fetchware;
$App::Fetchware::VERSION = '1.014';
# ABSTRACT: App::Fetchware is Fetchware's API used to make extensions.
###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;

# CPAN modules making Fetchwarefile better.
use File::Spec::Functions qw(catfile splitpath splitdir file_name_is_absolute);
use Path::Class;
use Data::Dumper;
use File::Copy 'cp';
use HTML::TreeBuilder;
use Scalar::Util qw(blessed looks_like_number);
use Digest::SHA;
use Digest::MD5;
#use Crypt::OpenPGP::KeyRing;
#use Crypt::OpenPGP;
use Archive::Tar;
use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
use Cwd 'cwd';
use Sub::Mage;
use URI::Split qw(uri_split uri_join);
use Text::ParseWords 'quotewords';
use File::Temp 'tempfile';
use Term::ReadLine;
use Term::UI;

use App::Fetchware::Util ':UTIL';
use App::Fetchware::Config ':CONFIG';

# 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's API to everyone who use's it
# including fetchware's ability to let you rip into its guts, and customize it
# as you need.
use Exporter qw( import );
# By default fetchware exports its configuration file like subroutines.
#
# These days popular dogma considers it bad to import stuff without being asked
# to do so, but App::Fetchware is meant to be a configuration file that is both
# human readable, and most importantly flexible enough to allow customization.
# This is done by making the configuration file a perl source code file called a
# Fetchwarefile that fetchware simply executes with eval.
our @EXPORT = qw(
    program
    filter
    temp_dir
    fetchware_db_path
    user
    prefix
    configure_options
    make_options
    build_commands
    install_commands
    uninstall_commands
    lookup_url
    lookup_method
    gpg_keys_url
    gpg_sig_url
    sha1_url
    md5_url
    user_agent
    verify_method
    no_install
    verify_failure_ok
    user_keyring
    stay_root
    mirror
    config

    new
    new_install
    check_syntax
    start
    lookup
    download
    verify
    unarchive
    build
    install
    end
    uninstall
    upgrade

    hook
);

# These tags allow you to replace some or all of fetchware's default behavior to
# install unusual software.
our %EXPORT_TAGS = (
    # No OVERRIDE_START OVERRIDE_END because start() does *not* use any helper
    # subs that could be beneficial to override()rs.
    OVERRIDE_NEW => [qw(
        extension_name
        fetchwarefile_name
        opening_message
        get_lookup_url
        download_lookup_url
        get_mirrors
        get_verification
        get_filter_option
        append_to_fetchwarefile
        prompt_for_other_options
        append_options_to_fetchwarefile
        edit_manually
    )],
    OVERRIDE_NEW_INSTALL => [qw(
        ask_to_install_now_to_test_fetchwarefile
    )],
    OVERRIDE_CHECK_SYNTAX => [qw(
        check_config_options
    )],
    OVERRIDE_LOOKUP => [qw(
        get_directory_listing
        parse_directory_listing
        determine_download_path
        ftp_parse_filelist
        http_parse_filelist
        file_parse_filelist
        lookup_by_timestamp
        lookup_by_versionstring
        lookup_determine_downloadpath
    )],
    OVERRIDE_DOWNLOAD => [qw(
        determine_package_path
    )],
    OVERRIDE_VERIFY => [qw(
        gpg_verify
        sha1_verify
        md5_verify
        digest_verify
    )],
    OVERRIDE_UNARCHIVE => [qw(
        check_archive_files
        list_files
        list_files_tar
        list_files_zip
        unarchive_package
        unarchive_tar
        unarchive_zip
    )],
    OVERRIDE_BUILD => [qw(
        run_star_commands
        run_configure
    )],
    OVERRIDE_INSTALL => [qw(
        chdir_unless_already_at_path
    )],
    OVERRIDE_UNINSTALL => [qw()],
    OVERRIDE_UPGRADE => [qw()],
);
# OVERRIDE_ALL is simply all other tags combined.
@{$EXPORT_TAGS{OVERRIDE_ALL}} = map {@{$_}} values %EXPORT_TAGS;
# *All* entries in @EXPORT_TAGS must also be in @EXPORT_OK.
our @EXPORT_OK = @{$EXPORT_TAGS{OVERRIDE_ALL}};




###BUGALERT### Add strict argument checking to App::Fetchware's API subroutines
#to check for not being called correctly to aid extension debugging.



###BUGALERT### Recommend installing http://gpg4win.org if you use fetchware on
# Windows so you have gpg support.






# _make_config_sub() is an internal subroutine that only App::Fetchware and
# App::Fetchware::CreateConfigOptions should use. Use
# App::Fetchware::CreateConfigOptions to create any configuration option
# subroutines that you want your fetchware extensions to have.
#=head2 _make_config_sub()
#
#    _make_config_sub($name, $one_or_many_values)
#
#A function factory that builds many functions that are the exact same, but have
#different names. It supports three types of functions determined by
#_make_config_sub()'s second parameter.  It's first parameter is the name of that
#function. This is the subroutine that builds all of Fetchwarefile's
#configuration subroutines such as lookupurl, mirror, fetchware, etc....
#
#=over
#=item LIMITATION
#
#_make_config_sub() creates subroutines that have prototypes, but in order for
#perl to honor those prototypes perl B know about them at compile-time;
#therefore, that is why _make_config_sub() must be called inside a C block.
#
#=back
#
#=over
#=item NOTE
#_make_config_sub() uses caller to determine the package that _make_config_sub()
#was called from. This package is then prepended to the string that is eval'd to
#create the designated subroutine in the caller's package. This is needed so that
#App::Fetchware "subclasses" can import this function, and enjoy its simple
#interface to create custom configuration subroutines.
#
#=back
#
#=over
#
#=item $one_or_many_values Supported Values
#
#=over
#
#=item * 'ONE'
#
#Generates a function with the name of _make_config_sub()'s first parameter that
#can B be called one time per Fetchwarefile. If called more than one time
#will die with an error message.
#
#Function created with C<$CONFIG{$name} = $value;> inside the generated function that
#is named $name.
#
#=item * 'ONEARRREF'
#
#Generates a function with the name of _make_config_sub()'s first parameter that
#can B be called one time per Fetchwarefile. And just like C<'ONE'> above
#if called more than once it will throw an exception. However, C<'ONEARRREF'> can
#be called with a list of values just like C<'MANY'> can, but it can still only
#be called once like C<'ONE'>.
#
#=item * 'MANY'
#
#Generates a function with the name of _make_config_sub()'s first parameter that
#can be called more than just once. This option is only used by fetchware's
#C API call.
#
#Function created with C inside the generated function that
#is named $name.
#
#=item * 'BOOLEAN'
#
#Generates a function with the name of _make_config_sub()'s first parameter that
#can be called only once just like 'ONE' can be, but it also only support true or
#false values.  What is true and false is the same as in perl, with the exception
#that /false/i and /off/i are also false.
#
#Function created the same way as 'ONE''s are, but with /false/i and /off/i
#mutated into a Perl accepted false value (they're turned into zeros.).
#
#=back
#
#=back
#
#All API subroutines fetchware provides to Fetchwarefile's are generated by
#_make_config_sub() except for fetchware() and override().
#
#=cut

    my @api_functions = (
        [ program => 'ONE' ],
        [ filter => 'ONE' ],
        [ temp_dir => 'ONE' ],
        [ fetchware_db_path => 'ONE' ],
        [ user => 'ONE' ],
        [ prefix => 'ONE' ],
        [ configure_options=> 'ONEARRREF' ],
        [ make_options => 'ONEARRREF' ],
        [ build_commands => 'ONEARRREF' ],
        [ install_commands => 'ONEARRREF' ],
        [ uninstall_commands => 'ONEARRREF' ],
        [ lookup_url => 'ONE' ],
        [ lookup_method => 'ONE' ],
        [ gpg_keys_url => 'ONE' ],
        [ gpg_sig_url => 'ONE' ],
        [ sha1_url => 'ONE' ],
        [ md5_url => 'ONE' ],
        [ user_agent => 'ONE' ],
        [ verify_method => 'ONE' ],
        [ mirror => 'MANY' ],
        [ no_install => 'BOOLEAN' ],
        [ verify_failure_ok => 'BOOLEAN' ],
        [ stay_root => 'BOOLEAN' ],
        [ user_keyring => 'BOOLEAN' ],
    );


# Loop over the list of options needed by _make_config_sub() to generated the
# needed API functions for Fetchwarefile.
    for my $api_function (@api_functions) {
        _make_config_sub(@{$api_function});
    }


sub _make_config_sub {
    my ($name, $one_or_many_values, $callers_package) = @_;

    # Obtain caller's package name, so that the new configuration subroutine
    # can be created in the caller's package instead of our own. Use the
    # specifed $callers_package if the caller specified one. This allows
    # create_config_options() to reuse _make_config_sub() by passing in its
    # caller to _make_config_sub().
    my $package = $callers_package // caller;

    die <
App-Fetchware: internal syntax error: _make_config_sub() was called without a
name. It must receive a name parameter as its first paramter. See perldoc
App::Fetchware.
EOD
    unless ($one_or_many_values eq 'ONE'
            or $one_or_many_values eq 'ONEARRREF',
            or $one_or_many_values eq 'MANY'
            or $one_or_many_values eq 'BOOLEAN') {
        die <
App-Fetchware: internal syntax error: _make_config_sub() was called without a
one_or_many_values parameter as its second parameter. Or the parameter it was
called with was invalid. Only 'ONE', 'MANY', and 'BOOLEAN' are acceptable
values. See perldoc App::Fetchware.
EOD
    }

    if ($one_or_many_values eq 'ONE') {
        my $eval = <<'EOE';
package $package;

sub $name (@) {
    my $value = shift;

    die <
App-Fetchware: internal syntax error: $name was called more than once in this
Fetchwarefile. Currently only mirror supports being used more than once in a
Fetchwarefile, but you have used $name more than once. Please remove all calls
to $name but one. See perldoc App::Fetchware.
EOD
    unless (@_) {
        config('$name', $value);
    } else {
        die <
App-Fetchware: internal syntax error. $name was called with more than one
option. $name only supports just one option such as '$name 'option';'. It does
not support more than one option such as '$name 'option', 'another option';'.
Please chose one option not both, or combine both into one option. See perldoc
App::Fetchware.
EOD
    }
}
1; # return true from eval
EOE
        $eval =~ s/\$name/$name/g;
        $eval =~ s/\$package/$package/g;
        eval $eval or die <
1App-Fetchware: internal operational error: _make_config_sub()'s internal eval()
call failed with the exception [$@]. See perldoc App::Fetchware.
EOD
    } elsif ($one_or_many_values eq 'ONEARRREF') {
        my $eval = <<'EOE';
package $package;

sub $name (@) {
    my $value = shift;

    die <
App-Fetchware: internal syntax error: $name was called more than once in this
Fetchwarefile. Currently only mirror supports being used more than once in a
Fetchwarefile, but you have used $name more than once. Please remove all calls
to $name but one. See perldoc App::Fetchware.
EOD
    unless (@_) {
        config('$name', $value);
    } else {
        config('$name', $value, @_);
    }
}
1; # return true from eval
EOE
        $eval =~ s/\$name/$name/g;
        $eval =~ s/\$package/$package/g;
        eval $eval or die <
2App-Fetchware: internal operational error: _make_config_sub()'s internal eval()
call failed with the exception [$@]. See perldoc App::Fetchware.
EOD
    } elsif ($one_or_many_values eq 'MANY') {
        my $eval = <<'EOE';
package $package;

sub $name (@) {
    my $value = shift;

    # Support multiple arguments specified on the same line. like:
    # mirror 'http://djfjf.com/a', 'ftp://kdjfjkl.net/b';
    unless (@_) {
        config('$name', $value);
    } else {
        config('$name', $value, @_);
    }
}
1; # return true from eval
EOE
        $eval =~ s/\$name/$name/g;
        $eval =~ s/\$package/$package/g;
        eval $eval or die <
3App-Fetchware: internal operational error: _make_config_sub()'s internal eval()
call failed with the exception [\$@]. See perldoc App::Fetchware.
EOD
    } elsif ($one_or_many_values eq 'BOOLEAN') {
        my $eval = <<'EOE';
package $package;

sub $name (@) {
    my $value = shift;

    die <
App-Fetchware: internal syntax error: $name was called more than once in this
Fetchwarefile. Currently only mirror supports being used more than once in a
Fetchwarefile, but you have used $name more than once. Please remove all calls
to $name but one. See perldoc App::Fetchware.
EOD
    # Make extra false values false (0). Not needed for true values, because
    # everything but 0, '', and undef are true values.
    if ($value =~ /false/i) {
        $value = 0;
    } elsif ($value =~ /off/i) {
        $value = 0;
    }

    unless (@_) {
        config('$name', $value);
    } else {
        die <
App-Fetchware: internal syntax error. $name was called with more than one
option. $name only supports just one option such as '$name 'option';'. It does
not support more than one option such as '$name 'option', 'another option';'.
Please chose one option not both, or combine both into one option. See perldoc
App::Fetchware.
EOD
    }
}
1; # return true from eval
EOE
        $eval =~ s/\$name/$name/g;
        $eval =~ s/\$package/$package/g;
        eval $eval or die <
4App-Fetchware: internal operational error: _make_config_sub()'s internal eval()
call failed with the exception [\$@]. See perldoc App::Fetchware.
EOD
    }
}






sub new {
    my ($term, $program_name) = @_;

    # Instantiate a new Fetchwarefile object for managing and generating a
    # Fetchwarefile, which we'll write to a file for the user or use to
    # build a associated Fetchware package.
    my $now = localtime;
    my $fetchwarefile = App::Fetchware::Fetchwarefile->new(
        header => <
use App::Fetchware;
# Auto generated $now by fetchware's new command.
# However, feel free to edit this file if fetchware's new command's
# autoconfiguration is not enough.
#
# Please look up fetchware's documentation of its configuration file syntax at
# perldoc App::Fetchware, and only if its configuration file syntax is not
# malleable enough for your application should you resort to customizing
# fetchware's behavior. For extra flexible customization see perldoc
# App::Fetchware.
EOF
        descriptions => {

            program => <
program simply names the program the Fetchwarefile is responsible for
downloading, building, and installing.
EOA
            filter => <
filter specifies a program name and/or version number that tells fetchware
which program and or which version of a program you want fetchware to install.
This is *only* needed in cases where there are multiple programs and or
multiple versions of the same program in the directory lookup_url specifies.
EOA
            temp_dir => <
temp_dir specifies what temporary directory fetchware will use to download and
build this program.
EOA
            user => <
user specifes a user that fetchware will drop priviledges to when fetchware
downloads and builds your software. It will then switch back to root privs, if
run as root, and install your software system wide. This does not work on
Windows.
EOA
            fetchware_database_path => <
fetchware_database_path specifies an alternate path for fetchware to use to
store the fetchware package that 'fetchware install' creates, and that
'fetchware upgrade' uses to upgrade this fetchware package.
EOA
            prefix => <
prefix specifies what base path your software will be installed under. This
only works for software that uses GNU AutoTools to configure itself, it uses
./configure.
EOA
            configure_options => <
configure_options specifes what options fetchware should pass to ./configure
when it configures your software. This option only works for software that
uses GNU AutoTools.
EOA
            make_options => <
make_options specifes what options fetchware should pass to make when make is
run to build and install your software.
EOA
            build_commands => <
build_commands specifies what commands fetchware should execute to build your
software.
EOA
            install_commands => <
install_commands specifies what commands fetchware should execute to install
your software.
EOA
            uninstall_commands => <
uninstall_commands specifies what commands fetchware should execute to uninstall
your software.
EOA
            lookup_url => <
lookup_url specifes the url that fetchware uses to determine what what
versions of your program are available. It should point to a directory listing
instead of a specific file.
EOA
            lookup_method => <
lookup_method specifies how fetchware determines what version of your program
to install. The default is the 'timestamp' algorithm, and then to try the
'versionstring' algorithm if 'timestamp' fails. lookup_method specifies which
one you would like to use. Only the strings 'timestamp' and 'versionstring'
are allowed options.
EOA
            gpg_keys_url => <
gpg_keys_url specifies the url that fetchware will use to download the author's
KEYS file that it uses for gpg verification.
EOA
            gpg_sig_url => <
gpg_sig_url specifies the url that fetchware uses to download digital
signatures of this program. They're files that usually end .asc.
EOA
            sha1_url => <
sha1_url specfies the url that fetchware uses to download sha1sum files of
this program. This url should be the program's main download site instead of a
mirror, because a hacked mirror could alter the sha1sum on that mirror.
EOA
            md5_url => <
md5_url specfies the url that fetchware uses to download md5sum files of
this program. This url should be the program's main download site instead of a
mirror, because a hacked mirror could alter the md5sum on that mirror.
EOA
            verify_method => <
verify_method specifes a specific method that fetchware should use to verify
your program. This method can be 'gpg', 'sha1', or 'md5'.
EOA
            no_install => <
no_install specifies that this software should not be installed. Instead, the
install step is skipped, and fetchware prints to STDOUT where it downloaded,
verified, and built your program. no_install must be a true or false value.
EOA
            verify_failure_ok => <
verify_failure_ok specifies that fetchware should not stop installing your
software and terminate with an error message if fetchware fails to verify your
software. You should never set this to true. Doing so could cause fetchware to
install software that may have been compromised, or had malware inserted into
it. Never use this option unless the author or maintainer of this program does
not gpg sign or checksum his software.
EOA
            user_keyring => <
users_keyring if enabled causes fetchware to use the user's own gpg keyring
instead of fetchware's own keyring.
EOA
            mirror => <
The mirror configuration option provides fetchware with alternate servers to
try to download this program from. This option is used when the server
specified in the url options in this file is unavailable or times out.
EOA
        }
    );
    ###INSANEFEATUREENHANCEMENT### Prompt for name of program, and do a fuzzy
    #search on CPAN for that program under
    #App::Fetchware::FetchwarefileX::UpCasedProgName. Consider using the meta
    #CPAN API. And if it exists ask user if they wanna use that one instead of
    #autogening one.
    #
    #Perhaps create a 'fetchwarefile' command to download and look at
    #fetchwarefiles from CPAN, and then install them, and/or perhaps upload
    #them pausing to ask for the user's PAUSE credentials!!!!!!!!!


    extension_name(__PACKAGE__);


    my $opening_message = <
Fetchware's new command is reasonably sophisticated, and is smart enough to
determine based on the lookup_url you provide if it can autogenerate a
Fetchwarefile for you. If Fetchware cannot, then it will ask you more
questions regarding the information it requires to be able to build a
installable fetchware package for you. After that, fetchware will ask you if
you would like to edit the Fetchwarefile, fetchware has created for you in an
editor. If you say yes, fetchware will open a editor for you, but if you say
no, fetchware will skip the custom editing. Next, fetchware will create a test
Fetchwarefile for you, and ask you if you would like to test it by trying to
install it now. If you say yes, fetchware will install it, and if you say no,
then fetchware will print the location of the Fetchwarefile it created for
you to later use to install your application.
EOM

    opening_message($opening_message);

    # Ask user for name of program unless the user provided one at command
    # line such as fetchware new .
    $program_name = fetchwarefile_name(program => $program_name);
    vmsg "Determined name of your program to be [$program_name]";

    $fetchwarefile->config_options(program => $program_name);
    vmsg "Appended program [$program_name] configuration option to Fetchwarefile";

    my $lookup_url = get_lookup_url($term);
    vmsg "Asked user for lookup_url [$lookup_url] from user.";

    $fetchwarefile->config_options(lookup_url => $lookup_url);
    vmsg "Appended lookup_url [$lookup_url] configuration option to Fetchwarefile";

    vmsg "Downloaded lookup_url [$lookup_url]";
    my $filename_listing = download_lookup_url($term, $lookup_url);
    vmsg "Downloaded lookup_url's directory listing";
    vmsg Dumper($filename_listing);

    my $mirrors_hashref = get_mirrors($term, $filename_listing);
    vmsg "Added mirrors to your Fetchwarefile.";
    vmsg Dumper($mirrors_hashref);

    my $verify_hashref = get_verification($term, $filename_listing, $lookup_url);
    vmsg "Added verification settings to Fetchwarefile.";
    vmsg Dumper($verify_hashref);

    my $filter_hashref = get_filter_option($term, $filename_listing);
    vmsg "Added [$filter_hashref->{filter}] filter setting to Fetchwarefile.";

    $fetchwarefile->config_options(
        %$mirrors_hashref,
        %$verify_hashref,
        %$filter_hashref
    );

    ###BUGALERT### Ask to parrallelize make with make_options???
    ###BUGALERT### Verify prefix is writable by current user, who will
    #presumably be the user who will install the package now and later.
    ###BUGALERT### Ask user for a prefix if their running nonroot???
    vmsg 'Prompting for other options that may be needed.';
    my $other_options_hashref = prompt_for_other_options($term,
        temp_dir => {
            prompt => <
What temp_dir configuration option would you like?
EOP
            print_me => <
temp_dir is the directory where fetchware creates a temporary directory that
stores all of the temporary files it creates while it is building your software.
The default directory is /tmp on Unix systems and C:\\temp on Windows systems.
EOP
        },
        user => {
            prompt => <
What user configuration option would you like?
EOP
            print_me => <
user specifies what user fetchware will drop priveleges to on Unix systems
capable of doing so. This allows fetchware to download files from the internet
with user priveleges, and not do anything as the administrative root user until
after the downloaded software package has been verified as exactly the same as
the author of the package intended it to be. If you use this option, the only
thing that is run as root is 'make install' or whatever this package's
install_commands configuratio option is.
EOP
        },
        prefix => {
            prompt => <
What prefix configuration option would you like?
EOP
            print_me => <
prefix specifies the base path that will be used to install this software. The
default is /usr/local, which is acceptable for most unix users. Please note that
this difective only works for software packages that use GNU AutoTools, software
that uses ./configure --prefix= to change the prefix.
EOP
        },
        configure_options => {
            prompt => <
What configure_options configuration option would you like?
EOP
            print_me => <
configure_options specifies what options fetchware should add when it configures
this software package for you. A list of possible options can be obtained by
running unarchiving the software package that corresponds to this Fetchwarefile,
and running the command './configure --help'. These options vary from software
package to software package. Please note that this option only works for GNU
AutoTools based software distributions, ones that use ./configure to configure
the software.
EOP
        },
        make_options => {
            prompt => <
What make_options configuration option would you like?
EOP
            print_me => <
make_options specifies what options fetchware will pass to make when make is run
to compile, perhaps test, and install your software package. They are simpley
added after make is called. An example is '-j 4', which will cause make to
execute 4 jobs simultaneously. A reasonable rule of thumb is to set make's -j
argument to two times as many cpu cores your computer has as compiling programs
is sometimes IO bound instead of CPU bound, so you can get away with running
more jobs then you have cores.
EOP
        },
###BUGALERT### Create a config sub called build_system that takes args like
#AutoTools, cmake, MakeMaker, Module::Build, and so on that will use the default
#build commands of whatever system this option specifies.
        build_commands => {
            prompt => <
What build_commands configuration option would you like?
EOP
            print_me => <
build_commands specifies what commands fetchware will run to compile your
software package. Fetchware's default is simply 'make', which is good for most
programs. If you're software package uses something other than fetchware's
default of GNU AutoTools, then you may need to change this configuration option
to specify what you would like instead. Specify multiple build commands in
single quotes with a comma between them:
'./configure', 'make'
EOP
        },
        install_commands => {
            prompt => <
What install_commands configuration option would you like?
EOP
            print_me => <
install_commands specifies what commands fetchware will run to install your
software package. Fetchware's default is simply 'make install', which is good
for most programs. If you're software package uses something other than
fetchware's default of GNU AutoTools, then you may need to change this
configuration option to specify what you would like instead. Specify multiple
build commands in single quotes with a comma between them:
'make test', 'make install'
EOP
        },
        uninstall_commands => {
            prompt => <
What uninstall_commands configuration option would you like?
EOP
            print_me => <
uninstall_commands specifes what commands fetchware will run to uninstall your
software pacakge. The default is 'make uninstall,' which works for some GNU
AutoTools packages, but not all. If your software package does not have a 'make
uninstall' make target, but it has some other command that can uninstall it,
then please specify it using uninstall_commands so fetchware can uninstall it.
EOP

        },
        lookup_method => {
            prompt => <
What lookup_method configuration option would you like?
EOP
            print_me => <
lookup_method specifies what how fetchware determines if a new version of your
software package is available. The available algorithms are 'timstamp' and
'versionstring'. 'timestamp' uses the timestamp listed in the FTP or HTTP
listing, and uses the software package that is the newest by filesystem
timestamp. The 'versionstring' algorithm uses the filename of the files in the
FTP or HTTP listing. It parses out the version information, sorts it highest to
lowest, and then picks the highest version of your software package. The default
is try 'timestamp' and if that doesn't work, then try 'versionstring'.
EOP
        },
        gpg_keys_url => {
            prompt => <
What gpg_keys_url configuration option would you like?
EOP
            print_me => <
gpg_keys_url specifies a url similar to lookup_url in that it should specify a
directory instead a specific file. It is used to download KEYS files, which
contain your program author's gpg keys to import into gpg.
EOP
        },
        gpg_sig_url => {
            prompt => <
What gpg_sig_url configuration option would you like?
EOP
            print_me => <
gpg_sig_url specifies a url similar to lookup_url in that it should specify a
directory instead a specific file. It is used to download gpg signatures to
verify your software package.
EOP
        },
        sha1_url => {
            prompt => <
What sha1_url configuration option would you like?
EOP
            print_me => <
sha1_url specifies a url similar to lookup_url in that it should specify a
directory instead of a specific file. It is separate from lookup_url, because
you should download software from mirrors, but checksums from the original
vendor's server, because checksums are easily replaced on a mirror by a hacker
if the mirror gets hacked.
EOP
        },
        md5_url => {
            prompt => <
What md5_url configuration option would you like?
EOP
            print_me => <
md5_url specifies a url similar to lookup_url in that it should specify a
directory instead of a specific file. It is separate from lookup_url, because
you should download software from mirrors, but checksums from the original
vendor's server, because checksums are easily replaced on a mirror by a hacker
if  the mirror gets hacked.
EOP
        },
        verify_method => {
            prompt => <
What verify_method configuration option would you like?
EOP
            print_me => <
verify_method specifies what method of verification fetchware should use to
ensure the software you have downloaded has not been tampered with. The default
is to try gpg verification, then sha1, and then finally md5, and if they all
fail an error message is printed and fetchware exits, because if your software
package cannot be verified, then it should not be installed. This configuration
option allows you to remove the warnings by specifying a specific way of
verifying your software has not been tampered with. To disable verification set
the 'verify_failure_ok' configuration option to true.
EOP
        },
###BUGALERT### replace no_install config su with a command line option that
#would be the opposite of --force???
# Nah! Leave it! Just create a command line option for it too!
        no_install => {
            prompt => <
Would you like to enable the no_install configuration option?
EOP
            ###BUGALERT### no_install is not currently implemented properly!!!
            print_me => <
no_install is a true or false option, whoose acceptable values include 1
or 0, true or falue, On or Off. It's default value is false, but if you enable
it, then fetchware will not install your software package, and instead it will
simply download, verify, and build it. And then it will print out the full path
of the directory it built your software package in.
EOP
            ###BUGALERT### Add support for a check regex, so that I can ensure
            #that what the user enters will be either true or false!!!
        },
        verify_failure_ok => {
            prompt => <
Would you like to enable the verify_failure_ok configuration option?
EOP
            print_me => <
verify_failure_ok is a true or false option, whoose acceptable values include 1
or 0, true or falue, On or Off. It's default value is false, but if you enable
it, then fetchware will not print an error message and exit if verification
fails for your software package. Please note that you should never use this
option, because it makes it possible for fetchware to install source code that
may have been tampered with.
EOP
        },
        users_keyring => {
            prompt => <
Would you like to enable users_keyring configuration option?
EOP
            print_me => <
users_keyring when enabled causes fetchware to use the user who calls
fetchware's gpg keyring instead of fetchware's own gpg keyring. Useful for
source code distributions that do not provide an easily accessible KEYS file.
Just remember to import the author's keys into your gpg keyring with gpg
--import.
EOP
        },
    );
    vmsg 'User entered the following options.';
    vmsg Dumper($other_options_hashref);

    # Append all other options to the Fetchwarefile.
    $fetchwarefile->config_options(%$other_options_hashref);
    vmsg 'Appended all other options listed above to Fetchwarefile.';

    my $edited_fetchwarefile = edit_manually($term, $fetchwarefile);
    vmsg <
Asked user if they would like to edit their generated Fetchwarefile manually.
EOM
    # Generate Fetchwarefile.
    if (blessed($edited_fetchwarefile)
        and
    $edited_fetchwarefile->isa('App::Fetchware::Fetchwarefile')) {
        # If edit_manually() did not modify the Fetchwarefile, then generate
        # it.
        $fetchwarefile = $fetchwarefile->generate();
    } else {
        # If edit_manually() modified the Fetchwarefile, then do not
        # generate it, and replace the Fetchwarefile object with the new
        # string that represents the user's edited Fetchwarefile.
        $fetchwarefile = $edited_fetchwarefile;
    }

    # Whatever variables the new() API subroutine returns are written via a pipe
    # back to the parent, and then the parent reads the variables back, and
    # makes then available to new_install(), back in the parent, as arguments.
    return $program_name, $fetchwarefile;
}






sub extension_name {
    # Use a state variable to keep $extension_name's value between calls.
    state $extension_name;

    # If $extension_name has never been touch and is still undef, then allow it
    # to be set.
    if (not defined $extension_name) {
        $extension_name = shift;
    # If $extension_name *is* set, and extension_name() was called with an
    # argument, which is what defined shift does (shift shifts the first value
    # off of @_ (the subroutine argument array), while defined checks to see if
    # one was actually defined and provided by the caller.)
    } elsif (defined $extension_name and defined shift) {
        die <
App-Fetchware: extension_name() was called more than once. It is a singleton,
and therefore can only be called once. Please only call it once to set its
value, and then call it repeatedly wherever you need that value. see perldoc
App::Fetchware for more details.
EOD
    }

    # Return the singleton $extension_name.
    return $extension_name;
}



sub opening_message {
    my $opening_message = shift;

    # Just print the opening message.
    print $opening_message;
}



sub fetchwarefile_name {
    my ($term, $fetchwarefile_name, $fetchwarefile_name_value) = @_;
    my $what_a_fetchwarefile_name_is = <
Fetchware uses the $fetchwarefile_name configuration option to name this
specific Fetchwarefile that Fetchware's new command is helping you create.
Since, you did not provide a $fetchwarefile_name on the command line, please
provide one below
EOM
    die <
App-Fetchware: in your call to fetchwarefile_name() you failed to call it with a
defined \$fetchwarefile_name option. The \$fetchwarefile_name option you
specified is [$fetchwarefile_name]. Please specify this option, and try again.
EOD

    if (not defined $fetchwarefile_name_value) {
        $fetchwarefile_name_value = $term->get_reply(
            prompt => q{What would you like to name this specific Fetchwarefile? },
            print_me => $what_a_fetchwarefile_name_is,
            # This option requires a name, so just pressing return, which would
            # yield undef is not acceptable. We need an actual value, so check
            # the value to ensure that it is defined.
            allow => sub { defined shift @_ ? return 1 : return 0 }
        );
    }

    return $fetchwarefile_name, $fetchwarefile_name_value;
}



sub get_lookup_url {
    my $term = shift;


    # prompt for lookup_url.
    my $lookup_url = $term->get_reply(
        print_me => <
Fetchware's heart and soul is its lookup_url. This is the configuration option
that tells fetchware where to check what the latest version of your program is.
This version number is then parsed out of the HTTP/FTP/local directory listing,
and compared against the latest installed version to determine when a new
version of your program has been released.

How to determine your application's lookup_url:
    1. Go to your application's Web site.
    2. Determine the download link for the latest version and copy it with
       CTRL-C or right-click it and select "copy".
    3. Paste the download link into your browser's URL Location Bar.
    4. Delete the filename from the location by starting at the end and deleting
       everything to the left until you reach a slash '/'.
       * ftp://a.url/downloads/program.tar.gz -> ftp://a.url/downloads/
    5. Press enter to access the directory listing on your Application's mirror
       site.
    6. If the directory listing in either FTP or HTTP format is displayed in
       your browser, then Fetchware's default, built-in lookup fuctionality will
       probably work properly. Copy and paste this URL into the prompt below, and
       Fetchware will download and analyze your lookup_url to see if it will work
       properly. If you do not end up with a browser directory listing, then
       please see Fetchware's documentation using perldoc App::Fetchware.
EOP
        prompt => q{What is your application's lookup_url? },
        allow => qr!(ftp|http|file)://!);

    return $lookup_url;
}



sub download_lookup_url {
    my $term = shift;
    my $lookup_url = shift;

    my $filename_listing;
    eval {
        # Use no_mirror_download_dirlist(), because the regular one uses
        # config(qw(lookup_url mirror)), which is not known yet.
        my $directory_listing = no_mirror_download_dirlist($lookup_url);

        # Create a fake lookup_url, because parse_directory_listing() uses it to
        # determine the type of *_filename_listing() subroutine to call.
        config(lookup_url => $lookup_url);

        $filename_listing = parse_directory_listing($directory_listing);

        __clear_CONFIG();

        # Fix the most annoying bug that ever existed in perl.
        # http://blog.twoshortplanks.com/2011/06/06/unexceptional-exceptions-in-perl-5-14/
        1;
    } or do {
        my $lookup_url_failed_try_again = <
fetchware: the lookup_url you provided failed because of :
[$@]
Please try again. Try the steps outlined above to determine what your program's
lookup_url should be. If you cannot figure out what it should be please see
perldoc @{[extension_name()]} for additional hints on how to choose a lookup_url.
EOF
        $lookup_url = get_lookup_url($term, $lookup_url_failed_try_again);

        eval {
            # Use no_mirror_download_dirlist(), because the regular one uses
            # config(qw(lookup_url mirror)), which is not known yet.
            my $dir_list = no_mirror_download_dirlist($lookup_url);

            # Create a fake lookup_url, because parse_directory_listing() uses
            # it to determine the type of *_filename_listing() subroutine to
            # call.
            config(lookup_url => $lookup_url);

            $filename_listing = parse_directory_listing($dir_list);

            __clear_CONFIG();
        # Fix the most annoying bug that ever existed in perl.
        # http://blog.twoshortplanks.com/2011/06/06/unexceptional-exceptions-in-perl-5-14/
        1;
        } or do {
            die <
fetchware: run-time error. The lookup_url you provided [$lookup_url] is not a
usable lookup_url because of the error below:
[$@]
Please see perldoc @{[extension_name()]} for troubleshooting tips and rerun
fetchware new.
EOD
        };
    };

    return $filename_listing;
}



###BUGALERT### Use the $filename_listing argument to search for a MIRRORS file
#that specifies this open source distribution's official listing of mirrors,
#parse it, and add them to the returned hash or mirrors. But, it'll probably
#need configuration. Use GeoIP? No options are avalable. Parse the list, and
#present it to the user, and ask him to pick some:)
sub get_mirrors {
    my ($term, $filename_listing) = @_;

    my @mirrors;

    my $mirror = $term->get_reply(
        print_me => <
Fetchware requires you to please provide a mirror. This mirror is required,
because most software authors prefer users download their software packages from
a mirror instead of from the authors main download site, which your lookup_url
should point to.

The mirror should be a URL in standard browser format such as [ftp://a.mirror/].
FTP, HTTP, and local file:// mirrors are supported. All other formats are not
supported.
EOP
        prompt => 'Please enter the URL of your mirror: ',
        allow => qr!^(ftp|http|file)://!,
    );

    # Append mirror to $fetchwarefile.
    push @mirrors, $mirror;

    if (
        $term->ask_yn(
        print_me => <
In addition to the one required mirror that you must define in order for
fetchware to function properly, you may specify additonal mirros that fetchware
will use if the mirror you've already specified is unreachable or download
attempts using that mirror fail.
EOP
        prompt => 'Would you like to add any additional mirrors? ',
        default => 'n',
        )
    ) {
        # Prompt for first mirror outside loop, because if you just hit enter or
        # type done, then the above text will be appended to your fetchwarefile,
        # but you'll be able to skip actually adding a mirror.
        my $first_mirror = $term->get_reply(
                prompt => 'Type in URL of mirror or done to continue: ',
                allow => qr!^(ftp|http|file)://!,
            );
            # Append $first_mirror to $fetchwarefile.
            push @mirrors, $first_mirror;

        while (1) {
            my $mirror_or_done = $term->get_reply(
                prompt => 'Type in URL of mirror or done to continue: ',
                default => 'done',
                allow => qr!(^(ftp|http|file)://)|done!,
            );
            if ($mirror_or_done eq 'done') {
                last;
            } else {
                # Append $mirror_or_done to $fetchwarefile.
                push @mirrors, $mirror_or_done;
            }
        }
    }

    return {mirror => \@mirrors};
}



sub get_verification {
    my ($term, $filename_listing, $lookup_url) = @_;

    my %options;

    my %available_verify_methods;
    # Determine what types of verification are available.
    for my $file_and_timestamp (@$filename_listing) {
        if ($file_and_timestamp->[0] =~ /\.(asc|sig|sign)$/) {
            $available_verify_methods{gpg}++;
        } elsif ($file_and_timestamp->[0] =~ /\.sha1?$/) {
            $available_verify_methods{sha1}++;
        } elsif ($file_and_timestamp->[0] =~ /\.md5$/) {
            $available_verify_methods{md5}++;
        }
    }

    my $verify_configed_flag = 0;
    #If gpg is available prefer it over the others.
    if (exists $available_verify_methods{gpg}
            and defined $available_verify_methods{gpg}
            and $available_verify_methods{gpg} > 0
    ) {
        msg <
gpg digital signatures found. Using gpg verification.
EOM
        $options{verify_method} = 'gpg';

        # Search for a KEYS file to use to import the author's keys.
        if (grep {$_->[0] eq 'KEYS'} @$filename_listing) {
            msg <
KEYS file found using lookup_url. Adding gpg_keys_url to your Fetchwarefile.
EOM
            # Add 'KEYS' or '/KEYS' to $lookup_url's path.
            my ($scheme, $auth, $path, $query, $fragment) =
                uri_split($lookup_url);
            $path = catfile($path, 'KEYS');
            $lookup_url = uri_join($scheme, $auth, $path, $query, $fragment);

            $options{gpg_keys_url} = $lookup_url;
            $verify_configed_flag++;
        } else {
            msg <
KEYS file *not* found!
EOM
            # Since autoconfiguration of KEYS failed, try asking the user if
            # they would like to import the author's key themselves into their
            # own keyring and have fetchware use that.
            if (
                $term->ask_yn(prompt =>
q{Would you like to import the author's key yourself after fetchware completes? },
                    default => 'n',
                    print_me => <
Automatic KEYS file discovery failed. Fetchware needs the author's keys to
download and import into its own keyring, or you may specify the option
user_keyring, which if true will cause fetchware to use the user who runs
fetchware's keyring instead of fetchware's own keyring. But you, the user, needs
to import the author's keys into your own gpg keyring. You can do this now in a
separate shell, or after you finish configuring this Fetchwarefile. Just run the
command [gpg --import ].
EOP
                )
            ) {
                $options{user_keyring} = 'On';

                $verify_configed_flag++;
            }

            # And if the user does not want to, then fallback to sha1 and/or md5
            # if they're defined, which is done below.
        }
    }


    # Only try sha1 and md5 if gpg failed.
    unless ($verify_configed_flag == 1) {
        if (exists $available_verify_methods{sha1}
                and defined $available_verify_methods{sha1}
                and $available_verify_methods{sha1} > 0
        ) {
            msg <
SHA1 checksums found. Using SHA1 verification.
EOM
            $options{verify_method} = 'sha1';
        } elsif (exists $available_verify_methods{md5}
                and defined $available_verify_methods{md5}
                and $available_verify_methods{md5} > 0
        ) {
            msg <
MD5 checksums found. Using MD5 verification.
EOM
            $options{verify_method} = 'md5';
        } else {
            # Print a huge long nasty warning even include links to news stories
            # of mirrors actually getting hacked and serving malware, which
            # would be detected and prevented with proper verification enabled.

            # Ask user if they would like to continue installing fetchware even if
            # verification fails, and then enable the verify_failure_ok option.
            if (
                $term->ask_yn(prompt => <
Would you like fetchware to ignore the fact that it is unable to verify the
authenticity of any downloads it makes? Are you ok with possibly downloading
viruses, worms, rootkits, or any other malware, and installing it possibly even
as root?
EOP
                    default => 'n',
                    print_me => <
Automatic verification of your fetchware package has failed! Fetchware is
capable of ignoring the error, and installing software packages anyway using its
verify_failure_ok configuration option. However, installing software packages
without verifying that they have not been tampered with could allow hackers to
potentially install malware onto your computer. Don't think this is *not*
possible or do you think its extremely unlikely? Well, it's actually
surprisingly common:
    1.  http://arstechnica.com/security/2012/09/questions-abound-as-malicious-phpmyadmin-backdoor-found-on-sourceforge-site/
    Discusses how a mirror for sourceforge was hacked, and the phpMyAdmin
    software package on that mirror was modified to spread malware.
    2.  http://www.geek.com/news/major-open-source-code-repository-hacked-for-months-says-fsf-551344/
    Discusses how FSF's gnu.org ftp download site was hacked.
    3.  http://arstechnica.com/security/2012/11/malicious-code-added-to-open-source-piwik-following-website-compromise/
    Discusses how Piwiki's wordpress software was hacked, and downloads of
    Piwiki had malicious code inserted into them.
    4. http://www.theregister.co.uk/2011/03/21/php_server_hacked/
    Discusses how php's wiki.php.org server was hacked yielding credentials to
    php's source code repository.
Download mirrors *do* get hacked. Do not make the mistake, and think that it is
not possible. It is possible, and it does happen, so please properly configure
your Fetchwarefile to enable fetchware to verify that the downloaded software is
the same what the author uploaded.
EOP
                )
            ) {
                # If the user is ok with not properly verifying downloads, then
                # ignore the failure, and install anyway.
                $options{verify_failure_ok} = 'On';
            } else {
                # Otherwise, throw an exception.
                die <
fetchware: Fetchware *must* be able to verify any software packages that it
downloads. The Fetchwarefile that you were creating could not do this, because
you failed to specify how fetchware can verify its downloads. Please rerun
fetchware new again, and this time be sure to specify a gpg_keys_url, specify
user_keyring to use your own gpg keyring, or answer yes to the question
regarding adding verify_failure_ok to your Fetchwarefile to make failing
verificaton acceptable to fetchware.
EOD
            }
        }
    }

    return \%options;
}



sub get_filter_option {
    my $term = shift;
    # $filename_listing is an array of [$filename, $timestamp] arrays.
    my $filename_listing = shift;
    msg <
Analyzing the lookup_url you provided to determine if fetchware can use it to
successfully determine when new versions of your software are released.
EOS

    my $filter;
    if (grep {$_->[0] =~ /^(CURRENT|LATEST)[_-]IS[_-].+/} @$filename_listing) {
        # There is only one version in the lookup_url directory listing, so
        # I do not need a filter option.
        msg <
* The lookup_url you gave fetchware includes a CURRENT_IS or a LATEST_IS file
that tells fetchware and regular users what the latest version is. Because of
this we can be reasonable sure that a filter option is not needed, so I'll skip
asking for one. You can provide one later if you need to provide one, when
fetchware prompts you for any custom options you may want to use.
EOS
    } else {
        # There is a CURRENT_IS_ or LATEST_IS_ file that tells
        # you what the latest version is.
###BUGALERT### Why is this line in both sections of the if statement??? Inside
#this else block means that a CURRENT_IS or LATEST-IS was *not* found??? Fix
#this!!!!!!
        msg <
* The directory listing of your lookup_url has a CURRENT_IS_ or
LATEST_IS_ file that specifies the latest version, which means that
your program's corresponding Fetchwarefile does not need a filter option. If you
still would like to provide one, you can do so later on, when fetchware allows
you to define any additional configuration options.
EOS
        my $what_a_filter_is = <
Fetchware needs you to provide a filter option, which is a pattern that fetchware
compares each file in the directory listing of your lookup_url to to determine
which version of your program to install.

Directories will have other junk files in them or even completely different
programs that could confuse fetchware, and even potentially cause it to install
a different program. Therefore, you should also add the program name to the
begining of your filter. For example if you program is apache, then your filter
should include the name of apache on mirror sites, which is actually:
httpd

For example, Apache's lookup_url has three versions in the same lookup_url
directory listing. These are 2.4, 2.2, and 2.0. Without the filter option
fetchware would choose the highest, which would be 2.4, which is the latest
version. However, you may want to stick with the older and perhaps more stable
2.2 version of apache. Therefore, you'll need to tell fetchware this by using
by adding the version number to your filter:
httpd-2.2
will result in fetchware filtering the results of its lookup check through your
filter of httpd-2.2 causing fetchware to choose the latest version from the 2.2
stable branch instead of the higher version numbered 2.4 or 2.0 legacy releases.
Note the use of the dash, which is used in the filename to separate the 'httpd'
name part from the '2.2' version part.

Note: fetchware accepts any valid perl regular expresion as an acceptable
filter option, but that should only be needed for advanced users. See perldoc
fetchware.
EOA
        # Prompt for the needed filter option.
        $filter = $term->get_reply(
            prompt => <
[Just press enter or return to skip adding a filter option]
What does fetchware need your filter option to be?
EOP
            print_me => $what_a_filter_is,
        );
        ###BUGALERT### Consider Adding a loop around checking the filter option
        #that runs determine_lookup_url() using the provided filter option, and
        #then asking the user if that is indeed the correct filter option, and
        #if not ask again and try it again unit it succeeds or user presses
        #ctrl-c|z.
    }

    return {filter => $filter};
}



sub prompt_for_other_options {
    my $term = shift;

    my %option_description = @_;

    my %answered_option;

    if (
        $term->ask_yn(prompt =>
        q{Would you like to add extra configuration options to your fetchwarefile?},
        default => 'n',
        print_me => <
Fetchware has many different configuration options that allow you to control its
behavior, and even change its behavior if needed to customize fetchware for any
possible source code distribution.

If you think you need to add configuration options please check out perldoc
fetchware for more details on fetchware and its Fetchwarefile configuration
options.

If this is your first package your creating with Fetchware or you're creating a
package for a new program for the first time, you should skip messing with
fetchware's more flexible options, and just give the defaults a chance.
EOP
        )
    ) {
        my @options = keys %option_description;
        my @config_file_options_to_provide = $term->get_reply(
            print_me => <
Below is a listing of Fetchware's available configuration options.
EOP
            prompt => <
Please answer with a space seperated list of the number before the configuration
file options that you would like to add to your configuration file?
EOP
            choices => \@options,
            multi => 1,
        );


        for my $config_file_option (@config_file_options_to_provide) {
            $answered_option{$config_file_option} = $term->get_reply(
                print_me => $option_description{$config_file_option}->{print_me},
                prompt => $option_description{$config_file_option}->{prompt},
            );
        }
    }
    return \%answered_option;
}



sub edit_manually {
    my ($term, $fetchwarefile) = @_;

    if (
        $term->ask_yn(
        print_me => <
Fetchware has now asked you all of the needed questions to determine what it
thinks your new program's Fetchwarefile should look like. But it's not perfect,
and perhaps you would like to tweak it manually. If you would like to edit it
manually in your favorite editor, answer 'yes', and if you want to skip this just
answer 'no', or just press .

If you would like to cancel any edits you have made, and use the automagically
generated Fetchwarefile, just delete the entire contents of the file, and save
an empty file.
EOP
            prompt => q{Would you like to edit your automagically generated Fetchwarefile manually? },
        default => 'n',
        )
    ) {
        my ($fh, $fetchwarefile_filename) =
            tempfile('Fetchwarefile-XXXXXXXXX', TMPDIR => 1);
        print $fh $fetchwarefile->generate();

        close $fh;

        # Ask what editor to use if EDITOR environment variable is not set.
        my $editor = $ENV{EDITOR} || do {
            $term->get_reply(prompt => <
What text editor would you like to use?
EOP
                print_me => <
The Environment variable EDITOR is not set. This is used by fetchware and other
programs to determine what program fetchware should use to edit your
Fetchwarefile. Please enter what text editor you would like to use. Examples
include: vim, emacs, nano, pico, or notepad.exe (on Windows).
EOP
            );
        };

        run_prog($editor, $fetchwarefile_filename);
        # NOTE: fetchware will "block" during the above call to run_prog(), and
        # wait for the user to close the editor program.

        # If the edited Fetchwarefile does not have a file size of zero.
        if (not -z $fetchwarefile_filename) {
            my $fh = safe_open($fetchwarefile_filename, <
fetchware: run-time error. fetchware can't open the fetchwarefile you edited
with your editor after you edited it. This just shouldn't happen. Possible race
condition or weird bug. See perldoc fetchware.
EOD
            # Since the generated Fetchwarefile has been edited, because its
            # size is nonzero, then replace the App::Fetchware::Fetchwarefile
            # object with whatever text can be slurped from the file the user
            # edited. Since it is now a scalar instead of an object, that is how
            # Fetchware will tell if the user changed it or not.
            $fetchwarefile = do { local $/; <$fh> }; # slurp fetchwarefile
        } else {
            msg <
You canceled any custom editing of your fetchwarefile by writing an empty file
to disk.
EOM
        }
    }
    return $fetchwarefile;
}





sub new_install {
    my ($term, $program_name, $fetchwarefile) = @_;

    my $fetchware_package_path =
        ask_to_install_now_to_test_fetchwarefile($term, \$fetchwarefile,
            $program_name);

    return $fetchware_package_path;

}






sub ask_to_install_now_to_test_fetchwarefile {
    my ($term, $fetchwarefile, $program_name) = @_;


    vmsg <
Determining if user wants to install now or just save their Fetchwarefile.
EOM

    # If the user wants to install their new Fetchwarefile.
    if (
        $term->ask_yn(
        print_me => <
It is recommended that fetchware go ahead and install the package based on the
Fetchwarefile that fetchware has created for you. If you don't want to install
it now, then enter 'no', but if you want to test your Fetchwarefile now, and
install it, then please enter 'yes' or just press .
EOP
        prompt => q{Would you like to install the package you just created a Fetchwarefile for? },
        default => 'y',
        )
    ) {

        # Create a temp Fetchwarefile to store the autogenerated configuration.
        my ($fh, $fetchwarefile_filename)
            =
            tempfile("fetchware-$$-XXXXXXXXXXXXXX", TMPDIR => 1, UNLINK => 1);
        print $fh $$fetchwarefile;
        # Close the temp file to ensure everything that was written to it gets
        # flushed from caches and actually makes it to disk.
        close $fh;

        vmsg <
Saved Fetchwarefile temporarily to [$fetchwarefile_filename].
EOM

        # Reach up bin/fetchware's skirt, and call cmd_install directly, because
        # if I use system() and call fetchware again in a separate process using
        # the install command, it will return a useless number indicating
        # success instead of the $fetchware_package_path I want. I could parse
        # the output, but that's a head ache I want to avoid. Instead, I'll just
        # be a little frisky.
        my $fetchware_package_path = fetchware::cmd_install($fetchwarefile_filename);
        ###BUGALERT### Call cmd_install() inside an eval that will catch any
        #problems that come up, and suggest how to fix them???
        #Is that really doable???
        vmsg <
Copied Fetchwarefile package to fetchware database [$fetchware_package_path].
EOM
        msg 'Installed Fetchware package to fetchware database.';
        return $fetchware_package_path;
    # Else the user just wants to save the Fetchwarefile somewhere.
    } else {
        my $fetchwarefile_filename = $program_name . '.Fetchwarefile';

        # Get a name for the Fetchwarefile that does not already exist.
        if (-e $fetchwarefile_filename) {
            while (1) {
                $fetchwarefile_filename = $term->get_reply(
                    prompt => <
What would you like your new Fetchwarefile's filename to be?
EOP
                    print_me => <
Fetchware by default uses the program name you specified at the beginning of
running fetchware new plus a '.Fetchwarefile' extension to name your
Fetchwarefile. But his file already exists, so you'll have to pick a new
filename that does not currently exist.
EOP
                );
                last unless -e $fetchwarefile_filename;
            }
        }
        vmsg <
Determine Fetchwarefile name to be [$fetchwarefile_filename].
EOM

    ###BUGALERT### Replace >, create or delete whole file and replace it with
    #what I write now, with >> for append to file if it already exists????
    ###BUGALERT### Should safe_open() be moved into the loop above, and instead
    #of checking for existence, open the file using safeopen as needed, but
    #don't write to it just yet, and then test the open file handle if it's
    #empty, and therefore presumable a new file, or an old file that no one
    #cares about anymore, because it's empty?
        my $fh = safe_open($fetchwarefile_filename, < '>');
fetchware: failed to open your new fetchwarefile because of os error
[$!]. This really shouldn't happen in this case. Probably a bug, or a weird race
condition.
EOD
        print $fh $$fetchwarefile;

        close $fh;

        msg "Saved Fetchwarefile to [$fetchwarefile_filename].";
        return $fetchwarefile_filename;
    }
}




    sub start {
        my %opts = @_;

        # Add temp_dir config sub to create_tempdir()'s arguments.
        if (config('temp_dir')) {
            $opts{TempDir} = config('temp_dir');
            vmsg "Using user specified temporary directory [$opts{TempDir}]";
        }

        # Add KeepTempDir option if no_install is set. That way user can still
        # access the build directory to do the install themselves.
        if (config('no_install')) {
            $opts{KeepTempDir} = 1;
            vmsg "no_install option enabled not deleting temporary directory.";
        }

        # Forward opts to create_tempdir(), which does the heavy lifting.
        my $temp_dir = create_tempdir(%opts);
        msg "Created fetchware temporary directory [$temp_dir]";

        return $temp_dir;
    }




sub lookup {
    msg "Looking up download url using lookup_url [@{[config('lookup_url')]}]";

    # obtain directory listing for file, ftp, or http. (a sub for each.)
    vmsg 'Downloading a directory listing using your lookup_url';
    my $directory_listing = get_directory_listing();
    vmsg 'Obtained the following directory listing:';
    vmsg Dumper($directory_listing);
    # parse the directory listing's format based on ftp or http.
    vmsg 'Parse directory listing into internal format.';
    my $filename_listing = parse_directory_listing($directory_listing);
    vmsg 'Directory listing parsed as:';
    vmsg Dumper($filename_listing);
    # Run those listings through lookup_by_timestamp() and/or
        # lookup_by_versionstring() based on lookup_method, or first by timestamp,
        # and then by versionstring if timestamp can't figure out the latest
        # version (normally because everything in the directory listing has the
        # same timestamp.
    # return $download_url, which is lookup_url .
    vmsg 'Using parsed directory listing to determine download url.';
    my $download_path = determine_download_path($filename_listing);

    vmsg "Download path determined to be [$download_path]";

    return $download_path;
}






sub get_directory_listing {

    return download_dirlist(config('lookup_url'));
}



sub parse_directory_listing {
    my ($directory_listing) = @_;

    if (config('lookup_url') =~ m!^ftp://!) {
    ###BUGALERT### *_parse_filelist may not properly skip directories, so a
    #directory could exist that could wind up being the "latest version"
        return ftp_parse_filelist($directory_listing);
    } elsif (config('lookup_url') =~ m!^http://!) {
        return http_parse_filelist($directory_listing);
    } elsif (config('lookup_url') =~ m!^file://!) {
        return file_parse_filelist($directory_listing);
    }
}



sub determine_download_path {
    my $filename_listing = shift;

    # Base lookup algorithm on lookup_method configuration sub if it was
    # specified.
    my $sorted_filename_listing;
    if (defined config('lookup_method')
        and config('lookup_method') eq 'timestamp'
    ) {
        $sorted_filename_listing = lookup_by_timestamp($filename_listing);
    } elsif (defined config('lookup_method')
        and config('lookup_method') eq 'versionstring'
    ) {
        $sorted_filename_listing = lookup_by_versionstring($filename_listing);
    # Default is to just use timestamp although timestamp will call
    # versionstring if it can't figure it out, because all of the timestamps
    # are the same.
    } else {
        $sorted_filename_listing = lookup_by_timestamp($filename_listing);
    }

    # Manage duplicate timestamps apropriately including .md5, .asc, .txt files.
    # And support some hacks to make lookup() more robust.
    return lookup_determine_downloadpath($sorted_filename_listing);
}




{ # Bare block for holding %month {ftp,http}_parse_filelist() need.
    my %month = (
        Jan => '01',
        Feb => '02',
        Mar => '03',
        Apr => '04',
        May => '05',
        Jun => '06',
        Jul => '07',
        Aug => '08',
        Sep => '09',
        Oct => '10',
        Nov => '11',
        Dec => '12',
    );

    my %num_month = (
         1 => '01',
         2 => '02',
         3 => '03',
         4 => '04',
         5 => '05',
         6 => '06',
         7 => '07',
         8 => '08',
         9 => '09',
        10 => '10',
        11 => '11',
        12 => '12',
    );


    sub  ftp_parse_filelist {
        my $ftp_listing = shift;

        my ($filename, $timestamp, @filename_listing);

        for my $listing (@$ftp_listing) {
            # Example Net::FTP->dir() output.
            #drwxrwsr-x   49 200      200          4096 Oct 05 14:27 patches
            #     0       1  2         3             4   5  6    7     8
            my @fields = split /\s+/, $listing;
            # Test & try it???  Probaby won't work.
            #my ($month, $day, $year_or_time, $filename) = ( split /\s+/, $listing )[-4--1];
            $filename = $fields[-1];
            #month       #day        #year
            #"$fields[6] $fields[7] $fields[8]";
            my $month = $fields[5];
            my $day = $fields[6];
            my $year_or_time = $fields[7];

            # Normalize timestamp format.
            # It's a time.
            if ($year_or_time =~ /\d\d:\d\d/) {
                # the $month{} hash access replaces text months with numerical
                # ones.
                $year_or_time =~ s/://; # Make 12:00 1200 for numerical sort.
                $timestamp = "9999$month{$month}$day$year_or_time";
                # It's a year.
            } elsif ($year_or_time =~ /\d\d\d\d/) {
                # the $month{} hash access replaces text months with numerical
                # ones.
                $timestamp = "$year_or_time$month{$month}${day}0000";
            }
            push @filename_listing, [$filename, $timestamp];
        }

        return \@filename_listing;
    }



    sub  http_parse_filelist {
        my $http_listing = shift;

        # Use HTML::TreeBuilder to parse the scalar of html into a tree of tags.
        my $tree = HTML::TreeBuilder->new_from_content($http_listing);

        my @filename_listing;
        my @matching_links = $tree->look_down(
            _tag => 'a',
            sub {
                my $h = shift;

                #parse out archive name.
                my $link = $h->as_text();
                # NOTE: The weird alternations adding .asc, .md5, and .sha.?,
                # and also a KEYS file are to allow fetchware new to also use
                # this subroutine to parse http file listings to analyze the
                # contents of the user's lookup_url. It does not make any sense
                # to copy and paste this function or even add a callback argument
                # allowing you to change the regex.
                if ($link =~
                    /(\.(tar\.(gz|bz2|xz)|(tgz|tbz2|txz))|(asc|md5|sha.?))|KEYS$/) {
                    # Should I strip out dirs just to be safe?
                    my $filename = $link;
                    # Obtain the tag to the right of the archive link to find the
                    # timestamp.
                    if (my $rh = $h->right()) {
                        my $listing_line;
                        if (blessed($rh)) {
                            $listing_line = $rh->as_text();
                        } else {
                            $listing_line = $rh;
                        }
                        my @fields = split ' ', $listing_line;
                        ###BUGALERT### Internationalization probably breaks this
                        #datetime parsing? Can a library do it?
                        # day-month-year   time
                        # $fields[0]      $fields[1]
                        # Normalize format for lookup algorithms .
                        my ($day, $month, $year) = split /-/, $fields[0];
                        # Ditch the ':' in the time.
                        $fields[1] =~ s/://;
                        # Some dirlistings use string months Aug, Jun, etc...
                        if (looks_like_number($month)) {
                            # Strip leading 0 if it exists by converting the
                            # string with the useless leading 0 into an integer.
                            # The %num_month hash lookup will add back a leading
                            # 0 if there was one. This stupid roundabout code is
                            # to ensure that there always is a leading 0 if the
                            # number is less than 10 to ensure that all of the
                            # numbers this hacky datetime parser outputs all
                            # have the same length so that the numbers can
                            # easily be compared with each other.
                            $month = sprintf("%u", $month);
                            push @filename_listing, [$filename,
                                "$year$num_month{$month}$day$fields[1]"];
                        # ...and some use numbers 8, 6, etc....
                        } else {
                            push @filename_listing, [$filename,
                                "$year$month{$month}$day$fields[1]"];
                        }
                    } else {
###BUGALERT### Add support for other http servers such as lighttpd, nginx,
#cherokee, starman?, AND use the Server: header to determine which algorithm to
#use.
                        die <
App-Fetchware: run-time error. A hardcoded algorithm to parse HTML directory
listings has failed! Fetchware currently only supports parseing Apache HTML
directory listings. This is a huge limitation, but surprisingly pretty much
everyone who runs a mirror uses apache for http support. This is a bug so
please report it. Also, if you want to try a possible workaround, just use a ftp
mirror instead of a http one, because ftp directory listings are a easy to
parse. See perldoc App::Fetchware.
EOD
                    }
                }
            }
        );


        # Delete the $tree, so perl can garbage collect it.
        $tree = $tree->delete;

        return \@filename_listing;
    }


} # end bare block for %month.





sub file_parse_filelist {
    my $file_listing = shift;

    for my $file (@$file_listing) {
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,
            $blksize,$blocks)
            = stat($file) or die <
App-Fetchware: Fetchware failed to stat() the file [$file] while trying to parse
your local [file://] lookup_url. The OS error was [$!]. This should not happen,
and is either a bug in fetchware or some sort of race condition.
EOD

        # Replace scalar filename with a arrayref of the filename with its
        # assocated timestamp for later processing for lookup().
        #
        # Use Path::Class's file() constructor & basename() method to strip out
        # all unneeded directory information leaving just the file's name.
        # Add all of the timestamp numbers together, so that only one numberical
        # sort is needed instead of a descending list of numerical sorts.
        $file = [file($file)->basename(), $mtime ];
    }

    return $file_listing;
}



sub  lookup_by_timestamp {
    my $file_listing = shift;

    # Sort the timstamps to determine the latest one. The one with the higher
    # numbers, and put $b before $a to put the "bigger", later versions before
    # the "lower" older versions.
    # Sort based on timestamp, which is $file_listing->[0..*][1][0..6].
    # Note: the crazy || ors are to make perl sort each timestamp array first by
    # year, then month, then day of the month, and so on.
    my @sorted_listing = sort { $b->[1] <=> $a->[1] } @$file_listing;

    return \@sorted_listing;
}



sub  lookup_by_versionstring {
    my $file_listing = shift;

    # Implement versionstring algorithm.
    my @versionstrings;
    for (my $i = 0; $i <= $#{$file_listing}; $i++) {
        # Split the filename on "Not a numbers", so remove all "not
        # numbers", but keep a list of things that actually are numbers.
        my @iversionstring = split(/\D+/, $file_listing->[$i][0]);

        # Use grep to strip leading empty strings (eg: '').
        @iversionstring = grep {$_ ne ''} @iversionstring;

        if (@iversionstring == 0) {
            # Let the usr know we're skipping this filename, but only if they
            # really want to know (They turned on verbose output.).
            vmsg <
File [$file_listing->[$i][0]] has no version number in it. Ignoring.
EOM
            # And also skip adding this @iversionstring to @versionstrings,
            # because this @iversionstring is empty, and how do I sort an empty
            # array? Return undef--nope causes "value undef in sort fatal errors
            # and warnings." Return 0--nope causes a file with no version number
            # at beginning of listing to stay at listing, and cause fetchware to
            # fail picking the right version. Return -1--nope, because that's
            # hackish and lame. Instead, just not include them in the lookup
            # listing, and if that means that the lookup listing is empty throw
            # an exception.
            next;
        }
        # Add $i's version string to @versionstrings.
        push @versionstrings, [$i, @iversionstring];

        # And the sort below sorts them into highest number first order.
    }

   die <
App-Fetchware: The lookup_url your provided [@{[config('lookup_url')]}] does not
have any filenames with detectable version numbers in them. Fetchware's
'versionstring' lookup algorithm depends on files having version numbers in them
such as [httpd-2.2.22.tar.gz] notice the [2.2.22] version number. Fetchware
failed to find any of those in the lookup_url you provided. Consider a different
lookup_url or try switching to the default 'timestamp' lookup algorithm adding
the "lookup_method" configuration option to your Fetchwarefile.
EOD

   # LIMITATION: The sort block below can not have any undef values in its
   # input. If there are any, then perl will give a warning about a value being
   # undef in a sort, if you are not lucky, then it will actually trigger a
   # fatal error. There are CPAN Testers reports with this problem, so it really
   # can happen. But you do not have to worry about this, because the for loop
   # above that creates @versionstrings
    @versionstrings = sort {
        # Figure out whoose ($b or $a) is larger and set $last_index to it.
        my $last_index;
        if ($#{$b} > $#{$a}) {
            $last_index = $#{$b};
        } else {
            $last_index = $#{$a};
        }

        # Loop over the indexes of both $b and $a at the same time comparing
        # them one by one with <=>...
        # ...and be sure to start at index 1, because index 0 is the index of
        # $file_listing that this entry in @versionstrings belongs to...
        for my $x (1..$last_index) {
            # If one of $b or $a has more numbers in it ($#{$a_or_b} is smaller than
            # $x), then if it's $b we should return -1, because $b is smaller
            # than $a, and if it's $a, we should return 1, because $b is bigger
            # than $a.
            return -1 if $x > $#{$b};
            return 1 if $x > $#{$a};

            my $spaceship_result = $b->[$x] <=> $a->[$x];

            # ...and as soon as they no longer equal each other return whatever
            # result (-1 or 1) <=> gives.
            return $spaceship_result if $spaceship_result != 0;
        }

        # Return 0 for equal, because if the two versions were not equal, then
        # the for loop above would have caught it, and returned the appropriate
        # -1 or 1.
        return 0;
    } @versionstrings;

    # Now, "sort" $file_listing into the order @versionstrings was sorted into
    # using the copy @sorted_file_listing.
    my @sorted_file_listing;
    for my $versionstring_arrayref (@versionstrings) {
        push @sorted_file_listing,
            # The $versionstring_arrayref->[0] part refers to the index that was
            # saved first when @versionstrings was created.
            $file_listing->[$versionstring_arrayref->[0]];
    }

    # Return the sorted $file_listing, @sorted_filename_listing.
    return \@sorted_file_listing;
}




sub lookup_determine_downloadpath {
    my $file_listing = shift;

    # First grep @$file_listing for $CONFIG{filter} if $CONFIG{filter} is defined.
    # This is done, because some distributions have multiple versions of the
    # same program in one directory, so sorting by version numbers or
    # timestamps, and then by filetype like below is not enough to determine,
    # which file to download, so filter was invented to fix this problem by
    # letting Fetchwarefile's specify which version of the software to download.
    if (defined config('filter')) {
        @$file_listing = grep { $_->[0] =~ /@{[config('filter')]}/ } @$file_listing;
    }

    # Skip any filenames with win32 in them on non-Windows systems.
    # Windows systems who may need to download the win32 version can just use
    # filter 'win32' for that or maybe 'win32|http-2.2' if they need the other
    # functionality of filter.
    if ($^O ne 'MSWin32') { # $^O is what os I'm on, MSWin32, Linux, darwin, etc
        @$file_listing = grep { $_->[0] !~ m/win32/i } @$file_listing;
    }

    # Support 'LATEST{_,-}IS' and 'CURRENT{_,-}IS', which indicate what the
    # latest version is.  These files come from each software distributions
    # mirror scripts, so they should be more accurate than either of my lookup
    # algorithms. Both Apache and the Linux kernel maintain these files.
    $_->[0] =~ /^(?:latest|current)[_-]is[_-](.*)$/i for @$file_listing;
    my $latest_version = $1;
    @$file_listing = grep { $_->[0] =~ /$latest_version/ } @$file_listing
        if defined $latest_version;

    # Determine the $download_url based on the sorted @$file_listing by
    # finding a downloadable file (a tarball or zip archive).
    # Furthermore, choose them based on best compression to worst to save some
    # bandwidth.
    for my $fl (@$file_listing) {
        if ($fl->[0] =~ /\.tar\.xz$/) {
            my $path = ( uri_split(config('lookup_url')) )[2];
            return "$path/$fl->[0]";
        } elsif ($fl->[0] =~ /\.txz$/) {
            my $path = ( uri_split(config('lookup_url')) )[2];
            return "$path/$fl->[0]";
        } elsif ($fl->[0] =~ /\.tar\.bz2$/) {
            my $path = ( uri_split(config('lookup_url')) )[2];
            return "$path/$fl->[0]";
        } elsif ($fl->[0] =~ /\.tbz$/) {
            my $path = ( uri_split(config('lookup_url')) )[2];
            return "$path/$fl->[0]";
        } elsif ($fl->[0] =~ /\.tar\.gz$/) {
            my $path = ( uri_split(config('lookup_url')) )[2];
            return "$path/$fl->[0]";
        } elsif ($fl->[0] =~ /\.tgz$/) {
            my $path = ( uri_split(config('lookup_url')) )[2];
            return "$path/$fl->[0]";
        } elsif ($fl->[0] =~ /\.zip$/) {
            my $path = ( uri_split(config('lookup_url')) )[2];
            return "$path/$fl->[0]";
        } elsif ($fl->[0] =~ /\.fpkg$/) {
            my $path = ( uri_split(config('lookup_url')) )[2];
            return "$path/$fl->[0]";
        }
##DELME##        if (config('lookup_url') =~ m!^file://!) {
##DELME##        # Must prepend scheme, so that download() knows how to retrieve this
##DELME##        # file with download_file(), which requires a URL that must begin
##DELME##        # with a scheme, and file:// is the scheme for local files.
##DELME##        $fl->[0] =~ s/"file://$fl->[0]";
    }
    die <
App-Fetchware: run-time error. Fetchware failed to determine what URL it should
use to download your software. This URL is based on the lookup_url you
specified. See perldoc App::Fetchware.
EOD
}




sub download {
    my ($temp_dir, $download_path) = @_;

    # Ensure we're passed just a path, and *not* a full URL.
    die <
App-Fetchware: download() has been passed a full URL *not* only a path.
download() should only be called with a path never a full URL. The URL you
specified was [$download_path]
EOD

    vmsg <
Using [$download_path] as basis for determined our download_url using the user
supplied mirrors.
EOM

    msg "Downloading from url [$download_path] to temp dir [$temp_dir]";

    my $downloaded_file_path = download_file(PATH => $download_path);
    vmsg "Downloaded file to [$downloaded_file_path]";

    my $package_path = determine_package_path($temp_dir, $downloaded_file_path);
    msg "Determined package path to be [$package_path]";

    return $package_path;
}






sub determine_package_path {
    my ($tempdir, $filename) = @_;

    # return $package_path, which stores the full path of where the file
    # HTTP::Tiny downloaded.
    ###BUGALERT### $tempdir is no longer used, so remove it from
    #determine_package_path() and probably download() too.
    return catfile(cwd(), $filename)
}




sub verify {
    my ($download_path, $package_path) = @_;

    msg "Verifying the downloaded package [$package_path]";

    my $retval;
    unless (defined(config('verify_method'))) {
        # if gpg fails try
        # sha and if it fails try
        # md5 and if it fails die
        msg 'Trying to use gpg to cyptographically verify downloaded package.';
        my ($gpg_err, $sha_err, $md5_err);
        eval {$retval = gpg_verify($download_path)};
        $gpg_err = $@;
        if ($gpg_err) {
            msg <
Cyptographic verification using gpg failed!
GPG verification error [
$@
]
EOM
            warn $gpg_err;
        }
        if (! $retval or $gpg_err) {
            msg <
Trying SHA1 verification of downloaded package.
EOM
            eval {$retval = sha1_verify($download_path, $package_path)};
            $sha_err = $@;
            if ($sha_err) {
                msg <
SHA1 verification failed!
SHA1 verificaton error [
$@
]
EOM
                warn $sha_err;
            }
            if (! $retval or $sha_err) {
                msg <
Trying MD5 verification of downloaded package.
EOM
                eval {$retval = md5_verify($download_path, $package_path)};
                $md5_err = $@;
                if ($md5_err) {
                    msg <
MD5 verification failed!
MD5 verificaton error [
$@
]
EOM
                    warn $md5_err;
                }
            }
            if (! $retval or $md5_err) {
                die <
App-Fetchware: run-time error. Fetchware failed to verify your downloaded
software package. You can rerun fetchware with the --force option or add
[verify_failure_ok 'True';] to your Fetchwarefile. See the section VERIFICATION
FAILED in perldoc fetchware.
EOD
            }
            if (config('verify_failure_ok')) {
                    warn <
App-Fetchware: run-time warning. Fetchware failed to verify the integrity of you
downloaded file [$package_path]. This is ok, because you asked Fetchware to
ignore its errors when it tries to verify the integrity of your downloaded file.
You can also ignore the errors Fetchware printed out abover where it tried to
verify your downloaded file. See perldoc App::Fetchware.
EOW
                vmsg <
Verification Failed! But you asked to ignore verification failures, so this
failure is not fatal.
EOM
                return 'warned due to verify_failure_ok'
            }
        }
    } elsif (config('verify_method') =~ /gpg/i) {
        vmsg <
You selected gpg cryptographic verification. Verifying now.
EOM
        ###BUGALERT### Should trap the exception {gpg,sha1,md5}_verify()
        #throws, and then add that error to the one here, otherwise the
        #error message here is never seen.
        gpg_verify($download_path)
            or die <
App-Fetchware: run-time error. You asked fetchware to only try to verify your
package with gpg or openpgp, but they both failed. See the warning above for
their error message. See perldoc App::Fetchware.
EOD
    } elsif (config('verify_method') =~ /sha1?/i) {
        vmsg <
You selected SHA1 checksum verification. Verifying now.
EOM
        sha1_verify($download_path, $package_path)
            or die <
App-Fetchware: run-time error. You asked fetchware to only try to verify your
package with sha, but it failed. See the warning above for their error message.
See perldoc App::Fetchware.
EOD
    } elsif (config('verify_method') =~ /md5/i) {
        vmsg <
You selected MD5 checksum verification. Verifying now.
EOM
        md5_verify($download_path, $package_path)
            or die <
App-Fetchware: run-time error. You asked fetchware to only try to verify your
package with md5, but it failed. See the warning above for their error message.
See perldoc App::Fetchware.
EOD
    } else {
        die <
App-Fetchware: run-time error. Your fetchware file specified a wrong
verify_method option. The only supported types are 'gpg', 'sha', 'md5', but you
specified [@{[config('verify_method')]}]. See perldoc App::Fetchware.
EOD
    }
    msg 'Verification succeeded.';
}






sub gpg_verify {
    my $download_path = shift;

    my $keys_file;
    # Attempt to download KEYS file in lookup_url's containing directory.
    # If that fails, try gpg_keys_url if defined.
    # Import downloaded KEYS file into a local gpg keyring using gpg command.
    # Determine what URL to use to download the signature file *only* from
    # lookup_url's host, so that we only download the signature from the
    # project's main mirror.
    # Download it.
    # gpg verify the sig using the downloaded and imported keys in our local
    # keyring.

    # Skip downloading and importing keys if we're called from inside a
    # fetchware package, which should already have a copy of our package's
    # KEYS file.
    unless (config('user_keyring')
        or (-e './pubring.gpg' and -e './secring.gpg')) {
        # Obtain a KEYS file listing everyone's key that signs this distribution.
        if (defined config('gpg_keys_url')) {
            $keys_file = no_mirror_download_file(config('gpg_keys_url'));
        } else {
            eval {
                $keys_file = no_mirror_download_file(config('lookup_url'). '/KEYS');
            };
                die <
App-Fetchware: Fetchware was unable to download the gpg_key_url you specified or
that fetchware tried appending asc, sig, or sign to [@{[config('lookup_url')]}].
It needs to download this file to properly verify you software package. This is
a fatal error, because failing to verify packages is a perferable default over
potentially installing compromised ones. If failing to verify your software
package is ok to you, then you may disable verification by adding
verify_failure_ok 'On'; to your Fetchwarefile. See perldoc App::Fetchware.
EOD
        }

        # Import downloaded KEYS file into a local gpg keyring using gpg
        # command.
        eval {
            # Add --homedir option if needed.
            if (config('user_keyring')) {
                run_prog('gpg', '--import', $keys_file);
            } else {
                run_prog('gpg', '--homedir', '.', '--import', $keys_file);
            }
            1;
        } or msg <
App-Fetchware: Warning: gpg exits nonzero when importing large KEY files such as
Apache's. However, despite exiting nonzero gpg still manages to import most of
the keys into its keyring. It only exits nonzero, because some of the keys in
the KEYS file had errors, and these key's errors were enough to cause gpg to
exit nonzero, but not enough to cause it to completely fail importing the keys.
EOM
    }

    # Download Signature using lookup_url.
    my $sig_file;
    my (undef, undef, $path, undef, undef) = uri_split($download_path);
    my ($scheme, $auth, undef, undef, undef) = uri_split(config('lookup_url'));
    my $sig_url;
    for my $ext (qw(asc sig sign)) {
        eval {
            $sig_url = uri_join($scheme, $auth, "$path.$ext", undef, undef);
            $sig_file = no_mirror_download_file($sig_url);

        };
        # If the file was downloaded stop trying other extensions.
        last if defined $sig_file;
    }
    die <
App-Fetchware: Fetchware was unable to download the gpg_sig_url you specified or
that fetchware tried appending asc, sig, or sign to [$sig_url]. It needs
to download this file to properly verify you software package. This is a fatal
error, because failing to verify packages is a perferable default over
potentially installing compromised ones. If failing to verify your software
package is ok to you, then you may disable verification by adding
verify_failure_ok 'On'; to your Fetchwarefile. See perldoc App::Fetchware.
EOD


###BUGALERT###    # Use Crypt::OpenPGP if its installed.
###BUGALERT###    if (eval {use Crypt::OpenPGP}) {
##DOESNTWORK??        # Build a pubring needed for verify.
##DOESNTWORK??        my $pubring = Crypt::OpenPGP::KeyRing->new();
##DOESNTWORK??        my $secring = Crypt::OpenPGP::KeyRing->new();
##DOESNTWORK??
##DOESNTWORK??        # Turn on gpg compatibility just in case its needed.
##DOESNTWORK??        my $pgp = Crypt::OpenPGP->new(
##DOESNTWORK??            Compat     => 'GnuPG',
##DOESNTWORK??            PubRing => $pubring,
##DOESNTWORK??            SecRing => $secring,
##DOESNTWORK??            # Automatically download public keys as needed.
##DOESNTWORK??            AutoKeyRetrieve => 1,
##DOESNTWORK??            # Use this keyserver to download them from.
##DOESNTWORK??            KeyServer => 'pool.sks-keyservers.net',
##DOESNTWORK??        );
##DOESNTWORK??
##DOESNTWORK??        # Verify the downloaded file.
##DOESNTWORK??        my $retval = $pgp->verify(SigFile => $sig_file, Files => $CONFIG{PackagePath});
##DOESNTWORK??        if ($retval == 0) {
##DOESNTWORK??            warn "Crypt::OpenPGP failed due to invalid signature.";
##DOESNTWORK??            # return failure, because Fetchware failed to verify the downloaded
##DOESNTWORK??            # file.
##DOESNTWORK??            return undef;
##DOESNTWORK??        } elsif ($retval) {
##DOESNTWORK??            return 'Package verified';
##DOESNTWORK??        } else {
##DOESNTWORK??            # print warning about $pgp errstr message.
##DOESNTWORK??            my $errstr = $pgp->errstr();
##DOESNTWORK??            warn "Crypt::OpenPGP failed with message: [$errstr]";
##DOESNTWORK??            # return failure, because Fetchware failed to verify the downloaded
##DOESNTWORK??            # file.
##DOESNTWORK??            return undef;
##DOESNTWORK??        }
###BUGALERT###    } else {
###BUGALERT###        ###BUGALERT### eval the run_prog()'s below & add better error reporting in
###BUGALERT###        ###BUGALERT### if Crypt::OpenPGP works ok remove gpg support & this if &
###BUGALERT###    }
        #IPC::System::Simple dependency.
        #my standard format.
        # Use automatic key retrieval & a cool pool of keyservers
        ###BUGALERT## Give Crypt::OpenPGP another try with
        #pool.sks-keyservers.net
        ###BUGALERT### Should I cache the files gpg puts in its "homedir"? They
        #are the public keys that verify this fetchware package. Or should they
        #always be downloaded on demand as they are now??? But if verify() can
        #have keys cached inside the fetchware package does that mean that I
        #should open up this as an API for fetchware extensions????? I don't
        #know. I'll have to think more about this issue.
        #run_prog('gpg', '--keyserver', 'pool.sks-keyservers.net',
        #    '--keyserver-options', 'auto-key-retrieve=1',
        #    '--homedir', '.',  "$sig_file");

        # Verify sig.
        # Add --homedir option if needed.
        if (config('user_keyring')) {
            run_prog('gpg', '--verify', $sig_file);
        } else {
            run_prog('gpg', '--homedir', '.', '--verify', $sig_file);
        }

    # Return true indicating the package was verified.
    return 'Package Verified';
}



sub sha1_verify {
    my ($download_path, $package_path) = @_;

    return digest_verify('SHA-1', $download_path, $package_path);
}



sub md5_verify {
    my ($download_path, $package_path) = @_;

    return digest_verify('MD5', $download_path, $package_path);
}



sub digest_verify {
    my ($digest_type, $download_path, $package_path) = @_;

    # Turn SHA-1 into sha1 & MD5 into md5.
    my $digest_ext = $digest_type;
    $digest_ext = lc $digest_type;
    $digest_ext =~ s/-//g;
##subify get_sha_sum()
    my $digest_file;
    # Obtain a sha sum file.
    if (defined config("${digest_ext}_url")) {
        my (undef, undef, $path, undef, undef) = uri_split($download_path);
        my ($scheme, $auth, undef, undef, undef) =
            uri_split(config("${digest_ext}_url"));
        my $digest_url = uri_join($scheme, $auth, $path, undef, undef);
        msg "Downloading $digest_ext digest using [$digest_url.$digest_ext]";
        $digest_file = no_mirror_download_file("$digest_url.$digest_ext");
    } else {
        eval {
            my (undef, undef, $path, undef, undef) = uri_split($download_path);
            my ($scheme, $auth, undef, undef, undef) =
                uri_split(config('lookup_url'));
            my $digest_url = uri_join($scheme, $auth, $path, undef, undef);
            msg "Downloading $digest_ext digest using [$digest_url.$digest_ext]";
            $digest_file = no_mirror_download_file("$digest_url.$digest_ext");
        };
        if ($@) {
            die <
App-Fetchware: Fetchware was unable to download the $digest_type sum it needs to
download to properly verify you software package. This is a fatal error, because
failing to verify packages is a perferable default over potentially installin
compromised ones. If failing to verify your software package is ok to you, then
you may disable verification by adding verify_failure_ok 'On'; to your
Fetchwarefile. See perldoc App::Fetchware.
EOD
        }
    }

###BUGALERT###subify calc_sum()
    # Open the downloaded software archive for reading.
    my $package_fh = safe_open($package_path, <
App-Fetchware: run-time error. Fetchware failed to open the file it downloaded
while trying to read it in order to check its MD5 sum. The file was
[$package_path]. See perldoc App::Fetchware.
EOD

    # Do Digest type checking myself, because until Digest.pm 1.17,
    # Digest->new() could run any Perl code you specify or a user does causing
    # the security hole. Instead of use Digest 1.17, just avoid it altogether.
    my $digest;
    if ($digest_type eq 'MD5') {
        $digest = Digest::MD5->new();
    } elsif ($digest_type eq 'SHA-1') {
        $digest = Digest::SHA->new();
    } else {
        die <
EOD
    }

    # Digest requires the filehandle to have binmode set.
    binmode $package_fh;

    my $calculated_digest;
    eval {
        # Add the file for digesting.
        $digest->addfile($package_fh);
        # Actually digest it.
        $calculated_digest = $digest->hexdigest();
    };
    if ($@) {
        die <
App-Fetchware: run-time error. Digest::$digest_type croak()ed an error [$@].
See perldoc App::Fetchware.
EOD
    }

    close $package_fh or die <
App-Fetchware: run-time error Fetchware failed to close the file
[$package_path] after opening it for reading. See perldoc App::Fetchware.
EOD

###subify compare_sums();
    # Open the downloaded software archive for reading.
    my $digest_fh = safe_open($digest_file, <
App-Fetchware: run-time error. Fetchware failed to open the $digest_type file it
downloaded while trying to read it in order to check its $digest_type sum. The file was
[$digest_file]. See perldoc App::Fetchware.
EOD
    # Will only check the first checksum it finds.
    while (<$digest_fh>) {
        next if /^\s+$/; # skip whitespace only lines just in case.
        my @fields = split ' '; # Defaults to $_, which is filled in by <>

        # Search the @fields for a regex that is either 32 hex for md5 or 40 hex
        # for sha1.
        my ($checksum) = grep /^[0-9a-f]{32}(?:[0-9a-f]{8})?$/i, @fields;

        # Skip trying to verify the $checksum if we failed to find it in this
        # line, and instead skip to the next line in the checksum file to try to
        # find a $checksum.
        next unless defined $checksum;

        if ($checksum eq $calculated_digest) {
            return 'Package verified';
        # Sometimes a = is appended to make it 32bits.
        } elsif ("$checksum=" eq $calculated_digest) {
            return 'Package verified';
        }
    }
    close $digest_fh;

    # Return failure, because fetchware failed to verify by checksum
    return undef;
}




sub unarchive {
    my $package_path = shift;

    msg "Unarchiving the downloaded package [$package_path]";


    my ($format, $files) = list_files($package_path);

    { # Encloseing block for $", which prints a \n between each array element.
    local $" = "\n";
    vmsg <
Files are:
[
@$files
]
EOM
    } # Enclosing block for $"

    # Ensure no files starting with an absolute path get extracted
    # And determine $build_path.
    my $build_path = check_archive_files($files);

    vmsg "Unarchiving $format archive [$package_path].";
    unarchive_package($format, $package_path);

    msg "Determined build path to be [$build_path]";
    return $build_path;
}






sub list_files {
    my $package_path = shift;

    # List files based on archive format.
    my $files;
    my $format;
    if ($package_path =~ /\.(t(gz|bz|xz|Z))|(tar\.(gz|bz2|xz|Z))|.fpkg$/) {
        $format = 'tar';
        vmsg <
Listing files in your tar format archive [$package_path].
EOM
        $files = list_files_tar($package_path);
    } elsif ($package_path =~ /\.zip$/) {
        $format = 'zip';
        vmsg <
Listing files in your zip format archive [$package_path].
EOM
        $files = list_files_zip($package_path);
    } else {
        die <
App-Fetchware: Fetchware failed to determine what type of archive your
downloaded package is [$package_path]. Fetchware only supports zip and tar
format archives.
EOD
    }

    # unarchive_package() needs $format, so return that too.
    return $format, $files;
}



sub list_files_tar {
    my $path_to_tar_archive = shift;

    my $tar_iter = Archive::Tar->iter($path_to_tar_archive, 1, );
    die <
App-Fetchware: fetchware failed to create a new Archive::Tar iterator. The
Archive::Tar error message was [@{[Archive::Tar->error()]}].
EOD

    # Iterate over the the archive one file at a time to save memory on big
    # archives suchs a say MariaDB or the Linux kernel.
    my @files;
    while (my $file = $tar_iter->() ) {
        push @files, $file->full_path();
    }

    return \@files;
}


{ # Begin %zip_error_codes hash.
my %zip_error_codes = (
    AZ_OK => 'Everything is fine.',
    AZ_STREAM_END =>
        'The read stream (or central directory) ended normally.',
    AZ_ERROR => 'There was some generic kind of error.',
    AZ_FORMAT_ERROR => 'There is a format error in a ZIP file being read.',
    AZ_IO_ERROR => 'There was an IO error'
);



sub list_files_zip {
    my $path_to_zip_archive = shift;

    my $zip = Archive::Zip->new();

    my $zip_error;
    if(($zip_error = $zip->read($path_to_zip_archive)) ne AZ_OK) {
        die <
App-Fetchware: Fetchware failed to read in the zip file [$path_to_zip_archive].
The zip error message was [$zip_error_codes{$zip_error}].
EOD
    }

    # List the zip files "members," which are annoying classes not just a list
    # of file names. I could use the memberNames() method, but that method
    # returns their "internal" names, but I want their external names, what
    # their names will be on your file system.
    my @members = $zip->members();

    my @external_filenames;
    for my $member (@members) {
        push @external_filenames, $member->fileName();
    }

    # Return list of "external" filenames.
    return \@external_filenames;
}



sub unarchive_package {
    my ($format, $package_path) = @_;

    unarchive_tar($package_path) if $format eq 'tar';
    unarchive_zip($package_path) if $format eq 'zip';
}



sub unarchive_tar {
    my $path_to_tar_archive = shift;

    my @extracted_files = Archive::Tar->extract_archive($path_to_tar_archive);
    # extract_archive() returns false if the extraction failed, which will
    # create an array with one false element, so I have test if tha one element
    # is false not something like if (@extracted_files), because if
    # extract_archive() returns undef on failure not empty list.
    unless ($extracted_files[0]) {
        die <
App-Fetchware: Fetchware failed to extract your archive [$path_to_tar_archive].
The error message from Archive::Tar was [@{[Archive::Tar->error()]}].
EOD
    } else {
        return @extracted_files;
    }
}



sub unarchive_zip {
    my $path_to_zip_archive = shift;

    my $zip = Archive::Zip->new();

    my $zip_error;
    if(($zip_error = $zip->read($path_to_zip_archive)) ne AZ_OK) {
        die <
App-Fetchware: Fetchware failed to read in the zip file [$path_to_zip_archive].
The zip error message was [$zip_error_codes{$zip_error}].
EOD
    }

    if (($zip_error = $zip->extractTree()) ne AZ_OK) {
        die <
App-Fetchware: Fetchware failed to extract the zip file [$path_to_zip_archive].
The zip error message was [$zip_error_codes{$zip_error}].
EOD
    } else {
        return 'Extraced files successfully.';
    }
}

} # End %zip_error_codes




sub check_archive_files {
    my $files = shift;


    # Determine if *all* files are in the same directory.
    my %dir;
    for my $path (@$files) {
        # Skip Fetchwarefiles.
        next if $path eq './Fetchwarefile';
        if (file_name_is_absolute($path)) {
            my $error = <
App-Fetchware: run-time error. The archive you asked fetchware to download has
one or more files with an absolute path. Absolute paths in archives is
dangerous, because the files could potentially overwrite files anywhere in the
filesystem including important system files. That is why this is a fatal error
that cannot be ignored. See perldoc App::Fetchware.
Absolute path [$path].
EOE
            $error .= "[\n";
            $error .= join("\n", @$files);
            $error .= "\n]\n";

            die $error;
        }

        my ($volume,$directories,$file) = splitpath($path);
        my @dirs = splitdir($directories);
        # Skip empty directories.
        next unless @dirs;

        $dir{$dirs[0]}++;
    }


    my $i = 0;
    for my $dir (keys %dir) {
        $i++;
        warn < 1;
App-Fetchware: run-time warning. The archive you asked Fetchware to download
does *not* have *all* of its files in one and only one containing directory.
This is not a problem for fetchware, because it does all of its downloading,
unarchive, and building in a temporary directory that makes it easy to
automatically delete all of the files when fetchware is done with them. See
perldoc App::Fetchware.
EOD

        # Return $build_path
        my $build_path = $dir;
        return $build_path;
    }
}




sub build {
    my $build_path = shift;

    msg "Building your package in [$build_path]";

    vmsg "changing Directory to build path [$build_path]";
    chdir $build_path or die <
App-Fetchware: run-time error. Failed to chdir to the directory fetchware
unarchived [$build_path]. OS error [$!].
EOD


    # If build_commands is set, then all other build config options are ignored.
    if (defined config('build_commands')) {
        vmsg 'Building your package using user specified build_commands.';
        run_star_commands(config('build_commands'));
    # Otherwise handle the other options properly.
    } elsif (
        defined config('configure_options')
        or defined config('prefix')
        or defined config('make_options')
    ) {

        # Set up configure_options and prefix, and then run ./configure.
        vmsg "Running configure with options [@{[config('configure_options')]}]";
        run_configure();

        # Next, make.
        if (defined config('make_options')) {
            vmsg 'Executing make to build your package';
            run_prog('make', config('make_options'))
        } else {
            vmsg 'Executing make to build your package';
            run_prog('make');
        }

    # Execute the default commands.
    } else {
        vmsg 'Running default build commands [./configure] and [make]';
        run_prog($_) for qw(./configure make);
    }

    # Return success.
    msg 'The build was successful.';
    return 'build succeeded';
}

###BUGALERT### Add a *() API REFERENCE section for each fetchware API
#subroutine, and subify the API subs that aren't yet.




sub run_star_commands {
    my @star_commands = @_;

    # Support multiple options like star_command './configure', 'make';
    # Should be called like run_star_commands(config'*_commands')), and
    # config('star_commands') returns a list of *all* star_commands.
    for my $star_command (@star_commands) {
        # If a /,\s+/ is present in a $star_command
        # To support: star_commands './configure, make';
        if ($star_command =~ /,\s*/) {
            # split on it, and run each resulting command.
            my @star_commands = split /,\s*/, $star_command;
            for my $split_star_command (@star_commands) {
                run_prog($split_star_command);
            }
        # Or just run the one command.
        } else {
            run_prog($star_command);
        }
    }
}



###BUGALERT### Add an uninstall() option to instead edit the AutoTools paths
#into relative ones.

sub run_configure {
    my $configure = './configure';
    if (config('configure_options')) {
        # Support multiple options like configure_options '--prefix', '.';
        for my $configure_option (config('configure_options')) {
            $configure .= " $configure_option";
        }
    }

    if (config('prefix')) {
        if ($configure =~ /--prefix/) {
            die <
App-Fetchware: run-time error. You specified both the --prefix option twice.
Once in 'prefix' and once in 'configure_options'. You may only specify prefix
once in either configure option. See perldoc App::Fetchware.
EOD
        } else {
            ###BUGALERT## At least under AutoTools, --prefix needs to be a full
            #path. Should I check for this here? Ignore this possible error, and
            #just let ./configure check its own arguments. Or add syntax
            #checking to configuration subroutines???
            $configure .= " --prefix=@{[config('prefix')]}";
        }
    }

    # Finally run ./configure.
    run_prog($configure);

    # Return success.
    return 'Configure successful';
}



sub install {
    my $build_path = shift;

    # Skip installation if the user requests it.
    if (config('no_install')) {
        msg <
Installation skipped, because no_install is specified in your Fetchwarefile.
EOM
        return 'installation skipped!' ;
    }

    msg 'Installing your software package.';

    chdir_unless_already_at_path($build_path);

    if (defined config('install_commands')) {
        vmsg 'Installing your package using user specified commands.';
        run_star_commands(config('install_commands'));
    } else {
        if (defined config('make_options')) {
            vmsg <
Installing package using default command [make] with user specified make options.
EOM
            run_prog('make', config('make_options'), 'install', );
        } else {
            vmsg <
Installing package using default command [make].
EOM
            run_prog('make', 'install');
        }
    }

    msg 'Installation succeeded';
    # Return success.
    return 'install succeeded';
}





sub chdir_unless_already_at_path {
    my $path = shift;

    # chdir() to $path unless its already our cwd.
    # This is needed, because we'll inherit the "child's" chdir if stay_root is
    # turned on, because stay_root does *not* fork and drop privs, which
    # typicially causes the child's chdir to be "inherited" by the parent,
    # because there is no parent and there is no child due to *not* forking.
    unless ( dir(cwd())->dir_list(-1, 1) eq $path ) {
        chdir($path) or die <
fetchware: fetchware failed to chdir to the build directory [$path]. It
needs to chdir() to this directory, so that it can finish your fetchware
command.
EOD
    vmsg "chdir()'d to the necessary path [$path].";
    }
}






###BUGALERT### Is uninstall() calling API subs a bug??? Should it just use the
#lower level library functions of these tools. Have it do this after I subify
#the rest of the API subs like I've done to lookup and download.
###BUGALERT### NOT TESTED!!! There is no t/App-Fetchware-uninstall.t test
#file!!! cmd_uninstall(), which uses uninstall(), is tested, but not uninstall()
#directly!!!
sub uninstall {
    my $build_path = shift;

    msg "Uninstalling package unarchived at path [$build_path]";

    chdir_unless_already_at_path($build_path);

    if (defined config('uninstall_commands')) {
        vmsg 'Uninstalling using user specified uninstall commands.';
        run_star_commands(config('uninstall_commands'));
    } else {
        # Set up configure_options and prefix, and then run ./configure, because
        # Autotools uses full paths that ./configure sets up, and these paths
        # change from install time to uninstall time.
        vmsg q{Uninstalling using AutoTool's default of make uninstall};

        vmsg q{Running AutoTool's default ./configure};
        run_configure();
        if (defined config('make_options')) {
            vmsg <
Running AutoTool's default make uninstall with user specified make options.
EOM
            run_prog('make', config('make_options'), 'uninstall');
        } else {
            vmsg <
Running AutoTool's default make uninstall.
EOM
            run_prog('make', 'uninstall');
        }
    }


    msg <
Package uninstalled from system, but still installed in Fetchware's database.
EOM
    # Return success.
    return 'uninstall succeeded';
}




sub upgrade {
    my ($download_path, $fetchware_package_path) = @_;

    # I only need the basename.
    my $download_path_basename = file($download_path)->basename();
    my $upgrade_name_basename =
        file( $fetchware_package_path)->basename();
    vmsg <
Shortened the new download url [$download_path_basename] and the installed
package's [$upgrade_name_basename] into just their basenames.
EOM

    # Strip trailing garbage to normalize their names, so that they can be
    # compared to each other.
    ###BUGALERT### This comparision is quite fragile. Figure out a better way to
    #do this!!!
    $upgrade_name_basename =~ s/\.fpkg$//;
    $download_path_basename
        =~ s/(\.(?:zip|tgz|tbz|txz|fpkg)|(?:\.tar\.(gz|bz2|xz|Z)?))$//;
    vmsg <
Striped the new download url [$download_path_basename] and the installed
package's [$upgrade_name_basename] of their file extensions.
EOM

    # Check if $upgrade_name_basename and $download_path_basename are eq, and if
    # they are return false indicating that this program should not be upgraded,
    # because the version available for upgrading is the same as the currently
    # installed version.
    return if $upgrade_name_basename eq $download_path_basename;

        # Transform both competing filenames into a string of version numbers.

    # Use lookup_by_versionstring() to determine which version of the same
    # program is "newer."
    my $sorted_file_names = lookup_by_versionstring(
        [
            [$upgrade_name_basename, 'placeholder'],
            [$download_path_basename, 'placeholder'],
        ]
    );

    if ($sorted_file_names->[0][0] eq $download_path_basename
        # Make sure cmd_upgrade() does not upgrade when the latest version is
        # the same as the currently installed version ($upgrade_name_basename).
        and $sorted_file_names->[0][0] ne $upgrade_name_basename) {
        # The latest version we can download ($download_path_basename) is newer
        # than the currently installed version ($upgrade_name_basename), so we
        # should upgrade.
        return 1;
    } else {
        # Currenlty installed version ($upgrade_name_basename) is equal to the
        # latest version available for download ($download_path_basename), so
        # return false indicating that we sould not upgrade.
        return;
    }
}




sub check_syntax {

    # Use check_config_options() to run config() a bunch of times to check the
    # already parsed Fetchwarefile.
    return check_config_options(
        BothAreDefined => [ [qw(build_commands)],
            [qw(prefix configure_options make_options)] ],
        Mandatory => [ 'program', <
App-Fetchware: Your Fetchwarefile must specify a program configuration
option. Please add one, and try again.
EOM
        Mandatory => [ 'mirror', <
App-Fetchware: Your Fetchwarefile must specify a mirror configuration
option. Please add one, and try again.
EOM
        Mandatory => [ 'lookup_url', <
App-Fetchware: Your Fetchwarefile must specify a lookup_url configuration
option. Please add one, and try again.
EOM
        ConfigOptionEnum => ['lookup_method', [qw(timestamp versionstring)] ],
        ConfigOptionEnum => ['verify_method', [qw(gpg sha1 md5)] ],
    );
}





sub check_config_options {
    my @args = @_;

    my @both_are_defined;
    my @mandatory;
    my @config_option_enum;

    # Process arguments, and check that they were specified correctly.
    # Loop over @args 2 at a time hence the $i += 2 instead of $i++.
    for( my $i = 0; $i < @args; $i += 2 ) {
        my( $type, $AnB ) = @args[ $i, $i+1 ];
        die <
App-Fetchware: check_config_options()'s even arguments must be an array
reference. Please correct your arguments, and try again.
EOD
        die <
App-Fetchware: check_config_options()'s even arguments must be an array
reference with exactly two elements in it. Please correct and try again.
EOD

        if ($type eq 'BothAreDefined') {
            push @both_are_defined, $AnB;
        } elsif ($type eq 'Mandatory') {
            push @mandatory, $AnB;
        } elsif ($type eq 'ConfigOptionEnum') {
            push @config_option_enum, $AnB;
        } else {
            die <
App-Fetchware: check_config_options() only supports types 'BothAreDefined',
'Mandatory', and 'ConfigOptionEnum.' Please specify one of these, and try again.
EOD
        }
    }

    # Process @both_are_defined by checking if both of the elements in the
    # provided arrayrefs are "both defined", and if they are "both defined"
    # throw an exception.
    for my $AnB (@both_are_defined) {
        my ($A, $B) = @$AnB;

        my @A_defined;
        my @B_defined;

        # Check which ones are defined in both $A and $B
        {
            # the config() call will call the specified strings of which many
            # are expected to be uninitialized. Because we expect them to be
            # uninitialized, we use that behavior to determine if they have been
            # specified in the users Fetchwarefile, and if an option was not
            # specified, then undef is returned by config(). Since, we expect
            # lots of undef warnings, we'll disable them.
            no warnings 'uninitialized';
            @A_defined = grep {config($_)} @$A;
            @B_defined = grep {config($_)} @$B;
        }

        if (@A_defined > 0 and @B_defined > 0) {
            die <
App-Fetchware: Your Fetchwarefile has incompatible configuration options.
You specified configuration options [@$A] and [@$B], but these options are not
compatible with each other. Please specifiy either [@$A] or [@$B] not both.
EOD
        }
    }


    # Process @mandatory options by checking if they're defined, and if not
    # throwing the specified exception.
    for my $AnB (@mandatory) {
        my ($option, $error_message) = @$AnB;

        die $error_message if not defined config($option);
    }


    # Process @config_option_enum.
    for my $AnB (@config_option_enum) {
        my ($option, $enumerations) = @$AnB;

        # Ditch uninitialized warnings, because I'm using undef to mean
        # unspecified, so undef is not something unexpected to bother warning
        # about, but something that will happen all the time.
        {
            no warnings 'uninitialized';

            # Only test the @enumerations if $option was specified in the
            # Fetchwarefile.
            if (config($option)) {

                # Only one @enumerations should equal $option not more than one, hence
                # the == 1 part.
                die <
App-Fetchware: You specified the option [$option], but failed to specify only
one of its acceptable values [@$enumerations]. Please change the value you
specified [@{[config($option)]}] to one of the acceptable ones listed above, and try again.
EOD
            }

        }
    }

    return 'Syntax Ok';
}




sub end {
    # Use cleanup_tempdir() to cleanup your tempdir for us.
    cleanup_tempdir();
}



1;

















sub hook ($$) {
    my ($sub_to_hook, $callback) = @_;

    die <can($sub_to_hook);
App-Fetchware: The subroutine [$sub_to_hook] you attempted to override does
not exist in this package. Perhaps you misspelled it, or it does not exist in
the current package.
EOD

    override $sub_to_hook => $callback;

    # Overriding the subroutine is not enough, because it is overriding it
    # inside App::Fetchware, so I need to also override the subroutine inside
    # hook()'s caller as done below.
    {
        no warnings 'redefine';
        clone($sub_to_hook => (from => 'App::Fetchware', to => caller()));
    }
}


###BUGALERT### Add an section of use cases. You know explaing why you'd use
#no_install, or why'd you'd use look, or why And so on.....




###BUGALERT### Create a fetchware command to do this for users perhaps even
#plugin it into Module::Starter???? If possible.
####BUGALERT## Even have so that you can specify which API subs you want to
#override or avoid overriding, and then it will create the skelton with stubs
#for those API sub already having some empty POD crap and the correct
#prototypes.








###BUGALERT### Actually implement croak or more likely confess() support!!!

__END__