#!/usr/bin/perl -w

=begin comment

File:           GetComponents
Version:        $Revision: 1.42 $
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 Data::Dumper;
use Getopt::Long;
use Pod::Usage;
use File::stat;
use Cwd;
use LWP::Simple;
use sigtrap qw(die INT);

my @components_to_checkout;
my @components_to_update;
my $checkout_size = 0;
my $update_size = 0;
my @components_error;
my $ROOT = '';
my $ARR = '';
my $VERBOSE = 0;
my $DEBUG = 0;
my $HELP = 0;
my $MAN = 0;
my $ANONYMOUS_CHECKOUT = 0;
my $DO_UPDATES = 0;
my $INPUT;
my %DEFINITIONS;
my $cvs = 'cvs';
my $svn = 'svn';
my $git = 'git';
my $wget = 'wget';
my $hg = 'hg';
my $cvs_found = 0;
my $svn_found = 0;
my $git_found = 0;
my $wget_found = 0;
my $hg_found = 0;
my %updated_git_repos;
my %updated_mercurial_repos;
my %checkout_types = (
        'cvs'       => \&handle_cvs,
        'svn'       => \&handle_svn,
        'git'       => \&handle_git,
        'http'      => \&handle_wget,
        'https'     => \&handle_wget,
        'ftp'       => \&handle_wget,
        'mercurial' => \&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)
           or pod2usage(2);
pod2usage(1) if $HELP;
pod2usage(-verbose => 2) if $MAN;

# if no args
pod2usage("\n$0: No files given.\nSpecify -man for an explanation of how to use this script.\n\n") if ((@ARGV == 0) && (-t STDIN));

# grab the directory the script was called from, we will need this later
my $orig_dir = cwd();

find_tools();
parse_list();
process_users();
prompt_for_update();
# start timer here, we don't care about authentication time
my $start_time = time;   
checkout();
update() if $DO_UPDATES;
print_summary();
exit (@components_error > 0);
#exit 0;

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

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 wget") == 0) {$wget_found = 1}
    if (run_command("which hg") == 0) {$hg_found = 1}
}

sub parse_list 
{
    my $file = '';
    foreach my $ARG (@ARGV) {
        $INPUT = $ARG;
        open(my $COMPONENT_LIST, $INPUT) or DIE("Could not open $INPUT");
        # check for CRL Header
        while (<$COMPONENT_LIST>) {
            next if m/^#|^\s*$/;
            if (m/^!CRL_VERSION/) {
                $_ = '';
                last;
            }
            if (m/\w/) {
                print "$INPUT is not an 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>;
        # grab definitions
        foreach my $line (@lines) {
            if ($line =~ /!DEFINE/) {
                $line =~ s/\s+//gm;
                my @defs = split(/!DEFINE|=/, $line);
                shift @defs;
                # check for repeated definitions
                if (defined($DEFINITIONS{$defs[0]}) and 
                            $DEFINITIONS{$defs[0]} ne $defs[1]) 
                    {DIE("Repeated definition of $defs[0]")}
                # resolve compound definitions
                $defs[1] =~ s/\$(\w+)/$DEFINITIONS{$1}/;
                    
                $DEFINITIONS{$defs[0]} = $defs[1];
                $line = '';
            }
        }
        close($COMPONENT_LIST);
        $file .= join("", @lines);
    }
    # 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/!REPOSITORY_PATH/!REPO_PATH/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}
    if (defined($DEFINITIONS{ARR})) {$ARR = $DEFINITIONS{ARR}}
    
    my @sections = split(/^!TARGET\s*=\s*/m, $file);
    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 = @pairs;
                
        # make sure the user has all the required tools
        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)) {
            print "You have requested an $rec{TYPE} checkout, but the system was unable to find wget.\n";
            print "Please enter the path to wget: ";
            $wget = <STDIN>;
            chomp $wget;
        }
        if (($rec{"TYPE"} eq "mercurial") && (!$hg_found)) {
            print "You have requested a mercurial checkout, but the system was unable to find mercurial.\n";
            print "Please enter the path to mercurial: ";
            $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;
        }
        
        # parse name of mercurial repo
        if ($rec{"TYPE"} eq "mercurial") {
            my $mercurial_repo = $rec{"URL"};
            $mercurial_repo =~ s/\.hg$//;
            $mercurial_repo =~ s/^.*[:\/]//;
            $rec{"MERCURIAL_REPO"} = $mercurial_repo;
            # add the repo to %updated_mercurial_repos and set it to 0
            # we will use this to track which repos have already been cloned
            # or updated
            $updated_mercurial_repos{$mercurial_repo} = 0;
        }

        # save target in original form to check existence.
        my $target = $rec{"TARGET"};
        # save url in original form for parsing $1/$2
        my $url = $rec{"URL"};
        my $auth_url = $rec{"AUTH_URL"};
        
        # split target into directory/target
        # this is makes the mkdir/chdir/checkout much easier.
        if ($rec{"TARGET"} =~ m!(^.+/)!) {
            $rec{"DIR"} = $1;
            $rec{"TARGET"} =~ s/$rec{"DIR"}//;
        }
                
        # 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 for svn
            if ($rec{"TYPE"} eq 'svn') {
                my ($dir1, $dir2);
                if ($checkout =~ m!/!) {
                    ($dir1, $dir2) = $checkout =~ m!(.+)/(.+)!;
                }
                else {
                    $dir1 = $checkout;
                }
                if (defined($rec{URL})) {
                    $rec{URL} = $url;
                    $rec{URL} =~ s!\$1!$dir1!;
                    $rec{URL} =~ s!\$2!$dir2!;
                }
                if (defined($rec{AUTH_URL})) {
                    $rec{AUTH_URL} = $auth_url;
                    $rec{AUTH_URL} =~ s!\$1!$dir1!;
                    $rec{AUTH_URL} =~ s!\$2!$dir2!;
                }    
            }    
 
        
            $rec{"CHECKOUT"} = $checkout;
            my %component = %rec;
            # check for CVS directory
            if (-e "$target/$checkout/CVS") {
                push @components_to_update, \%component;
            }
            # or for .svn directory
            elsif (-e "$target/$checkout/.svn") {
                push @components_to_update, \%component;
            }
            # special case for $ROOT
            elsif ( $target eq $ROOT && (-e "$target/CVS" || -e "$target/.svn")) {
                push @components_to_update, \%component;
            }
            # special case for $ARR. need to find general solution
            elsif ($target ne $ARR && (-e "$target/CVS" || -e "$target/.svn")) {
                push @components_to_update, \%component;
            }
            # slightly different approach for git
            elsif ($component{"TYPE"} eq "git" && -e "$target/$checkout") {
                push @components_to_update, \%component;
            }
            # and for mercurial
            elsif ($component{"TYPE"} eq "mercurial" && -e "$target/$checkout") {
                push @components_to_update, \%component;
            }
            elsif ($component{"TYPE"} eq "http" && -e "$target/$checkout") {
                push @components_to_update, \%component;
            }
            elsif ($component{"TYPE"} eq "https" && -e "$target/$checkout") {
                push @components_to_update, \%component;
            }
            elsif ($component{"TYPE"} eq "ftp" && -e "$target/$checkout") {
                push @components_to_update, \%component;
            }
            else {
                push @components_to_checkout, \%component;
            }
        }
    }
}

sub process_users
{
    foreach my $component (@components_to_checkout) {
        
        # 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...

        # currently only for cvs and svn
        
        # 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 'git')) {
            # first we check the users file for a match
            my $saved_user = find_user($component->{AUTH_URL});

            # if no match is found, we prompt the user for a username
            # and attempt to login
            if (!defined $saved_user) {
                print "No user found for $component->{AUTH_URL}\n";
                print "Please enter your username: [blank for anonymous checkout] ";
                $saved_user = <STDIN>;
                chomp $saved_user;
                # we want to save that the user wants to use anonymous access
                if ($saved_user =~ /^$/) {
                    save_user('N/A', $component->{AUTH_URL});
                    delete $component->{AUTH_URL};
                    next;
                }
                $component->{USER} = $saved_user;
                $checkout_types{$component->{TYPE}}->('authenticate', 
                                                    %{$component}); 
            }
            # check for specified anonymous access
            elsif ($saved_user eq 'N/A') {
                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 undef}
    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 ($saved_url eq $url);
    }
    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 @components_to_update;
    
    print "Do you want to update all existing components? yes, no [yes] : ";
    my $answer = <STDIN>;
    chomp $answer;
    $DO_UPDATES = 1 if ($answer =~ /^y|^$/);
    $DO_UPDATES = 0 if ($answer =~ /^n/);
}

sub checkout
{
    foreach my $component (@components_to_checkout) {
        process_component($component->{TYPE}, 'checkout', %{$component});
    }
}

sub update
{
    foreach my $component (@components_to_update) {
        process_component($component->{TYPE}, 'update', %{$component});
    }
}

sub process_component
{
    my ($type, $method, %component) = @_;
    if (!exists($checkout_types{$type})) {
        DIE("Unrecognized checkout type: $type");
    }
    chdir($orig_dir);
    $checkout_types{$type}->($method, %component);
    
    # increment the checkout or update counter
    # no need to check the return of the system call because anything
    # in @components_error will override these counters
    $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 $dir = $component{DIR}; 
    my $cmd = '';
    
    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') {
        
        if (defined($dir)) {
            if (! -e "$dir$target") {
                run_command("mkdir -p $dir$target");    
            }
        }
        else {
            if (! -e "$target") {
                run_command("mkdir -p $target");
            }
        }
        
        # add password for anon checkout
        $user = $user.":$pass" if defined($pass);
        
        ## temporary fix for arrangements, where cvs fails 
        ## from mismatched repos.
        ## not quite sure how to apply a general fix yet.
        if ($target eq "arrangements") {
            chdir("$dir/$target");            
            $cmd = "$cvs -q -d $url co $checkout";
        }
        else {    
            chdir("$dir") unless (!defined($dir));            
            $cmd = "$cvs -q -d $url co -d $target $checkout";
        }
        
        # remove password from $url for security
        $url =~ s/:$pass// if defined($pass);
        print_checkout_info($checkout, $url, $target, $dir);
        run_command($cmd) == 0 or push (@components_error, $checkout);
    }
    
    elsif ($method eq 'update') {
        
        # renaming of checkout directories i.e. Cactus => Cactus_test_th3
        # makes us check for a few different directory structures
        if (defined($dir)) {
            if (-e "$dir$target/$checkout") {
                chdir("$dir$target/$checkout");
                $cmd = "$cvs -q update";
            }
            else {
                chdir("$dir$target");
                $cmd = "$cvs -q update";
            }
        }
        else {
            if (-e "$target/$checkout") {
                chdir("$target/$checkout");
                $cmd = "$cvs -q update";
            }
            else {
                chdir("$target");
                $cmd = "$cvs -q update";
            }
        }
        
        # remove password from $url for security
        #$url =~ s/:$pass//;
        print_update_info($checkout, $url, $target, $dir);
        run_command($cmd) == 0 or push (@components_error, $checkout);
    }
    
    elsif ($method eq 'authenticate') {
        
        $cmd = "$cvs -q -d $url login";
        run_command($cmd) == 0 or push (@components_error, $checkout);
        
        # store repository name and username
        # remove username from url first
        $url =~ s/$user\@//;
        save_user($user, $url);        
    }
    
    else {DIE("Unrecognized checkout method: $method")}    
}

sub handle_svn
{
    my ($method, %component) = @_;
    my $checkout = $component{"CHECKOUT"};
    my $target = $component{"TARGET"};
    my $dir = $component{"DIR"}; 
    my $cmd = ''; 
    my $user = ' ';
    my $pass = ' ';          
    
    my $url = $component{"URL"};
    if (defined($component{"AUTH_URL"})) {
        $url = $component{"AUTH_URL"};
    }
    
    if ($method eq 'checkout') {
    
        if (defined($dir)) {
            if (! -e "$dir$target/$checkout") {
                run_command("mkdir -p $dir$target/$checkout");
            }
            chdir("$dir") unless $dir eq "";
            $cmd = "$svn co $user $url $target/$checkout";
        }
        else {
            if (! -e "$target/$checkout") {
                run_command("mkdir -p $target/$checkout");
            }
            $cmd = "$svn co $user $url $target/$checkout";
        }    
        
        print_checkout_info($checkout, $url, $target, $dir);
        run_command($cmd) == 0 or push (@components_error, $checkout);
    }
    
    elsif ($method eq 'update') {
    
        if (defined($dir)) {
            if (-e "$dir$target/$checkout") {
                chdir("$dir$target/$checkout");
                $cmd = "$svn update";
            }
            else {
                chdir("$dir$target");
                $cmd = "$svn update";
            }
        }
        else {
            if (-e "$target/$checkout") {
                chdir("$target/$checkout");
                $cmd = "$svn update";
            }
            else {
                chdir("$target");
                $cmd = "$svn update";
            }
        }
        print_update_info($checkout, $url, $target, $dir);
        run_command($cmd) == 0 or push (@components_error, $checkout);
    }
    
    elsif ($method eq 'authenticate') {
        
        $user = $component{USER};
        $cmd = "$svn info --username $user $url";
        run_command($cmd) == 0 or push (@components_error, $checkout);
        
        # store username and repo
        save_user($user, $url);
    }
    
    else {DIE("Unrecognized checkout method: $method")}        
}

sub handle_git
{
    my ($method, %component) = @_;
    my $target = $component{"TARGET"};
    my $url = $component{"URL"};
    if (defined($component{"AUTH_URL"})) {
        $url = $component{"AUTH_URL"};
    }
    my $dir = $component{"DIR"};
    my $checkout = $component{"CHECKOUT"};
    my $repo_path = $component{"REPO_PATH"}; 
    my $git_repo = $component{"GIT_REPO"};
    my $cmd = '';

    if ($method eq 'checkout') {
                
        # clone the git repo
        if (! -e "$ROOT/git_repos/$git_repo") {
            $cmd = "$git clone $url $ROOT/git_repos/$git_repo";
            print_checkout_info($checkout, $url, $target, $dir);
            run_command($cmd) == 0 or push (@components_error, $checkout);
            $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("$ROOT/git_repos/$git_repo");
            print_checkout_info($checkout, $url, $target, $dir);
            run_command("$git pull -a") == 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, $dir)}
        
        # have to chdir to checkout dir for link to work properly      
        my($checkout_dir, $checkout_item) = split(/\//, $checkout);
        if (! -e "$dir$target/$checkout_dir") {
            run_command("mkdir -p $dir$target/$checkout_dir");
        }
        chdir("$dir$target/$checkout_dir");
        
        # now we create a symlink from the repo to the appropriate target
        if (defined($repo_path)) {
            if ($repo_path =~ /\$2/) {
                $checkout =~ m!(.*)/(.*)!;
                $repo_path = $2;
                $cmd = "ln -s ../../git_repos/$git_repo/$repo_path $checkout_item";
                if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            }
            else {
                $cmd = "ln -s ../../git_repos/$git_repo/$repo_path/$checkout $checkout_item";
                if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            }
            return if (-e "$checkout_item");
            run_command($cmd);
        }
        else {
            $cmd = "ln -s ../../git_repos/$git_repo/$checkout $checkout_item";
            if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            return if (-e "$checkout_item");
            run_command($cmd);
        }
    }   
    
    elsif ($method eq 'update') {
        
        if ($updated_git_repos{$git_repo} == 0) {
            chdir("$ROOT/git_repos/$git_repo");
            print_update_info($checkout, $url, $target, $dir);
            run_command("$git pull -a") == 0 or push (@components_error, $checkout);
            $updated_git_repos{$git_repo} = 1;
            chdir($orig_dir)
        }
        # 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, $dir)}
    }
    
    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, $url);
    }
    
    else {DIE("Unrecognized checkout method: $method")}             
}

sub handle_wget
{
    my ($method, %component) = @_;   
    my $target = $component{"TARGET"};
    my $url = $component{"URL"};
    my $dir = $component{"DIR"};
    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') {
            
        if (defined($dir)) {
            if(! -e "$dir$target") {
                run_command("mkdir -p $dir$target");
            }
            chdir("$dir$target");
            $cmd = "$wget $user $pass $url/$checkout";
        }
        else {
            if(! -e "$target") {
                run_command("mkdir -p $target");
            }
            chdir("$target");
            $cmd = "$wget $user $pass $url/$checkout";
        }
        print_checkout_info($checkout, $url, $target, $dir);
        run_command($cmd) == 0 or push (@components_error, $checkout);
    }
    
    elsif ($method eq 'update') {
    
        if (defined($dir)) {
            chdir("$dir$target");
            $cmd = "$wget $user $pass $url/$checkout";
        }
        else {
            chdir("$target");
            $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, $dir);
        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");
        }
    } 
    
    else {DIE("Unrecognized checkout method: $method")}           
}

sub handle_hg
{
    my ($method, %component) = @_;
    my $target = $component{"TARGET"};
    my $url = $component{"URL"};
    my $dir = $component{"DIR"};
    my $checkout = $component{"CHECKOUT"};
    my $repo_path = $component{"REPO_PATH"}; 
    my $mercurial_repo = $component{"MERCURIAL_REPO"};
    my $cmd = '';

    if ($method eq 'checkout') {
    
        if (! -e "$ROOT/mercurial_repos") {
            run_command("mkdir -p $ROOT/mercurial_repos");
        }
        # clone the mercurial repo
        if (! -e "$ROOT/mercurial_repos/$mercurial_repo") {
            chdir("$ROOT/mercurial_repos");
            $cmd = "$hg clone $url $mercurial_repo";
            print_checkout_info($checkout, $url, $target, $dir);
            run_command($cmd) == 0 or push (@components_error, $checkout);
            $updated_mercurial_repos{$mercurial_repo} = 1;
            chdir($orig_dir);
        }
        # if mercurial repo has already been cloned, we will pull the latest version
        elsif ($updated_mercurial_repos{$mercurial_repo} == 0) {
            chdir("$ROOT/mercurial_repos/$mercurial_repo");
            print_checkout_info($checkout, $url, $target, $dir);
            run_command("$hg pull") == 0 or push (@components_error, $checkout);
            $updated_mercurial_repos{$mercurial_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, $dir)}
        
        # have to chdir to checkout dir for link to work properly  
        my($checkout_dir, $checkout_item) = split(/\//, $checkout);
        if ($checkout =~ /\//) {    
            if (! -e "$dir$target/$checkout_dir") {
                run_command("mkdir -p $dir$target/$checkout_dir");
            }
            chdir("$dir$target/$checkout_dir");
        }
        else {
            chdir("$dir$target");
            $checkout_item = $checkout;
        }
        
        # now we create a symlink from the repo to the appropriate target
        if (defined($repo_path)) {
            if ($repo_path =~ /\$2/) {
                $checkout =~ m!(.*)/(.*)!;
                $repo_path = $2;
                $cmd = "ln -s $orig_dir/$ROOT/mercurial_repos/$mercurial_repo/$repo_path $checkout_item";
                if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            }
            else {
                $cmd = "ln -s $orig_dir/$ROOT/mercurial_repos/$mercurial_repo/$repo_path/$checkout $checkout_item";
                if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            }
            return if (-e "$checkout_item");
            run_command($cmd);
        }
        else {
            $cmd = "ln -s $orig_dir/$ROOT/mercurial_repos/$mercurial_repo/$checkout $checkout_item";
            if ($orig_dir eq $ROOT) {$cmd =~ s!$orig_dir/!!}
            return if (-e "$checkout_item");
            run_command($cmd);
        }        
    }

    elsif ($method eq 'update') {
    
        if ($updated_mercurial_repos{$mercurial_repo} == 0) {
            chdir("$ROOT/mercurial_repos/$mercurial_repo");
            print_update_info($checkout, $url, $target, $dir);
            run_command("$hg pull") == 0 or push (@components_error, $checkout);
            $updated_mercurial_repos{$mercurial_repo} = 1;
            chdir($orig_dir)
        }
        # if mercurial 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, $dir)}        
    }

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

sub run_command
{
    my $command = shift;
    if ($command =~ /^$/) {return}
    if ($DEBUG) {
        print "$command\n";
        return;
    }
    # 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";
        my $exit = system($command);
        die "\nDetected CTRL-C\n" if ($exit & 127);
        LOG("Could not run command: $command, because of: $!") if $exit != 0;
        print "\n";
        return $exit;
    }
    # 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 =~ /^which|^mkdir/)) {
        print "cwd = ".cwd()."\n";
        print "$command\n";
        my $exit = system("$command 2>&1 1>/dev/null"); 
        die "\nDetected CTRL-C\n" if ($exit & 127);
        LOG("Could not run command: $command, because of $!") if $exit != 0;
        print "\n";
        return $exit;
    }
    # if $VERBOSE == 0 we will suppress all output from the command
    else {
        my $exit = system("$command 1>/dev/null 2>&1"); 
        die "\nDetected CTRL-C\n" if ($exit & 127);
        LOG("Could not run command: $command, because of $!") if $exit != 0;
        return $exit;
   }
}

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

sub print_checkout_info
{
    return if $DEBUG;
    
    my ($checkout, $url, $target, $dir) = @_;
    if (defined($dir)) {
        print "-----------------------------------------------------------------\n";
        print "  Checking out module: $checkout\n";
        print "      from repository: $url\n";
        print "                 into: $dir$target\n";
    }
    else {
        print "-----------------------------------------------------------------\n";
        print "  Checking out module: $checkout\n";
        print "      from repository: $url\n";
        print "                 into: $target\n";
    }
}

sub print_update_info
{
    return if $DEBUG;
    
    my ($checkout, $url, $target, $dir) = @_;
    if (defined($dir)) {
        print "-----------------------------------------------------------------\n";
        print "  Updating module: $checkout\n";
        print "  from repository: $url\n";
        print "       located in: $dir$target\n";
    }
    else {
        print "-----------------------------------------------------------------\n";
        print "  Updating module: $checkout\n";
        print "  from repository: $url\n";
        print "       located in: $target\n";
    }
}

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 {
        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}
    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:  ";
    print {$logfile} "$log\n";
    close $logfile;
}    

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


__END__

=head1 NAME
GetComponents

=head1 SYNOPSIS
GetComponents [options] [file]

    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
        
=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 all commands to be executed and exit.

=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.

=back

=head1 DESCRIPTION

B<This program> will parse the given input file(s), and checkout/update the requested components using cvs, svn, git, mercurial, 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.

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, 
                !REPOSITORY_PATH, and !AUTHORIZATION_URL. The shortened 
                directives !ANON_USER, !ANON_PASS, !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 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) !ANON_USER and !ANON_PASS will specify the login credentials for an anonymous cvs checkout from the repository.

9) !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.

10) 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.

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

12) 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
