view release on metacpan or  search on metacpan

bin/fetchware  view on Meta::CPAN

    my $output = drop_privs(
    sub {
        my $write_pipe = shift;

        ###BUGALERT### Have lookup() replace the timestamp of what we should
        #download too to make upgrade() be able to use the lookup_by_timestamp
        #algorithm too, which is a better default anyway.
        $P_download_path = lookup();

        # Call upgrade() to determine if the currently available version
        # ($P_download_path) is newer than the currenlty installed version
        # ($P_fetchware_package_path).
        my $P_upgrade = upgrade($P_download_path, $P_fetchware_package_path);

        if ($P_upgrade) {
            msg 'New version available upgrading now.';

            my $package_path = download($temp_dir, $P_download_path);

            ###BUGALERT### Add support for caching the key files gpg creates to the
            #fetchwarefile, and for actually using them later on inside the fpkg.
            verify($P_download_path, $package_path);

            $P_build_path = unarchive($package_path);
            build($P_build_path);
        } else {
            # If a new version is not available, then the child should do
            # nothing, and let the parent call end() to clean up below.

            # Set $P_build_path to something that will fail, and give a decent
            # error message just in case.
            $P_build_path = 'Build Path not set because upgrade not needed.';
        }

        # Tell the parent, root, process the values of the variables the
        # child calculated in this coderef, and write them across this pipe
        # back to the parent
        write_dropprivs_pipe($write_pipe,
            $P_upgrade,
            $P_build_path,
            $P_download_path,
            $P_fetchware_package_path
        );
    }, config('user')
    ); # End drop_privs()

    # Read from the pipe the child, the drop_privs()ed process, writes to to
    # read the necessary values that correspond to the variables that the
    # child must communicate back to the parent, so the parent can continue
    # processing as though no fork()ing or priv dropping took place.
    ($P_upgrade,
    $P_build_path,
    $P_download_path,
    $P_fetchware_package_path) = read_dropprivs_pipe($output);

    # Test if a new version is available again due to drop_priv() ending
    # half way through this if statement.
    if ($P_upgrade) {
        install($P_build_path);

        my $updated_fetchware_package_path
            =
            create_fetchware_package($fetchwarefile, cwd());
        vmsg <<EOM;
Created a new fetchware package for the newly installed upgraded fetchware
package [$updated_fetchware_package_path].
EOM

        uninstall_fetchware_package_from_database($P_fetchware_package_path);
        vmsg 'Uninstalled the old fetchware package from the fetchware database.';

        my $installed_fetchware_package_path
            = copy_fpkg_to_fpkg_database($updated_fetchware_package_path);
        vmsg <<EOM;
Installed new fetchware package to fetchware package database
[$installed_fetchware_package_path].
EOM

        end();

        # Return the path of the created and installed fetchware package.
        return $installed_fetchware_package_path;
    } else {

        # I only need the basename.
        my $download_path_basename = file($P_download_path)->basename();
        my $upgrade_name_basename =
            file( $P_fetchware_package_path)->basename();

        # 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)?))$//;

        msg <<EOM;
The latest version [$download_path_basename] is the same as the currently
installed version [$upgrade_name_basename]. So no upgrade is needed. 
EOM
        # Clean up temp dir.
        end();

        # Return success! An upgrade isn't needed, because the latest version
        # has been installed.
        return 'No upgrade needed.';
    }
}



sub cmd_upgrade_all {
    # Does *not* drop_privs(), because it calls cmd_upgrade(), which does, and
    # it does not make any real sense to do it in cmd_upgrade_all(), because all
    # it does is glob the fetchware_database_path(), and pass each element
    # of that list to cmd_upgrade() to do the actual upgrading.
    die <<EOD if @_;
fetchware: fetchware's upgrade-all command takes no arguments. Instead, it
simply loops through fetchware's package database, and upgrades all already
installed fetchware packages. Please rerun fetchware upgrade-all without any
arguments to upgrade all already installed packages, or run fetchware help for
usage instructions.
EOD

    msg 'Upgrading all installed fetchware packages.';

    my $fetchware_db_glob = catfile(fetchware_database_path(), '*');

    my @upgraded_packages;
    for my $fetchware_package (glob $fetchware_db_glob) {
        vmsg 'Looping over list of installed fetchware packages.';
        ###BUGALERT### subize the 2 lines below, because I do this more than