#!/usr/bin/env perl

=begin comment

File:           GetComponents
Version:        1.0
Author:         Eric Seidel
Email:          eric@eseidel.org
Description:    This program automates the procedure of checking out components
                from multiple sources and mechanisms. For more info see the
                Pod Documentation with ./GetComponents -m

                                LICENSE

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.


=end comment

=cut

use strict;
use warnings;
#use diagnostics;
use Data::Dumper;
use Getopt::Long;
use Pod::Usage;
use File::stat;
use Cwd;

# import optional threading modules
my $PARALLEL;
my %semaphores;
my $QUEUE;
eval {
    require threads;
    require threads::shared;
    require Thread::Queue;
    require Thread::Semaphore;
};
unless ($@) {
    import threads;
    import threads::shared;
    import Thread::Queue;
    import Thread::Semaphore;
    #$PARALLEL = 1;
    $QUEUE = Thread::Queue->new();

}

my $combined_components = "# This file was automatically generated using the GetComponents script.\n\n";
my %components_to_checkout;
my %components_to_update;
my @all_components;
my $checkout_size :shared = 0;
my $update_size :shared = 0;
my @components_error :shared;
my $ROOT = '';
my $VERBOSE = 0;
my $DEBUG = 0;
my $HELP = 0;
my $MAN = 0;
my $EXPERIMENTAL = 0;
my $ANONYMOUS_CHECKOUT = 0;
my $DO_UPDATES = 0;
my $STATUS = 0;
my $DIFF = 0;
my $DATE;
my @CRL_LISTS;
my %DEFINITIONS;
my $cvs = 'cvs';
my $svn = 'svn';
my $git = 'git';
my $darcs = 'darcs';
my $wget = 'wget';
my $hg = 'hg';
my $curl = 'curl';
my $cvs_found = 0;
my $svn_found = 0;
my $git_found = 0;
my $darcs_found = 0;
my $wget_found = 0;
my $curl_found = 0;
my $hg_found = 0;
my %updated_git_repos :shared;
my %updated_darcs_repos :shared;
my %updated_hg_repos :shared;
my %verified_git_repos;
my %verified_darcs_repos;
my %verified_hg_repos;
my %checkout_types = (
        'cvs'       => \&handle_cvs,
        'svn'       => \&handle_svn,
        'git'       => \&handle_git,
        'darcs'     => \&handle_darcs,
        'http'      => \&handle_wget,
        'https'     => \&handle_wget,
        'ftp'       => \&handle_wget,
        'hg' => \&handle_hg
);
my $crl_dir = ".crl";
if (defined($ENV{HOME})) {
    $crl_dir = "$ENV{HOME}/.crl";
}
else {
    print "Home directory is not set. CRL files will be stored in .crl\n";
}
if (! -e "$crl_dir") {
    run_command("mkdir $crl_dir");
}


####################### MAIN PROGRAM #####################################

# parse options and print usage if syntax error
GetOptions('verbose+'       => \$VERBOSE,
           'help|?'         => \$HELP,
           'man'            => \$MAN,
           'debug'          => \$DEBUG,
           'anonymous'      => \$ANONYMOUS_CHECKOUT,
           'update'         => \$DO_UPDATES,
           'root=s'         => \$ROOT,
           'date=s'         => \$DATE,
           'experimental'   => \$EXPERIMENTAL,
           'status'         => \$STATUS,
           'diff'           => \$DIFF,
           'parallel'       => \$PARALLEL,
           'reset-authentication'   => sub { system("rm $crl_dir/users") })
           or pod2usage(2);
pod2usage(1) if $HELP;
pod2usage(-verbose => 2) if $MAN;

find_tools();

&process_args();

# grab the directory the script was called from, we will need this later
my $orig_dir = cwd();
if ($ROOT ne '') {$DEFINITIONS{ROOT} = $ROOT};

parse_list();
print_list() if $DEBUG;
get_status() if $STATUS;
get_diff() if $DIFF;
process_users();
prompt_for_update();
verify_urls() if $DO_UPDATES;
# start timer here, we don't care about authentication time
my $start_time = time;

foreach my $key (sort(keys %components_to_checkout)) {
    checkout(@{$components_to_checkout{$key}});
}
if ($DO_UPDATES) {
    foreach my $key (sort(keys %components_to_update)) {
        update(@{$components_to_update{$key}});
    }
}

if ($EXPERIMENTAL) {
  write_componentlist_target();
}
print_summary();
exit (@components_error > 0);

##########################################################################

sub process_args()
{
    unless (@ARGV || (-e "$crl_dir/component_lists")) {
        pod2usage("\n$0: No files given.\nSpecify -man for an explanation of how to use this script.\n\n");
    }
    # not using this option currently
    if (@ARGV == 0) {
        my $list_dir = "$crl_dir/component_lists";
        opendir(DIR, $list_dir) || DIE("Can't open $list_dir");
        my @files = grep { (!/^\./) && -f "$list_dir/$_" } readdir(DIR);
        closedir DIR;
        print "The following component lists were found:\n";
        for my $file (@files) {
            print "$file\n";
        }
        print "Would you like to update these? [(y)es no] ";
        my $answer = <STDIN>;
        exit;
    }
    else {
        foreach my $ARG (@ARGV) {
            if ($ARG =~ m!^https?://!) {
                download_list($ARG);
                $ARG =~ s!.*/!!;
            }
            push @CRL_LISTS, $ARG;
        }
    }
}

sub download_list
{
    my $url = shift;
    my $file = $url;
    $file =~ s!.*/!!;
    if ($curl_found) {
        run_command("$curl '$url' -o $file")==0 and return;
    }
    run_command("$wget '$url' -O $file")==0 and return;
    DIE("Couldn't download $url correctly.");
}

sub find_tools
{
    if (run_command("which $cvs") == 0) {$cvs_found = 1}
    if (run_command("which $svn") == 0) {$svn_found = 1}
    if (run_command("which $git") == 0) {$git_found = 1}
    if (run_command("which $curl") == 0) {$curl_found = 1; $curl .= " -f"}
    elsif (run_command("which $wget") == 0) {$wget_found = 1}
    if (run_command("which $darcs") == 0) {$darcs_found = 1}
    if (run_command("which $hg") == 0) {$hg_found = 1}
    if ($cvs_found) {
        # Use compression to speed up slow links, and to avoid
        # transmission errors with CCT's CVS server
        $cvs = "$cvs -z9";
    }
}

sub download_include
{
    my $url = shift;
    print("Using include $url\n");
    if ($url !~ /^https?:\/\//) {
        DIE("Don't know how to retrieve include url $url");
    }
    if (-e "$crl_dir/include_tmp") {
        unlink("$crl_dir/include_tmp");
    }
    if (!$curl_found or
        run_command("$curl '$url' -o $crl_dir/include_tmp") or
        run_command("$wget '$url' -O $crl_dir/include_tmp")) {
        DIE("Couldn't download include url $url correctly\n");
    }
    if (! -e "$crl_dir/include_tmp") {
        DIE("Couldn't download include url $url correctly\n");
    }
    open (my $INCL, "$crl_dir/include_tmp") or DIE("Couldn't open include url file from $url\n");
    my @lines = <$INCL>;
    unshift(@lines, "\n");
    close ($INCL);
    return @lines;
}

sub parse_list
{
    my $file = '';
    foreach my $LIST (@CRL_LISTS) {
        open(my $COMPONENT_LIST, $LIST) or DIE("Could not open $LIST");
        # check for CRL Header
        while (<$COMPONENT_LIST>) {
            next if m/^#|^\s*$/;
            if (m/^!CRL_VERSION .*_experimental/) {
                $EXPERIMENTAL = 1;
                print "Using experimental features, be careful!\n";
            }
            if (m/^!CRL_VERSION/) {
                # save Header
                $combined_components .= $_;
                $_ = '';
                last;
            }
            if (m/\w/) {
                print "$LIST is not a CRL file.\n";
                print "Do you want to continue? yes no [no]: ";
                my $answer = <STDIN>;
                chomp $answer;
                exit unless $answer =~ /^y/;
                last;
             }
        }
        # now that we know we have an CRL file, we slurp it
        my @lines = <$COMPONENT_LIST>;
        close($COMPONENT_LIST);
        # handle includes
        if ($EXPERIMENTAL == 1) {
            my $i = -1;
            foreach my $line (@lines) {
                $i++;
                if ($line =~ /^[^#]*!INCLUDE *= *(.*)$/) {
                    splice(@lines, $i, 1, &download_include($1));
                }
            }
        }
        # grab definitions
        foreach my $line (@lines) {
            if ($line =~ /^!DEFINE\s*([^\s]+)\s*=\s*(.+)/) {
                my ($def, $value) = ($1, $2);
                # don't set ROOT if already given on the command line
                next if $def eq 'ROOT' && $ROOT ne '';
                # check for repeated definitions
                if (defined($DEFINITIONS{$def}) and
                            $DEFINITIONS{$def} ne $value) {
                    if ($EXPERIMENTAL) {
                        WARN_nonfatal("Repeated definition of $def, ignored");
                    } else {
                        DIE("Repeated definition of $def");
                    }
                } else {
                    # resolve compound definitions
                    $value =~ s/\$(\w+)/$DEFINITIONS{$1}/;

                    $DEFINITIONS{$def} = $value;
                }
            }
        }
        $file .= "\n\n# Component list: $LIST\n\n";
        $file .= join("", @lines);
    }
    my $orig_file = $file;
    # convert CR to newline (for lists generated by windows)
    $file =~ s/\r/\n/gm;
    # remove comments
    $file =~ s/^\s*#.*$//gm;
    $file =~ s/\n\n/\n/g;
    $file =~ s/#.*$//gm;

    # replace long-form directives with short-form directives
    $file =~ s/!ANONYMOUS_USER/!ANON_USER/gm;
    $file =~ s/!ANONYMOUS_PASS/!ANON_PASS/gm;
    $file =~ s/!ANONYMOUS_PASSWORD/!ANON_PASS/gm;
    $file =~ s/!LOCAL_PATH/!LOC_PATH/gm;
    $file =~ s/!REPOSITORY_PATH/!REPO_PATH/gm;
    $file =~ s/!REPOSITORY_BRANCH/!REPO_BRANCH/gm;
    $file =~ s/!AUTHORIZATION_URL/!AUTH_URL/gm;

    # replace definitions
    $file =~ s/\$(\w+)/
                        exists $DEFINITIONS{$1} ? $DEFINITIONS{$1} : '$'.$1
                        /egm;

    # if $ROOT is undefined, it will be set to the current directory
    if (defined($DEFINITIONS{ROOT})) {$ROOT = $DEFINITIONS{ROOT}}
    else {$ROOT = $orig_dir}

    my @sections = split(/^!TARGET\s*=\s*/m, $file);
    shift(@sections);
    foreach my $section (@sections) {

        # if there is only one section there will be an empty section
        # which must be skipped
        if ($section =~ /^$/) {next}

        $section = "!TARGET = $section";
        my @pairs = split(/^\s*!([^\s=]+)\s*=\s*/m, $section);
        shift(@pairs);
        #chomp @pairs;
        my %rec;

        # turn off warnings for this statement, we do our own checking
        {no warnings 'all'; %rec = @pairs;}

        # skip ignored thorns
        if ($rec{"TYPE"} =~ /ignore/) {
            next;
        }
        
        if (!defined($rec{"CHECKOUT"})) {
            WARN_nonfatal("Nothing will be checked out from $rec{URL}\n");
            next;
        }
        chomp %rec;

        # make sure the user has all the required tools
        if (!defined($rec{"TYPE"})) {
            print "Something is missing in the following section:\n";
            print Dumper %rec;
            die();
        }
        if (($rec{"TYPE"} eq "cvs") && (!$cvs_found)) {
            print "You have requested a cvs checkout, but the system was unable to find cvs.\n";
            print "Please enter the path to cvs: ";
            $cvs = <STDIN>;
            chomp $cvs;
        }
        if (($rec{"TYPE"} eq "svn") && (!$svn_found)) {
            print "You have requested a subversion checkout, but the system was unable to find subversion.\n";
            print "Please enter the path to subversion: ";
            $svn = <STDIN>;
            chomp $svn;
        }
        if (($rec{"TYPE"} eq "git") && (!$git_found)) {
            print "You have requested a git checkout, but the system was unable to find git.\n";
            print "Please enter the path to git: ";
            $git = <STDIN>;
            chomp $git;
        }
        if (($rec{"TYPE"} eq ("http" or "https")) && !($wget_found || $curl_found)) {
            print "You have requested an $rec{TYPE} checkout, but the system was unable to find curl or wget.\n";
            print "Please enter the path to curl or wget: ";
            my $path = <STDIN>;
            chomp $path;
            if ($path =~ /curl/) {
                $curl = $path;
                $curl_found = 1;
            }
            else {
                $wget = $path;
                $wget_found = 1;
            }
        }
        if (($rec{"TYPE"} eq "darcs") && (!$darcs_found)) {
            print "You have requested a darcs checkout, but the system was unable to find darcs.\n";
            print "Please enter the path to darcs: ";
            $darcs = <STDIN>;
            chomp $darcs;
        }
        if (($rec{"TYPE"} eq "hg") && (!$hg_found)) {
            print "You have requested an hg checkout, but the system was unable to find hg.\n";
            print "Please enter the path to hg: ";
            $hg = <STDIN>;
            chomp $hg;
        }

        # parse name of git repo
        if ($rec{"TYPE"} eq "git") {
            my $git_repo = $rec{"URL"};
            $git_repo =~ s/\.git$//;
            $git_repo =~ s/^.*[:\/]//;
            $rec{"GIT_REPO"} = $git_repo;
            # add the repo to %updated_git_repos and set it to 0
            # we will use this to track which repos have already been cloned
            # or updated
            $updated_git_repos{$git_repo} = 0;
            if ($PARALLEL) {
                $semaphores{$git_repo} = Thread::Semaphore->new();
            }
        }

        # parse name of darcs repo
        if ($rec{"TYPE"} eq "darcs") {
            my $darcs_repo = $rec{"URL"};
            $darcs_repo =~ s/_darcs$//;
            $darcs_repo =~ s/^.*[:\/]//;
            $rec{"DARCS_REPO"} = $darcs_repo;
            # add the repo to %updated_darcs_repos and set it to 0
            # we will use this to track which repos have already been cloned
            # or updated
            $updated_darcs_repos{$darcs_repo} = 0;
            if ($PARALLEL) {
                $semaphores{$darcs_repo} = Thread::Semaphore->new();
            }
        }

        # parse name of mercurial repo
        if ($rec{"TYPE"} eq "hg") {
            my $hg_repo = $rec{"URL"};
            $hg_repo =~ s/\.hg$//;
            $hg_repo =~ s/^.*[:\/]//;
            $rec{"HG_REPO"} = $hg_repo;
            # add the repo to %updated_hg_repos and set it to 0
            # we will use this to track which repos have already been cloned
            # or updated
            $updated_hg_repos{$hg_repo} = 0;
            if ($PARALLEL) {
                $semaphores{$hg_repo} = Thread::Semaphore->new();
            }
        }

        # save target in original form to check existence.
        my $target = $rec{"TARGET"};

        # If AUTH_URL is not defined, use URL instead
        if (defined($rec{"URL"}) and !defined($rec{"AUTH_URL"})) {
            $rec{"AUTH_URL"} = $rec{"URL"};
        }

        # save url in original form for parsing $1/$2
        $rec{"URL_ORIG"}      = $rec{"URL"};
        $rec{"AUTH_URL_ORIG"} = $rec{"AUTH_URL"};

        # we are splitting each group of components into individuals
        # to check for existence. they will now be passed individually to
        # the checkout/update subroutines. this will take up more memory,
        # but it should make it easier if the user decides to add another
        # component from the same repository later
        my @checkouts = split(/\s+/m, $rec{"CHECKOUT"});
        foreach my $checkout (@checkouts) {

            # parse url variables
            my ($dir1, $dir2);
            if ($checkout =~ m!/!) {
                ($dir1, $dir2) = $checkout =~ m!(.+)/(.+)!;
            }
            else {
                $dir1 = $checkout;
            }
            if (defined($rec{URL})) {
                $rec{URL} = $rec{"URL_ORIG"};
                $rec{URL} =~ s!\$1!$dir1!;
                $rec{URL} =~ s!\$2!$dir2!;
            }
            if (defined($rec{AUTH_URL})) {
                $rec{AUTH_URL} = $rec{"AUTH_URL_ORIG"};
                $rec{AUTH_URL} =~ s!\$1!$dir1!;
                $rec{AUTH_URL} =~ s!\$2!$dir2!;
            }



            $rec{"CHECKOUT"} = $checkout;
            my %component :shared = %rec;
            my $name = $rec{"NAME"};
            my $dir = defined($name) ? $name : $checkout;

            # skip ignored thorns
            if ($component{"TYPE"} eq 'ignore') {
                next;
            }
            # check for CVS directory
            elsif (-e "$target/$dir/CVS") {
                push @{$components_to_update{$target}}, \%component;
            }
            # or for .svn directory
            elsif (-e "$target/$dir/.svn") {
                push @{$components_to_update{$target}}, \%component;
            }
            # slightly different approach for git
            elsif ($component{"TYPE"} eq "git" && -e "$target/$dir") {
                push @{$components_to_update{$target}}, \%component;
            }
            # and for darcs
            elsif ($component{"TYPE"} eq "darcs" && -e "$target/$dir") {
                push @{$components_to_update{$target}}, \%component;
            }
            # and for hg
            elsif ($component{"TYPE"} eq "hg" && -e "$target/$dir") {
                push @{$components_to_update{$target}}, \%component;
            }
            elsif ($component{"TYPE"} eq "http" && -e "$target/$dir") {
                push @{$components_to_update{$target}}, \%component;
            }
            elsif ($component{"TYPE"} eq "https" && -e "$target/$dir") {
                push @{$components_to_update{$target}}, \%component;
            }
            elsif ($component{"TYPE"} eq "ftp" && -e "$target/$dir") {
                push @{$components_to_update{$target}}, \%component;
            }
            else {
                push @{$components_to_checkout{$target}}, \%component;
            }
            push @all_components, \%component;
        }
    }
    $combined_components .= $orig_file;
}

sub print_list
{
    my $num_checkouts = 0;
    my $num_updates = 0;
    foreach my $group (values %components_to_checkout) {
        foreach my $component (@{$group}) {
            $num_checkouts++;
        }
    }
    foreach my $group (values %components_to_update) {
        foreach my $component (@{$group}) {
            $num_updates++;
        }
    }
    print $num_checkouts." components will be checked out.\n";
    print $num_updates." components will be updated.\n";
    print "Would you like a detailed list? [yes no] ";
    my $answer = <STDIN>;
    if ($answer =~ /y/) {
        foreach my $group (values %components_to_checkout) {
            foreach my $component (@{$group}) {
                print "A    $component->{TARGET}/$component->{CHECKOUT}";
                print "/$component->{NAME}" if defined $component->{NAME};
                print "\n";
            }
        }
        foreach my $group (values %components_to_update) {
            foreach my $component (@{$group}) {
                print "U    $component->{TARGET}/$component->{CHECKOUT}";
                print "/$component->{NAME}" if defined $component->{NAME};
                print "\n";
            }
        }
    }
    exit 0;
}

sub get_status
{
    foreach my $component (@all_components) {
        $checkout_types{$component->{TYPE}}->('status', %{$component});
    }
    print "Would you like a diff for these files? yes [no] ";
    my $answer = <STDIN>;
    if ($answer =~ /y/) {get_diff()}
    exit 0;
}

sub get_diff
{
    foreach my $component (@all_components) {
        $checkout_types{$component->{TYPE}}->('diff', %{$component});
    }
    exit 0;
}

sub verify_urls
{
    foreach my $group (values %components_to_update) {
        foreach my $component (@{$group}) {
            my $ret = $checkout_types{$component->{TYPE}}->('verify_url', %{$component});
            if (!$ret) {
                DIE("The URL for $component->{CHECKOUT} has changed, please perform a clean checkout.");
            }
        }
    }
}

sub write_componentlist_target
{
    chdir($orig_dir);
    # find directory to put file into
    my $fn = $ROOT;
    if (defined($DEFINITIONS{"COMPONENTLIST_TARGET"})) {
        $fn = $DEFINITIONS{"COMPONENTLIST_TARGET"};
        run_command("mkdir -p '$fn'");
    }
    # find file name
    my $short_name = $CRL_LISTS[0];
    $short_name =~ s/.*\///g;
    $fn .= "/$short_name";
    # write file
    open(ALL, ">$fn") or die("Could not write file $fn");
    print ALL $combined_components;
    close(ALL);
}

sub process_users
{
    my $user = $ENV{USER};
    my $last = $user;
    foreach my $component (@all_components) {

        # accessing the component hash looks weird here, but what we are doing
        # is using the hash reference stored in @components directly.
        # we can't convert the reference back to a hash because that would
        # create a new hash not in the array...

        # if $ANONYMOUS_CHECKOUT is set we override any stored users
        if ($ANONYMOUS_CHECKOUT) {
            delete $component->{AUTH_URL};
            next;
        }
        # if AUTH_URL is defined we want to find the username:
        if (defined($component->{AUTH_URL}) and
             ($component->{TYPE} eq 'cvs' or
             $component->{TYPE} eq 'svn' or
             $component->{TYPE} eq 'darcs' or
             $component->{TYPE} eq 'git')) {

            # first we check the users file for a match
            my $saved_user = find_user($component->{AUTH_URL_ORIG});

            # if no match is found, we prompt the user for a username
            # and attempt to login
            if (!defined $saved_user) {
                if ($component->{AUTH_URL} =~ /([^\/]+)@/) {
                    $user = $1;
                }
                print "No user found for $component->{AUTH_URL_ORIG}\n";
                print "Please enter your username ('-' for anonymous access) [$user]: ";
                my $answer = <STDIN>;
                chomp $answer;
                # we want to save that the user wants to use anonymous access
                if ($answer =~ /^-$/) {
                    save_user('N/A', $component->{AUTH_URL_ORIG});
                    delete $component->{AUTH_URL_ORIG};
                    delete $component->{AUTH_URL};
                    next;
                }
                elsif ($answer =~ /^$/) {
                    $component->{USER} = $user;
                    $checkout_types{$component->{TYPE}}->('authenticate',
                                                    %{$component});
                }
                else {
                    $component->{USER} = $answer;
                    $last = $answer;
                    $checkout_types{$component->{TYPE}}->('authenticate',
                                                    %{$component});
                }
                # reset user to the last entry
                $user = $last;
            }
            # check for specified anonymous access
            elsif ($saved_user eq 'N/A') {
                delete $component->{AUTH_URL_ORIG};
                delete $component->{AUTH_URL};
                next;
            }
            # if a match is found, the user has previously logged in and
            # we can continue
            else {
                $component->{USER} = $saved_user;
                next;
            }
        }
    }
}

sub save_user
{
    my ($user, $url) = @_;
    open(my $USERS, ">> $crl_dir/users") or DIE("Could not open $crl_dir/users because of: $!");
    print {$USERS} "$user $url\n";
    close $USERS;
}

sub find_user
{
    my $url = shift;
    if (! -e "$crl_dir/users") {return}
    open(my $USERS, "$crl_dir/users") or DIE("Could not open $crl_dir/users.");
    while (my $line = <$USERS>) {
        chomp $line;
        my ($saved_user, $saved_url) = split(' ', $line);
        return $saved_user if index($url, $saved_url) == 0;
    }
    return undef;
}

sub prompt_for_update
{
    # if updates have been specified from the cmd line there's no need
    # to bother the user
    return if $DO_UPDATES == 1;
    # if there are no components to update there's no reason to ask..
    return unless scalar (values %components_to_update);

    print "Do you want to update all existing components? yes, no [no] : ";
    my $answer = <STDIN>;
    chomp $answer;
    $DO_UPDATES = 1 if ($answer =~ /^y/);
}

sub checkout
{
    my @components :shared = @_;
    if ($PARALLEL) {
#         foreach my $component (@components_to_checkout) {
#             shift @components_to_checkout;
#             if ($component->{TARGET} == $DEFINITIONS{ROOT}) {
#                 process_component($component->{TYPE}, 'checkout', %{$component});
#             } else {
#                 push @components_to_checkout, $component;
#             }
#         }
        no warnings 'threads';
        $QUEUE->enqueue(@components);
        my $thr1 = threads->create(\&worker, 'checkout');
        my $thr2 = threads->create(\&worker, 'checkout');
        my $thr3 = threads->create(\&worker, 'checkout');
        my $thr4 = threads->create(\&worker, 'checkout');
        foreach my $thr (threads->list()) {
            $thr->join();
        }
    } else {
        foreach my $component (@components) {
            process_component($component->{TYPE}, 'checkout', %{$component});
        }
    }
}

sub update
{
    my @components :shared = @_;
    if ($PARALLEL) {
        no warnings 'threads';
        $QUEUE->enqueue(@components);
        my $thr1 = threads->create(\&worker, 'update');
        my $thr2 = threads->create(\&worker, 'update');
        my $thr3 = threads->create(\&worker, 'update');
        my $thr4 = threads->create(\&worker, 'update');
        foreach my $thr (threads->list()) {
            $thr->join();
        }
    } else {
        foreach my $component (@components) {
            process_component($component->{TYPE}, 'update', %{$component});
        }
    }
}

sub worker
{
    my $method = shift;
    while (my $component = $QUEUE->dequeue_nb()) {
           process_component($component->{TYPE}, $method, %{$component});
    }
}

sub process_component
{
    my ($type, $method, %component) = @_;
    if (!exists($checkout_types{$type})) {
        DIE("Unrecognized checkout type: $type");
    }
    chdir($orig_dir);
    my $err = $checkout_types{$type}->($method, %component);

    # increment the checkout or update counter
    unless ($err) {
      $checkout_size++ if $method eq 'checkout';
      $update_size++ if $method eq 'update';
    }
}

sub handle_cvs
{
    my ($method, %component) = @_;
    my $checkout = $component{CHECKOUT};
    my $user;
    my $pass;
    my $url;
    my $target = $component{TARGET};
    my $name = $component{NAME};
    my $cmd = '';
    my $branch = defined($component{REPO_BRANCH}) ? '-r '.$component{REPO_BRANCH} : '';
    my $date = defined $DATE ? '-D '.$DATE : '';

    if (defined($component{AUTH_URL})) {
        $url = $component{AUTH_URL};
        $user = $component{USER};

        # this looks ugly... but we're not guaranteed that $component{USER}
        # will exist... i.e. for updates we don't define the username
        if ($url =~ /:pserver:/) {
            $url =~ s/:pserver:/:pserver:$user\@/ if defined $user;
        }
        else {
            $url = "$user\@$url" if defined $user;
        }
    }
    else {
        $url = $component{URL};
        $user = $component{ANON_USER};
        $pass = $component{ANON_PASS};
        if ($url =~ /:pserver:/) {
            $url =~ s/:pserver:/:pserver:$user:$pass\@/;
        }
        else {
            $url = "$user:$pass\@$url";
        }
    }

    if ($method eq 'checkout') {

        run_command("mkdir -p $target");
        chdir("$orig_dir/$target");
        if (defined($name)) {
            die if $checkout =~ m{/};
            # cvs cannot check out into the current directory.  cvs
            # also has problems checking out into subdirectory if the
            # current directory contains a "CVS" entry.  we therefore
            # check out into a new "tmp" subdirectory, and then move
            # the content of "tmp" into the current directory, and
            # then delete "tmp" again.
            my $tmpdir = ".GetComponents-tmp-$$";
            $cmd =
                "{ " .
                "rm -rf $tmpdir && " .
                "$cvs -q -d $url checkout -d $tmpdir $branch $date $checkout && " .
                "mkdir -p $name && " .
                "mv $tmpdir/* $name && " .
                "rmdir $tmpdir; " .
                "}";
        } else {
            $cmd = "$cvs -q -d $url checkout $date $branch $checkout";
        }

        print_checkout_info($checkout, $url, $target, $name);
        my $err = run_command($cmd);
        if ($err != 0) {
            WARN_nonfatal("  ERROR: Could not check out module $checkout");
            push (@components_error, $checkout);
        }
        return $err;
    }

    elsif ($method eq 'update') {

        my $dir = defined($name) ? $name : $checkout;
        chdir("$target/$dir");
        $cmd = "$cvs -q update -dP $date $branch";

        print_update_info($checkout, $url, $target, $name);
        my $err = run_command($cmd);
        if ($err != 0) {
            WARN_nonfatal("  ERROR: Could not update module $checkout");
            push (@components_error, $checkout);
        }
        return $err;
    }

    elsif ($method eq 'status') {

        my $dir = defined($name) ? $name : $checkout;
        chdir("$orig_dir/$target/$dir");
        $cmd = "$cvs -n -q update -dP $branch";

        print "In $target/$dir:\n";
        run_command($cmd, 1);
    }

    elsif ($method eq 'diff') {

        my $dir = defined($name) ? $name : $checkout;
        chdir("$orig_dir");
        $cmd = "$cvs -q -d $url diff -u $target/$dir";

        run_command($cmd, 1);
    }

    elsif ($method eq 'authenticate') {

        $cmd = "$cvs -q -n -d $url checkout $checkout > /dev/null 2>&1";
        my $err = run_command($cmd);
        if ($err != 0) {

            $cmd = "$cvs -q -d $url login";
            run_command($cmd);
        }
        # store repository name and username
        # remove username from url first
        $url =~ s/$user\@//;
        save_user($user, $url);
    }

    elsif ($method eq 'verify_url') {
        my $dir = defined($name) ? $name : $checkout;
        chdir("$orig_dir");
        $url =~ s/:pserver://;
        my $same_url;

        open(my $rootfile, "$target/$dir/CVS/Root") or die "Could not open $target/$dir/CVS/Root";
        while (<$rootfile>) {
            if (/$url/) {
                $same_url = 1;
            }
        }
        return 1 if $same_url;
        return 0;
    }

    else {DIE("Unrecognized checkout method: $method")}
}

sub handle_svn
{
    my ($method, %component) = @_;
    my $checkout = $component{"CHECKOUT"};
    my $target = $component{"TARGET"};
    my $name = $component{"NAME"};
    my $cmd = '';
    my $user = defined($component{USER}) ? "--username $component{USER}" : ' ';
    my $err = 0;
    my $date = defined $DATE ? "-r {$DATE}" : ' ';

    my $url = $component{"URL"};
    if (defined($component{"AUTH_URL"})) {
        $url = $component{"AUTH_URL"};
    }

    if ($method eq 'checkout') {

        run_command("mkdir -p $target");
        my $dir = defined($name) ? $name : $checkout;
        $cmd = "$svn checkout $user $date $url $orig_dir/$target/$dir";

        print_checkout_info($checkout, $url, $target, $name);
        ($err = run_command($cmd)) == 0 or push (@components_error, $checkout);
    }

    elsif ($method eq 'update') {

        my $dir = defined($name) ? $name : $checkout;
        $cmd = "$svn update $date $orig_dir/$target/$dir";

        print_update_info($checkout, $url, $target, $name);
        ($err = run_command($cmd)) == 0 or push (@components_error, $checkout);
    }

    elsif ($method eq 'status') {

        my $dir = defined($name) ? $name : $checkout;
        chdir("$orig_dir/$target/$dir");
        $cmd = "$svn status";
        print "In $target/$dir:\n";
        run_command($cmd, 1);
    }

    elsif ($method eq 'diff') {

        my $dir = defined($name) ? $name : $checkout;
        chdir("$orig_dir");
        $cmd = "$svn diff $target/$dir";

        run_command($cmd, 1);
    }

    elsif ($method eq 'authenticate') {

        $cmd = "$svn info $user $url";
        $err = run_command($cmd);

        # store username and repo
        save_user($component{USER}, defined($component{"AUTH_URL_ORIG"})?
                           $component{"AUTH_URL_ORIG"}:$component{"URL_ORIG"});
    }

    elsif ($method eq 'verify_url') {
        chdir("$orig_dir");
        my $dir = defined($name) ? $name : $checkout;
        my $cmd = "$svn info $target/$dir";

        print "cwd = ".cwd()."\n" if $VERBOSE;
        print $cmd."\n" if $VERBOSE;

        # have to run command manually to modify output
        # so we get paths starting with $ROOT
        my $same_url;
        $url =~ s!https?://!!;
        open (my $output, "$cmd |");
        while (<$output>) {
            #print;
            if (/URL:.*$url/) {
                $same_url = 1;
            }
        }
        #print $url."\n";
        return 1 if $same_url;
        return 0;

    }
    else {DIE("Unrecognized checkout method: $method")}
    return $err;
}

sub handle_git
{
    my ($method, %component) = @_;
    my $target = $component{"TARGET"};
    my $name = $component{"NAME"};
    my $url = $component{"URL"};
    my $shallow = ' --depth 1';
    if (defined($component{"AUTH_URL"})) {
        $url = $component{"AUTH_URL"};
        $shallow = '';
    }
    my $checkout = $component{"CHECKOUT"};
    my $repo_path = $component{"REPO_PATH"};
    my $git_repo = $component{"GIT_REPO"};
    my $cmd = '';
    my $git_repos_dir = '';
    my $branch = defined($component{REPO_BRANCH}) ? $component{REPO_BRANCH} : undef;
    # find a revision from $DATE
    #my $date = defined $DATE ? '$'."($git rev-list --max-count=1 --before=$DATE $branch)" : $branch;

    my $repo_loc = "$orig_dir/$ROOT/repos/$git_repo/.git";

    if ($method eq 'checkout') {

        if ($PARALLEL) {
            $semaphores{$git_repo}->down();
        }

        run_command("mkdir -p $orig_dir/$ROOT/repos");
        # clone the git repo
        if (! -e $repo_loc) {
            $cmd = "$git clone$shallow $url $orig_dir/$ROOT/repos/$git_repo";
            print_checkout_info($checkout, $url, $target, $name);
            run_command($cmd) == 0 or push (@components_error, $checkout);
            if (defined $branch) {
                chdir("$orig_dir/$ROOT/repos/$git_repo");
                run_command("git checkout --track -b $branch origin/$branch") == 0 or push (@components_error, $checkout);
                #run_command("git checkout $date") == 0 or push (@components_error, $checkout);
                chdir("$orig_dir");
            }
            $updated_git_repos{$git_repo} = 1;
        }
        # if git repo has already been cloned, we will pull the latest version
        elsif ($updated_git_repos{$git_repo} == 0) {
            #chdir("$orig_dir/$ROOT/repos/$git_repo");
            print_checkout_info($checkout, $url, $target, $name);
            run_command("$git --git-dir=$repo_loc pull -a") == 0 or push (@components_error, $checkout);
            #run_command("git checkout $date") == 0 or push (@components_error, $checkout);

            $updated_git_repos{$git_repo} = 1;
            #chdir($orig_dir)
        }
        # if git repo has already been updated, we will print checkout info
        # anyway to suggest that we didn't miss a module
        else {print_checkout_info($checkout, $url, $target, $name)}

        my($checkout_dir, $checkout_item) = split(/\//, $checkout);
        unless ($checkout =~ m!/!) {
            # if $checkout does not contain a '/', the item to be checked
            # out will be placed in $checkout_dir instead of $checkout_item,
            # breaking the relative path for the symlink
            $checkout_dir = '';
        }
        # get relative path from target directory to directory containing the repositories
        $git_repos_dir = File::Spec->abs2rel("$orig_dir/$ROOT/repos", "$orig_dir/$target/$checkout_dir");
        # have to chdir to checkout dir for link to work properly
        if ($checkout =~ /\//) {
            run_command("mkdir -p $orig_dir/$target/$checkout_dir");
            chdir("$orig_dir/$target/$checkout_dir");
        }
        else {
            chdir("$orig_dir/$target");
            $checkout_item = $checkout;
        }

        # now we create a symlink from the repo to the appropriate target
        if (defined($repo_path)) {
            if ($repo_path =~ /\$1|\$2/) {

                my ($dir1, $dir2) = $checkout =~ m!(.*)/(.*)!;
                $repo_path =~ s!\$1!$dir1!;
                $repo_path =~ s!\$2!$dir2!;

                $cmd = "ln -s $git_repos_dir/$git_repo/$repo_path $checkout_item";
                if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            }
            else {
                $cmd = "ln -s $git_repos_dir/$git_repo/$repo_path/$checkout $checkout_item";
                if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            }
            #return if (-e "$checkout_item");
            my $err = run_command($cmd);
            if ($err) {push (@components_error, $checkout.": symlink error.")}
            if ($PARALLEL) {
                $semaphores{$git_repo}->up();
            }
            return $err;
        }
        else {
            $cmd = "ln -s $git_repos_dir/$git_repo/$checkout $checkout_item";
            if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            return if (-e "$checkout_item");
            my $err = run_command($cmd);
            if ($err) {push (@components_error, $checkout.": symlink error.")}
            if ($PARALLEL) {
                $semaphores{$git_repo}->up();
            }
            return $err;
        }
    }

    elsif ($method eq 'update') {

        if ($updated_git_repos{$git_repo} == 0) {
            if ($PARALLEL) {
                $semaphores{$git_repo}->down();
            }

            if (! -e "$orig_dir/$ROOT/repos/$git_repo" && -e "$orig_dir/$ROOT/git-repos/$git_repo") {
                run_command("mkdir -p $orig_dir/$ROOT/repos");
                chdir("$orig_dir/$ROOT/repos");
                run_command("ln -s ../git-repos/$git_repo $git_repo")
            }
            chdir($orig_dir);
            print_update_info($checkout, $url, $target, $name);
            my $err = run_command("$git --git-dir=$repo_loc pull -a");
            if ($err) {push (@components_error, $checkout)}
            $updated_git_repos{$git_repo} = 1;
            #chdir($orig_dir);

            if ($PARALLEL) {
                $semaphores{$git_repo}->up();
            }
            return $err;
        }
        # if git repo has already been updated print update info anyway
        # to suggest that we didn't miss a module
        else {print_update_info($checkout, $url, $target, $name); return 0;}
    }

    elsif ($method eq 'status') {

        chdir("$orig_dir/$ROOT/repos/$git_repo");
        print "In $ROOT/repos/$git_repo:\n";
        run_command("$git status", 1)
    }

    elsif ($method eq 'diff') {

        # only need to run diff once per repo
        return if $updated_git_repos{$git_repo};

        # help a bit with differentiating between diffs
        print "================================================================\n";

        chdir("$orig_dir/$ROOT/repos/$git_repo");
        $cmd = "$git diff --exit-code HEAD";

        print "cwd = ".cwd()."\n" if $VERBOSE;
        print $cmd."\n" if $VERBOSE;

        # have to run command manually to modify output
        # so we get paths starting with $ROOT

        open (my $output, "$cmd |");
        while (<$output>) {
            s!^--- a/!--- a/$ROOT/repos/$git_repo/!;
            s!^\+\+\+ b/!\+\+\+ b/$ROOT/repos/$git_repo/!;
            print;
        }
        close $output; # to get $?

        # reuse this hash, we won't be updating anything this run..
        $updated_git_repos{$git_repo} = 1;

        if ($? == 1) {
            print "================================================================\n";
        }

    }

    elsif ($method eq 'authenticate') {
        # do something, nothing for now...
        # git authenticates through ssh, so no storing usernames and stuff yet
        my $user = $component{USER};
        save_user($user, $component{AUTH_URL_ORIG});
    }

    elsif ($method eq 'verify_url') {
        # only need to run once per repo
        return 1 if $verified_git_repos{$git_repo};

        chdir("$orig_dir/$ROOT/repos/$git_repo");

        my $cmd = "grep 'url =' .git/config";

        print "cwd = ".cwd()."\n" if $VERBOSE;
        print $cmd."\n" if $VERBOSE;

        # have to run command manually to modify output
        # so we get paths starting with $ROOT
        my $same_url;
        open (my $output, "$cmd |");
        while (<$output>) {
            print if $VERBOSE;
            if (/url = $url/) {
                $same_url = 1;
            }
        }
        chdir("$orig_dir");
        $verified_git_repos{$git_repo} = 1;
        return 1 if $same_url;
        return 0;
    }
    else {DIE("Unrecognized checkout method: $method")}
}

sub handle_curl
{
    my ($method, %component) = @_;
    my $target = $component{"TARGET"};
    my $name = $component{"NAME"};
    my $url = $component{"URL"};
    my $user = ' ';
    my $pass = ' ';
    my $checkout = $component{"CHECKOUT"};
    my $cmd = '';
    if (defined($component{"USER"})) {
        $user = "--user $component{USER}:$component{PASS}";
    }

    if ($method eq 'checkout') {

        run_command("mkdir -p $target");
        chdir($target);
        if (defined($name)) {
            die if $checkout =~ m{/};
            # wget cannot check out into a specific directory.  we
            # therefore check out in a new "tmp" subdirectory, and
            # then rename, and then delete "tmp" again.
            my $tmpdir = ".GetComponents-tmp-$$";
            $cmd =
                "{ " .
                "rm -rf $tmpdir && " .
                "mkdir $tmpdir && " .
                "(cd $tmpdir && $curl -O $user $url/$checkout) && " .
                "mv $tmpdir/$checkout $name &&" .
                "rmdir $tmpdir; " .
                "}";
        } else {
            $cmd = "$curl -O $user $url/$checkout";
        }
        print_checkout_info($checkout, $url, $target, $name);
        run_command($cmd) == 0 or push (@components_error, $checkout);
    }

    elsif ($method eq 'update') {

        chdir("$target");
        if (defined($name)) {
            die if $checkout =~ m{/};
            # wget cannot check out into a specific directory.  we
            # therefore check out in a new "tmp" subdirectory, and
            # then rename, and then delete "tmp" again.
            my $tmpdir = ".GetComponents-tmp-$$";
            $cmd =
                "{ " .
                "rm -rf $tmpdir && " .
                "mkdir $tmpdir && " .
                "mv $name $tmpdir/$checkout && ".
                "(cd $tmpdir && $curl -O $user $url/$checkout) && " .
                "mv $tmpdir/$checkout $name &&" .
                "rmdir $tmpdir; " .
                "}";
        } else {
            $cmd = "$curl -O $user $url/$checkout";
        }

        # add modification timestamp to old version
        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(stat($checkout)->mtime);
        $year += 1900;
        $mon++;
        my $temp = "$mon.$mday.$year.$checkout";
        run_command("mv $checkout $temp");
        print_update_info($checkout, $url, $target, $name);
        run_command($cmd) == 0 or push (@components_error, $checkout);
        # compare new version, if equivalent delete old
        if (run_command("diff $checkout $temp") == 0) {
            run_command("rm -r $temp");
        }
    }

    elsif ($method eq 'status') {
        warn "Status method not available for type: $component{TYPE}";
        return;
    }

    elsif ($method eq 'diff') {
        warn "Diff method not available for type: $component{TYPE}";
        return;
    }

    elsif ($method eq 'verify_url') {
        # nothing to do for http/ftp
        return 1;
    }

    else {DIE("Unrecognized checkout method: $method")}
}

sub handle_darcs
{
    my ($method, %component) = @_;
    my $target = $component{"TARGET"};
    my $name = $component{"NAME"};
    my $url = $component{"URL"};
    if (defined($component{"AUTH_URL"})) {
        $url = $component{"AUTH_URL"};
    }
    my $checkout = $component{"CHECKOUT"};
    my $repo_path = $component{"REPO_PATH"};
    my $darcs_repo = $component{"DARCS_REPO"};
    my $cmd = '';
    my $darcs_repos_dir = '';

    my $repo_loc = "$orig_dir/$ROOT/repos/$darcs_repo";

    if ($method eq 'checkout') {

        if ($PARALLEL) {
            $semaphores{$darcs_repo}->down();
        }

        run_command("mkdir -p $orig_dir/$ROOT/repos");
        # clone the darcs repo
        if (! -e $repo_loc) {
            $cmd = "$darcs clone $url $orig_dir/$ROOT/repos/$darcs_repo";
            print_checkout_info($checkout, $url, $target, $name);
            run_command($cmd) == 0 or push (@components_error, $checkout);
            $updated_darcs_repos{$darcs_repo} = 1;
        }
        # if darcs repo has already been cloned, we will pull the latest version
        elsif ($updated_darcs_repos{$darcs_repo} == 0) {
            #chdir("$orig_dir/$ROOT/repos/$darcs_repo");
            print_checkout_info($checkout, $url, $target, $name);
            run_command("$darcs pull --repodir=$repo_loc") == 0 or push (@components_error, $checkout);
            $updated_darcs_repos{$darcs_repo} = 1;
            #chdir($orig_dir)
        }
        # if darcs repo has already been updated, we will print checkout info
        # anyway to suggest that we didn't miss a module
        else {print_checkout_info($checkout, $url, $target, $name)}

        my($checkout_dir, $checkout_item) = split(/\//, $checkout);
        unless ($checkout =~ m!/!) {
            # if $checkout does not contain a '/', the item to be checked
            # out will be placed in $checkout_dir instead of $checkout_item,
            # breaking the relative path for the symlink
            $checkout_dir = '';
        }
        # get relative path from target directory to directory containing the repositories
        $darcs_repos_dir = File::Spec->abs2rel("$orig_dir/$ROOT/repos", "$orig_dir/$target/$checkout_dir");
        # have to chdir to checkout dir for link to work properly
        if ($checkout =~ /\//) {
            run_command("mkdir -p $orig_dir/$target/$checkout_dir");
            chdir("$orig_dir/$target/$checkout_dir");
        }
        else {
            chdir("$orig_dir/$target");
            $checkout_item = $checkout;
        }

        # now we create a symlink from the repo to the appropriate target
        if (defined($repo_path)) {
            if ($repo_path =~ /\$1|\$2/) {

                my ($dir1, $dir2) = $checkout =~ m!(.*)/(.*)!;
                $repo_path =~ s!\$1!$dir1!;
                $repo_path =~ s!\$2!$dir2!;

                $cmd = "ln -s $darcs_repos_dir/$darcs_repo/$repo_path $checkout_item";
                if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            }
            else {
                $cmd = "ln -s $darcs_repos_dir/$darcs_repo/$repo_path/$checkout $checkout_item";
                if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            }
            #return if (-e "$checkout_item");
            my $err = run_command($cmd);
            if ($err) {push (@components_error, $checkout.": symlink error.")}

            if ($PARALLEL) {
                $semaphores{$darcs_repo}->up();
            }
            return $err;
        }
        else {
            $cmd = "ln -s $darcs_repos_dir/$darcs_repo/$checkout $checkout_item";
            if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            return if (-e "$checkout_item");
            my $err = run_command($cmd);
            if ($err) {push (@components_error, $checkout.": symlink error.")}

            if ($PARALLEL) {
                $semaphores{$darcs_repo}->up();
            }
            return $err;
        }
    }

    elsif ($method eq 'update') {
        if ($updated_darcs_repos{$darcs_repo} == 0) {
            if ($PARALLEL) {
                $semaphores{$darcs_repo}->down();
            }
            if (! -e "$orig_dir/$ROOT/repos/$darcs_repo" && -e "$orig_dir/$ROOT/darcs-repos/$darcs_repo") {
                run_command("mkdir -p $orig_dir/$ROOT/repos");
                chdir("$orig_dir/$ROOT/repos");
                run_command("ln -s ../darcs-repos/$darcs_repo $darcs_repo")
            }
            chdir($orig_dir);
            print_update_info($checkout, $url, $target, $name);
            my $err = run_command("$darcs pull --repodir=$repo_loc");
            if ($err) {push (@components_error, $checkout);}
            $updated_darcs_repos{$darcs_repo} = 1;
            #chdir($orig_dir);

            if ($PARALLEL) {
                $semaphores{$darcs_repo}->up();
            }
            return $err;
        }
        # if darcs repo has already been updated print update info anyway
        # to suggest that we didn't miss a module
        else {print_update_info($checkout, $url, $target, $name); return 0;}
    }

    elsif ($method eq 'status') {

        chdir("$orig_dir/$ROOT/repos/$darcs_repo");
        print "In $ROOT/repos/$darcs_repo:\n";
        run_command("$darcs status", 1);
    }

    elsif ($method eq 'diff') {

        chdir("$orig_dir");
        $cmd = "$darcs diff -u $ROOT/darcs_repos/$darcs_repo";

        run_command($cmd, 1);
    }

    elsif ($method eq 'verify_url') {
        # only need to run once per repo
        return 1 if $verified_darcs_repos{$darcs_repo};

        chdir("$orig_dir/$ROOT/repos/$darcs_repo");

        my $cmd = "$darcs show repo --no-files";

        print "cwd = ".cwd()."\n" if $VERBOSE;
        print $cmd."\n" if $VERBOSE;

        # have to run command manually to modify output
        # so we get paths starting with $ROOT
        my $same_url;
        open (my $output, "$cmd |");
        while (<$output>) {
            if (/Default Remote: $url/) {
                $same_url = 1;
            }
        }
        chdir("$orig_dir");
        $verified_darcs_repos{$darcs_repo} = 1;
        return 1 if $same_url;
        return 0;
    }

    elsif ($method eq 'authenticate') {
        # do something, nothing for now...
        # darcs authenticates through ssh, so no storing usernames and stuff yet
        my $user = $component{USER};
        save_user($user, $url);
    }

    else {DIE("Unrecognized checkout method: $method")}
}

sub handle_wget
{
    my ($method, %component) = @_;
    my $target = $component{"TARGET"};
    my $name = $component{"NAME"};
    my $url = $component{"URL"};
    my $user = ' ';
    my $pass = ' ';
    my $checkout = $component{"CHECKOUT"};
    my $cmd = '';
    if (defined($component{"USER"})) {
        $user = "--user=".$component{"USER"};
        $pass = "--password=".$component{"PASS"};
    }

    if ($method eq 'checkout') {

        run_command("mkdir -p $target");
        chdir($target);
        if (defined($name)) {
            die if $checkout =~ m{/};
            # wget cannot check out into a specific directory.  we
            # therefore check out in a new "tmp" subdirectory, and
            # then rename, and then delete "tmp" again.
            my $tmpdir = ".GetComponents-tmp-$$";
            $cmd =
                "{ " .
                "rm -rf $tmpdir && " .
                "mkdir $tmpdir && " .
                "(cd $tmpdir && $wget $user $pass $url/$checkout) && " .
                "mv $tmpdir/$checkout $name &&" .
                "rmdir $tmpdir; " .
                "}";
        } else {
            $cmd = "$wget $user $pass $url/$checkout";
        }
        print_checkout_info($checkout, $url, $target, $name);
        run_command($cmd) == 0 or push (@components_error, $checkout);
    }

    elsif ($method eq 'update') {

        chdir("$target");
        if (defined($name)) {
            die if $checkout =~ m{/};
            # wget cannot check out into a specific directory.  we
            # therefore check out in a new "tmp" subdirectory, and
            # then rename, and then delete "tmp" again.
            my $tmpdir = ".GetComponents-tmp-$$";
            $cmd =
                "{ " .
                "rm -rf $tmpdir && " .
                "mkdir $tmpdir && " .
                "mv $name $tmpdir/$checkout && ".
                "(cd $tmpdir && $wget $user $pass $url/$checkout) && " .
                "mv $tmpdir/$checkout $name &&" .
                "rmdir $tmpdir; " .
                "}";
        } else {
            $cmd = "$wget $user $pass $url/$checkout";
        }

        # add modification timestamp to old version
        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(stat($checkout)->mtime);
        $year += 1900;
        $mon++;
        my $temp = "$mon.$mday.$year.$checkout";
        run_command("mv $checkout $temp");
        print_update_info($checkout, $url, $target, $name);
        run_command($cmd) == 0 or push (@components_error, $checkout);
        # compare new version, if equivalent delete old
        if (run_command("diff $checkout $temp") == 0) {
            run_command("rm -r $temp");
        }
    }

    elsif ($method eq 'status') {
        warn "Status method not available for type: $component{TYPE}";
        return;
    }

    elsif ($method eq 'diff') {
        warn "Diff method not available for type: $component{TYPE}";
        return;
    }

    elsif ($method eq 'verify_url') {
        # nothing to do for http/ftp
        return 1;
    }

    else {DIE("Unrecognized checkout method: $method")}
}

sub handle_hg
{
    my ($method, %component) = @_;
    my $target = $component{"TARGET"};
    my $name = $component{"NAME"};
    my $url = $component{"URL"};
    my $checkout = $component{"CHECKOUT"};
    my $repo_path = $component{"REPO_PATH"};
    my $hg_repo = $component{"HG_REPO"};
    my $cmd = '';
    my $hg_repos_dir = '';
    my $branch = defined($component{REPO_BRANCH}) ? $component{REPO_BRANCH} : undef;
    my $date = defined $DATE ? '-d '.$DATE : undef;

    my $repo_loc = "$orig_dir/$ROOT/repos/$hg_repo";

    if ($method eq 'checkout') {
        if ($PARALLEL) {
            $semaphores{$hg_repo}->down();
        }

        run_command("mkdir -p $orig_dir/$ROOT/repos");
        # clone the hg repo
        if (! -e $repo_loc) {
            #chdir("$orig_dir/$ROOT/repos");
            $cmd = "$hg clone $url $repo_loc";
            print_checkout_info($checkout, $url, $target, $name);
            run_command($cmd) == 0 or push (@components_error, $checkout);
            if (defined($branch)) {
                #chdir("$hg_repo");
                run_command("hg --repository $repo_loc checkout $branch") == 0 or push (@components_error, $checkout);
                #chdir("..");
            }
            if (defined $date) {
                #chdir("$hg_repo");
                run_command("hg --repository $repo_loc checkout --date $date") == 0 or push (@components_error, $checkout);
                #chdir("..");
            }
            $updated_hg_repos{$hg_repo} = 1;
            #chdir($orig_dir);
        }
        # if mercurial repo has already been cloned, we will pull the latest version
        elsif ($updated_hg_repos{$hg_repo} == 0) {
            #chdir("$orig_dir/$ROOT/repos/$hg_repo");
            print_checkout_info($checkout, $url, $target, $name);
            run_command("$hg --repository $repo_loc pull") == 0 or push (@components_error, $checkout);
            if (defined($branch)) {
                run_command("hg --repository $repo_loc checkout $branch") == 0 or push (@components_error, $checkout);
            }
            if (defined $date) {
                run_command("hg --repository $repo_loc checkout --date $date") == 0 or push (@components_error, $checkout);
            }
            $updated_hg_repos{$hg_repo} = 1;
            #chdir($orig_dir);
        }
        # if mercurial repo has already been updated, we will print checkout info
        # anyway to suggest that we didn't miss a module
        else {print_checkout_info($checkout, $url, $target, $name)}

        my($checkout_dir, $checkout_item) = split(/\//, $checkout);
        unless ($checkout =~ m!/!) {
            # if $checkout does not contain a '/', the item to be checked
            # out will be placed in $checkout_dir instead of $checkout_item,
            # breaking the relative path for the symlink
            $checkout_dir = '';
        }
        # get relative path from target directory to directory containing the repositories
        $hg_repos_dir = File::Spec->abs2rel("$orig_dir/$ROOT/repos", "$orig_dir/$target/$checkout_dir");
        # have to chdir to checkout dir for link to work properly
        if ($checkout =~ /\//) {
            run_command("mkdir -p $orig_dir/$target/$checkout_dir");
            chdir("$orig_dir/$target/$checkout_dir");
        }
        else {
            chdir("$orig_dir/$target");
            $checkout_item = $checkout;
        }

        # now we create a symlink from the repo to the appropriate target
        if (defined($repo_path)) {
            if ($repo_path =~ /\$1|\$2/) {

                my ($dir1, $dir2) = $checkout =~ m!(.*)/(.*)!;
                $repo_path =~ s!\$1!$dir1!;
                $repo_path =~ s!\$2!$dir2!;

                $cmd = "ln -s $hg_repos_dir/$hg_repo/$repo_path $checkout_item";
                if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            }
            else {
                $cmd = "ln -s $hg_repos_dir/$hg_repo/$repo_path/$checkout $checkout_item";
                if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            }
            #return if (-e "$checkout_item");
            my $err = run_command($cmd);
            if ($err) {push (@components_error, $checkout.": symlink error.")}

            if ($PARALLEL) {
                $semaphores{$hg_repo}->up();
            }
            return $err;
        }
        else {
            $cmd = "ln -s $hg_repos_dir/$hg_repo/$checkout $checkout_item";
            if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            return if (-e "$checkout_item");
            my $err = run_command($cmd);
            if ($err) {push (@components_error, $checkout.": symlink error.")}

            if ($PARALLEL) {
                $semaphores{$hg_repo}->up();
            }
            return $err;
        }
    }

    elsif ($method eq 'update') {
        if ($updated_hg_repos{$hg_repo} == 0) {
            if ($PARALLEL) {
                $semaphores{$hg_repo}->down();
            }
            if (! -e "$orig_dir/$ROOT/repos/$hg_repo" && -e "$orig_dir/$ROOT/hg-repos/$hg_repo") {
                run_command("mkdir -p $orig_dir/$ROOT/repos");
                chdir("$orig_dir/$ROOT/repos");
                run_command("ln -s ../hg-repos/$hg_repo $hg_repo")
            }
            chdir($orig_dir);
            print_update_info($checkout, $url, $target, $name);
            my $err = run_command("$hg --repository $repo_loc pull --update");
            if ($err) {push (@components_error, $checkout);}
            if (defined($branch)) {
                run_command("hg --repository $repo_loc checkout $branch") == 0 or push (@components_error, $checkout);
            }
            if (defined($date)) {
                run_command("hg --repository $repo_loc checkout --date $date") == 0 or push (@components_error, $checkout);
            }
            $updated_hg_repos{$hg_repo} = 1;
            #chdir($orig_dir);

            if ($PARALLEL) {
                $semaphores{$hg_repo}->up();
            }
            return $err;
        }
        # if hg repo has already been updated print update info anyway
        # to suggest that we didn't miss a module
        else {print_update_info($checkout, $url, $target, $name); return 0;}
    }

    elsif ($method eq 'status') {

        chdir("$orig_dir/$ROOT/repos/$hg_repo");
        print "In $ROOT/repos/$hg_repo:\n";
        run_command("$hg status", 1)
    }

    elsif ($method eq 'diff') {

        # only need to run diff once per repo
        return if $updated_hg_repos{$hg_repo};

        # help a bit with differentiating between diffs
        print "================================================================\n";

        chdir("$orig_dir/$ROOT/repos/$hg_repo");
        $cmd = "$hg diff";
        print "cwd = ".cwd()."\n" if $VERBOSE;
        print $cmd."\n" if $VERBOSE;

        # have to run command manually to modify output
        # so we get paths starting with $ROOT

        open (my $output, "$cmd |");
        while (<$output>) {
            s!^--- a/!--- a/$ROOT/repos/$hg_repo/!;
            s!^\+\+\+ b/!\+\+\+ b/$ROOT/repos/$hg_repo/!;
            print;
        }
        close $output; # to get $?

        # reuse this hash, we won't be updating anything this run..
        $updated_hg_repos{$hg_repo} = 1;

        if ($? == 1) {
            print "================================================================\n";
        }
    }

    elsif ($method eq 'verify_url') {
        # only need to run once per repo
        return 1 if $verified_hg_repos{$hg_repo};

        chdir("$orig_dir/$ROOT/repos/$hg_repo");

        my $cmd = "$hg showconfig";

        print "cwd = ".cwd()."\n" if $VERBOSE;
        print $cmd."\n" if $VERBOSE;

        # have to run command manually to modify output
        # so we get paths starting with $ROOT
        my $same_url;
        open (my $output, "$cmd |");
        while (<$output>) {
            if (/paths.default=$url/) {
                $same_url = 1;
            }
        }
        chdir("$orig_dir");
        $verified_hg_repos{$hg_repo} = 1;
        return 1 if $same_url;
        return 0;
    }

    else {DIE("Unrecognized checkout method: $method")}
}

sub run_command
{
    my $command = shift;
    my $VERBOSE_OVERRIDE = shift;
    if ($command =~ /^$/) {return}
    my $out = '';
    # if for some reason $VERBOSE has been set to a value higher than 2, we will
    # assume the user wants full verbosity

    # if $VERBOSE == 2 we will print the current directory, the command, and all
    # output from the command
    if ($VERBOSE >= 2) {
        print "cwd = ".cwd()."\n";
        print "$command\n";
        open (my $output, "$command 2>&1 |");
        while (<$output>) {
            if (/^cvs|^svn|^error|^fatal|^abort/) {
                $out .= $_;
            }
            print;
        }
        close $output; # to get $?
        my $errno = $?;
        LOG("Could not run command: $command\n$out") if $errno;
        return $errno;
    }
    # if $VERBOSE == 1 we will print the current directory, the command, and
    # any output directed to STDERR (testing the last part to see if it's
    # useful). we will not show any "which" or "mkdir" commands in this level.
    elsif ($VERBOSE == 1 && !($command =~ m{^ln|^mkdir|^mv|^rm|^rmdir|^which})) {
        print "cwd = ".cwd()."\n";
        print "$command\n";
        open (my $output, "$command 2>&1 1>/dev/null |");
        while (<$output>) {
            if (/^cvs|^svn|^error|^fatal|^abort/) {
                $out .= $_;
            }
            print;
        }
        close $output; # to get $?
        my $errno = $?;
        LOG("Could not run command: $command\n$out") if $errno;
        return $errno;
    }
    # if $VERBOSE == 0 we will suppress all output from the command, except for errors
    else {
        open (my $output, "$command 2>&1 |");
        while (<$output>) {
            if (/^cvs|^svn|^error|^fatal|^abort/ || $VERBOSE_OVERRIDE) {
                $out .= $_;
                print;
            }
        }
        close $output; # to get $?
        my $errno = $?;
        LOG("Could not run command: $command\n$out") if $errno;
        return $errno;
   }
}

sub info
{
    my $text = shift;
    if ($VERBOSE) {print $text}
}

sub print_checkout_info
{
    return if $DEBUG;

    my ($checkout, $url, $target, $name) = @_;
    my $msg = "-----------------------------------------------------------------\n".
              "  Checking out module: $checkout\n".
              "      from repository: $url\n".
              "                 into: $target\n";
    if (defined($name)) {
        $msg .= "                   as: $name\n";
    }
    print $msg;
}

sub print_update_info
{
    return if $DEBUG;

    my ($checkout, $url, $target, $name) = @_;
    my $msg = "-----------------------------------------------------------------\n".
              "  Updating module: $checkout\n".
              "  from repository: $url\n".
              "       located in: $target\n";
    if (defined($name)) {
        $msg .= "            under: $name\n";
    }
    print $msg;
}

sub print_summary
{
    return if $DEBUG;

    print "-----------------------------------------------------------------\n";
    if (@components_error == 0) {
        print "  $checkout_size components checked out successfully.\n";
        print "  $update_size components updated successfully.\n\n";
    }
    else {
        print "  $checkout_size components checked out.\n";
        print "  $update_size components updated.\n\n";
        foreach my $error (@components_error) {
            print "  Unable to process $error\n";
        }
        print "\n";
    }

    #my $end_time = clock();
    my $elapsed_time = time - $start_time;
    my $min = int($elapsed_time / 60);
    my $sec = $elapsed_time % 60;
    print "  Time Elapsed: $min minutes, $sec seconds\n\n";
}

sub LOG
{
    return if $DEBUG;

    my $log = shift;
    if ($log =~ /^$/) {return}
    # move the file at 100KB, so it doesn't get too Long
    if (-e "$crl_dir/crl.log") {
        if (stat("$crl_dir/crl.log")->size > 100000) {
            run_command("mv $crl_dir/crl.log $crl_dir/crl.log.old");
        }
    }
    open (my $logfile, '>>', "$crl_dir/crl.log") or die $!;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    my @abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
    print {$logfile} "$abbr[$mon] $mday, $hour:$min:$sec:  $log\n";
    close $logfile or die $!;
}

sub WARN
{
    my $warning = shift;
    LOG($warning);
    warn ("\n$warning\n\n");
    die;
}

sub WARN_nonfatal
{
    my $warning = shift;
    LOG($warning);
    warn ("\n$warning\n\n");
}

sub DIE
{
    my $error = shift;
    LOG($error);
    die ("\n$error\n\n");
}

__END__

=head1 NAME
GetComponents

=head1 SYNOPSIS

GetComponents [options] [file]

GetComponents [options] [URL]

Options:

    --help          brief help message

    --man           full documentation

    --verbose       print all system commands as they are executed

    --debug         print all commands to be executed and exit

    --anonymous     use anonymous checkout for all components

    --update        process all updates

    --status        run status commands for each component

    --diff          run diff commands for each component

    --root          override root directory

    --date          checkout from a specific date

    --reset-
    authentication  delete authentication files

=head1 OPTIONS

=over 8

=item B<--help>

Print a brief help message and exit.

=item B<--man>

Print the full man page and exit.

=item B<--verbose>

Print all system commands as they are executed by script. A second level of verbosity, declared by -v -v, will also display the output from the system commands.

=item B<--debug>

Print a list of components that will be checked out or updated, along with the total number of components in the list.

=item B<--anonymous>

Override any stored login credentials and use anonymous checkouts for all components.

=item B<--update>

Override the update prompt and process all updates.

=item B<--status>

Provide a list of files that differ from the repository versions.

=item B<--diff>

Run a diff on the entire source tree. Be careful with this as it could run for a long time and produce a large output.

=item B<--root>

Override the root directory in the component list.
This allows checking out into an arbitrary directory.

=item B<--date>

Checkout components from a specific date. Currently only supported for cvs, svn, and mercurial.


=item B<--reset-authentication>

Delete any CRL authentication files before processing the component list.

=back

=head1 DESCRIPTION

B<This program> will parse the given input file(s), and checkout/update the requested components using cvs, svn, git, darcs, hg, http, https, and ftp. It requires an argument specifying the file that will contain the information required to checkout the components. Multiple files may be passed together. A component list may also be specified as the URL where the list is located, in which case GetComponents will download the component list, and then proceed as usual.

This file must have the following syntax:

0. The first (non-comment) line must be '!CRL_VERSION = 1.0'

1. It will be split up in to multiple sections, with each section corresponding to a repository. The order of the sections is irrelevant.

2. Each section will contain multiple directives beginning with a !.
Required directives are: !TARGET, !TYPE, !URL, and !CHECKOUT.
Optional directives are: !ANONYMOUS_USER, !ANONYMOUS_PASSWORD,
!LOCAL_PATH, !REPOSITORY_PATH, and !AUTHORIZATION_URL. The shortened
directives !ANON_USER, !ANON_PASS, !LOC_PATH, !REPO_PATH, and
!AUTH_URL are also recognized.

3. !TARGET MUST be the first directive for each section. It will specify the directory, in which the components for the current repository will be placed.
!TARGET may contain predefined constants i.e. $ROOT, which could represent the root directory for all of the components.

4. !TYPE specifies the tool used to checkout the components. Currently, cvs, svn, git, http, https, ftp, and hg (mercurial) are supported.

5. !URL specifies the location of the repository for anonymous checkout. !URL may contain variables $1, $2, etc, which will correspond to the directories in the path given by !CHECKOUT. For example, if !URL = http://svn.foo.com/$2/trunk and !CHECKOUT = foo/bar, !URL will be interpreted as http://svn.foo.com/bar/trunk.

6. !AUTH_URL will specify a different location for an authenticated checkout. If both !AUTH_URL and !URL are defined, !AUTH_URL will take precedence.

7. !CHECKOUT specifies the components to checkout from the repository. !CHECKOUT can contain a path through multiple directories, in which case they must be separated by a /. If there are multiple components to be checked out from a single repository, they should be separated by a newline. Any trailing whitespace or comments will be ignored.

8. !NAME specifies an alternate name for the component to be checked out. That means that if !TARGET is foo, !CHECKOUT is bar, and !NAME is foobar, the resulting directory tree will be foo/foobar.

9. !ANON_USER and !ANON_PASS will specify the login credentials for an anonymous cvs checkout from the repository.

10. !REPO_PATH will specify the location of the item to be checked out within a repository. It can consist of a file path, or $1 or $2, and will essentially serve as a prefix to the checkout path when the script is looking for the checkout item.

11. Each directive will be followed by optional whitespace, an =, optional whitespace, the corresponding argument, and more optional whitespace. The end of an argument will be indicated by the ! preceding the next directive. The argument may be enclosed in quotes (" or '), in which case the argument will be taken literally and no variable substitution will occur.

12. Extra newlines may be inserted between sections for greater clarity, and any comments will be preceded by a #.

13. There is an optional section that will contain any definitions i.e. $ROOT. These definitions will be preceded by !DEFINE, and then follow the syntax for the directives. Definitions may only be defined once.

=cut