##############################################################################
# Utility functions for Database Manager helper scripts                      #
##############################################################################
#     $Author: villek $ 
#       $Date: 2012/09/07 12:36:16 $ 
#   $Revision: 1.69 $ 
##############################################################################
# COPYRIGHT NOTICE                                                           #
# Copyright 2008-2012 Matrix Science Limited  All Rights Reserved.           #
#                                                                            #
# This program may be used and modified within the licensee's organisation   #
# provided that this copyright notice remains intact. Distribution of this   #
# program or parts thereof outside the licensee's organisation without the   #
# prior written consent of Matrix Science Limited is expressly forbidden.    #
##############################################################################

package DBManager::Workhorse::CLI;

use strict;
use warnings;

use Carp qw(confess);

use Storable qw(nstore_fd fd_retrieve);
use Digest::MD5 qw(md5_hex); # core module since 5.8

# We must use without explicit command line in order to get all the constants
# in below.
use HTTP::Status;

BEGIN {
    if (exists $HTTP::Status::EXPORT_TAGS{'constants'}) {
        HTTP::Status->import(qw(:constants));
    } else {
        # This happens if we're using an old version of HTTP::Status.
        # The :constants keyword was introduced in LWP 5.817 
        # (released 2008-10-10), and the constants were also renamed from RC_
        # to HTTP_. We don't use many in this file, so renaming manually
        # is fine.

        *HTTP_OK = \&RC_OK;
        *HTTP_NO_CONTENT = \&RC_NO_CONTENT;
        *HTTP_PARTIAL_CONTENT = \&RC_PARTIAL_CONTENT;
        *HTTP_NOT_MODIFIED = \&RC_NOT_MODIFIED;
        *HTTP_NOT_FOUND = \&RC_NOT_FOUND;
        *HTTP_NOT_IMPLEMENTED = \&RC_NOT_IMPLEMENTED;
        *HTTP_METHOD_NOT_ALLOWED = \&RC_METHOD_NOT_ALLOWED;
        *HTTP_PROXY_AUTHENTICATION_REQUIRED = \&RC_PROXY_AUTHENTICATION_REQUIRED;
        *HTTP_INTERNAL_SERVER_ERROR = \&RC_INTERNAL_SERVER_ERROR;
    }
}

# Now we can import more.
use HTTP::Status qw(
    is_info is_success is_redirect is_client_error is_server_error
);

use HTTP::Date qw(time2str str2time);
use File::Listing qw(parse_dir);

use Cwd qw(cwd);

use List::Util qw(sum);

use File::stat;
use Fcntl qw(SEEK_SET SEEK_END);

use File::Temp qw(tempdir);
use File::Spec;
use File::Copy qw();

use DBManager::Defaults;
use DBManager::TaskDB;
use DBManager::TaskLog;
use DBManager::Workhorse::XMLTools;

use MascotDat; # for directories

use DBManager::Workhorse::DatabaseTools qw(
    compile_parse_rule
    find_all_matching_filepaths
    fasta_file_is_present
    reference_file_is_present
);

use DBManager::Workhorse::Util qw(
    find_db
    local_filename_has_wildcard
    local_filename_to_regex
    string_to_local_filename
    rename_local_filename_extension
    concretise_local_filename

    make_database_id
    make_taxonomy_entry_id

    backup_configuration_files
    mk_backup_filepath_token
    mk_backup_filepath

    proxy_strategy

    unigene_url_to_filename
);

use DBManager::Workhorse::PublicDefinitions;

use Util::FileOps qw(
    acquire_read_fh 
    acquire_write_fh 
    release_fh 
    inherit_directory_permissions_dir
    inherit_directory_permissions_fh
    inherit_directory_permissions_filepath
    abs_program
    mkpath
);

use Util::Text qw(
    shell_quote 
    human_readable_filesize
    human_readable_transfer_speed
    joinor
);
use Util::Time qw(human_readable_seconds timestamp_to_iso8601);
use Util::URI qw(mk_useragent stringify_proxy_strategy);
use Util::Errors qw(grab_all);
use Util::List qw(any);

use constant {
    ETAGS_FILENAME => 'db_manager.etags',

    # Maximum number of retries in cases where the remote file changes
    # during downloading. (Must be at least 1 or the code will not work.)
    MAX_GARBLE_RETRIES => 5,

    # Timeouts are the same regardless of how many proxy strategies there
    # are; i.e. each proxy strategy timeout is set to the same value, so
    # in the worst case you might have to wait HTTP_TIMEOUT * number of
    # proxy strategies seconds. (This same value is used for FTP requests.)

    HTTP_TIMEOUT => 60, # seconds

    # For debugging: reduce downloading speed to a crawl.
    DEBUG_TRANSFER_PROBLEMS => 0,
};

our ($LWP_REQUEST_DEBUGGING, $SHELL_DEBUGGING, $FILE_OPERATION_DEBUGGING);

sub set_verbosity {
    if ($_[1]) {
        # Increase verbosity of logging: show individual HTTP and FTP requests,
        # their headers and the response headers.
        $LWP_REQUEST_DEBUGGING = 1;

        if ($_[1] >= 2) {
            # Increase verbosity of logging: show individual shell commands.
            $SHELL_DEBUGGING = 1;
        }

        if ($_[1] >= 3) {
            # Increase verbosity of logging: show moving and renaming of files
            # and creating directories.
            $FILE_OPERATION_DEBUGGING = 1;
        }
    }
}

use base qw(Exporter);

# Conventions: 
#
#  - All functions named do_* or _do_* return 0 on failure and 1 on success.
#    In case of failure, errors are logged using DBManager::TaskLog and the
#    task entry (if it exists) will be cleaned up from disk. Otherwise
#    reporting is up to the caller.
#
#  - All functions named create_* or _create_* return an object on success and
#    undef on failure. The failure will be logged using DBManager::TaskLog and
#    the task entry (if it exists) will be cleaned up from disk. Otherwise
#    reporting is up to the caller.
#
# Both types of function take $process_info and $task_entry as the first two
# parameters.

our @EXPORT_OK = qw(
    load_task_entry

    do_get_private_doc
    do_get_public_definitions
    do_reopen_private_doc_for_writing
    do_get_mascot_dat
    do_get_db_entry
    do_get_public_docs

    do_release_lock

    do_make_url_mapping
    do_fetch_files
    do_move_files
    do_rename_moved_files
    do_update_taxonomy_and_unigene
    do_save_configuration
    do_cleanup_downloaded_files

    progress_messager
    progress_offset

    successful_finish
    cancelled_finish
    fatal_finish

    dual_progress
);

sub dual_progress {
    my ($process_info, $progress_messager, $amount, $msg) = @_;

    DBManager::TaskLog->info($process_info, $msg);
    use Carp qw(confess); confess if not $progress_messager;
    $progress_messager->($amount, $msg);

    return 1;
}

sub load_task_entry {
    my ($process_info, $task_ID) = @_;

    my $task_entry;

    if ($task_ID) {
        $task_entry = eval { DBManager::TaskDB->running_task($task_ID) };

        if ($@) {
            my $err = $@;

            DBManager::TaskLog->warn(
                $process_info,
                sprintf(
                    "Could not open process directory for process %d: %s",
                    $task_ID,
                    $err,
                ),
            );
        }

        if (defined $task_entry) {
            DBManager::TaskLog->info(
                $process_info,
                sprintf(
                    "Task to process is '%s'",
                    $task_entry->get_attribute('title'),
                ),
            );
        } else {
            $task_entry = DBManager::Workhorse::SimpleTask->new();

            DBManager::TaskLog->info(
                $process_info,
                sprintf(
                    "No task entry exists for process ID '%d'. Progress information will be output to standard error stream.",
                    $task_ID,
                ),
            );
        }
    }

    if (not $task_entry) {
        $task_entry = DBManager::Workhorse::SimpleTask->new();
    }

    return $task_entry;
}

sub do_get_private_doc {
    my ($process_info, $task_entry, $mode, $mascot_dat_def, 
        $private_doc_ref) = @_;

    my $private_doc_def = _create_doc(
        $process_info,
        $task_entry,
        DBManager::Defaults->private_defs_directory,
        DBManager::Defaults->private_defs_filepath,
        $mode,
    );

    if (not $private_doc_def) {
        return 0;
    }

    if (_mascot_dat_out_of_sync($private_doc_def, $mascot_dat_def)) {
        return fatal_finish(
            $process_info,
            $task_entry,
            'At least one section in mascot.dat under Database Manager control has been modified, which means configuration files no longer match exactly; cannot continue.',
        );
    }

    $$private_doc_ref = $private_doc_def;
    return 1;
}

sub _mascot_dat_out_of_sync {
    my ($private_def, $mascot_dat_def) = @_;

    my $mascot_dat_md5 = $$mascot_dat_def{'structured_md5'}{'sections'};
    my $private_md5 = $$private_def{'doc'}{'MascotDatMD5'};

    for my $section (keys %$mascot_dat_md5) {
        my $section_md5 = $$mascot_dat_md5{$section};
        my $current_md5 = $$private_md5{$section};

        if (not defined $current_md5 or $current_md5 ne $section_md5) {
            return $section;
        }
    }

    return;
}

sub do_get_public_definitions {
    my ($process_info, $task_entry, $progress_messager, $filename_ref) = @_;

    my $from_disk = eval {
        DBManager::Workhorse::PublicDefinitions->latest_from_disk()
    };

    if ($@) {
        return fatal_finish($process_info, $task_entry, $@);
    }

    my $mtime = eval {
        DBManager::Workhorse::PublicDefinitions->mtime_from_disk()
    };

    if ($@) {
        return fatal_finish($process_info, $task_entry, $@);
    }

    my $filename = eval {
        DBManager::Workhorse::PublicDefinitions->latest(60)
    };

    if ($@) {
        my $err = $@;

        if (defined $from_disk) {
            DBManager::TaskLog->warn(
                $process_info, sprintf(
                    "Could not fetch latest predefined definitions: %s\nUsing most recent local predefined definitions file.",
                    $err,
                )
            );

            $progress_messager->(
                1, sprintf(
                    'Using most recent local predefined definitions file (last modified %s.)',
                    timestamp_to_iso8601(localtime($mtime)),
                )
            );

            $$filename_ref = $from_disk;
            return 1;
        }

        return fatal_finish(
            $process_info, 
            $task_entry,
            'Could not fetch latest predefined definitions and no file exists on disk; cannot continue.',
        );
    }

    my $msg;

    if (defined $filename) {
        my $new_mtime = eval {
            DBManager::Workhorse::PublicDefinitions->mtime_from_disk()
        };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }

        if ($new_mtime == $mtime) {
            $msg = 'Latest predefined definitions file is already available (last modified %s); using it.';
        } else {
            $msg = 'New predefined definitions file fetched (last modified %s); using it.';
        }

        dual_progress($process_info, $progress_messager, 1, 
            sprintf($msg, timestamp_to_iso8601(localtime($new_mtime))),
        );

        $$filename_ref = $filename;
        return 1;
    } 

    return fatal_finish(
        $process_info, 
        $task_entry,
        'Could not fetch latest predefined definitions and no file exists on disk; cannot continue.',
    );
}

sub do_reopen_private_doc_for_writing {
    my ($process_info, $task_entry, $private_doc_def, $mascot_dat_def, 
        $db_entry_ref) = @_;

    do_get_private_doc(
        $process_info, $task_entry, 'write', $mascot_dat_def, \my $doc_def
    ) or return 0;

    if ($$doc_def{'file_md5'} eq $$private_doc_def{'file_md5'}) {
        %$private_doc_def = %$doc_def; # refresh 'fh'
        return 1;
    }

    my $entry = find_db($$db_entry_ref->name, $$doc_def{'doc'});

    if (not $entry) {
        return fatal_finish(
            $process_info,
            $task_entry,
            sprintf("Local configuration file '%s' has changed since it was last read, and database %s configuration no longer exists in the file; cannot continue.",
                $$doc_def{'filepath'},
                $$db_entry_ref->name,
            ),
        );
    }

    my $current_md5 = $$private_doc_def{'structured_md5'}{'serialised_entries'}{'Databases'}{
        make_database_id($$db_entry_ref->inherit_from, $$db_entry_ref->inherit_name, $$db_entry_ref->name)
    };

    my $new_md5 = $$doc_def{'structured_md5'}{'serialised_entries'}{'Databases'}{
        make_database_id($entry->inherit_from, $entry->inherit_name, $entry->name)
    };

    if ($current_md5 eq $new_md5) {
        # If the rest of the file has changed, it need not worry us.  We only
        # need to keep the locally editable fields of this particular database
        # entry, such as Active, current_path, incoming_path, NumberOfThreads,
        # MemoryMap, LockToMemory. Cron settings are kept in mascot.dat.

        %$private_doc_def = %$doc_def;
        $$db_entry_ref = $entry;
        return 1;
    }

    if ($entry->current_path ne $$db_entry_ref->current_path) {
        return fatal_finish(
            $process_info,
            $task_entry,

            sprintf("Local configuration file '%s' has changed since it was last read, and database definition for '%s' has changed. Cannot continue.",
                $$doc_def{'filepath'},
                $$db_entry_ref->name,
            )
        );
    }

    return 1;
}


sub do_get_mascot_dat {
    my ($process_info, $task_entry, $mascot_dat_ref) = @_;

    my $def = _create_mascot_dat(
        $process_info,
        $task_entry,
    );

    if (not $def) {
        return 0;
    }

    $$mascot_dat_ref = $def;
    return 1;
}

sub do_get_db_entry {
    my ($process_info, $task_entry, $db_entry_ref, $private_doc_def, $db_name) = @_;

    my $doc = $$private_doc_def{'doc'};

    my $db_entry = find_db($db_name, $doc);

    if (not $db_entry) {
        return fatal_finish($process_info, $task_entry,
            sprintf("Database '%s' is not defined in local configuration file.",
                $db_name,
            ),
        );
    }

    $$db_entry_ref = $db_entry;
    return 1;
}

sub do_get_public_docs {
    my ($process_info, $task_entry, $pub_docs_ref, $private_doc_def, @extra) = @_;

    my $inherited_docs = DBManager::Workhorse::XMLTools->inherited_docs(
        $$private_doc_def{'doc'}
    );

    my @filenames = (@extra, keys %$inherited_docs);

    my %ret = ();

    for (@filenames) {
        next if $ret{$_};

        my $pub_def = _create_doc(
            $process_info,
            $task_entry,
            DBManager::Defaults->public_defs_dir,
            join('/', DBManager::Defaults->public_defs_dir, $_),
        );

        if (not $pub_def) {
            return 0;
        }

        $ret{$_} = $pub_def;
    }

    DBManager::Workhorse::XMLTools->verify_consistency(
        $$private_doc_def{'doc'},
        { map { $_ => $ret{$_}{'doc'} } keys %ret },
    );

    $$pub_docs_ref = \%ret;
    return 1;
}

sub fatal_finish {
    my ($process_info, $task_entry, $err, $ret) = @_;

    _do_fail_task_entry($process_info, $task_entry, $err);
    DBManager::TaskLog->fatal($process_info, $err);

    return 0;
}

sub successful_finish {
    my ($process_info, $task_entry, $msg) = @_;

    _do_succeed_task_entry($process_info, $task_entry, $msg);
    DBManager::TaskLog->success($process_info, $msg);

    return 0;
}

sub cancelled_finish {
    my ($process_info, $task_entry, $msg, $ret) = @_;

    _do_cancel_task_entry($process_info, $task_entry, $msg);
    DBManager::TaskLog->cancelled($process_info, $msg);

    return 0;
}

sub _create_doc {
    my ($process_info, $task_entry, $dir, $filepath, $mode) = @_;

    if (not -e $filepath) {
        return fatal_finish(
            $process_info,
            $task_entry,
            sprintf(
                'Database configuration file \'%s\' does not exist; cannot continue.',
                $filepath,
            ),
        );
    }

    my $fh;

    if (defined $mode and $mode eq 'write') {
        $fh = eval { acquire_write_fh($filepath) };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }

        my ($filename) = $filepath =~ m#([^/]+)$#;

        eval { 
            inherit_directory_permissions_fh($dir, $fh, $filename)
        };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }
    } else {
        $fh = eval { acquire_read_fh($filepath) };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }
    }

    binmode($fh) or return fatal_finish(
        $process_info, $task_entry, 
        sprintf("Cannot set binmode on '%s': %s (%s)", $filepath, $!, $^E),
    );

    my ($xml, $error) = DBManager::Workhorse::XMLTools->parse_xml($fh);

    if (not defined $xml) {
        return fatal_finish(
            $process_info,
            $task_entry,
            sprintf(
                'Database configuration file \'%s\' cannot be parsed: %s',
                $filepath,
                $error,
            ),
        );
    }

    _do_compute_fh_md5(
        $process_info, $task_entry, $filepath, $fh, \my $file_md5,
    ) or return 0;

    my $doc = DBManager::Workhorse::XMLTools->interpret_xml(
        $$xml{'document'}, $$xml{'nsprefix'}, \my @parse_errors,
    );

    if (@parse_errors) {
        DBManager::TaskLog->warn(
            $process_info,
            sprintf("The following parse errors occurred while opening '%s':\n - %s",
                $filepath,
                join("\n - ", @parse_errors)
            )
        );
    }

    return {
        filepath => $filepath,
        fh => $fh,
        doc => $doc,
        file_md5 => $file_md5,
        structured_md5 => DBManager::Workhorse::XMLTools->structured_md5($doc),
    };
}

sub do_release_lock {
    my ($process_info, $task_entry, $def) = @_;

    eval { release_fh($$def{'fh'}) };

    if ($@) {
        return fatal_finish($process_info, $task_entry, $@);
    }

    $$def{'fh'} = undef;

    return 1;
}

sub _create_mascot_dat {
    my ($process_info, $task_entry) = @_;

    my $ms_datfile = msparser::ms_datfile->new(
        join('/', MascotDat->mascotdatdir, 'mascot.dat')
    );

    if (not $ms_datfile->isValid) {
        my @errors = grab_all($ms_datfile->getErrorHandler);

        return fatal_finish(
            $process_info,
            $task_entry,
            sprintf("Cannot read mascot.dat:\n - %s", 
                join("\n - ", @errors)
            ),
        );
    }

    if (my @warnings = grab_all($ms_datfile->getErrorHandler)) {
        DBManager::TaskLog->warn(
            $process_info,
            sprintf("The following warnings occurred while opening mascot.dat:\n- %s",
                join("\n - ", @warnings)
            ),
        );
    }

    _do_compute_file_md5(
        $process_info, $task_entry, $ms_datfile->getFileName, \my $file_md5
    ) or return 0;

    return {
        ms_datfile => $ms_datfile,
        file_md5 => $file_md5,
        structured_md5 => DBManager::Workhorse::DatFileTools->structured_md5(
            $ms_datfile
        ),
    };
}

sub _do_cancel_task_entry {
    my ($process_info, $task_entry, $msg) = @_;

    return _finish_task_entry(
        $process_info,
        $task_entry,
        status => 'cancelled',
        status_message => $msg,
        last_progress_message => 'Cancelled: '.$msg,
    );
}

sub _do_succeed_task_entry {
    my ($process_info, $task_entry, $msg) = @_;

    return _finish_task_entry(
        $process_info,
        $task_entry,
        status => 'succeeded',
        status_message => $msg,
        last_progress_message => 'Succeeded: '.$msg,
    );
}

sub _do_fail_task_entry {
    my ($process_info, $task_entry, $error) = @_;

    return _finish_task_entry(
        $process_info,
        $task_entry,
        status => 'failed',
        status_message => $error,
        last_progress_message => 'Failed: '.$error,
    );
}


sub _finish_task_entry {
    my ($process_info, $task_entry, %data) = @_;

    if (ref $task_entry eq 'DBManager::Workhorse::SimpleTask') {
        $task_entry->more_progress(1, $data{'last_progress_message'});
        return 0;
    }

    eval {
        $task_entry->more_progress(
            1, 
            $data{'last_progress_message'},
        );
    };

    if ($@) {
        DBManager::TaskLog->warn($process_info, $@);
    }

    my $success = eval { 
        DBManager::TaskDB->finish_task($task_entry)
    };

    if ($@ or not $success) {
        my $error = $@ ? $@ : '(unknown error)';
        DBManager::TaskLog->warn($process_info, 
            "Could not move task to the finished task list: $error"
        );
    }

    return 0;
}

sub progress_messager {
    my ($process_info, $task_entry, $min, $max) = @_;

    my $fail_once = 0;

    return progress_offset(
        sub { 
            return if $fail_once;

            eval {
                $task_entry->more_progress(@_) 
            };

            if ($@) {
                $fail_once = 1;
                DBManager::TaskLog->warn($process_info, $@);
            }
        }, $min, $max
    );
}

sub progress_offset {
    my ($fun, $min, $max) = @_;

    if ($min < 0 or $max > 1) {
        confess "limits exceeded: min=$min, max=$max";
    }

    my $range = $max - $min;

    return sub {
        my ($amount, $state) = @_;
        return $fun->($min + $amount * $range, $state);
    };
}

sub _do_ensure_directory_exists {
    my ($process_info, $task_entry, $path, $inherit_from_dir) = @_;

    if (not -d $path) {
        if ($FILE_OPERATION_DEBUGGING) {
            DBManager::TaskLog->info(
                $process_info,
                sprintf("make directory %s", $path),
            );
        }

        eval {
            mkpath($path, { mode => 0777 });
        };

        if ($@) {
            return fatal_finish($process_info, $task_entry,
                sprintf("Cannot create directory '%s': %s", $path, $@)
            );
        }

        eval {
            inherit_directory_permissions_dir($path, $inherit_from_dir)
        };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }
    }

    if (not -r $path) {
        return fatal_finish($process_info, $task_entry,
            sprintf("Directory '%s' is not readable (permission error).",
                $path
            ),
        );
    } elsif (not -w _) {
        return fatal_finish($process_info, $task_entry,
            sprintf("Directory '%s' is not writable (permission error).",
                $path
            ),
        );
    }

    return $path;
}

BEGIN {
    my $version = 2;

    # "ETag store" is a misnomer; the file also saves:
    #   - etag (ETag)
    #   - mtime (Last-Modified)
    #   - size (Content-Length)
    #   - md5 (calculated from downloaded data)
    # These can be used to validate that files on disk match previously
    # downloaded ones.
    sub _do_read_etag_store {
        my ($process_info, $task_entry, $incoming_dir) = @_;

        my $filepath = join('/', $incoming_dir, ETAGS_FILENAME.'.'.$version);
        return {} if not -e $filepath;

        my $fh = eval { acquire_read_fh($filepath) };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }

        my $stat = stat($fh);

        if (not defined $stat) {
            return fatal_finish($process_info, $task_entry, 
                sprintf("Cannot stat '%s': %s (%s)", $filepath, $!, $^E)
            );
        }

        return {} if $stat->size == 0;

        my $data = eval { fd_retrieve($fh) };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }

        return $data || {};
    }

    sub _do_write_etag_store {
        my ($process_info, $task_entry, $incoming_dir, $data) = @_;

        my $filename = ETAGS_FILENAME.'.'.$version;
        my $filepath = join('/', $incoming_dir, $filename);

        my $fh = eval { acquire_write_fh($filepath) };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@, 0);
        }

        eval {
            nstore_fd($data, $fh);
            truncate($fh, tell($fh));
        };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@, 0);
        }

        eval {
            inherit_directory_permissions_fh($incoming_dir, $fh, $filename);
        };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@, 0);
        }

        eval { release_fh($fh) };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@, 0);
        }

        return 1;
    }
}

sub nil_or_empty { !defined($_[0]) || $_[0] eq '' }

sub do_make_url_mapping {
    my ($process_info, $task_entry, $db_entry, $the_full_db_entry,
        $private_doc_def, $pub_defs, $latest_pub_filename, $fetch_ref) = @_;

    my $the_pub_doc = $$pub_defs{$latest_pub_filename}{'doc'};
    my $the_pub_doc_filename = $latest_pub_filename;
    my $the_repo_doc = $the_pub_doc;
    my $the_repo_doc_filename = $the_pub_doc_filename;
    
    if (not $the_full_db_entry) {
        if ($db_entry->inherit_from) {
            $the_full_db_entry = $$the_repo_doc{'Databases'}{
                make_database_id('', '', $db_entry->inherit_name)
            };

            if (not $the_full_db_entry) {
                if ($db_entry->inherit_from eq $latest_pub_filename) {
                    return fatal_finish(
                        $process_info,
                        $task_entry,
                        sprintf("Database %s does not exist in the predefined definitions file '%s'; cannot continue.",
                            $db_entry->inherit_name,
                            $db_entry->inherit_from,
                        )
                    );
                } else {
                    $the_pub_doc = $$pub_defs{$db_entry->inherit_from}{'doc'};
                    $the_pub_doc_filename = $the_repo_doc_filename = $db_entry->inherit_from;
                    $the_repo_doc = $the_pub_doc;

                    $the_full_db_entry = $$the_pub_doc{'Databases'}{
                        make_database_id('', '', $db_entry->inherit_name)
                    };

                    if (not $the_full_db_entry) {
                        return fatal_finish(
                            $process_info,
                            $task_entry,
                            sprintf("Database %s does not exist in neither the latest predefined definitions file '%s' nor in '%s'; cannot continue.",
                                $db_entry->inherit_name,
                                $latest_pub_filename,
                                $db_entry->inherit_from,
                            )
                        );
                    }

                    DBManager::TaskLog->warn(
                        $process_info,
                        sprintf("Database %s does not exist in the latest predefined definitions file; it may have been removed. Continuing with current configuration.",
                            $db_entry->name,
                        ),
                    );
                }
            }
        } else {
            $the_full_db_entry = $db_entry;
            $the_repo_doc = $$private_doc_def{'doc'};
            $the_repo_doc_filename = '';
        }
    }

    my $incoming_path = _do_ensure_directory_exists(
        $process_info, $task_entry, $db_entry->incoming_path
    );
    return 0 if not $incoming_path;

    my $current_path = _do_ensure_directory_exists(
        $process_info, $task_entry, $db_entry->current_path
    );
    return 0 if not $current_path;

    my %fetch_def = ();

    if (not nil_or_empty(my $repo_id = $the_full_db_entry->fasta_remote_source)) {
        my $repo = $$the_repo_doc{'Repositories'}{$repo_id};

        if (not $repo) {
            return fatal_finish($process_info, $task_entry,
                sprintf("FASTA file repository '%s' is not defined in the configuration file.",
                    $repo_id
                ),
            );
        }

        $fetch_def{'fasta'} = [{
            incoming_dir => $incoming_path,
            current_dir => $current_path,
            target_filename => $db_entry->local_filename,
            mirrors => $repo,
            file_is_missing => not(fasta_file_is_present($db_entry)),
        }];
    }

    if (not nil_or_empty(my $repo_id = $the_full_db_entry->version_remote_source)) {
        my $repo = $$the_repo_doc{'Repositories'}{$repo_id};

        if (not $repo) {
            return fatal_finish($process_info, $task_entry,
                sprintf("Version file repository '%s' is not defined in the configuration file.",
                    $repo_id
                ),
            );
        }

        my $parse_rule; 
        
        if (not nil_or_empty(my $rule_id = $the_full_db_entry->version_parse_rule)) {
            my $rule = $$the_repo_doc{'ParseRules'}{$rule_id};

            if ($rule) {
                $parse_rule = $rule->str;
            }
        }

        my $target_filename = rename_local_filename_extension(
            $db_entry->local_filename, '.nam'
        );

        my ($existing) = find_all_matching_filepaths($current_path, $target_filename);

        $fetch_def{'version'} = [{
            incoming_dir => $incoming_path,
            current_dir => $current_path,
            target_filename => $target_filename,
            mirrors => $repo,
            parse_rule => $parse_rule,
            file_is_missing => not($existing) || not(@$existing),
            master_tag_type => 'fasta',
            master_local_filename => $db_entry->local_filename,
            # The newest version file must always be downloaded if 
            # the FASTA file doesn't exist and is to be downloaded.
            # Otherwise the version tag of the FASTA file will be incorrect;
            # see bug #11091. (This will override the previous 
            # file_is_missing entry.)
            file_is_missing => not(fasta_file_is_present($db_entry)),
        }];
    }

    # If the reference file has an associated remote source, the file
    # will only be downloaded if LocalRefFile is true. This is different
    # from db_update.pl in Mascot 2.3 and earlier. 

    if (not nil_or_empty(my $repo_id = $the_full_db_entry->reference_remote_source)) {
        my $is_present = reference_file_is_present($db_entry);

        if ($the_full_db_entry->LocalRefFile
                # Exception to the rule: a fresh custom definition where none
                # of the settings have yet been made, but which has a reference
                # file URL.
                or nil_or_empty($the_full_db_entry->AccessionParseRule)
                # Exception to the rule: if the reference file is missing but
                # has a URL defined, it will be always downloaded regardless of
                # LocalRefFile. See bug 11196.
                or not($is_present)) {
            my $repo = $$the_repo_doc{'Repositories'}{$repo_id};

            if ($repo) {
                $fetch_def{'reference'} = [{
                    incoming_dir => $incoming_path,
                    current_dir => $current_path,
                    target_filename => $db_entry->local_filename,
                    mirrors => $repo,
                    keep_remote_extension => 1,
                    fallback_extension => '.ref',
                    file_is_missing => not($is_present),
                    master_tag_type => 'fasta',
                    master_local_filename => $db_entry->local_filename,
                }];
            } else {
                DBManager::TaskLog->warn(
                    $process_info,
                    sprintf("Reference file repository '%s' is not defined in the configuration file.",
                        $repo_id
                    ),
                );
            }
        }
    }

    if (defined(my $t = $the_full_db_entry->TaxonomyParseRule)) {
        my $current_taxonomy_path = _do_ensure_directory_exists(
            $process_info, $task_entry, MascotDat->taxonomydir
        );
        return 0 if not $current_taxonomy_path;

        my $incoming_taxonomy_path = _do_ensure_directory_exists(
            $process_info,
            $task_entry,
            join('/', MascotDat->taxonomydir, 'incoming'),
            MascotDat->taxonomydir,
        );
        return 0 if not $incoming_taxonomy_path;

        my $tax_name = $$t{'name'};

        if ($tax_name) {
            my $tax_entry;
            my $the_tax_repo_doc = $the_repo_doc;

            if ($db_entry->inherit_from or $db_entry->request_to_merge) {
                # Public definitions don't use inheritance in taxonomy parse
                # rules.
                $the_tax_repo_doc = $the_pub_doc;
                $tax_entry = $$the_pub_doc{'Taxonomy'}{
                    make_taxonomy_entry_id('', '', $tax_name)
                };

                if (not $tax_entry) {
                    return fatal_finish($process_info, $task_entry,
                        sprintf("Taxonomy entry '%s' is not defined in '%s'.",
                            $tax_name,
                            $the_pub_doc_filename,
                        ),
                    );
                }
            } else {
                my ($inherit_name, $inherit_from) = @$t{qw(inherit_name inherit_from)};
                my $local_entry = $$private_doc_def{'doc'}{'Taxonomy'}{
                    make_taxonomy_entry_id($inherit_from, $inherit_name, $tax_name)
                };

                if (not $local_entry) {
                    return fatal_finish($process_info, $task_entry,
                        sprintf("Taxonomy entry '%s' is not defined in the local configuration file.",
                            $tax_name
                        ),
                    );
                }

                if ($local_entry->inherit_from) {
                    my $found_entry;

                    for my $id (keys %{ $$the_pub_doc{'Taxonomy'} }) {
                        my $entry = $$the_pub_doc{'Taxonomy'}{$id};

                        if ($entry->name eq $local_entry->inherit_name) {
                            $found_entry = $entry;
                            last;
                        }
                    }

                    if ($found_entry) {
                        $tax_entry = $found_entry;
                        $the_tax_repo_doc = $the_pub_doc;
                    } else {
                        $the_tax_repo_doc = $$pub_defs{$local_entry->inherit_from}{'doc'};
                        $tax_entry = $$the_tax_repo_doc{'Taxonomy'}{
                            make_taxonomy_entry_id('', '', $local_entry->inherit_name)
                        };

                        if (not $tax_entry) {
                            return fatal_finish($process_info, $task_entry,
                                sprintf("Taxonomy entry '%s' is not defined in neither '%s' nor '%s'.",
                                    $tax_name,
                                    $local_entry->inherit_from,
                                    $latest_pub_filename,
                                ),
                            );
                        }
                    }
                } else {
                    $tax_entry = $local_entry;
                    $the_tax_repo_doc = $$private_doc_def{'doc'};
                }
            }

            # It's not enough to extract the taxonomy files needed for
            # this entry; we need to extract all of them, or at least all
            # that are used by *any* other taxonomy entry. Otherwise
            # the extracted files can become from different versions of
            # e.g. taxdump.tar, and that would not be very nice.

            my %ret = ();

            for my $key (qw(GencodeFile NodesFile SpeciesFile)) {
                my $arr = $tax_entry->$key;

                for (@$arr) {
                    my $filename = $_->FileName;
                    next if nil_or_empty($filename);

                    my $repo_id = $_->remote_source;
                    next if nil_or_empty($repo_id);

                    my $repo = $$the_tax_repo_doc{'Repositories'}{$repo_id};
                    next if not $repo;

                    my $uri_str = join("\0",
                        sort map { $_->uri } @$repo
                    );
                    
                    $ret{$uri_str}{'mirrors'} = $repo;
                    $ret{$uri_str}{'source_filenames'}{$filename} = 1;
                }
            }

            for my $id (keys %{ $$private_doc_def{'doc'}{'Taxonomy'} }) {
                my $tax_entry = $$private_doc_def{'doc'}{'Taxonomy'}{$id};

                my $repo_doc = $$private_doc_def{'doc'};
                my $full_tax_entry = $tax_entry;

                if ($tax_entry->inherit_from) {
                    $repo_doc = $$pub_defs{$tax_entry->inherit_from}{'doc'};
                    $full_tax_entry = $$repo_doc{'Taxonomy'}{
                        make_taxonomy_entry_id('', '', $tax_entry->inherit_name)
                    };
                    next unless $full_tax_entry;
                }

                for my $key (qw(GencodeFile NodesFile SpeciesFile)) {
                    my $arr = $full_tax_entry->$key;

                    for (@$arr) {
                        my $filename = $_->FileName;
                        next if nil_or_empty($filename);

                        my $repo_id = $_->remote_source;
                        next if nil_or_empty($repo_id);

                        my $repo = $$repo_doc{'Repositories'}{$repo_id};
                        next unless $repo;

                        my $uri_str = join("\0",
                            sort map { $_->uri } @$repo
                        );
                    
                        next unless $ret{$uri_str};

                        $ret{$uri_str}{'source_filenames'}{$filename} = 1;
                    }
                }
            }

            if (%ret) {
                for (keys %ret) {
                    my @source_filenames = sort keys %{ $ret{$_}{'source_filenames'} };
                    # The filename doesn't have a wildcard in it, but this
                    # way we don't need to handle special cases.
                    my @target_filenames = map { 
                        string_to_local_filename($_) 
                    } @source_filenames;

                    push @{ $fetch_def{'taxonomy'} }, {
                        incoming_dir => $incoming_taxonomy_path,
                        current_dir => $current_taxonomy_path,
                        source_filenames => \@source_filenames,
                        target_filenames => \@target_filenames,
                        mirrors => $ret{$_}{'mirrors'},
                    };
                }
            }
        }
    }

    my %unigene = ();

    for ($the_full_db_entry, $db_entry) {
        if (defined(my $u = $_->unigene)) {
            $unigene{'enabled'} = $u->enabled if defined $u->enabled;
            $unigene{'indices'} = $u->indices if defined $u->indices;
        }
    }

    do {
        my @indices = @{ $unigene{'indices'} || [] };
        # Don't download UniGene index files if the indices are not enabled.
        # This is consistent with reference file handling.
        # 
        # If the indices are enabled, always download missing files, even
        # if the remote FASTA file has not changed. This is handled in
        # do_fetch_files() and controlled with 'file_is_missing'.

        @indices = () if not $unigene{'enabled'};

        my @fetch = ();

        for (@indices) {
            next if nil_or_empty($_);

            my $pub_entry = $$the_pub_doc{'UniGene'}{$_};

            if (not $pub_entry) {
                DBManager::TaskLog->warn(
                    sprintf('UniGene index \'%s\' is not defined in \'%s\'.',
                        $_,
                        $the_pub_doc_filename,
                    )
                );
                next;
            }

            my $repo_id = $pub_entry->remote_source;
            next if nil_or_empty($repo_id);

            my $repo = $$the_pub_doc{'Repositories'}{$repo_id};
            next if not $repo;

            my ($current_unigene_dir, $local_filename);

            if (my $entry = $$private_doc_def{'doc'}{'UniGene'}{$_}) {
                $current_unigene_dir = $entry->path;
                next if nil_or_empty($current_unigene_dir);

                $local_filename = $entry->local_filename;
                next if not $local_filename;
            } else {
                # Spawn it on the spot.

                my $root = MascotDat->unigenedir;
                $current_unigene_dir = join('/', $root, $_, 'current');

                $local_filename = string_to_local_filename(
                    unigene_url_to_filename($repo->[0]->uri)
                );
            }

            $current_unigene_dir = _do_ensure_directory_exists(
                $process_info, $task_entry, $current_unigene_dir,
                MascotDat->unigenedir,
            );
            return 0 if not $current_unigene_dir;

            my $incoming_unigene_dir = _do_ensure_directory_exists(
                $process_info,
                $task_entry,
                join('/', $current_unigene_dir, 'incoming'),
                MascotDat->unigenedir,
            );
            return 0 if not $incoming_unigene_dir;

            my ($existing) = find_all_matching_filepaths($current_unigene_dir, $local_filename);

            push @fetch, {
                incoming_dir => $incoming_unigene_dir,
                current_dir => $current_unigene_dir,
                target_filename => $local_filename,
                mirrors => $repo,
                file_is_missing => not(defined $existing) || not(@$existing),
            };
        }

        if (@fetch) {
            $fetch_def{'unigene'} = \@fetch;
        }
    };

    %$fetch_ref = %fetch_def;
    return 1;
}

sub do_fetch_files {
    my ($process_info, $task_entry, $progress_messager, $fetch_def, %opts) = @_;

    my @proxy_strategy = proxy_strategy();
    my %etag_store = ();
    my $already_on_disk = 0;

    # Always try the FASTA file first. The order of the rest is not 
    # significant.
    my @types = grep { $_ ne 'fasta' } keys %$fetch_def;
    unshift @types, 'fasta' if $$fetch_def{'fasta'};

    my $num_entries = sum(map { scalar(@$_) } values %$fetch_def);
    my $head_entry_ix = -1;

    my $head_progress_messager = progress_offset($progress_messager, 0, 0.05);

    my @remote_available = ();
    my @remote_unreachable = ();
    my @remote_unchanged = ();

    dual_progress($process_info, $progress_messager, 0,
        sprintf("Request timeout is set to %d seconds.", HTTP_TIMEOUT),
    );

    for my $type (@types) {
        ENTRY: for my $entry (@{ $$fetch_def{$type} }) {
            my $incoming_dir = $$entry{'incoming_dir'};
            my $mirrors = $$entry{'mirrors'};
            ++$head_entry_ix;

            dual_progress($process_info, $head_progress_messager,
                $head_entry_ix/$num_entries,
                sprintf(
                    'Checking which remote files have new versions available (%d out of %d).',
                    1 + $head_entry_ix,
                    $num_entries,
                ),
            );

            my $etags = $etag_store{$incoming_dir};

            if (not $etags) {
                my $e = _do_read_etag_store(
                    $process_info, $task_entry, $incoming_dir
                );

                return 0 if not ref $e;

                $etags = $etag_store{$incoming_dir} = $e;
            }

            my @errors = ();

            MIRROR: for my $mirror (@$mirrors) {
                if ($task_entry->should_do('cancel')) {
                    return cancelled_finish(
                        $process_info, $task_entry,
                        'Cancelled due to user request.',
                    );
                }

                my %success = _HEAD_request(
                    $process_info,
                    $task_entry,

                    $etags,
                    $mirror,
                    \@proxy_strategy,
                );

                if ($success{'died'}) {
                    return fatal_finish(
                        $process_info, $task_entry, $success{'error'}
                    );
                }

                if ($success{'unreachable'}) { # or not found
                    push @errors, $success{'proxy_errors'};
                    next MIRROR;
                }

                my $head_data = $success{'head_data'};

                if ($$head_data{'not_modified'}) {
                    my $temp_filepath = _downloaded_file_filepath(
                        $process_info, $task_entry, $incoming_dir, $head_data
                    );

                    if (not -e $temp_filepath) {
                        if ($opts{'download_even_if_unchanged'} or $$entry{'file_is_missing'}) {
                            push @remote_available, {
                                type => $type,
                                entry => $entry,
                                head_data => $head_data,
                                proxy => $success{'proxy'},
                                mirror => $mirror,
                            };

                            next ENTRY;
                        }

                        push @remote_unchanged, {
                            type => $type,
                            entry => $entry,
                        };

                        next ENTRY;
                    }

                    my $test = _downloaded_file_matches_HEAD(
                        $process_info, $task_entry, $incoming_dir, $head_data,
                        $temp_filepath, $etags
                    );

                    return 0 unless $test;

                    if (my $temp_filepath = $$test{'temp_filepath'}) {
                        $$entry{'downloaded'} = {
                            local_filepath => $temp_filepath,
                            remote_filename => $$head_data{'remote_filename'},
                            remote_mtime => $$head_data{'mtime'},
                            # The exact mirror definition is needed in parsing
                            # the contents of the version file.
                            mirror => $mirror,
                        };

                        push @remote_unchanged, {
                            type => $type,
                            entry => $entry,
                        };

                        ++$already_on_disk;

                        next ENTRY;
                    }

                    push @remote_available, {
                        type => $type,
                        entry => $entry,
                        head_data => $head_data,
                        proxy => $success{'proxy'},
                        mirror => $mirror,
                        incomplete => 1,
                    };

                    next ENTRY;
                }

                my $temp_filepath = _downloaded_file_filepath(
                    $process_info, $task_entry, $incoming_dir, $head_data
                );

                push @remote_available, {
                    type => $type,
                    entry => $entry,
                    head_data => $head_data,
                    proxy => $success{'proxy'},
                    mirror => $mirror,
                    incomplete => -e $temp_filepath ? 1 : 0,
                };

                next ENTRY;
            }
            
            # The loop only comes here if all mirrors fail.

            push @remote_unreachable, {
                type => $type,
                entry => $entry,
                mirror_errors => \@errors,
            };
        }
    }

    if ($num_entries == $already_on_disk) {
        dual_progress(
            $process_info, $progress_messager, 1,
            'All remote sources already exist on disk; no downloading needs to be done.',
        );

        return 2;
    }

    if (@remote_unreachable) {
        my @msg = ();

        for (@remote_unreachable) {
            my $mirror_errors = $$_{'mirror_errors'};
            my $entry = $$_{'entry'};
            my $mirrors = $$entry{'mirrors'};
            my $mirror_prefix = @$mirrors == 1
                ? ''
                : '[mirror #%d] '
                ;
            my @e = ();

            for my $i (0 .. $#$mirrors) {
                my $errors = $$mirror_errors[$i];

                push @e, sprintf("%s%s\n%s",
                    $mirror_prefix ? sprintf($mirror_prefix, $i + 1) : '',
                    $$mirrors[$i]->uri,
                    join("\n", map { sprintf("  %s", $_) } @$errors)
                );
            }

            push @msg, sprintf(
                "Could not fetch remote file (type %s). Check Database Manager proxy settings and that the Internet connection works from the Mascot Server machine.\n\n%s",
                $$_{'type'}, join("\n", @e),
            );
        }

        return fatal_finish(
            $process_info,
            $task_entry,
            join("\n", @msg),
        );
    }

    if ($opts{'download_missing_only'}) {
        @remote_available = grep { $$_{'entry'}{'file_is_missing'} } @remote_available;

        if (@remote_available == 0) {
            return 3;
        }
    }

    if (@remote_available == 0) {
        if (@remote_unchanged) {
            return 2 if any(map { 
                $$_{'entry'}{'downloaded'} and $$_{'entry'}{'file_is_missing'} 
            } @remote_unchanged);

            return 3;
        }

        return fatal_finish(
            $process_info, $task_entry,
            'None of the remote sources were available or had data to return; cannot continue.',
        );
    }

    if (0 == grep { $$_{'incomplete'} } @remote_available) {
        my $do_download_missing = any(
            map { $$_{'entry'}{'file_is_missing'} } @remote_available
        );

        if ($do_download_missing) {
            # Continue downloading.
        } else {
            if ($opts{'download_missing_only'}) {
                # No missing files to download (in particular, we don't want
                # to update any existing files).
                return 3;
            }

            if (@remote_unchanged) {
                # Unchanged as in returned 304 Not Modified and no previous 
                # downloaded files exist on disk.
                if (my $str = $opts{'skip_if_remote_unchanged'}) {
                    for (@remote_unchanged) {
                        if ($$_{'type'} eq $str) {
                            return $$_{'entry'}{'downloaded'} ? 2 : 3;
                        }
                    }
                }
            }
        }
    }
    
    if ($opts{'head_check_only'}) {
        $$fetch_def{'_remote_available'} = \@remote_available;
        return 1;
    }

    my @progress_increments = ();

    do {
        my %size = map { $_ => $$_{'head_data'}{'size'} } @remote_available;
        @remote_available = sort { 
            ($size{$a} || 0) <=> ($size{$b} || 0) 
        } @remote_available;

        my @sizes = values %size;
        my @defined = grep { defined $_ } @sizes;

        # Size could be undefined for some resources if the server didn't
        # return any size. The only meaningful progress estimate we can
        # make in that case is the number of files downloaded out of the
        # total.

        if (@sizes == @defined) {
            my $cumulative_sum = 0;

            for (@sizes) {
                push @progress_increments, $cumulative_sum;
                $cumulative_sum += $_;
            }

            push @progress_increments, $cumulative_sum;

            DBManager::TaskLog->info(
                $process_info,
                sprintf(
                    @remote_available == 1
                        ? "Total size to download is %s (%d file)."
                        : "Total size to download is %s (%d files)."
                        ,
                    human_readable_filesize($cumulative_sum),
                    scalar(@remote_available),
                ),
            );
        } else {
            @progress_increments = (0 .. @remote_available);

            DBManager::TaskLog->info(
                $process_info,
                sprintf("Total number of files to download is %d (total size unknown).",
                    scalar(@remote_available),
                ),
            );
        }
    };

    my $get_progress_messager = progress_offset($progress_messager, 0.05, 1.0);
    my $files_downloaded = 0;

    for my $i (0 .. $#remote_available) {
        my ($type, $entry, $head_data, $proxy, $mirror) = @{ $remote_available[$i] }{qw(
            type entry head_data proxy mirror
        )};

        my $incoming_dir = $$entry{'incoming_dir'};

        my $single_get_progress = progress_offset(
            $get_progress_messager, 
            $progress_increments[$i]/$progress_increments[-1],
            $progress_increments[$i+1]/$progress_increments[-1],
        );

        dual_progress($process_info, $single_get_progress, 0,
            sprintf("Downloading file %d out of %d.",
                1 + $i,
                scalar(@remote_available),
            )
        );

        # It's possible for the remote file to not be available again, 
        # especially if the time between GETs is long (e.g. a large file).
        # _GET_request deals with the discrepancy. In that case we should
        # readjust the progress increments, but it's fairly safe to assume
        # the size discrepancy can't be very big...

        my %status = _GET_request(
            $process_info,
            $task_entry,
            $single_get_progress,

            $head_data,
            $proxy,
            $incoming_dir,
        );

        if ($status{'died'}) {
            return fatal_finish(
                $process_info,
                $task_entry,
                $status{'error'},
            );
        }

        if ($status{'unreachable'}) {
            # HEAD succeeded but GET didn't; out of disk space, for example?
            # Somebody pulled the cable between now and then?
            # Remote server compromised?

            return fatal_finish(
                $process_info, $task_entry,
                sprintf("HEAD request succeeded for <%s>, but GET did not; cannot continue (consult error log for details)",
                    $$head_data{'remote_uri'},
                ),
            );
        }

        if ($status{'garbled'}) {
            return fatal_finish(
                $process_info, $task_entry,
                sprintf("All attempts to download <%s> failed due to timeouts or remote data constantly changing while downloading; cannot continue",
                    $$head_data{'remote_uri'},
                ),
            );
        }

        if ($status{'success'}) {
            if ($status{'unverified'}) {
                # XXX: log here?
            }

            my $etags = $etag_store{$incoming_dir};

            $$etags{ $$head_data{'remote_uri'} } = {
                etag => $status{'etag'},
                mtime => $status{'mtime'},
                size => $status{'size'},
                md5 => $status{'md5'},
            };

            _do_write_etag_store(
                $process_info, $task_entry, $incoming_dir, $etags
            ) or return 0;

            ++$files_downloaded;

            $$entry{'downloaded'} = {
                local_filepath => $status{'temp_filepath'},
                remote_filename => $$head_data{'remote_filename'},
                remote_mtime => $status{'mtime'},
                # The exact mirror definition is needed in parsing
                # the contents of the version file.
                mirror => $mirror,
            };

            next;
        }

        if ($status{'suspended'} or $status{'cancelled'}) {
            return 0;
        }

        die "programming error";
    }

    if ($files_downloaded != @remote_available) {
        return fatal_finish(
            $process_info,
            $task_entry,
            'Not all file downloads succeeded; cannot continue.',
        );
    }

    return 1;
}

sub _select_token { (grep { defined($_) } @_)[0] }

# Note: HEAD and GET are HTTP verbs, but they are implemented as analogous 
# operations for FTP sources.

sub _HEAD_request {
    my ($process_info, $task_entry, $etags, $mirror, $proxy_strategy) = @_;

    # $mirror is of type DBManager::Internal::RemoteSourceURI.

    my $uri = URI->new($mirror->uri);
    my $wildcard;
    
    if ($uri->scheme eq 'ftp') {
        if (not nil_or_empty($mirror->wildcard)) {
            $wildcard = $mirror->wildcard; # with some number of * or ?

            if ($uri->path !~ m#/$#) {
                # If the URI points to a file, this will make it into
                # a nonexistent directory. But that's a problem with the
                # configuration.
                $uri->path($uri->path.'/');
            }
        }
    }

    my %errors_by_proxy = ();
    
    PROXY_STRATEGY: for my $proxy (@$proxy_strategy) {
        my $data;
        my $strategy = stringify_proxy_strategy($proxy);

        DBManager::TaskLog->info(
            $process_info,
            sprintf(
                "Trying to access <%s> via %s%s",
                $uri, 
                $strategy =~ /direct/ ? '' : " proxy strategy ",
                $strategy,
            ),
        );

        my @errors = ();

        if (defined $wildcard) {
            $data = _HEAD_request_wildcard(
                $process_info,
                $proxy,
                $uri,
                $etags,
                $wildcard,

                \@errors,
            );
        } else {
            my ($etag, $mtime);

            if ($$etags{$uri}) {
                $etag = $$etags{$uri}{'etag'};
                $mtime = $$etags{$uri}{'mtime'};
            }

            $data = _HEAD_request_filepath(
                $process_info,
                $proxy,
                $uri,
                $mtime,
                $etag,

                \@errors,
            );
        }

        if ($data) {
            if ($$data{'died'}) {
                return %$data;
            }

            if ($$data{'not_found'}) {
                if (@errors) {
                    $errors_by_proxy{stringify_proxy_strategy($proxy)} = \@errors;
                }

                next PROXY_STRATEGY;
            }

            my $strategy = stringify_proxy_strategy($proxy);

            DBManager::TaskLog->info(
                $process_info,
                sprintf(
                    'Success; using%s%s when accessing <%s>',
                    $strategy =~ /direct/ ? '' : " proxy strategy ",
                    $strategy,
                    $uri, 
                )
            );

            return (
                head_data => $data,
                proxy => $proxy,
            );
        }

        if (@errors) {
            $errors_by_proxy{stringify_proxy_strategy($proxy)} = \@errors;
        }

        next PROXY_STRATEGY;
    }

    my @errors = map {
        my $p = $_;
        map { 
            sprintf("%s%s: %s", $p =~ /direct/ ? '' : 'proxy=', $p, $_) 
        } @{ $errors_by_proxy{$p} }
    } sort keys %errors_by_proxy;

    return (
        unreachable => 1,
        proxy_errors => \@errors,
    );
}

sub _HEAD_request_filepath {
    return _make_HEAD_request_filepath(
        'HEAD', @_
    );
}

sub _mk_final_response {
    return {
        code => $_[0]->code,
        status_line => $_[0]->status_line,
        headers => $_[0]->headers->clone(),
        request_uri => $_[0]->request->uri(),
    };
}

BEGIN {
    my @blacklist = (
        qr{^http://[^/]*uniprot.org/}
    );

    sub _only_use_GET {
        my ($uri) = @_;

        if ($uri->scheme ne 'http') {
            # There is a bizarre interaction between FTP requests and
            # Windows Firewall on Windows XP. If the request is aborted
            # (either internally by Net::FTP or by using a request callback
            # by us), the final response status will be "500 FTP close 
            # response", regardless of whether the original request succeeded
            # or not. There are two solutions:
            #  1) Disable Windows Firewall.
            #  2) Save the successful response object before aborting.
            # We do the latter by always using the simulated GET request
            # with FTP "HEAD" requests and create a replica of the response
            # data in the request callback just before dying.
            return 1;
        }

        # Some web servers are blacklisted, because they return different
        # headers for exactly the same resource depending on request type 
        # (GET or HEAD), which violates the HTTP standard. We only use GET for
        # blacklisted servers.
        for my $re (@blacklist) {
            if ($uri =~ $re) {
                return 1;
            }
        }

        return 0;
    }
}

sub _make_HEAD_request_filepath {
    my ($request_method, $process_info, $proxy, $uri, $current_mtime, 
        $current_etag, $errors) = @_;

    if ($request_method ne 'GET') {
        if (_only_use_GET($uri)) {
            return _make_HEAD_request_filepath(
                'GET', $process_info, $proxy, $uri, $current_mtime, 
                $current_etag, $errors,
            );
        }
    }

    # Range headers in HEAD requests are meaningless, so they are 
    # not used here.

    # Also, LWP doesn't insert the Content-Length header to 304 responses
    # from FTP servers, so we can't actually use any of the headers for
    # FTP URLs. So much for automation.

    my %headers = ();

    if ($uri->scheme eq 'http') {
        if (defined $current_mtime) {
            $headers{'If-Modified-Since'} = time2str($current_mtime);
        }

        if (defined $current_etag) {
            $headers{'If-None-Match'} = sprintf('"%s"', $current_etag);
        }
    }

    my $request = HTTP::Request->new(
        $request_method => $uri, 
        HTTP::Headers->new(%headers)
    );

    my $ua = mk_useragent($request, $proxy);
    $ua->timeout(HTTP_TIMEOUT);

    if ($LWP_REQUEST_DEBUGGING) {
        DBManager::TaskLog->info($process_info, 
            sprintf(
                "_make_HEAD_request_filepath(request_method=%s, proxy=%s, mtime=%s, etag=\"%s\"); request:\n%s",
                $request_method, 
                stringify_proxy_strategy($proxy),
                defined($current_mtime) ? $current_mtime : '<undef>',
                defined($current_etag) ? $current_etag : '<undef>',
                $request->as_string("\n"),
            ),
        );
    }

    my $final_response;

    # Use of eval{} is the belt and suspenders approach.

    my $response = eval {
        $ua->request($request, 
            # Don't try to download any content body in GET request.
            $request_method eq 'HEAD' 
                ? () 
                : sub { $final_response = _mk_final_response($_[1]); die 'enough' }
        )
    };

    my $err;

    if ($@) {
        $err = $@;
    } else {
        $err = $response->header('X-Died');
    }

    if (not defined $final_response) {
        $final_response = _mk_final_response($response);
    }

    if ($err) {
        if ($err =~ m#^enough#) {
            # skip
        } elsif ($err =~ m#^Timeout#) {
            # LWP/Protocol/ftp.pm can throw an unhandled Timeout exception
            # when Net::FTP times out while reading from the socket.
            push @$errors, 'Timeout while reading from socket';
            return;
        } else {
            return { died => 1, error => $err };
        }
    }

    if ($LWP_REQUEST_DEBUGGING) {
        DBManager::TaskLog->info($process_info, 
            sprintf(
                "_make_HEAD_request_filepath(request_method=%s, proxy=%s, mtime=%s, etag=\"%s\"); response:\n%s\n\n%s",
                $request_method, 
                stringify_proxy_strategy($proxy),
                defined($current_mtime) ? $current_mtime : '<undef>',
                defined($current_etag) ? $current_etag : '<undef>',
                $$final_response{'status_line'},
                $$final_response{'headers'}->as_string("\n"),
            ),
        );
    }

    if (is_success($$final_response{'code'})) {
        if ($$final_response{'code'} == HTTP_OK 
                or $$final_response{'code'} == HTTP_NO_CONTENT) {
            my ($etag, $mtime, $size) = _parse_response_headers(
                $$final_response{'headers'}, $uri->scheme, 
                $$final_response{'request_uri'},
            );

            my $not_modified = 0;

            if ($uri->scheme eq 'http') {
                # Some servers don't return 304 Not Modified even when we
                # make a conditional request... Those same servers don't
                # "do" ETags either, so we'll use that as the discriminating
                # feature.

                if (not defined $current_etag) {
                    $not_modified = _resource_not_modified(
                        $current_etag, $current_mtime, $etag, $mtime
                    );
                }
            } else {
                $not_modified = _resource_not_modified(
                    $current_etag, $current_mtime, $etag, $mtime,
                );
            } 

            return {
                unreachable => 0,
                not_modified => $not_modified,
                etag => $etag,
                mtime => $mtime,
                size => $size,
                remote_filename => _remote_filename_from_response(
                    $$final_response{'headers'}, 
                    $$final_response{'request_uri'},
                ),
                remote_uri => $uri,
            };
        }
    }

    if (is_redirect($$final_response{'code'})) {
        if ($$final_response{'code'} == HTTP_NOT_MODIFIED) {
            my ($etag, $mtime, $size) = _parse_response_headers(
                $$final_response{'headers'}, $uri->scheme, 
                $$final_response{'request_uri'},
            );

            # Infuriatingly some proxies (e.g. squid) don't return an ETag in
            # a 304 response even if the original request had If-None-Match.

            # HTTP only branch.
            return {
                unreachable => 0,
                not_modified => 1,
                etag => nil_or_empty($current_etag)
                    ? $etag
                    : $current_etag
                    ,
                mtime => nil_or_empty($current_mtime)
                    ? $mtime
                    : $current_mtime,
                    ,
                size => $size,
                remote_filename => _remote_filename_from_response(
                    $$final_response{'headers'}, 
                    $$final_response{'request_uri'},
                ),
                remote_uri => $uri,
            };
        }

        # HTTP_USE_PROXY is a possible code, but it's not intended
        # for a use where a request fails due to a proxy error.
        # So, the rest are an error.
    }

    if (is_client_error($$final_response{'code'})) {
        if ($$final_response{'code'} == HTTP_METHOD_NOT_ALLOWED) {
            if ($request_method eq 'HEAD') {
                return _make_HEAD_request_filepath(
                    'GET', $process_info, $proxy, $uri, $current_mtime, 
                    $current_etag, $errors,
                );
            }
        }

        if ($$final_response{'code'} == HTTP_NOT_FOUND) {
            push @$errors, 'Remote file not found';
            return { not_found => 1 };
        }

        # fall-through
    }

    my $is_internal_error = ($response->header('Client-Warning') || '') eq 'Internal response';

    if ($is_internal_error 
            and $$final_response{'code'} == HTTP_INTERNAL_SERVER_ERROR) {
        if ($request_method eq 'HEAD') {
            DBManager::TaskLog->info($process_info, 
                sprintf(
                    "HEAD not supported? Trying GET for <%s>",
                    $uri
                ),
            );

            return _make_HEAD_request_filepath(
                'GET', $process_info, $proxy, $uri, $current_mtime, 
                $current_etag, $errors,
            );
        }
    }

    push @$errors, $$final_response{'status_line'};
    return;
}

sub _remote_filename_from_response {
    my ($headers, $response_request_uri) = @_;

    # HTTP::Response in LWP 5.813 and newer implements a method 'filename()',
    # which tries to parse the remote filename from the following sources:
    # - Content-Disposition
    # - Content-Location
    # - URI
    #
    # It's not supported in LWP 5.805 (ActivePerl 5.8.8 820), so we need
    # to do the same manually.

    if (my $content_disposition = $headers->header('Content-Disposition')) {
        my ($filepath) = $content_disposition =~ m#filename="(.+)"#;

        if (not nil_or_empty($filepath)) {
            my ($filename) = $filepath =~ m#([^/]+)$#;
            return $filename if not nil_or_empty($filename);
        }
    }

    my $remote_uri;

    if (my $content_location = $headers->header('Content-Location')) {
        $remote_uri = URI->new($content_location);
    } else {
        # The request object could be different from the original one, if there
        # have been redirects.
        $remote_uri = URI->new($response_request_uri);
    }

    if (nil_or_empty($remote_uri->query)) {
        my ($filename) = $remote_uri->path =~ m#([^/]+)$#;

        if (not nil_or_empty($filename)) {
            return $filename;
        }

        # No choice but to use the full URL.
        $filename = $remote_uri->as_string;
        $filename =~ s#[^a-zA-Z0-9_.,"'=;&%+-]#_#g;

        return $filename;
    }

    # Do what wget does: make a filename from the combined path and query.
    my $filename = $remote_uri->path_query;
    $filename =~ s#[^a-zA-Z0-9_.,"'=;&%+-]#_#g;
    return $filename;
}

sub _parse_response_headers {
    my ($headers, $protocol, $response_request_uri, $override_content_length) = @_;

    my ($etag, $mtime, $size);

    if (not nil_or_empty(my $str = $headers->header('Content-Length'))) {
        $size = $str;
    }

    # For Range responses.
    if (defined $override_content_length) {
        $size = $override_content_length;
    }

    if ($protocol eq 'ftp') {
        if (not nil_or_empty($size)) {
            $etag = _fake_ftp_etag(
                $size, 
                _remote_filename_from_response(
                    $headers, $response_request_uri
                )
            );
        }
    } else {
        if (not nil_or_empty(my $str = $headers->header('ETag'))) {
            if (substr($str, 0, 2) eq 'W/') {
                # Weak ETag means another representation of the entity may
                # have the same ETag even if the byte representation differs.
                # No use to us.
            } else {
                ($etag) = $str =~ m#"(.+)"#;
            }
        }
    }

    if (not nil_or_empty(my $str = $headers->header('Last-Modified'))) {
        $mtime = str2time($str);
    }

    return ($etag, $mtime, $size);
}

sub _fake_ftp_etag { md5_hex(sprintf('%d|%s', $_[0], $_[1] || '')) }

sub _compile_wildcard {
    my ($wildcard) = @_;

    my $re;

    my $f = string_to_local_filename($wildcard);
    my @components = ();
        
    for (@$f) {
        if (not ref $_) {
            push @components, quotemeta($_);
            next;
        }

        if ($$_{'type'} ne 'wildcard') {
            push @components, quotemeta($$_{'_'});
            next;
        }

        if ($$_{'_'} eq '?') {
            push @components, '.';
            next;
        }

        if ($$_{'_'} eq '*') {
            push @components, '.*';
            next;
        }
    }

    my $str = join('', @components);
    my $err;

    do {
        use warnings FATAL => qw(regexp);
        $re = eval { qr{$str}i };

        if ($@) { 
            $err = $@;
        }
    };

    if ($err) {
        die "programming error: $err"
    }

    return $re;
}

sub _HEAD_request_wildcard {
    my ($process_info, $proxy, $directory_uri, $etags, $wildcard, $errors) = @_;

    my $re = _compile_wildcard($wildcard);
    my $request = HTTP::Request->new(GET => $directory_uri);

    my $ua = mk_useragent($request, $proxy);
    $ua->timeout(HTTP_TIMEOUT);

    if ($LWP_REQUEST_DEBUGGING) {
        DBManager::TaskLog->info($process_info, 
            sprintf(
                "_HEAD_request_wildcard(proxy=%s); request:\n%s",
                stringify_proxy_strategy($proxy),
                $request->as_string("\n"),
            ),
        );
    }

    my $response = eval { $ua->request($request) };

    if ($@) {
        my $err = $@;

        if ($err =~ /^Timeout/) {
            push @$errors, 'Timeout while reading from socket';
            return;
        }

        return { died => 1, error => $err };
    }

    if ($LWP_REQUEST_DEBUGGING) {
        DBManager::TaskLog->info($process_info, 
            sprintf(
                "_HEAD_request_wildcard(proxy=%s); response:\n%s\n\n%s",
                stringify_proxy_strategy($proxy),
                $response->status_line,
                $response->headers->as_string("\n"),
            ),
        );
    }

    my $is_internal_error = ($response->header('Client-Warning') || '') eq 'Internal response';

    if ($response->header('Content-Type') ne 'text/ftp-dir-listing') {
        push @$errors, 'FTP server did not return a file listing; cannot use wildcard';
        return;
    }

    my $content = $response->decoded_content();
    $content = $response->content if not defined $content;

    my $remote_entry;

    do {
        local $ENV{'LANG'} = 'C'; # File::Listing is picky
        # XXX: Is there a way to figure out the server timezone for
        # better timestamp accuracy?

        my $found_mode;

        for my $mode (qw(unix apache dosftp)) {
            my $unrecognised = 0;

            my @entries = grep { defined $_ } parse_dir(
                $content, undef, $mode, 
                # Weed out unrecognised entries
                sub { ++$unrecognised; return }
            );

            next if not @entries or $unrecognised;

            $found_mode = $mode;

            for (@entries) {
                my ($filename, $filetype, $filesize, $mtime) = @$_;

                next if $filetype ne 'f';
                next if $filename !~ $re;

                # $mtime is not reliable at all, because its formatting
                # can depend on how recently the file was changed (e.g. Unix 
                # ls can print just the hour and minute if the file was
                # changed today). So we need to perform an additional
                # HEAD request once the filename is known, just to find out
                # the exact modification time. Sigh.

                $remote_entry = {
                    filename => $filename,
                };

                last;
            }

            last;
        }

        if (not $found_mode) {
            push @$errors, 'Could not parse FTP directory listing; cannot use wildcard';
            return;
        }
    };

    if (not defined $remote_entry) {
        push @$errors, "No remote file matches wildcard '$wildcard'";

        return { not_found => 1 };
    }

    my $remote_uri = URI->new($directory_uri);
    # This assumes $uri->path ends in /, which it has to, as otherwise
    # we would not have received a file listing.
    $remote_uri->path($remote_uri->path.$$remote_entry{'filename'});

    my ($current_etag, $current_mtime);

    if (my $e = $$etags{$remote_uri}) {
        if (not nil_or_empty($$e{'etag'})) {
            $current_etag = $$e{'etag'};
        }
        
        if (not nil_or_empty($$e{'mtime'})) {
            $current_mtime = $$e{'mtime'};
        }
    }

    return _HEAD_request_filepath(
        $process_info, $proxy, $remote_uri, $current_mtime, $current_etag, 
        $errors,
    );
}

sub _resource_not_modified {
    my ($current_etag, $current_mtime, $remote_etag, $remote_mtime) = @_;

    my $num_tests = 0;
    my $num_succeeds = 0;

    if (defined $current_mtime) {
        ++$num_tests;

        if ($current_mtime == $remote_mtime) {
            ++$num_succeeds;
        }
    }

    if (defined $current_etag) {
        ++$num_tests;

        if ($current_etag eq $remote_etag) {
            ++$num_succeeds;
        }
    }

    return 0 if $num_tests == 0; # no way of knowing

    return $num_tests == $num_succeeds ? 1 : 0;
}

sub _mk_downloaded_filename {
    my ($remote_filename, $etag, $mtime) = @_;

    my $token = do {
        my $head_md5;

        if (my @a = map { nil_or_empty($_) ? '' : $_ } $etag, $mtime) {
            $head_md5 = md5_hex(join("\0", @a));
        }

        _select_token($head_md5, time)
    };

    return sprintf("%s.%s", $remote_filename, $token);
}

sub _cleanup_previous_file_versions {
    my ($process_info, $task_entry, $incoming_dir, $remote_file, 
        $temp_filename) = @_;

    my $re = qr{^\Q$remote_file\E\.(?:[0-9a-zA-Z]+)$};

    opendir(my $dirh, $incoming_dir) or return (
        error => sprintf("Cannot open directory '%s': %s (%s)", $incoming_dir, $!, $^E)
    );

    my $num_cleaned = 0;

    while (defined(my $filename = readdir($dirh))) {
        next if $filename eq '.' or $filename eq '..';
        next if $filename eq $temp_filename;
        next unless $filename =~ $re;

        my $filepath = join('/', $incoming_dir, $filename);

        if ($FILE_OPERATION_DEBUGGING) {
            DBManager::TaskLog->info(
                $process_info, 
                sprintf("remove %s", $filepath),
            );
        }

        unlink($filepath) or return (
            error => sprintf("Cannot remove '%s': %s (%s)", $filepath, $!, $^E)
        );

        ++$num_cleaned;
    }

    closedir($dirh) or return (
        error => sprintf("Cannot close directory '%s': %s (%s)", $incoming_dir, $!, $^E)
    );

    return (num_cleaned => $num_cleaned);
}

sub _downloaded_file_filepath {
    my ($process_info, $task_entry, $incoming_dir, $head_data) = @_;

    my $temp_filename = _mk_downloaded_filename(
        $$head_data{'remote_filename'},
        $$head_data{'etag'}, $$head_data{'mtime'},
    );
    
    return join('/', $incoming_dir, $temp_filename);
}

sub _downloaded_file_matches_HEAD {
    my ($process_info, $task_entry, $incoming_dir, $head_data, $temp_filepath,
        $etags) = @_;

    if (not -e $temp_filepath) {
        return { };
    }

    my $etag_store = $$etags{ $$head_data{'remote_uri'} };

    if (not $etag_store) {
        return { };
    }

    my $stat = stat($temp_filepath);

    if (not defined $stat) {
        return fatal_finish(
            $process_info, $task_entry, 
            sprintf("Cannot determine file size of '%s': %s (%s)", $temp_filepath, $!, $^E)
        );
    }

    my $filesize = $stat->size;
    my $current_size = $$etag_store{'size'};

    if ($current_size != $filesize) {
        DBManager::TaskLog->info(
            $process_info,
            sprintf("File size mismatch: downloading of <%s> into '%s' needs to be resumed.",
                $$head_data{'remote_uri'},
                $temp_filepath,
            ),
        );

        return { };
    }

    _do_compute_file_md5(
        $process_info, $task_entry, $temp_filepath, \my $md5
    ) or return 0;

    my $current_md5 = $$etag_store{'md5'};

    if ($current_md5 eq $md5) {
        DBManager::TaskLog->info(
            $process_info,
            sprintf("MD5 checksums match: <%s> has already been downloaded into '%s'.",
                $$head_data{'remote_uri'},
                $temp_filepath,
            ),
        );
        return { temp_filepath => $temp_filepath };
    }

    DBManager::TaskLog->info(
        $process_info,
        sprintf("MD5 checksums do not match: <%s> has been partially downloaded into '%s'.",
            $$head_data{'remote_uri'},
            $temp_filepath,
        ),
    );

    return { };
}

sub _do_compute_file_md5 {
    my ($process_info, $task_entry, $temp_filepath, $md5_ref) = @_;

    my $fh = eval { acquire_read_fh($temp_filepath) };

    if ($@) {
        return fatal_finish($process_info, $task_entry, $@);
    }

    return _do_compute_fh_md5(
        $process_info, $task_entry, $temp_filepath, $fh, $md5_ref
    );
}

sub _do_compute_fh_md5 {
    my ($process_info, $task_entry, $filepath, $fh, $md5_ref) = @_;

    seek($fh, 0, SEEK_SET) or return fatal_finish(
        $process_info,
        $task_entry,
        sprintf("Cannot read file '%s': %s (%s)", $filepath, $!, $^E),
    );

    binmode($fh) or return fatal_finish(
        $process_info, $task_entry, 
        sprintf("Cannot set binmode on '%s': %s (%s)", $filepath, $!, $^E)
    );

    my $md5 = Digest::MD5->new();

    eval { $md5->addfile($fh) };

    if ($@) {
        return fatal_finish($process_info, $task_entry, $@);
    }

    $$md5_ref = $md5->hexdigest;

    return 1;
}

sub _GET_request {
    my ($process_info, $task_entry, $progress_messager, $head_data, $proxy,
        $incoming_dir) = @_;

    # We can recognise partial downloads by testing if the temporary
    # filename already exists. To make it all work, the temporary name
    # must be constructed from the remote ETag and Last-Modified
    # header contents. This way if the remote file changes, it will
    # be downloaded under a new name.

    my %new_head_data = %$head_data;

    for my $garble_num (1 .. MAX_GARBLE_RETRIES) {
        my $temp_filename = _mk_downloaded_filename(
            $new_head_data{'remote_filename'},
            $new_head_data{'etag'}, $new_head_data{'mtime'},
        );

        my $temp_filepath = join('/', $incoming_dir, $temp_filename);

        # acquire_write_fh won't clobber if the file already exists.
        my $fh = eval { acquire_write_fh($temp_filepath) };

        if ($@) {
            return (died => 1, error => $@);
        }

        eval {
            inherit_directory_permissions_fh($incoming_dir, $fh, $temp_filename)
        };

        if ($@) {
            return (died => 1, error => $@);
        }

        binmode($fh) or return (
            died => 1, 
            error => sprintf("Cannot set binmode on '%s': %s (%s)", $temp_filepath, $!, $^E),
        );

        my $garble_messager = progress_offset(
            $progress_messager,
            ($garble_num - 1)/MAX_GARBLE_RETRIES,
            $garble_num/MAX_GARBLE_RETRIES,
        );

        my $garble_tag = sprintf("(try %d out of %d)", 
            $garble_num, MAX_GARBLE_RETRIES
        );

        dual_progress(
            $process_info,
            $garble_messager,
            0,
            sprintf('Downloading <%s> %s', 
                $new_head_data{'remote_uri'}, $garble_tag
            ),
        );
        
        my %status = _GET_request_filepath(
            $process_info, $task_entry, $garble_messager, \%new_head_data, 
            $proxy, $temp_filepath, $fh, $garble_tag
        );

        if ($status{'died'}) {
            # I/O error while writing to disk?
            return %status;
        }

        if ($status{'suspended'} or $status{'cancelled'}) {
            cancelled_finish(
                $process_info, $task_entry, 
                'Cancelled due to user request.',
            );

            return %status;
        }

        if ($status{'precondition_failed'} or $status{'garbled'}) {
            for (qw(etag mtime size)) {
                $new_head_data{$_} = $status{$_};
            }

            close($fh) or return (
                died => 1, 
                error => sprintf("Cannot close '%s': %s (%s)", $temp_filepath, $!, $^E),
            );

            if ($FILE_OPERATION_DEBUGGING) {
                DBManager::TaskLog->info(
                    $process_info, 
                    sprintf("remove %s", $temp_filepath),
                );
            }

            unlink($temp_filepath) or return (
                died => 1, 
                error => sprintf("Cannot remove '%s': %s (%s)", $temp_filepath, $!, $^E),
            );

            DBManager::TaskLog->warn(
                $process_info,
                sprintf('Downloading <%s> failed %s',
                    $new_head_data{'remote_uri'}, $garble_tag,
                ),
            );

            next;
        }

        if ($status{'timeout'} or $status{'ftp_error'}) {
            # Retry with the same data.

            close($fh) or return (
                died => 1, 
                error => sprintf("Cannot close '%s': %s (%s)", $temp_filepath, $!, $^E),
            );

            DBManager::TaskLog->warn(
                $process_info,
                sprintf('Downloading <%s> failed %s',
                    $new_head_data{'remote_uri'}, $garble_tag,
                ),
            );

            next;
        }

        if ($status{'unreachable'}) {
            # E.g. 404 Not Found, some other kind of server or client error.
            # $fh has not been touched, but we can't really continue. Clean
            # up if we haven't downloaded anything.

            if ($LWP_REQUEST_DEBUGGING) {
                DBManager::TaskLog->warn(
                    $process_info,
                    sprintf("Unreachable remote source <%s>\n%s",
                        $new_head_data{'remote_uri'},
                        $status{'error_body'},
                    )
                );
            }

            my $stat = stat($fh);

            if (not defined $stat) {
                return (
                    died => 1, 
                    error => sprintf("Cannot determine size of '%s': %s (%s)", 
                        $temp_filepath, $!, $^E
                    ),
                );
            } 

            my $size = $stat->size;
            
            if ($size == 0) {
                close($fh) or return (
                    died => 1, 
                    error => sprintf("Cannot close '%s': %s (%s)", $temp_filepath, $!, $^E),
                );

                if ($FILE_OPERATION_DEBUGGING) {
                    DBManager::TaskLog->info(
                        $process_info, 
                        sprintf("remove %s", $temp_filepath),
                    );
                }

                unlink($temp_filepath) or return (
                    died => 1, 
                    error => sprintf("Cannot remove '%s': %s (%s)", $temp_filepath, $!, $^E),
                );
            }

            return (
                unreachable => 1
            );
        }

        if ($status{'success'}) {
            close($fh) or return (
                died => 1, 
                error => sprintf("Cannot close '%s': %s (%s)", $temp_filepath, $!, $^E),
            );

            my %cleanup = _cleanup_previous_file_versions(
                $process_info, $task_entry,
                $incoming_dir, $new_head_data{'remote_filename'},
                $temp_filename,
            );
                
            if (defined $cleanup{'error'}) {
                return (died => 1, error => $cleanup{'error'});
            }

            dual_progress(
                $process_info,
                $progress_messager,
                1,
                sprintf(
                    'Success %s; saved <%s> into %s%s.',
                    $garble_tag,
                    $new_head_data{'remote_uri'},
                    $temp_filepath,
                    $cleanup{'num_cleaned'}
                        ? sprintf(
                            'and cleaned up %d old files from download directory',
                            $cleanup{'num_cleaned'}
                          )
                        : ''
                        ,
                )
            );

            return (
                %status,
                temp_filepath => $temp_filepath,
            );
        }

        die "programming error";
    }

    # All attempts were garbled.

    return (
        garbled => 1,
    );
}

sub _GET_request_filepath {
    my ($process_info, $task_entry, $progress_messager, $head_data, $proxy, 
        $temp_filepath, $fh, $garble_tag) = @_;

    # LWP doesn't support If-Unmodified-Since in FTP requests, so we need
    # to manually check that we are downloading the correct version of the
    # remote source. In addition to that, some FTP servers don't support
    # Range requests. LWP will return HTTP_NOT_IMPLEMENTED in that case,
    # and we will need to download the whole file again.

    my $uri = $$head_data{'remote_uri'};

    my $content_md5 = Digest::MD5->new();

    # $size_on_disk is the size of the file on disk. It can start from
    # a non-zero value if the file has been downloaded partially before.
    my $size_on_disk = 0;
    # $bytes_transferred is the number of bytes of message body received.
    # It can be less than $size_on_disk.
    my $bytes_transferred = 0;

    my %headers = ();

    seek($fh, 0, SEEK_SET) or return (
        died => 1, 
        error => sprintf("Cannot seek '%s': %s (%s)", $temp_filepath, $!, $^E),
    );

    do {
        my $stat = stat($fh);

        if (not defined $stat) {
            return (
                died => 1, 
                error => sprintf("Cannot determine size of '%s': %s (%s)", 
                    $temp_filepath, $!, $^E
                ),
            );
        }

        $size_on_disk = $stat->size;
    };

    if ($size_on_disk > 0) {
        eval { $content_md5->addfile($fh) };

        if ($@) {
            return (died => 1, error => $@);
        }

        seek($fh, 0, SEEK_END) or return (
            died => 1, 
            error => sprintf("Cannot seek '%s': %s (%s)", $temp_filepath, $!, $^E),
        );
    }

    my ($range_header, $bytes_to_download);
    
    if ($size_on_disk > 0) {
        # Even if we set a correct Range header, it's possible the
        # server doesn't understand Range requests. In that case (and
        # if everything else is fine), a 200 OK will be returned, so
        # we must be able to start writing from the beginning of the
        # file rather than appending to the end.

        # Also, LWP (at least in some versions) requires both start
        # and end byte in the header in FTP requests. If we don't
        # know the end byte (e.g. not returned in the HEAD request),
        # we can only set the starting byte and just be hopeful.

        # Note that on disk we have bytes 0 to k-1, and the filehandle
        # sits at byte k-1 (because you can't seek one byte past the end
        # of the filehandle). We then start writing to the file, which
        # writes from byte k onwards. So, we need to request the bytes
        # k to n-1. 
        #
        # However, the NCBI FTP server always returns one byte more than
        # requested if the ending byte is n-1, so we need to set it to n. 
        # (Or it could be a bug in LWP.) This should be okay for HTTP servers 
        # as well, because the server is supposed to normalise the ending
        # byte to n-1 if it exceeds n-1, according to the HTTP specification.

        if (nil_or_empty($$head_data{'size'})) {
            $range_header = sprintf('bytes=%d-', $size_on_disk);
        } else {
            if ($$head_data{'size'} == $size_on_disk) {
                # Downloaded previously in its entirety? We have to assume
                # so.
                DBManager::TaskLog->info(
                    $process_info,
                    sprintf(
                        'File size on disk matches remote file size (%s)',
                        human_readable_filesize($size_on_disk),
                    )
                );

                return _verify_GET(
                    $process_info, $task_entry, $proxy, $uri, 
                    $$head_data{'etag'}, $$head_data{'mtime'},
                    $size_on_disk, $content_md5->hexdigest,
                    $progress_messager,
                );
            }

            $range_header = sprintf('bytes=%d-%d', 
                $size_on_disk, $$head_data{'size'} 
            );
            $bytes_to_download = $$head_data{'size'} - $size_on_disk;
        }
    } else {
        if (nil_or_empty($$head_data{'size'})) {
            # Unknown number of bytes to download.
        } else {
            $bytes_to_download = $$head_data{'size'};
        }
    }

    if (not nil_or_empty($range_header)) {
        DBManager::TaskLog->info(
            $process_info,
            sprintf(
                'Partial file detected; resuming download of <%s> from byte %d (%s)',
                $$head_data{'remote_uri'},
                $size_on_disk,
                human_readable_filesize($size_on_disk),
            )
        );

        $headers{'Range'} = $range_header;
    }

    my $request = HTTP::Request->new(
        GET => $uri, 
        HTTP::Headers->new(%headers)
    );

    my $ua = mk_useragent($request, $proxy);
    $ua->timeout(HTTP_TIMEOUT);

    # If either callback calls die(), the request is aborted and an X-Died
    # header set.

    my $content_messager = progress_offset($progress_messager, 0, 0.95);
    my $content_cb;

    # See comments in _make_HEAD_request_filepath() about why the response
    # object needs to be saved outside the request callback in case the
    # request is aborted.
    my $response_from_die;

    do {
        my $headers_inspected = 0;
        my $speed_estimate;
        my ($byte_start_offset, $num_total_bytes);

        $content_cb = sub {
            my ($data, $response) = @_;

            if (not $headers_inspected) {
                if ($LWP_REQUEST_DEBUGGING) {
                    DBManager::TaskLog->info($process_info, 
                        sprintf(
                            "_GET_request_filepath(proxy=%s, uri=<%s>, mtime=%s, etag=%s); response:\n%s\n\n%s",
                            stringify_proxy_strategy($proxy),
                            $uri,
                            nil_or_empty($$head_data{'mtime'})
                                ? '<undef>'
                                : $$head_data{'mtime'}
                                ,
                            nil_or_empty($$head_data{'etag'})
                                ? '<undef>'
                                : $$head_data{'etag'}
                                ,
                            $response->status_line,
                            $response->headers->as_string("\n"),
                        ),
                    );
                }

                $byte_start_offset = $size_on_disk;

                _inspect_GET_headers_or_die(
                    $process_info, $temp_filepath, $fh, $response,
                    $uri->scheme, $$head_data{'etag'}, $$head_data{'mtime'},
                    $range_header, \$response_from_die,
                    \$byte_start_offset
                );

                $headers_inspected = 1;
                $speed_estimate = DownloadSpeedEstimate->new(time);

                if (nil_or_empty($$head_data{'size'})) {
                    $num_total_bytes = $response->header('Content-Length') || 0;
                } else {
                    $num_total_bytes = $$head_data{'size'};
                }
            }

            if (DEBUG_TRANSFER_PROBLEMS) {
                sleep 5;
            }

            _accumulate_GET_data_or_die(
                $process_info, $task_entry, $content_messager, 
                $byte_start_offset, $num_total_bytes, $uri, $garble_tag,
                $speed_estimate, $temp_filepath, $fh, $data, $response,
                \$response_from_die,
            );

            $content_md5->add($data);

            do {
                use bytes;

                my $l = length($data);

                $size_on_disk += $l;
                $bytes_transferred += $l;
            };

            return 1;
        };
    };

    if ($LWP_REQUEST_DEBUGGING) {
        DBManager::TaskLog->info($process_info, 
            sprintf(
                "_GET_request_filepath(proxy=%s, uri=<%s>, mtime=%s, etag=%s); request:\n%s",
                stringify_proxy_strategy($proxy),
                $uri,
                nil_or_empty($$head_data{'mtime'})
                    ? '<undef>'
                    : $$head_data{'mtime'}
                    ,
                nil_or_empty($$head_data{'etag'})
                    ? '<undef>'
                    : $$head_data{'etag'}
                    ,
                $request->as_string("\n"),
            ),
        );
    }

    my $response = eval { $ua->request($request, $content_cb) };

    my $err;

    if ($@) {
        $err = $@;
    } else {
        $err = $response->header('X-Died');
    }

    my $final_response;

    if (defined $response_from_die) {
        $final_response = $response_from_die;
    } else {
        $final_response = _mk_final_response($response);
    }

    # LWP_REQUEST_DEBUGGING handled in the callback.

    my ($io_err, $x_died, $error_happened);

    if ($err) {
        if (ref $err) {
            ($io_err, $x_died) = @{ $err }{qw(I/O X-Died)};
            $error_happened = 1;
        } else {
            if ($err =~ /^Timeout/) {
                # LWP/Protocol/ftp.pm can throw a Timeout exception when
                # Net::FTP times out while reading from the socket. It's
                # worth trying again if it happens.
                $x_died = 'timeout';
                $error_happened = 1;
            } else {
                # Exception not created by us.
                return (died => 1, error => $err);
            }
        }
    }

    if ($error_happened) {
        if ($io_err) {
            return (died => 1, error => $io_err);
        }

        # Could be a response code that is not 200 or 206,
        # or the task could have been paused or cancelled.

        if ($x_died eq 'timeout') {
            DBManager::TaskLog->warn(
                $process_info,
                'Remote server timed out while downloading.',
            );

            return (timeout => 1);
        } elsif ($x_died eq 'precondition_failed') {
            my ($etag, $mtime, $size) = _parse_response_headers(
                $$final_response{'headers'}, $uri->scheme, 
                $$final_response{'request_uri'},
            );

            # $size (Content-Length) is safe to use here, because we can't 
            # come here unless the response had no Range header.

            DBManager::TaskLog->warn(
                $process_info,
                'Remote data has changed since HEAD request.',
            );

            return (
                precondition_failed => 1,
                etag => $etag,
                mtime => $mtime,
                size => $size,
            );
        } elsif ($x_died eq 'invalid_range_response') {
            seek($fh, 0, SEEK_SET) or return (
                died => 1,
                error => sprintf("Cannot seek '%s': %s (%s)", $temp_filepath, $!, $^E),
            );
            truncate($fh, 0) or return (
                died => 1,
                error => sprintf("Cannot truncate '%s': %s (%s)", $temp_filepath, $!, $^E),
            );

            DBManager::TaskLog->warn(
                $process_info,
                'Remote server sent invalid range headers.',
            );

            return _GET_request_filepath(
                $process_info, $task_entry, $progress_messager, $head_data, 
                $proxy, $temp_filepath, $fh, $garble_tag
            );
        } elsif ($x_died eq 'suspended') {
            return (
                suspended => 1,
            );
        } elsif ($x_died eq 'cancelled') {
            return (
                cancelled => 1,
            );
        } elsif ($x_died eq 'header_fail') {
            if (not nil_or_empty($range_header) 
                    and $$final_response{'code'} == HTTP_NOT_IMPLEMENTED) {

                seek($fh, 0, SEEK_SET) or return (
                    died => 1,
                    error => sprintf("Cannot seek '%s': %s (%s)", $temp_filepath, $!, $^E),
                );
                truncate($fh, 0) or return (
                    died => 1,
                    error => sprintf("Cannot truncate '%s': %s (%s)", $temp_filepath, $!, $^E),
                );

                DBManager::TaskLog->warn(
                    $process_info,
                    'FTP server does not support resuming a download; retrying from beginning of file.',
                );

                return _GET_request_filepath(
                    $process_info, $task_entry, $progress_messager, $head_data,
                    $proxy, $temp_filepath, $fh, $garble_tag
                );
            }

            # Other status failures handled below, as many of them won't
            # have a body and thus $content_cb might not have called die().
        } else {
            return (died => 1, error => $x_died);
        }
    }

    if ($$final_response{'code'} != HTTP_OK 
            and $$final_response{'code'} != HTTP_PARTIAL_CONTENT) {
        my $is_internal_error = ($$final_response{'headers'}->header('Client-Warning') || '') eq 'Internal response';

        if ($$final_response{'status_line'} =~ /FTP close response:/) {
            # It's worth retrying; this could just be the FTP server acting
            # up after the download succeeded.
            DBManager::TaskLog->warn(
                $process_info,
                sprintf(
                    'Unexpected response%s: %s',
                    $is_internal_error ? ' (internal error)' : '',
                    $$final_response{'status_line'},
                )
            );

            return (ftp_error => 1);
        }

        my $content = $response->decoded_content();
        $content = $response->content if not defined $content;

        DBManager::TaskLog->warn(
            $process_info,
            sprintf(
                'Could not handle response%s: %s',
                $is_internal_error ? ' (internal error)' : '',
                $$final_response{'status_line'},
            )
        );

        return (
            unreachable => 1,
            error_body => $content,
        );
    }

    if (not nil_or_empty($$head_data{'size'})) {
        if ($size_on_disk != $$head_data{'size'}) {
            DBManager::TaskLog->warn(
                $process_info,
                sprintf(
                    'Downloaded file size on disk (%s bytes) differs from remote file size (%s bytes).',
                    $size_on_disk,
                    $$head_data{'size'}
                ),
            );

            return (
                garbled => 1,
                etag => $$head_data{'etag'},
                mtime => $$head_data{'mtime'},
                size => $$head_data{'size'},
            );
        }
    }

    do {
        my $msg = sprintf(
            'Downloading <%s> is done %s; received %s in total, and downloaded file size is %s.', 
            $uri,
            $garble_tag,
            human_readable_filesize($bytes_transferred),
            human_readable_filesize($size_on_disk),
        );

        dual_progress($process_info, $content_messager, 1, $msg);
    };

    my ($etag, $mtime) = _parse_response_headers(
        $$final_response{'headers'}, $uri->scheme, 
        $$final_response{'request_uri'},
        $range_header ? $size_on_disk : ()
    );

    return _verify_GET(
        $process_info, $task_entry, $proxy, $uri, $etag, $mtime,
        $size_on_disk, $content_md5->hexdigest,
        progress_offset($progress_messager, 0.95, 1),
    );
}

# Some servers (e.g. NCBI) can change the contents of the file while a download
# is in process, which means the downloaded file can contain garbled data. We
# can test against corruption by doing a subsequent HEAD request: if the remote
# ETag and Last-Modified (where either is available) are the same as before,
# we're OK. Otherwise we need to clean up and download again.
sub _verify_GET {
    my ($process_info, $task_entry, $proxy, $uri, $current_etag,
        $current_mtime, $current_size, $current_md5, $progress_messager) = @_;

    my $new_head_data = _HEAD_request_filepath(
        $process_info,
        $proxy,
        $uri,
        $current_mtime,
        $current_etag,

        \my @head_errors,
    );

    if ($new_head_data) {
        if ($$new_head_data{'died'}) {
            return %$new_head_data;
        }

        if ($$new_head_data{'unreachable'}) {
            DBManager::TaskLog->warn(
                $process_info,
                'Could not check if remote data has changed since downloading started; assuming no.',
            );

            return (
                success => 1,
                unverified => 1,
                etag => $current_etag,
                mtime => $current_mtime,
                size => $current_size,
                md5 => $current_md5,
            );
        }

        if ($$new_head_data{'not_modified'} or $$new_head_data{'not_found'}) {
            # If the remote file is not found, that's fine; we already
            # have a copy. It's a tad weird, though.

            dual_progress($process_info, $progress_messager,
                1, sprintf('Remote file <%s> has not changed since downloading started; all OK.',
                    $uri
                ),
            );

            return (
                success => 1,
                etag => $current_etag,
                mtime => $current_mtime,
                size => $current_size,
                md5 => $current_md5,
            );
        }
    } else {
        DBManager::TaskLog->warn(
            $process_info,
            sprintf(
                'Could not check if remote data has changed since downloading started; assuming no. Errors are:\n%s',
                join("\n", @head_errors)
            )
        );

        return (
            success => 1,
            unverified => 1,
            etag => $current_etag,
            mtime => $current_mtime,
            size => $current_size,
            md5 => $current_md5,
        );
    } 

    dual_progress($process_info, $progress_messager,
        1, sprintf('Remote file <%s> has changed during downloading; it needs to be downloaded again.',
            $uri
        ),
    );

    return (
        garbled => 1,
        etag => $$new_head_data{'etag'},
        mtime => $$new_head_data{'mtime'},
        size => $$new_head_data{'size'},
    );
}

sub _inspect_GET_headers_or_die {
    my ($process_info, $temp_filepath, $fh, $response, $protocol, 
        $current_etag, $current_mtime, $range_header, 
        $response_from_die_ref, $byte_start_offset_ref) = @_;

    if ($response->code == HTTP_OK) {
        if (not nil_or_empty($range_header)) {
            # Infuriatingly some versions of LWP don't return 
            # HTTP_PARTIAL_CONTENT for FTP range requests. The response
            # is 200 OK and Content-Length is set to the full file size,
            # even if downloading will start from some other byte than 0.
            # We will just have to trust that if we get this far, the
            # REST command is supported and the server will send the right
            # number of bytes.

            if ($protocol eq 'ftp') {
                return 1;
            }

            DBManager::TaskLog->info(
                $process_info,
                "Remote server decided to send the entire file despite range request; downloading the file from the beginning.",
            );
        }

        my ($etag, $mtime) = _parse_response_headers(
            $response->headers, $protocol, $response->request->uri
        );

        # Instead of comparing the remote ETag and Last-Modified ourselves,
        # we could do a conditional request with If-Match and 
        # If-Unmodified-Since. However, LWP doesn't support those for FTP
        # requests, and further we would not be able to just start downloading
        # the data into a new file if the server sent 416 Precondition Failed.

        my $not_modified = _resource_not_modified(
            $current_etag, $current_mtime, $etag, $mtime,
        );

        # This has to be done after the range header check, as the FTP
        # file "etag" depends on file size.
        if (!$not_modified) {
            $$response_from_die_ref = _mk_final_response($response);
            die { 'X-Died' => "precondition_failed" };
        }

        # Range request isn't in effect; start rewriting from
        # the beginning of the filehandle.
        seek($fh, 0, SEEK_SET) or do {
            $$response_from_die_ref = _mk_final_response($response);
            die {
                'I/O' => sprintf(
                    "Cannot seek '%s': %s (%s)", $temp_filepath, $!, $^E
                ),
            }
        };
        truncate($fh, 0) or do {
            $$response_from_die_ref = _mk_final_response($response);
            die {
                'I/O' => sprintf(
                    "Cannot truncate '%s': %s (%s)", $temp_filepath, $!, $^E
                ),
            }
        };

        $$byte_start_offset_ref = 0;

        return 1;
    } 
    
    if ($response->code == HTTP_PARTIAL_CONTENT) {
        # Range request OK; we'll receive the right bytes.
        my $response_range = $response->header('Content-Range');
        my ($from, $to, $total) = $response_range =~ m#bytes (\d+)-(\d+)/(\d+)#;

        if ($to < $from) {
            $$response_from_die_ref = _mk_final_response($response);
            die { 'X-Died' => "invalid_range_response" };
        }

        # XXX: what if $to != $total-1?

        return 1;
    } 

    # 1xx, 3xx, 4xx, 5xx
    $$response_from_die_ref = _mk_final_response($response);
    die { 'X-Died' => "header_fail" };
}

sub _accumulate_GET_data_or_die {
    my ($process_info, $task_entry, $progress_messager, $byte_start_offset,
        $num_total_bytes, $uri, $garble_tag, $speed_estimate, $temp_filepath,
        $fh, $data, $response, $response_from_die_ref) = @_;

    print $fh $data or do {
        $$response_from_die_ref = _mk_final_response($response);
        die {
            'I/O' => sprintf(
                "Cannot write to '%s': %s (%s)", $temp_filepath, $!, $^E
            ),
        }
    };

    my $statistics_available = do {
        use bytes;
        $speed_estimate->chunk_received(length($data))
    };

    if ($statistics_available) {
        # Signal tests are done here to prevent them being called too often.

        if ($task_entry->should_do('suspend')) {
            $$response_from_die_ref = _mk_final_response($response);
            die { 'X-Died' => 'suspended' };
        }

        if ($task_entry->should_do('cancel')) {
            $$response_from_die_ref = _mk_final_response($response);
            die { 'X-Died' => 'cancelled' };
        }

        my ($p, $msg);
        my $current_byte = $byte_start_offset + $speed_estimate->size_received;

        if ($num_total_bytes) {
            my $speed = $speed_estimate->median;
            my $estimated_seconds = $speed 
                ? ($num_total_bytes - $current_byte) / $speed 
                : -1
                ;

            $msg = sprintf('Downloading <%s> %s: %s (%s/%s, %s remaining)', 
                $uri,
                $garble_tag,
                human_readable_transfer_speed($speed),
                human_readable_filesize($current_byte),
                human_readable_filesize($num_total_bytes),
                $estimated_seconds >= 0
                    ? human_readable_seconds($estimated_seconds)
                    : 'unknown time'
                    ,
            );

            $p = $current_byte/$num_total_bytes;
        } else {
            $msg = sprintf('Downloading <%s> %s: %s (%s/unknown size)',
                $uri,
                $garble_tag,
                human_readable_transfer_speed($speed_estimate->median),
                human_readable_filesize($current_byte),
            );

            # XXX: make progress range in steps from 0 to 1 and back
            # to create a pulsating bar?
            $p = 0.5;
        }

        $progress_messager->($p, $msg);

        if ($LWP_REQUEST_DEBUGGING) {
            DBManager::TaskLog->info($process_info, $msg);
        }
    }

    return 1;
}

sub do_move_files {
    my ($process_info, $task_entry, $progress_messager, $fetch_def,
        $rename_ref) = @_;

    my @types = grep { $_ ne 'version' } keys %$fetch_def;

    my $num_entries = sum(map { scalar(grep { $$_{'downloaded'} } @$_) } values %$fetch_def);

    if ($num_entries == 0) {
        dual_progress($process_info, $progress_messager, 1,
            'Decompressing and moving done (no files to process).',
        );

        return 1;
    }

    my $entry_ix = -1;

    my %version_data = ();
    my %renaming = map { $_ => {} } keys %$fetch_def;

    if (my $version_entries = $$fetch_def{'version'}) {
        if (@$version_entries != 1) { die "programming error" }

        if (my $downloaded = $$version_entries[0]{'downloaded'}) {
            ++$entry_ix;

            my $messager = progress_offset(
                $progress_messager,
                $entry_ix/$num_entries,
                (1 + $entry_ix)/$num_entries,
            );

            my $progress_tag = sprintf('(file %d out of %d)', 
                1 + $entry_ix, $num_entries
            );

            my $filesize;

            do {
                my $stat = stat($$downloaded{'local_filepath'});

                if (not defined $stat) {
                    return fatal_finish($process_info, $task_entry,
                        sprintf(
                            "Could not stat %s: %s (%s)",
                            $$downloaded{'local_filepath'},
                            $!, 
                            $^E
                        )
                    );
                }

                $filesize = $stat->size;
            };

            dual_progress($process_info, $messager, 0,
                sprintf("Decompressing and moving %s (%s) %s",
                    $$downloaded{'local_filepath'},
                    human_readable_filesize($filesize),
                    $progress_tag,
                )
            );

            _do_decompress_and_move_entry(
                $process_info,
                $task_entry,
                $$version_entries[0],
                undef,
                $renaming{'version'},
                progress_offset($messager, 0, 0.75),
                $progress_tag,
            ) or return 0;

            # We know $renaming{'version'} has exactly one entry, because
            # there is exactly one version file.
            my $tmp_filepath = (keys %{ $renaming{'version'} })[0];
            my $mirror_regex = $$version_entries[0]{'parse_rule'};
            my $data;

            if (nil_or_empty($mirror_regex)) {
                if (-e $tmp_filepath.'.ignore') {
                    # User has chosen to not choose a parse rule. We'll 
                    # continue without parsing the file.

                    $renaming{'version'}{$tmp_filepath.'.ignore'}{'delete_this'} = 1;
                    $renaming{'version'}{$tmp_filepath.'.xyzzy2'}{'delete_this'} = 1;
                } else {
                    # Incomplete definition; we need to stop here and continue
                    # later.

                    my $to = $tmp_filepath.'.xyzzy2';

                    File::Copy::move($tmp_filepath => $to) or return fatal_finish(
                        $process_info, $task_entry, 
                        sprintf("Cannot move '%s' to '%s': %s (%s)", 
                            $tmp_filepath, $to, $!, $^E
                        ),
                    );

                    return 2;
                }
            } else {
                _do_parse_version_file(
                    $process_info,
                    $task_entry,
                    $mirror_regex,
                    $tmp_filepath,
                    progress_offset($messager, 0.75, 1),
                    \$data,
                ) or return 0;
            }

            if (defined $data) {
                # Could be false success.
                if ($data ne '') {
                    for (qw(fasta version reference)) {
                        $version_data{$_} = $data;
                    }

                    # Fix the version file renaming to be consistent with
                    # the FASTA file.
                    my $concrete_filename = concretise_local_filename(
                        $$version_entries[0]{'target_filename'}, {
                            wildcard => { '*' => $data }
                        },
                    );

                    # XXX: this breaks encapsulation of %renaming.
                    $renaming{'version'}{$tmp_filepath}{'to'} = join('/',
                        $$version_entries[0]{'current_dir'}, $concrete_filename
                    );
                }
            } else {
                DBManager::TaskLog->warn(
                    $process_info,
                    sprintf("Version file was downloaded, but version parse rule did not match anything in it. Using a timestamp as version identifier instead.")
                );
            }

            $renaming{'version'}{$tmp_filepath.'.ignore'}{'delete_this'} = 1;
            $renaming{'version'}{$tmp_filepath.'.xyzzy2'}{'delete_this'} = 1;
        }
    }

    for my $type (grep { $_ ne 'version' } keys %$fetch_def) {
        for my $entry (@{ $$fetch_def{$type} }) {
            my $downloaded = $$entry{'downloaded'};
            next unless $downloaded;

            ++$entry_ix;

            my $messager = progress_offset(
                $progress_messager,
                $entry_ix/$num_entries,
                (1 + $entry_ix)/$num_entries,
            );

            my $progress_tag = sprintf('(file %d out of %d)', 
                1 + $entry_ix, $num_entries
            );

            my $filesize;

            do {
                my $stat = stat($$downloaded{'local_filepath'});

                if (not defined $stat) {
                    return fatal_finish($process_info, $task_entry,
                        sprintf(
                            "Could not stat %s: %s (%s)",
                            $$downloaded{'local_filepath'},
                            $!,
                            $^E
                        )
                    );
                }

                $filesize = $stat->size;
            };

            dual_progress($process_info, $messager, 0,
                sprintf("Decompressing and moving %s (%s) %s",
                    $$downloaded{'local_filepath'},
                    human_readable_filesize($filesize),
                    $progress_tag,
                )
            );

            _do_decompress_and_move_entry(
                $process_info,
                $task_entry,
                $entry,
                $version_data{$type},
                $renaming{$type},
                $messager,
                $progress_tag,
            ) or return 0;
        }
    }

    dual_progress($process_info, $progress_messager, 1,
        $num_entries == 1
            ? "Decompressed and moved 1 file."
            : sprintf("Decompressed and moved %d files.", $num_entries)
    );

    %$rename_ref = %renaming;

    return 1;
}

sub _do_parse_version_file {
    my ($process_info, $task_entry, $regex_str, $tmp_filepath, 
        $progress_messager, $data_ref) = @_;

    if (nil_or_empty($regex_str)) {
        DBManager::TaskLog->warn(
            $process_info,
            sprintf("Version file was downloaded, but no version parse rule is defined. Using a timestamp as version identifier instead.")
        );

        $$data_ref = '';
        return 1; # false success
    } 
    
    my $fh = eval { acquire_read_fh($tmp_filepath) };

    if ($@) {
        return fatal_finish($process_info, $task_entry, $@);
    }

    my ($regex, $error) = compile_parse_rule($regex_str);

    if ($error) {
        DBManager::TaskLog->warn(
            $process_info,
            sprintf("Failed to compile version parse rule: $error\nUsing timestamp as version identifier instead.")
        );

        $$data_ref = '';
        return 1; # false success
    }

    my $data;

    while (defined(my $line = <$fh>)) {
        if ($line =~ $regex) {
            $data = $1;
            last;
        }
    }

    if (nil_or_empty($data)) {
        dual_progress($process_info, $progress_messager, 1,
            "Version file read, but no tag found.",
        );
    } else {
        my $cleaned_data = $data;
        $cleaned_data =~ s/[^a-zA-Z0-9_.\$%\(\)\[\]-]+/_/g;

        if ($cleaned_data eq $data) {
            dual_progress($process_info, $progress_messager, 1,
                sprintf("Version file parsed successfully: tag is '%s'.", $data)
            );
        } else {
            dual_progress($process_info, $progress_messager, 1,
                sprintf("Version file parsed successfully: tag is '%s', which was modified to '%s'.", 
                    $data,
                    $cleaned_data,
                )
            );
            $data = $cleaned_data;
        }
    }

    $$data_ref = $data;
    return 1;
}

sub _do_decompress_and_move_entry {
    my ($process_info, $task_entry, $entry, $version_data, $renaming, 
        $progress_messager, $progress_tag) = @_;

    if ($task_entry->should_do('cancel')) {
        return cancelled_finish(
            $process_info, $task_entry,
            'Cancelled due to user request.',
        );
    }

    my $downloaded = $$entry{'downloaded'};
    my $extractor = _pick_extractor($$downloaded{'remote_filename'});

    my $from_dir = $$entry{'incoming_dir'};
    my $temp_filepath = $$downloaded{'local_filepath'};

    if (not defined $extractor) {
        return fatal_finish(
            $process_info,
            $task_entry,
            sprintf(
                "No decompressors found for compressed file %s (%s)".
                $temp_filepath,
                $$downloaded{'remote_filename'},
            ),
        );
    }

    my $to_dir = $$entry{'current_dir'};

    my @target_filenames = ();
    my $source_filenames;
    my $renaming_master_data;

    if (ref $$entry{'target_filenames'}) {
        @target_filenames = @{ $$entry{'target_filenames'} };

        if (ref $$entry{'source_filenames'}) {
            $source_filenames = $$entry{'source_filenames'};
        }

        if (not defined $source_filenames) {
            die "programming error";
        }
    } else {
        # Only a single target filename.
        if (defined $$entry{'master_tag_type'}) {
            $renaming_master_data = {
                master_tag_type => $$entry{'master_tag_type'},
                master_local_filename => $$entry{'master_local_filename'},
            };
        }

        if ($$entry{'keep_remote_extension'}) {
            my $new_ext;
            my $c_ext = _detect_compression_extension($$downloaded{'remote_filename'});

            if (defined $c_ext) {
                my $base = substr(
                    $$downloaded{'remote_filename'}, 
                    0,
                    length($$downloaded{'remote_filename'}) - length($c_ext)
                );
                
                ($new_ext) = $base =~ m#(\.[^.]+)$#;
            }

            if (nil_or_empty($new_ext)) {
                $new_ext = $$entry{'fallback_extension'};
            }

            if (nil_or_empty($new_ext)) {
                die "programming error";
            }

            @target_filenames = rename_local_filename_extension(
                $$entry{'target_filename'}, $new_ext
            );
        } else {
            @target_filenames = $$entry{'target_filename'};
        }
    }

    if (0 < grep { not defined $_ } @target_filenames) {
        return fatal_finish(
            $process_info,
            $task_entry,
            sprintf(
                "Some target filenames are undefined; cannot decompress or move %s (%s).\nFull list of target filenames: %s",
                $temp_filepath,
                $$downloaded{'remote_filename'},
                join(' ', map { defined($_) ? $_ : '<undef>' } @target_filenames),
            ),
        );
    }

    if (not @target_filenames) {
        die "programming error";
    }
    
    my $wildcard_filler;

    if (defined $version_data) {
        $wildcard_filler = $version_data;
    } else {
        my $remote_mtime = $$downloaded{'remote_mtime'};

        if (nil_or_empty($remote_mtime)) {
            my $stat = stat($temp_filepath);

            if (not defined $stat) {
                return fatal_finish(
                    $process_info, $task_entry, 
                    sprintf("Cannot determine last modified time of '%s': %s (%s)",
                        $temp_filepath,
                        $!,
                        $^E
                    ),
                );
            }

            $remote_mtime = $stat->mtime;
        }

        my ($sec, $min, $hour, $mday, $mon, $year) = localtime($remote_mtime);

        $wildcard_filler = sprintf("%04d%02d%02d", 
            $year + 1900, $mon + 1, $mday
        );
    }

    if ($wildcard_filler) {
        $wildcard_filler = {
            wildcard => { '*' => $wildcard_filler },
        };
    }

    my $success = &$extractor(
        $process_info,
        $task_entry,
        $progress_messager,
        $progress_tag,

        $temp_filepath,
        $to_dir,
        'xyzzy',
        $wildcard_filler,
        $renaming,
        $renaming_master_data,

        $source_filenames,
        @target_filenames,
    );

    return $success;
}

BEGIN {
    sub _do_no_extractor {
        my ($process_info, $task_entry, $progress_messager, $progress_tag,
            $temp_filepath, $to_dir, $temp_ext, $wildcard_filler, $renaming, 
            $renaming_master_data, undef, @target_filenames) = @_;

        if (@target_filenames != 1) {
            return fatal_finish($process_info, $task_entry,
                sprintf(
                    "Expected '%s' to contain a single file, but %d were supposed to be extracted from it (missing decompressing tool?)",
                    $temp_filepath, 
                    scalar(@target_filenames),
                )
            );
        }

        for ($target_filenames[0]) {
            my $concrete_filename = concretise_local_filename(
                $_, $wildcard_filler
            );

            my $to = sprintf('%s/%s.%s', $to_dir, $concrete_filename, $temp_ext);

            if ($FILE_OPERATION_DEBUGGING) {
                DBManager::TaskLog->info(
                    $process_info, 
                    sprintf("copy %s --> %s", $temp_filepath, $to),
                );
            }

            my $stat = stat($temp_filepath);

            if (not defined $stat) {
                return fatal_finish($process_info, $task_entry,
                    sprintf("Cannot stat '%s': %s (%s)", $temp_filepath, $!, $^E)
                );
            }

            $progress_messager->(
                0,
                sprintf('Copying %s (%s) %s', 
                    $temp_filepath,
                    human_readable_filesize($stat->size),
                    $progress_tag,
                ),
            );

            File::Copy::copy($temp_filepath => $to) or return fatal_finish(
                $process_info, $task_entry, 
                sprintf("Cannot copy '%s' to '%s': %s (%s)", 
                    $temp_filepath, $to, $!, $^E
                ),
            );

            eval {
                inherit_directory_permissions_filepath(
                    $to_dir, join('.', $concrete_filename, $temp_ext)
                )
            };

            if ($@) {
                return fatal_finish($process_info, $task_entry, $@);
            }

            $$renaming{$to} = {
                %{ $renaming_master_data || {} },
                local_filename => $_,
                to_dir => $to_dir,
                concrete_filename => $concrete_filename,
            };
        }

        return 1;
    }

    # Note that all commands here redirect stderr to stdout. This is supported
    # with the same syntax on both Windows and Linux (e.g.
    # "Using command redirection operators"
    # http://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/redirection.mspx?mfr=true
    # ).

    sub _mk_decompress_unarchive_pipe {
        my ($decompressor, $decompress_cmd_template, $decompressor_name,
            $unarchiver, $unarchive_single_template, 
            $unarchive_multi_template, $unarchiver_name) = @_;

        return sub {
            my ($process_info, $task_entry, $progress_messager, $progress_tag,
                $archive_filepath, $to_dir, $temp_ext, $wildcard_filler, 
                $renaming, $renaming_master_data, $source_filenames, 
                @target_filenames) = @_;

            my @concretised_filenames = _filename_renaming(
                $to_dir, $temp_ext, $wildcard_filler, $renaming, 
                $renaming_master_data, @target_filenames
            );

            my $stat = stat($archive_filepath);

            if (not defined $stat) {
                return fatal_finish($process_info, $task_entry,
                    sprintf("Cannot stat '%s': %s (%s)", $archive_filepath, $!, $^E)
                );
            }

            if ($source_filenames) {
                my $decompressor_cmdline = sprintf(
                    $decompress_cmd_template,
                    shell_quote($archive_filepath)
                );

                my $unarchiver_cmdline = sprintf(
                    $unarchive_multi_template,
                    join(' ', map { shell_quote($_) } @$source_filenames),
                );

                my $cmd = sprintf("%s %s | %s %s 2>&1", 
                    $decompressor,
                    $decompressor_cmdline, 

                    $unarchiver,
                    $unarchiver_cmdline,
                );

                $progress_messager->(
                    0,
                    sprintf(
                        @concretised_filenames == 1
                            ? 'Decompressing %d file from %s (%s) %s'
                            : 'Decompressing %d files from %s (%s) %s'
                            ,
                        scalar(@concretised_filenames),
                        $archive_filepath,
                        human_readable_filesize($stat->size),
                        $progress_tag,
                    ),
                );

                return _do_unarchive(
                    $process_info, $task_entry, $progress_messager,
                    $progress_tag, $to_dir, $renaming, 
                    [$decompressor_name, $unarchiver_name], $cmd, 
                    $source_filenames, @concretised_filenames,
                );
            }

            my $unarchiver_cmdline = sprintf(
                $unarchive_single_template,
                shell_quote($archive_filepath)
            );

            $progress_messager->(
                0,
                sprintf(
                    'Decompressing 1 file from %s (%s) %s',
                    $archive_filepath,
                    human_readable_filesize($stat->size),
                    $progress_tag,
                ),
            );

            return _do_decompress(
                $process_info, $task_entry, $progress_messager, $progress_tag,
                $to_dir, $renaming, $unarchiver_name, $unarchiver,
                $unarchiver_cmdline, $concretised_filenames[0],
            );
        };
    }

    sub _do_unarchive {
        my ($process_info, $task_entry, $progress_messager, $progress_tag,
            $to_dir, $renaming, $tool_names, $cmd, $source_filenames, 
            @concretised_filenames) = @_;

        my $old_cwd = cwd();

        # We extract the files into a temporary directory in order
        # to avoid naming conflicts, and to avoid extracting files in
        # a loop.
        my $tmp_dir = eval { 
            tempdir('db_manager.XXXX', DIR => $to_dir, CLEANUP => 1)
        };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }

        _do_chdir($process_info, $task_entry, $tmp_dir) or return 0;

        if ($SHELL_DEBUGGING) {
            DBManager::TaskLog->info($process_info, $cmd);
        }

        for (@$source_filenames) {
            _do_touch($process_info, $task_entry, $_) or do {
                _do_chdir($process_info, $task_entry, $old_cwd, 1);
                return 0;
            };
        }

        #my $status = system($cmd);
        # We can't use system() on Windows due to a problem with SIGINT:
        # if the child program is interrupted with SIGINT (e.g. CTRL-C),
        # neither system()'s return value nor $? contain the SIGINT flag,
        # which means there's no way to know if the child was interrupted
        # or not. The only clean way seems to be using qx{}. If a SIGINT
        # is received, the child is interrupted and this script's signal
        # handler ($SIG{INT}) will catch it. If the child exits without
        # SIGINT, $? will contain the exit code, if any.

        my $qx_output = qx{$cmd};

        _do_system_status(
            $process_info, $task_entry, $tool_names, $cmd, $?, $qx_output
        ) or do {
            _do_chdir($process_info, $task_entry, $old_cwd, 1);
            return 0;
        };

        for my $i (0 .. $#concretised_filenames) {
            my $src = join('/', $tmp_dir, $$source_filenames[$i]);
            my $target = join('/', $to_dir, $concretised_filenames[$i]);

            if ($FILE_OPERATION_DEBUGGING) {
                DBManager::TaskLog->info(
                    $process_info, 
                    sprintf("move %s --> %s", $src, $target),
                );
            }

            File::Copy::move($src => $target) or do {
                _do_chdir($process_info, $task_entry, $old_cwd, 1);
                return fatal_finish(
                    $process_info, $task_entry, 
                    sprintf("Cannot move '%s' to '%s': %s (%s)",
                        $src, $target, $!, $^E
                    ),
                );
            };
            
            eval {
                inherit_directory_permissions_filepath(
                    $to_dir, $concretised_filenames[$i]
                )
            };

            if ($@) {
                _do_chdir($process_info, $task_entry, $old_cwd, 1);
                return fatal_finish($process_info, $task_entry, $@);
            }
        }

        _do_chdir($process_info, $task_entry, $old_cwd) or return 0;

        return 1;
    }

    sub _mk_decompress_pipe {
        my ($decompressor, $decompressor_cmd_template, $tool_name) = @_;

        return sub {
            my ($process_info, $task_entry, $progress_messager, $progress_tag,
                $compressed_filepath, $to_dir, $temp_ext, $wildcard_filler,
                $renaming, $renaming_master_data, undef, @target_filenames) = @_;

            if (@target_filenames != 1) {
                return fatal_finish($process_info, $task_entry,
                    sprintf(
                        "Expected '%s' to contain a single file, but %d were supposed to be extracted from it (configuration error)",
                        $compressed_filepath,
                        scalar(@target_filenames),
                    )
                );
            }

            my $stat = stat($compressed_filepath);

            if (not defined $stat) {
                return fatal_finish($process_info, $task_entry,
                    sprintf("Cannot stat '%s': %s (%s)", $compressed_filepath, $!, $^E)
                );
            }
            
            my @concretised_filenames = _filename_renaming(
                $to_dir, $temp_ext, $wildcard_filler, $renaming, 
                $renaming_master_data, @target_filenames
            );

            my $decompressor_cmdline = sprintf(
                $decompressor_cmd_template,
                shell_quote($compressed_filepath)
            );

            $progress_messager->(
                0,
                sprintf(
                    'Decompressing %s (%s) %s',
                    $compressed_filepath,
                    human_readable_filesize($stat->size),
                    $progress_tag,
                ),
            );

            return _do_decompress(
                $process_info, $task_entry, $progress_messager, $progress_tag,
                $to_dir, $renaming, $tool_name, $decompressor,
                $decompressor_cmdline, $concretised_filenames[0],
            );
        };
    }

    sub _do_decompress {
        my ($process_info, $task_entry, $progress_messager, $progress_tag,
            $to_dir, $renaming, $tool_name, $decompressor, 
            $decompressor_cmdline, $raw_filename) = @_;

        my $stderr_filename = $raw_filename.'.stderr'.time;

        my $old_cwd = cwd();

        my $cmd = sprintf("%s %s 1>%s 2>%s",
            $decompressor,
            $decompressor_cmdline, 

            shell_quote($raw_filename),
            shell_quote($stderr_filename),
        );

        _do_chdir($process_info, $task_entry, $to_dir) or return 0;

        # We need to manually 'touch' the output file to discover if
        # the directory is actually writable... On Unix, sh doesn't return
        # anything special if permission to write the piped output is
        # denied.
        _do_touch($process_info, $task_entry, $raw_filename) or do {
            _do_chdir($process_info, $task_entry, $old_cwd, 1);
            return 0;
        };

        if ($SHELL_DEBUGGING) {
            DBManager::TaskLog->info($process_info, $cmd);
        }

        #my $status = system($cmd);
        # See notes in _do_unarchive() about system() vs. qx{}.

        qx{$cmd}; # no output

        _do_slurp(join('/', $to_dir, $stderr_filename), \my $qx_output) or do { 
            # nothing
        };
            
        _do_system_status(
            $process_info, $task_entry, [$tool_name], $cmd, $?, $qx_output,
        ) or do{
            _do_chdir($process_info, $task_entry, $old_cwd, 1);
            return 0;
        };

        _do_chdir($process_info, $task_entry, $old_cwd) or return 0;

        return 1;
    }

    sub _do_touch {
        my ($process_info, $task_entry, $filename) = @_;

        my $cwd = cwd();

        # Assumes working directory is correct.
        my $fh = eval { acquire_write_fh(join('/', $cwd, $filename)) };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }

        eval { inherit_directory_permissions_fh($cwd, $fh, $filename) };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }

        eval { release_fh($fh) };

        if ($@) {
            return fatal_finish($process_info, $task_entry, $@);
        }

        return 1;
    }

    sub _mk_unarchive_only {
        my ($unarchiver, $single_template, $multi_template, $tool_name) = @_;

        return sub {
            my ($process_info, $task_entry, $progress_messager, $progress_tag,
                $archive_filepath, $to_dir, $temp_ext, $wildcard_filler, 
                $renaming, $renaming_master_data, $source_filenames, 
                @target_filenames) = @_;

            my @concretised_filenames = _filename_renaming(
                $to_dir, $temp_ext, $wildcard_filler, $renaming, 
                $renaming_master_data, @target_filenames
            );

            my $stat = stat($archive_filepath);

            if (not defined $stat) {
                return fatal_finish($process_info, $task_entry,
                    sprintf("Cannot stat '%s': %s (%s)", $archive_filepath, $!, $^E)
                );
            }
            
            if ($source_filenames) {
                my $unarchiver_cmdline = sprintf(
                    $multi_template,
                    shell_quote($archive_filepath),
                    join(' ', map { shell_quote($_) } @$source_filenames),
                );

                $progress_messager->(
                    0,
                    sprintf(
                        @concretised_filenames == 1
                            ? 'Decompressing %d file from %s (%s) %s'
                            : 'Decompressing %d files from %s (%s) %s'
                            ,
                        scalar(@concretised_filenames),
                        $archive_filepath,
                        human_readable_filesize($stat->size),
                        $progress_tag,
                    ),
                );

                return _do_unarchive(
                    $process_info, $task_entry, $progress_messager, 
                    $progress_tag, $to_dir, $renaming, [$tool_name],
                    $unarchiver_cmdline, $source_filenames,
                    @concretised_filenames,
                );
            }

            my $unarchiver_cmdline = sprintf(
                $single_template,
                shell_quote($archive_filepath)
            );

            $progress_messager->(
                0,
                sprintf(
                    'Decompressing 1 file from %s (%s) %s',
                    $archive_filepath,
                    human_readable_filesize($stat->size),
                    $progress_tag,
                ),
            );

            return _do_decompress(
                $process_info, $task_entry, $progress_messager, $progress_tag,
                $to_dir, $renaming, $tool_name, $unarchiver,
                $unarchiver_cmdline, $concretised_filenames[0],
            );
        };
    }

    # man unzip: unzip [-flags] zipfile.zip [archive files]
    #   -f freshen existing files
    #   -j junk paths (don't recreate directory structure)
    #   -u update existing files and create new ones
    #   -C case-insensitive matching
    #   -L convert filenames to lowercase if they originate from uppercase
    #       filesystems
    #   -o overwrite without prompting
    #   -q quiet
    #   -qq quieter
    #
    # Exit codes:
    #   0  no errors
    #   1  warnings only
    #   2  error in zip format (but might have succeeded)
    #   3  error in zip format (failure)
    #   4  out of memory
    #   5  out of memory
    #   6  out of memory
    #   7  out of memory
    #   8  unused
    #   9  zipfile not found
    #   10 invalid command-line options
    #   11 no matching files within zipfile
    #   50 full disk
    #   51 zipfile ended prematurely
    #   80 aborted (CTRL-C or killed)
    #   81 unsupported compression or encryption method
    #   82 bad password

    # man 7za: 7za [function] [-] [switches] archive.name [archive files]
    #   e   extract
    #  (x   extract with full path)
    #
    #   -si  read from stdin
    #   -so  write to stdout
    #   -y   assume yes
    #   -bd  disable percentage indicators
    #
    #   -aoa overwrite all
    #   -t{T} type T = { 7z, zip, gzip, bzip2, tar }
    #        (also tar.gzip or tar.bzip2)
    #
    # Exit codes:
    #   0  no errors
    #   1  warnings only
    #   2  fatal error
    #   7  not enough command-line parameters
    #   8  out of memory
    #   255 aborted (CTRL-C or killed)
    #
    # Pipe examples (dummy archive name is mandatory even in a pipe):
    #   7z a dummy -ttar -so History.txt License.txt | 7z a dummy -tgzip -si -so > test.tar.gz
    #   7z e test.tar.gz -tgzip -so | 7z e dummy -ttar -si License.txt

    # man tar: tar [function] [options] filenames
    #   -x      extract
    #   -f <F>  use filename F as the archive
    #   --ignore-case
    #   --overwrite
    #   --transform <E>  where E is a sed-style regex for transforming 
    #                    extracted filenames
    #
    # Exit codes (for GNU tar):
    #   0  no errors
    #   1  "some files differ" (only when creating or updating archive)
    #   2  fatal error

    # man gzip: gzip [flags] filename
    #   -c  write to stdout
    #   -d  decompress
    #   -f  force (don't ask)
    #
    # Exit codes:
    #   0  no errors
    #   1  fatal error
    #   2  warning

    # man bzip2: bzip2 [flags] filename
    #   -c  write to stdout
    #   -d  decompress
    #   -f  force (don't ask)
    #   -k  keep input files
    #   -q  quiet
    #   --  subsequent parameters are filenames
    #
    # Exit codes:
    #   0  no errors
    #   1  error (I/O, command-line parameters, etc.)
    #   2  corrupt input file
    #   3  internal panic

    my %error_description = (
        unzip => {
            3 => 'corrupt input file',
            4 => 'out of memory',
            5 => 'out of memory',
            6 => 'out of memory',
            7 => 'out of memory',
            9 => 'input file not found',
            10 => 'invalid command-line options',
            11 => 'no matching files inside input file',
            50 => 'out of disk space',
            51 => 'input file ended prematurely',
            80 => 'process killed prematurely',
            81 => 'unsupported compression method',
        },
        '7za' => {
            2 => 'fatal error',
            7 => 'not enough command-line parameters',
            8 => 'out of memory',
            255 => 'process killed prematurely',
        },
        tar => {
            2 => 'fatal error',
        },
        gzip => {
            1 => 'fatal error',
        },
        bzip2 => {
            1 => 'fatal error',
            2 => 'corrupt input file',
            3 => 'internal panic',
        },
    );

    my @tools = (
        {
            ext => [qw(.zip)],
            tools => [
                { 
                    unarchive => ['unzip', 
                        { many => '-ojCLqq %s %s', single => '-pjqq %s' }
                    ],
                },
                { 
                    unarchive => ['7za', 
                        { many => 'e -tzip -bd -y %s %s', single => 'e -tzip -bd -so %s' }
                    ],
                },
            ],
        },

        {
            ext => [qw(.tar.gz .tgz .tar.Z .taz)],
            tools => [
                { 
                    decompress => ['gzip', '-dc %s'],
                    unarchive => ['tar', 
                        { many => '-xf - %s', single => '-xOf -' }
                    ],
                },
                { 
                    decompress => ['7za', 'e %s -tgzip -so'],
                    unarchive => ['7za', 
                        { many => 'e dummy -ttar -bd -y -si %s', single => 'e dummy -ttar -bd -si -so' }
                    ], 
                },
            ],
        },

        {
            ext => [qw(.tar.bz2 .tbz)],
            tools => [
                { 
                    decompress => ['bzip2', '-dc %s'],
                    unarchive => ['tar', 
                        { many => '-xf - %s', single => '-xOf -' }
                    ],
                },
                { 
                    decompress => ['7za', 'e %s -tbzip2 -so'],
                    unarchive => ['7za', 
                        { many => 'e dummy -ttar -bd -y -si %s', single => 'e dummy -ttar -bd -si -so' }
                    ], 
                },
            ],
        },

        {
            ext => [qw(.tar)],
            tools => [
                { 
                    unarchive => ['tar', 
                        { many => '-xf %s %s', single => '-xOf %s' }
                    ],
                },
                { 
                    unarchive => ['7za', 
                        { many => 'e %s -bd -y -ttar %s', single => 'e %s -bd -ttar -so' }
                    ],
                }, 
            ],
        },

        {
            ext => [qw(.7z)],
            tools => [
                { 
                    unarchive => ['7za', 
                        { many => 'e %s -bd -y -t7z %s', single => 'e %s -bd -t7z -so' }
                    ],
                },
            ],
        },

        {
            ext => [qw(.gz)],
            tools => [
                { decompress => ['gzip', '-dc %s'] },
                { decompress => ['7za', 'e %s -bd -tgzip -so'] },
            ],
        },

        {
            ext => [qw(.bz2)],
            tools => [
                { decompress => ['bzip2', '-dc %s'] },
                { decompress => ['7za', 'e %s -bd -tbzip2 -so'] },
            ],
        },

    );

    sub _filename_renaming {
        my ($to_dir, $temp_ext, $wildcard_filler, $renaming, 
            $renaming_master_data, @filenames) = @_;

        my @concretised_filenames = ();

        for (@filenames) {
            my $concrete_filename = concretise_local_filename(
                $_, $wildcard_filler
            );

            my $to = sprintf('%s/%s.%s', $to_dir, $concrete_filename, $temp_ext);

            $$renaming{$to} = {
                %{ $renaming_master_data || {} },
                local_filename => $_,
                to_dir => $to_dir,
                concrete_filename => $concrete_filename,
            };

            push @concretised_filenames, $concrete_filename.'.'.$temp_ext;
        }

        return @concretised_filenames;
    }

    sub _do_slurp {
        my ($filepath, $output_ref) = @_;

        open(my $fh, '<', $filepath) or do {
            unlink($filepath) or do { };
            return 0;
        };

        $$output_ref = join('', <$fh>);

        close($fh) or do {
            unlink($filepath) or do { };
            return 0;
        };

        unlink($filepath) or return 0;
        return 1;
    }

    sub _do_system_status {
        my ($process_info, $task_entry, $tool_names, $cmdline, $questionmark,
            $qx_output) = @_;

        my $exit_code = $questionmark >> 8;
        my $signal = $questionmark & 0x7f;

        if ($questionmark == -1) {
            return fatal_finish(
                $process_info, $task_entry,
                sprintf("Failed to run '%s': %s", $cmdline, $qx_output),
            );
        } elsif ($signal) {
            my $is_coredump = $questionmark & 0x80;

            return fatal_finish(
                $process_info, $task_entry, 
                sprintf("Command '%s' ended with signal %d%s\n%s",
                    $cmdline,
                    $signal,
                    $is_coredump ? ' (core dumped)' : '',
                    $qx_output
                )
            );
        } else {
            if ($exit_code != 0) {
                my %err = ();
                
                for (@$tool_names) {
                    my $str = $error_description{$_}{$exit_code};

                    if (defined $str) {
                        $err{$str} = ();
                    }
                }

                my $errors = joinor(keys %err);

                return fatal_finish(
                    $process_info, $task_entry,
                    sprintf("Command '%s' ended with error%s\n%s",
                        $cmdline,
                        $errors ? ': '.$errors : ' (it may have been killed)',
                        $qx_output
                    ),
                );
            }
        }

        if ($SHELL_DEBUGGING) {
            DBManager::TaskLog->info(
                $process_info,
                sprintf("%s\n--> exit code=%d\n%s",
                    $cmdline,
                    $questionmark,
                    $qx_output,
                )
            );
        }

        return 1;
    }

    sub _do_chdir {
        my ($process_info, $task_entry, $dir, $warn_only) = @_;

        my ($vol, $path) = File::Spec->splitpath($dir, 1);
        
        if ($vol) {
            if ($SHELL_DEBUGGING) {
                DBManager::TaskLog->info(
                    $process_info, 'chdir '.$vol
                );
            }

            chdir($vol) or do {
                my $err = sprintf("Cannot change volume to '%s': %s (%s)", $vol, $!, $^E);

                if ($warn_only) {
                    DBManager::TaskLog->warn($process_info, $err);
                    return;
                } else {
                    return fatal_finish($process_info, $task_entry, $err);
                }
            };
        }

        if ($SHELL_DEBUGGING) {
            DBManager::TaskLog->info(
                $process_info, 'chdir '.$path
            );
        }

        chdir($path) or do {
            my $err = sprintf("Cannot change directory to '%s': %s (%s)", $path, $!, $^E);

            if ($warn_only) {
                DBManager::TaskLog->warn($process_info, $err);
                return;
            } else {
                return fatal_finish($process_info, $task_entry, $err);
            }
        };

        return 1;
    }

    my %known_ext = ();

    for (@tools) {
        my ($ext, $tools) = @$_{qw(ext tools)};

        # Decompress always happens by piping, so that 1) the original file 
        # is kept and 2) the output can be received by an unarchiver.
        # If an unarchiver is not needed, the decompression output is
        # just redirected into a single file. If decompression is not needed,
        # the archiver will read straight from the file, not from a pipe.

        my $sub;

        for my $tool (@$tools) {
            if (my $un = $$tool{'unarchive'}) {
                my $unarchiver = abs_program($$un[0]);

                if (not defined $unarchiver) {
                    next;
                }

                if (my $de = $$tool{'decompress'}) {
                    my $decompressor = abs_program($$de[0]);

                    if (not defined $decompressor) {
                        next;
                    }

                    $sub = _mk_decompress_unarchive_pipe(
                        $decompressor, $$de[1], $$de[0],
                        $unarchiver, $$un[1]{'single'}, $$un[1]{'many'}, $$un[0],
                    );

                    last;
                } else {
                    my $unarchiver = abs_program($$un[0]);

                    if (not defined $unarchiver) {
                        next;
                    }

                    $sub = _mk_unarchive_only(
                        $unarchiver, $$un[1]{'single'}, $$un[1]{'many'}, $$un[0],
                    );

                    last;
                }
            } elsif (my $de = $$tool{'decompress'}) {
                my $decompressor = abs_program($$de[0]);

                if (not defined $decompressor) {
                    next;
                }

                $sub = _mk_decompress_pipe(
                    $decompressor, $$de[1], $$de[0]
                );

                last;
            } else {
                die "programming error";
            }
        }

        # $sub could be undef.
        
        @known_ext{@$ext} = ($sub) x @$ext;
    }

    sub _pick_extractor {
        my ($filename) = @_;

        my $ext = _detect_compression_extension($filename);

        if (defined $ext) {
            return $known_ext{$ext};
        }

        return \&_do_no_extractor;
    }

    sub _detect_compression_extension {
        my ($filename) = @_;

        for (keys %known_ext) {
            if (substr($filename, -length($_)) eq $_) {
                return $_;
            }
        }

        return;
    }
}

sub do_rename_moved_files {
    my ($process_info, $task_entry, $progress_messager, $renaming) = @_;

    my $num_entries = 0;
    my $num_deletions = 0;
    
    for my $h (values %$renaming) {
        for (values %$h) {
            if ($$_{'delete_this'}) {
                ++$num_deletions;
                next;
            }

            ++$num_entries;
        }
    }

    if ($num_entries + $num_deletions == 0) {
        dual_progress($process_info, $progress_messager, 1,
            'Renaming done (no files to process).',
        );

        return 1;
    }

    # FASTA files are renamed last, because their appearance will trigger
    # a database activation in ms-monitor.exe. However, if a FASTA file
    # has been downloaded, its name (version tag) needs to be determined
    # first, so that the same version tag can be applied to the reference
    # file (if used). Thus the special treatment.
    my @types = grep { $_ ne 'fasta' } keys %$renaming;
    my @fasta_type = $$renaming{'fasta'} ? 'fasta' : ();

    my %actions = ();
    my %master_tag = ();

    DBManager::TaskLog->info(
        $process_info, 
        sprintf('Determining final version tags of %d files.', $num_entries),
    );

    my $entry_ix = -1;

    for my $type (@fasta_type, @types) {
        for my $from (keys %{ $$renaming{$type} }) {
            my $entry = $$renaming{$type}{$from};

            if ($$entry{'delete_this'}) {
                push @{ $actions{$type} }, {
                    from => $from,
                    delete_this => 1,
                };

                next;
            }

            ++$entry_ix;

            my $progress_tag = sprintf("%d out of %d", 
                1 + $entry_ix, $num_entries
            );

            my ($to_dir, $local_filename, $concrete_filename) = @$entry{qw(
                to_dir local_filename concrete_filename
            )};

            if (not local_filename_has_wildcard($local_filename)) {
                # Just overwrite if a file with the same name exists.
                push @{ $actions{$type} }, {
                    from => $from,
                    to => join('/', $to_dir, $concrete_filename),
                };

                DBManager::TaskLog->info(
                    $process_info, 
                    sprintf(
                        'File %s (%s) has no wildcard; no version tag check needed.', 
                        $progress_tag,
                        $concrete_filename
                    ),
                );

                next;
            }

            if (defined(my $master_type = $$entry{'master_tag_type'})) {
                my $version_tag = $master_tag{$master_type};

                # Assumption: only the FASTA file can be master_tag_type.
                # If there is no FASTA file in the downloaded batch,
                # we must dig up the current filename from disk. If
                # there is no FASTA file, then it doesn't matter which
                # version tag the other files use -- so we'll fall back
                # to the default strategy.

                if (not defined $version_tag) {
                    my ($current_filenames) = find_all_matching_filepaths(
                        $to_dir, $$entry{'master_local_filename'},
                    );

                    if ($current_filenames and @$current_filenames) {
                        my $re = local_filename_to_regex($$entry{'master_local_filename'}, 1);
                        $re = qr(/$re)i;

                        # The newest filename is the first -- we'll assume
                        # it's also the current one.
                        ($version_tag) = $$current_filenames[0] =~ $re;
                    }
                }

                if (defined $version_tag) {
                    # $tag will include 'x' if there was a name conflict.

                    my $new_filename = concretise_local_filename(
                        $local_filename, { 
                            wildcard => { '*' => $version_tag }
                        },
                    );

                    if ($new_filename ne $concrete_filename) {
                        push @{ $actions{$type} }, {
                            from => $from,
                            to => join('/', $to_dir, $new_filename),
                            original => $concrete_filename,
                        };

                        DBManager::TaskLog->info(
                            $process_info, 
                            sprintf(
                                'Version tag of file %s (%s) was tuned to match FASTA filename version tag.',
                                $progress_tag,
                                $new_filename,
                            ),
                        );

                        next;
                    }

                    push @{ $actions{$type} }, {
                        from => $from,
                        to => join('/', $to_dir, $concrete_filename),
                    };

                    DBManager::TaskLog->info(
                        $process_info, 
                        sprintf(
                            'Version tag of file %s (%s) matches FASTA filename version tag; no tuning needed.',
                            $progress_tag,
                            $concrete_filename,
                        ),
                    );

                    next;
                }
            }

            # Another special case: a file with the same name might
            # already exist.

            my $chosen_alternative = $concrete_filename;
            my ($ext) = $concrete_filename =~ m#(\.[^.]+)$#;
            my $base = substr($concrete_filename, 0, length($concrete_filename) - length($ext));
            my $supp = $base.'x'.$ext;
            my $is_modified = 0;

            if (-e join('/', $to_dir, $concrete_filename)) {
                # See perldoc File::stat why _ can't be used with File::stat.
                my $current_mtime = (CORE::stat(_))[9];

                if (-e join('/', $to_dir, $supp)) {
                    my $supp_mtime = (CORE::stat(_))[9];

                    # Both exist, so replace the older one.
                    if ($supp_mtime < $current_mtime) {
                        $chosen_alternative = $supp;

                        DBManager::TaskLog->info(
                            $process_info, 
                            sprintf(
                                'An "x" was added to the name of file %s (%s) due to a filename conflict (a file called %s already exists); this will replace the older file %s.', 
                                $progress_tag,
                                $supp,
                                $concrete_filename,
                                $supp,
                            ),
                        );
                    } else {
                        # Keep $chosen_alternative.
                        DBManager::TaskLog->info(
                            $process_info, 
                            sprintf(
                                'File %s (%s) replaces an existing file of the same name, as the alternative file %s exists and is newer than %s.',
                                $progress_tag,
                                $concrete_filename,
                                $supp,
                                $concrete_filename,
                            ),
                        );
                    }
                } else {
                    $chosen_alternative = $supp;

                    DBManager::TaskLog->info(
                        $process_info, 
                        sprintf(
                            'An "x" was added to the name of file %s (%s) due to a filename conflict (a file called %s already exists).', 
                            $progress_tag,
                            $supp,
                            $concrete_filename,
                        ),
                    );
                }
            } else {
                # Doesn't exist yet; $chosen_alternative is OK.
            }

            my $re = local_filename_to_regex($local_filename, 1);
            ($master_tag{$type}) = $chosen_alternative =~ $re;

            if ($concrete_filename eq $chosen_alternative) {
                push @{ $actions{$type} }, {
                    from => $from,
                    to => join('/', $to_dir, $chosen_alternative),
                };

                DBManager::TaskLog->info(
                    $process_info, 
                    sprintf(
                        'Version tag of file %s (%s) does not conflict with existing files; no change needed.',
                        $progress_tag,
                        $concrete_filename,
                    ),
                );
            } else {
                push @{ $actions{$type} }, {
                    from => $from,
                    to => join('/', $to_dir, $chosen_alternative),
                    original => $concrete_filename,
                };

                # The reason was logged above.
            }
        }
    }

    $entry_ix = -1;

    for my $type (@types, @fasta_type) {
        for (@{ $actions{$type} }) {
            if ($$_{'delete_this'}) {
                my $from = $$_{'from'};
                next if not -e $from;

                if ($FILE_OPERATION_DEBUGGING) {
                    DBManager::TaskLog->info(
                        $process_info, sprintf("delete %s", $from)
                    );
                }

                unlink $from or return fatal_finish(
                    $process_info, $task_entry,
                    sprintf("Cannot remove temporary file '%s': %s (%s)", $from, $!, $^E)
                );
                next;
            }

            my ($from, $to) = @$_{qw(from to)};
            ++$entry_ix;

            my $progress_tag = sprintf("%d out of %d", 
                1 + $entry_ix, $num_entries
            );

            dual_progress($process_info, $progress_messager,
                $entry_ix/$num_entries,
                sprintf("Renaming decompressed file %s", $progress_tag),
            );

            if ($FILE_OPERATION_DEBUGGING) {
                DBManager::TaskLog->info(
                    $process_info, 
                    sprintf("move %s --> %s", $from, $to),
                );
            }

            File::Copy::move($from => $to) or return fatal_finish(
                $process_info, $task_entry, 
                sprintf("Cannot move '%s' to '%s': %s (%s)", $from, $to, $!, $^E),
            );

            my ($filename) = $to =~ m#/([^/]+)$#;
            my $to_dir = substr($to, 0, length($to) - (length($filename) + 1));

            eval {
                # Directory could have changed.
                inherit_directory_permissions_filepath(
                    $to_dir, $filename
                )
            };

            if ($@) {
                return fatal_finish($process_info, $task_entry, $@);
            }
        }
    }

    dual_progress($process_info, $progress_messager, 1, 
        $num_entries == 1
            ? "Renamed 1 file."
            : sprintf("Renamed %d files.", $num_entries)
    );

    return 1;
}

sub do_update_taxonomy_and_unigene {
    my ($process_info, $task_entry, $private_doc, $pub_filename, $pub_doc) = @_;

    do {
        my ($new_section, $renaming) = DBManager::Workhorse::XMLTools->inherit_taxonomy_entries(
            $private_doc, {}, $pub_filename, $pub_doc, \my @errors,
        );

        if (@errors) {
            return fatal_finish(
                $process_info,
                $task_entry,
                join("\n", @errors),
            );
        }

        DBManager::Workhorse::XMLTools->apply_taxonomy_renaming(
            $$private_doc{'Databases'}, $renaming
        );

        $$private_doc{'Taxonomy'} = $new_section;
    };

    do {
        my $new_section = DBManager::Workhorse::XMLTools->inherit_unigene_entries(
            $private_doc, $pub_filename, $pub_doc, \my @errors,
        );

        if (@errors) {
            return fatal_finish(
                $process_info,
                $task_entry,
                join("\n", @errors),
            );
        }

        $$private_doc{'UniGene'} = $new_section;
    };

    return 1;
}

sub do_save_configuration {
    my ($process_info, $task_entry, $private_doc_def, $pub_defs,
        $additional_mascot_dat_processing) = @_;

    eval {
        DBManager::Workhorse::XMLTools->write_configuration(
            $$private_doc_def{'fh'}, 
            $$private_doc_def{'doc'}, 
            { map { $_ => $$pub_defs{$_}{'doc'} } keys %$pub_defs },
            $additional_mascot_dat_processing,
        )
    };

    if ($@) {
        return fatal_finish($process_info, $task_entry, $@);
    }

    return 1;
}

sub do_cleanup_downloaded_files {
    my ($process_info, $task_entry, $progress_messager, $fetch_def) = @_;

    my $num_entries = grep { $$_{'downloaded'} } map { @$_ } values %$fetch_def;

    if ($num_entries == 0) {
        return 1;
    }

    my $entry_ix = -1;

    for my $type (keys %$fetch_def) {
        for my $entry (@{ $$fetch_def{$type} }) {
            my $downloaded = $$entry{'downloaded'};
            next unless $downloaded;

            ++$entry_ix;

            dual_progress($process_info, $progress_messager,
                $entry_ix/$num_entries,
                sprintf("Cleaning up downloaded file %d out of %d.",
                    1 + $entry_ix, $num_entries,
                )
            );

            my $temp_filepath = $$downloaded{'local_filepath'};

            for ('') {
                next if not -e $temp_filepath.$_; 

                if ($FILE_OPERATION_DEBUGGING) {
                    DBManager::TaskLog->info(
                        $process_info, 
                        sprintf("remove %s", $temp_filepath.$_),
                    );
                }

                unlink($temp_filepath.$_) or return fatal_finish(
                    $process_info, $task_entry, 
                    sprintf("Cannot remove '%s': %s (%s)", $temp_filepath.$_, $!, $^E),
                );
            }
        }
    }

    dual_progress($process_info, $progress_messager, 1,
        $num_entries == 1
            ? "Cleaned up 1 file."
            : sprintf("Cleaned up %d files.", $num_entries)
    );

    return 1;
}

1;

# Mock replacement for DBManager::TaskDB::RunningEntry.
package DBManager::Workhorse::SimpleTask; 

use strict;
use warnings;

sub new { bless {}, shift }

sub more_progress {
    my $self = shift;
    my ($amount, $state) = @_;

    print STDERR sprintf(
        "[%5s%%] %s\n", sprintf("%.1f", $amount * 100), $state
    );
}

sub should_do { 0 }
sub is_done { 0 }

1;

package DownloadSpeedEstimate;

use strict;
use warnings;

use List::Util qw(sum);

use Util::SimpleMovingMedian;

# How many previous values to keep. Since chunk_received() only adds
# a value at most once a second, this is the lower bound of how old,
# in seconds, the history of speeds can be.
use constant SAMPLE_SIZE => 30; 

sub new {
    my $class = shift;
    my ($start_time) = @_;

    $start_time = time if not defined $start_time;
    
    bless { 
        smm => Util::SimpleMovingMedian->new(SAMPLE_SIZE),
        last_time => $start_time,
        last_size => 0,
        total_size => 0,
    }, $class;
}

sub chunk_received {
    my $self = shift;
    my ($size) = @_;

    $self->{'total_size'} += $size;

    my $time = time;
    my $time_delta = $time - $$self{'last_time'};

    my $statistics_available = 0;

    if ($time_delta >= 1) {
        my $size_delta = $$self{'total_size'} - $$self{'last_size'};

        $$self{'last_time'} = $time;
        $$self{'last_size'} = $$self{'total_size'};

        my $speed = $size_delta/$time_delta;
        $self->{'smm'}->add($speed);

        $statistics_available = 1;
    }

    return $statistics_available;
}

sub size_received { $_[0]->{'total_size'} }

sub median {
    my $self = shift;
    return $self->{'smm'}->result;
}

1;

