eval 'exec perl -sS $0 ${1+"$@"}' if 0; #!/usr/local/bin/perl -sw # remove "if 0" from the command line $#ARGV -= 2; #/*@@ # @file GetCactus # @date Feb 19 2000 # @author Gabrielle Allen # @desc # Installer for Cactus Code Flesh # # To run # ./GetCactus # # @enddesc # @version $Header: /mnt/data2/cvs2svn/cvs-repositories/Utilities/Scripts/GetCactus,v 1.79 2010-03-23 20:23:38 schnetter Exp $ # @@*/ # Add something here to checkout from a given date or tag, for example # -D 2002-01-01 $CHECKOUT_OPTIONS = " "; # Set to one to test without a network $debug = 0; # max processes at one time $processes = 1 if (! defined $processes); my %arrangement_dirs; # Where am I $mydir = `pwd`; chomp($mydir); if (($help||$h) || (${-help})) { # See if help is required GetCactusHelp(); } if ($options) { print "Syntax:\n"; print "\tperl -s GetCactus\n\n"; print "Options:\n"; print "\t-install=\"\" : (default: ./Cactus)\n"; print "\t-anonymous=\"\" : [yes/no] (default: yes)\n"; print "\t-fleshuser=\"\" : user name for flesh checkout (default: cvs_anon),\n". " overwrites -anonymous\n"; print "\t-cvs=\"\" : [] (default: cvs)\n"; print "\t-svn=\"\" : [] (default: svn)\n"; print "\t-git=\"\" : [] (default: git)\n"; print "\t-darcs=\"\" : [] (default: darcs)\n"; print "\t-repository=\"\" : [stable/development] (default: stable)\n"; print "\t-verbose=\"\" : [yes/no] (default: no)\n"; print "\t-defaults : instruct program to use defaults when unsure\n"; print "\t-updatemode= : [for thorns] (a)ll (n)one (i)nteractive (default=none)\n"; print "\t-updateflesh : updates the flesh\n"; print "\t-shownewthorns : lists thorns that will be checked out\n"; print "\t-processes= : number of processes to use (default=1)\n"; print "\t-options : this screen\n"; print "\t-help|-h : GetCactus Help Screen\n\n"; print "Example:\n\tperl -s GetCactus -anonymous=yes -repository=development -verbose=no -install=CheckOut -defaults WaveToyC.th\n"; DIE("Leaving GetCactus script"); } # Print welcome message &Message("hello"); # Ensure that $HOME is set if (! exists $ENV{"HOME"}) { my $home = `pwd`; chomp $home; $ENV{"HOME"} = $home; } # Check that CVS is on the system $cvs = &CVSFound if (!defined $cvs); DIE("cvs not found") if (!$cvs); # Check if SVN is on the system $svn = &SVNFound if (!defined $svn); # Check if SVN is on the system $git = &GITFound if (!defined $git); # Check if darcs is on the system $darcs = &DARCSFound if (!defined $darcs); # Look for ThornList while ($thornlist = shift) { $thornlist = "" if m:/^\-/:; $thornlist = &GetThornList($thornlist); # Needed for cygwin $thornlist =~ s,^//(.)/,$1:/,; push @thornlists, $thornlist; } # Find the Cactus checkout directory ($installdir,$cactusdir) = &GetCactusDir; # Parse CVS password file .cvspass @rep = &ParseCVSPasswordFile; $rep = join(" ",@rep); # anonymous repositories, automically added to .cvspass if not already there %anon_repos = ( ":pserver:cvs_anon\@cvs.cactuscode.org:/cactusdevcvs" => "Ay=0=", ":pserver:cvs_anon\@cvs.cactuscode.org:/cactus" => "Ay=0=", ":pserver:cvs_anon\@cvs.cactuscode.org:/arrangements" => "Ay=0=", ":pserver:cvs_anon\@cvs.cactuscode.org:/packages" => "Ay=0=", ":pserver:cvs_anon\@cvs.cct.lsu.edu:/numrel" => "Ay=0=", ); foreach my $repos (keys %anon_repos) { if ($rep !~ /$repos\b/i) { &AddCVSPasswordFile($repos, $anon_repos{$repos}); } } # Choose flesh repository and login $getrep = &FleshExists; if ($getrep) { # we don't need to ask which repository, or anonymous, we use our defaults $anonymous = "yes"; $fleshrep = $getrep; $getrep =~ s/.*(\/.*)/$1/; $updatetheflesh = 0; print "\n\n Do you want to update your flesh installation y)es n)o [no] : "; if ($defaults or defined $updateflesh) { $answer = "no"; if (defined $updateflesh) { $answer = "yes"; } print " $answer\n"; } else { $answer = ; } if ($answer =~ /^\s*?y/i) { $updatetheflesh = 1; } } else { do { print "\n Anonymous Flesh checkout? (y)es, n)o, h)elp) [yes] : "; $anonymous = "yes" if (($defaults) && (! defined $anonymous)); if (defined($fleshuser) and ($fleshuser !~ /^$/)) { $anonymous = "no"; } if (! defined $anonymous) { $answer = ; } else { $answer = $anonymous; print "$answer\n"; } if ($answer =~ /^h/i) { AnonymousCheckoutHelp(); } elsif ($answer =~ /^n/i) { $anon = 0; if (defined($fleshuser) and ($fleshuser !~ /^$/)) { $login = $fleshuser; } else { $login = &GetLoginName; } ($getrep,$tag) = &GetRepository; $fleshrep = ":pserver:$login\@cvs.cactuscode.org:$getrep"; $fleshrep_port = ":pserver:$login\@cvs.cactuscode.org:2401$getrep"; if ($rep !~ /$fleshrep/ and $rep !~ /$fleshrep_port/) { &LoginRepository($fleshrep); } } else { $anon = 1; $login = "cvs_anon"; ($getrep,$tag) = &GetRepository; $fleshrep = ":pserver:$login\@cvs.cactuscode.org:$getrep"; $anonymous = "yes"; } } while ($answer =~ /^h/i); } # Check repository exists (can only do this if logged in already) DIE(" Repository $fleshrep not found ... are you connected to the network?") if (!&RepositoryExists($fleshrep)); # Parse the ThornList foreach my $thornlist (@thornlists) { %thorns = &ParseThornList($thornlist,$login,$getrep,$tag); } # Parse CVS password file .cvspass # (again, incase cvs_anon stuff was added) @rep = &ParseCVSPasswordFile; $rep = join(" ",@rep); # see if we need any passwords foreach my $key (keys %thorns) { next if ($key !~ /REPOSITORY/); if ($rep !~ $thorns{$key}) { $thorns{$key} =~ /(.*:)(.*?)(\/.*)/; my $tmp = $3; if (($2 eq "") && ($1 =~ /:pserver.*/)) { my $temprepos = "${1}2401${tmp}"; if ($rep !~ $temprepos) { $unknownreps{$thorns{$key}} = 1; } } } } # print "\n(($rep))"; # get passwords we need foreach my $key (keys %unknownreps) { print "\n\n Repository ($key) not found in .cvspass, please login:\n"; &LoginRepository($key); } chdir $installdir; $thorns{"THORNS"} = &ShouldWeUpdate("$cactusdir/arrangements/", $thorns{"THORNS"}); # Get client options ($cvs_options,$svn_options) = &CheckoutOptions; # Checkout the flesh # (if already checked out, get the checked out repository) $fleshrep = &GetFlesh($fleshrep,$cvs_options) if ($updatetheflesh ne 0); chdir $mydir; # Checkout the thorns chdir $installdir; if (@thornlists) { &GetThorns($fleshrep,$cvs_options,$tag,%thorns); } chdir $mydir; # And finish nicely ... print "\n Checkout complete\n"; chdir $mydir; &Message("goodbye"); ######################################################################## #/*@@ # @routine Repository exists # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Check that the CVS repository is actually there # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub RepositoryExists { my($repository) = @_; my $command,@dummy; $command = "$cvs -d $_[0] co -s |"; if ($debug != 1) { open(MODULES,$command); @dummy = ; close(MODULES); } else { print "\n DEBUG: Checking repository exists\n"; print " DEBUG: $command\n\n"; } return !$?; } #/*@@ # @routine CVSFound # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # See if cvs is installed on the machine # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub CVSFound { my($foundit); if (-e "/usr/local/bin/cvs") { $cvs = "/usr/local/bin/cvs "; } elsif (-e "/usr/ncsa/bin/cvs") { $cvs = "/usr/ncsa/bin/cvs "; } else { $cvs = "cvs "; } $foundit = 0; open(MODULES,"$cvs -v | "); while () { # Frank Loeffler: Isn't this '!' in the next line a mistake? if (!/Concurrent Versions System/) { $foundit = $cvs; } } close(MODULES); return $foundit; } #/*@@ # @routine SVNFound # @date Sep 2007 # @author Frank Loeffler # @desc # See if svn is installed on the machine # @enddesc # @calls # @calledby # @history copy of CVSFound with small changes # # @endhistory # #@@*/ sub SVNFound { my($foundit); # here we do thing differently than cvs, because I (Frank Loeffler) think # that way is wrong. This script should by default choose the version of # Subversion which is first in the user's path, if there is one. $svn = "svn "; $foundit = 0; open(MODULES,"$svn --version | "); while () { if (/Subversion/) { $foundit = $svn; } } close(MODULES); if ($foundit eq 0) { if (-e "/usr/local/bin/svn") { $svn = "/usr/local/bin/svn "; } elsif (-e "/usr/ncsa/bin/svn") { $svn = "/usr/ncsa/bin/svn "; } } open(MODULES,"$svn --version | "); while () { if (/Subversion/) { $foundit = $svn; } } return $foundit; } #/*@@ # @routine GITFound # @date Sep 2009 # @author Frank Loeffler # @desc # See if git is installed on the machine # @enddesc # @calls # @calledby # @history copy of SVNFound with small changes # # @endhistory # #@@*/ sub GITFound { my($foundit); # here we do thing differently than cvs, because I (Frank Loeffler) think # that way is wrong. This script should by default choose the version of # Subversion which is first in the user's path, if there is one. $git = "git "; $foundit = 0; open(MODULES,"$git --version | "); while () { if (/git version/) { $foundit = $git; } } close(MODULES); if ($foundit eq 0) { if (-e "/usr/local/bin/git") { $git = "/usr/local/bin/git "; } elsif (-e "/usr/ncsa/bin/git") { $git = "/usr/ncsa/bin/git "; } } open(MODULES,"$git --version | "); while () { if (/git version/) { $foundit = $git; } } close(MODULES); return $foundit; } #/*@@ # @routine DARCSFound # @date Sep 2009 # @author Erik Schnetter # @desc # See if darcs is installed on the machine # @enddesc # @calls # @calledby # @history copy of GITFound with small changes # # @endhistory # #@@*/ sub DARCSFound { my($foundit); # here we do thing differently than cvs, because I (Frank Loeffler) think # that way is wrong. This script should by default choose the version of # Subversion which is first in the user's path, if there is one. $darcs = "darcs "; $foundit = 0; open(MODULES,"$darcs --version | "); while () { if (/^[0-9.]+/) { $foundit = $darcs; } } close(MODULES); if ($foundit eq 0) { if (-e "/usr/local/bin/darcs") { $darcs = "/usr/local/bin/darcs "; } elsif (-e "/usr/ncsa/bin/darcs") { $darcs = "/usr/ncsa/bin/darcs "; } } open(MODULES,"$darcs --version | "); while () { if (/^[0-9.]+/) { $foundit = $darcs; } } close(MODULES); return $foundit; } #/*@@ # @routine GetLoginName # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Choose login name if required # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub GetLoginName { my($login); my $default = "cvs_anon"; if (defined(%ENV) and defined($ENV{'USER'})) { $default = $ENV{'USER'}; } print "\n What is your login name [$default] : "; $login = if (! $defaults); if ($login =~ /^$/) { $login = "cvs_anon"; } chomp($login); return $login; } # # # # sub FleshExists { my $myrepository = "UNSET"; my $tag = ""; if (open(IN, "<$installdir/$cactusdir/CVS/Root")) { $myrepository = ; chomp($myrepository); if ($myrepository =~ /\w+/) { print "\n Flesh already checked out, using "; print $myrepository =~ /cactusdevcvs/ ? "development version." : "stable version."; return $myrepository; } } return 0; } #/*@@ # @routine # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Find out which repository to use for the flesh # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub GetRepository { my ($myrepository) = "UNSET"; my ($tag) = ""; do { print "\n Checkout Flesh from \n"; print " [1] Stable release\n"; print " [2] Development version (bug fixes/unstable)\n"; print " Choose version: (1-2, h)elp, q)uit) [1] : "; if ((! defined $repository) && (! $defaults)) { $answer = ; print "\n "; } else { if ($repository =~ /^dev/) { $answer = "2"; } else { $answer = "1"; } print "$answer\n"; } if ($answer =~ /^q/i) { DIE("Leaving GetCactus script"); } elsif ($answer =~ /^h/i) { GetRepositoryHelp(); } elsif ($answer =~ /^3/) { $myrepository = "/cactusdevcvs"; print " Choose required tag for development checkout : "; $tag = ; $tag = " -r $tag "; } elsif ($answer =~ /^2/) { $myrepository = "/cactusdevcvs"; } else { $myrepository = "/cactus"; } } until ($myrepository !~ /UNSET/); return ($myrepository,$tag); } #/*@@ # @routine # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Give help on the different CVS repositories # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub GetRepositoryHelp { print "\n\n"; print " CactusCode CVS Repositories\n"; print " ---------------------------\n\n"; print " CactusCode uses different CVS repositories to hold the stable\n"; print " and development versions of the source code.\n\n"; print " Your first choice should be the last stable release. This\n"; print " version has been tested on all our supported platforms.\n"; print " (See http://www.cactuscode.org/Development.html for release\n"; print " details)\n\n"; print " You will need to use the development version if you need features\n"; print " or bug fixes which have been added since the last release, or if you\n"; print " want to submit changes to the CactusCode flesh or thorns for inclusion\n"; print " in the next release. You should be aware that the development version\n"; print " is not always guaranteed to compile or work properly on all platforms\n"; print " and changes on a day-to-day basis.\n\n"; print " The development version is periodically tagged to provide thorn developers\n"; print " access to a version which includes all the latest features and bug fixes\n"; print " but is not changing on a daily basis\n\n"; print " The repositories used are\n\n"; print " STABLE VERSION :pserver:\@cvs.cactuscode.org:/cactus\n\n"; print " DEVELOPMENT VERSION :pserver:\@cvs.cactuscode.org:/cactusdevcvs\n\n"; print " here is either the anonymous CVS user (cvs_anon, with the\n"; print " password anon), or your own username if you have been assigned one\n\n"; print " It is not recommended to mix different versions of the flesh and thorns.\n"; print " If you need the development version of any thorn, or the flesh, then\n"; print " you should use the development version of everything.\n\n"; } #/*@@ # @routine ParseCVSPasswordFile # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Read in .cvspass if it is there # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub ParseCVSPasswordFile { my @rep; my $numinpass; my $home; $cvspassfile = $ENV{CVS_PASSFILE}; if (! $cvspassfile) { $home = $ENV{"HOME"}; if ($home =~ /^$/) { DIE("Set \$HOME environment variable to home directory"); } $cvspassfile = "$home/.cvspass"; } if (open(CVSPASS,"<$cvspassfile")) { $numinpass = 0; while () { if (/^.*?(:.*?)\s(\S.*)/) { $rep[$numinpass] = $1; $numinpass++; } } } else { @rep = ""; } return @rep; } #/*@@ # @routine AddCVSPasswordFile # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # If the checkout is anonymous add any needed passwords to .cvspass # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub AddCVSPasswordFile { my($rep, $pass) = @_; my $home; $home = $ENV{"HOME"}; if ($home =~ /^$/) { DIE("Set \$HOME environment variable to home directory"); } $cvspassfile = $ENV{CVS_PASSFILE}; $cvspassfile = "$home/.cvspass" if (! $cvspassfile); if ( -e "$cvspassfile") { open(CVSPASS,">>$cvspassfile"); } else { open(CVSPASS,">$cvspassfile"); } print CVSPASS "$rep $pass\n"; close(CVSPASS); } #/*@@ # @routine StripSpaces # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Remove spaces at start and end of word ... there's probably # a much easier way to do this # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub StripSpaces { my($name) = @_; $name =~ s/^\s*//; $name =~ s/\s*$//; return $name; } #/*@@ # @routine LoginRepository # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Login to a repository with chosen username # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub LoginRepository { my ($repository) = @_; my ($command); my $status = ""; $command = "$cvs -d $repository login 2>&1|"; if ($debug != 1) { open(CVSLOGIN,$command); while () { print $_; } close(CVSLOGIN); } else { print "\n DEBUG: Logging into repository\n"; print " DEBUG: $command\n\n"; } } #/*@@ # @routine Message # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Print messages to screen # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub Message { my($choice) = @_; my($line); $line = "--------------------------------------------------------------------"; if ($choice eq "hello") { print "\n"; print $line; print "\n\n"; print " -------------------------\n"; print " Installer for Cactus Code\n"; print " -------------------------\n"; print "\n This installer guides you through checking out the core (flesh)\n"; print " and modules (thorns) of the Cactus Code from the Cactus CVS server.\n\n"; print " For a description of the checkout procedure, and how to use this\n"; print " script, type \n\n"; print " ./GetCactus -help\n\n"; print " More information can be found on our web site at\n\n"; print " http://www.cactuscode.org\n"; print "\n For more information please contact cactusmaint\@cactuscode.org\n\n"; print $line; } elsif ($choice eq "goodbye") { # Mangle the thorn list till the Makefile is fixed $thornlist =~ m:(.*)/([^/]*)$:; $thorndir = $1; $thornname = $2; print "\n"; print $line; print "\n"; print "To install more arrangements and thorns:\n"; print "\n"; print " gmake checkout\n"; print "\n"; print "To compile Cactus:\n"; print "\n"; print " gmake \n"; print "\n"; print "To create user documentation:\n"; print "\n"; print " gmake UsersGuide\n"; print "\n"; print "To receive email updates about Cactus news and developments, please\n"; print "join our Cactus Users list by visiting \n"; print "and following the instructions there.\n"; print "\n"; print $line; print "\n"; } } #/*@@ # @routine GetFlesh # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Checkout the flesh from CVS # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub GetFlesh { my($repository,$options) = @_; my($installedrep,$answer); if (-e $cactusdir and -e "$cactusdir/src") { if (-e "$cactusdir/arrangements") { print "\n--------------------------------------------------------------------\n"; # print "\n Checking out Cactus Flesh\n"; # print " (CVS repository: $repository)"; #print "\n Cactus Flesh already installed ... no overwrite\n"; open(REP,"<$cactusdir/CVS/Root") || DIE("No CVS files for Flesh"); $installedrep = ; chop $installedrep; if ($repository !~ m:^$installedrep$:) { print " WARNING: Installed Flesh from different repository\n"; print " ($installedrep)\n\n"; print " Continue ? [yes] : "; if ($defaults) { print "\n"; } else { $answer = ; } if ($answer =~ /^n/i) { DIE("Leaving GetCactus script"); } else { $repository = $installedrep; } } else { if ($updatetheflesh) { $answer = "yes"; } else { print " Do you want to update your flesh installation y)es n)o [no] : "; if (($defaults) && ($defaults ne "2")) { print "\n"; } else { $answer = ; } } if ($answer =~ /^y/i) { print "\n Updating Cactus Flesh \n"; print " (CVS repository: $repository)\n\n"; chdir ($cactusdir); $command = "$cvs $cvs_options update -d -P CONTRIBUTORS COPYRIGHT Makefile lib doc src 2>&1"; # $command = "$cvs -d $repository $cvs_options update -d $cactusdir "; if ($debug != 1) { &RunCommand($command, 1); #open(CVSCO,$command); #while () #{ # print $_; #} #close CVSCO; } else { print "\n DEBUG: Updating Flesh ($repository)\n"; print " DEBUG: $command\n\n"; } } } close(REP); } else { DIE("Cactus Flesh installed, but no arrangements directory"); } } else { print "\n--------------------------------------------------------------------\n"; print "\n Checking out Cactus Flesh \n"; print " (CVS repository: $repository)\n"; $command = "$cvs $cvs_options -d $repository co $CHECKOUT_OPTIONS -d $cactusdir Cactus 2>&1"; if ($debug != 1) { &RunCommand($command, 1); #open(CVSCO,$command); #while () #{ # print $_; #} #close CVSCO; } else { print "\n DEBUG: Checking out Flesh ($repository)\n"; print " DEBUG: $command\n\n"; } } return $repository; } #/*@@ # @routine GetThorns # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Check out the thorns from CVS # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub GetThorns { my($fleshrep,$options,$tag,%thorns) = @_; if ( -d "$cactusdir/arrangements") { chdir "$cactusdir/arrangements"; } else { if ($debug != 1) { DIE("arrangements directory does not exist"); } else { print "DEBUG: NO ARRANGEMENTS DIRECTORY\n"; } } my @get_which_thorns = split(" ",$thorns{"THORNS"}); # just one process if ($processes <= 1) { foreach $th (@get_which_thorns) { &GetOneThorn($fleshrep, $options, $tag, $th, %thorns); } } # parallel mode else { my @procs = @get_which_thorns; my $proc = ''; @procs = (split(" ", $thorns{"THORNS"})); $| = 1; # load up the first batch for (my $num_of_procs = 0; $num_of_procs < $processes; $num_of_procs++) { last if (@procs == 0); $proc = pop(@procs); if (! fork()) { &GetOneThorn($fleshrep, $options, $tag, $proc, %thorns); exit; } } # we still got processes to finish? while (@procs > 0) { wait; $proc = pop(@procs); if (! fork()) { &GetOneThorn($fleshrep, $options, $tag, $proc, %thorns); exit; } } print "\n\nWaiting for child processes to finish"; # wait for all child processes to terminate while (wait() ne "-1") { # do something intelligent while we wait..... print "."; } } chdir "../.."; } # get a thorn via git sub GetOneThornGit { my ($location, $name, $th, $git) = @_; # get an internal name for the whole repository my $git_repo = $location; $git_repo =~ s/\.git$//; $git_repo =~ s/^.*[:\/]//; # figure out if we need to get the repository my $command_co; if (! -e "../git-repos/$git_repo") { $command_co = "$git clone $location 2>&1 ../git-repos/$git_repo"; &RunCommand($command_co, 1); } # link only the specified thorn my ($arrangement, $thorn) = split(/\//, $th); $command_co = "mkdir -p $arrangement"; &RunCommand($command_co, 1); $command_co = "ln -s ../../git-repos/$name/$th $arrangement/"; &RunCommand($command_co, 1); } # get a thorn via darcs sub GetOneThornDarcs { my ($location, $name, $th, $darcs) = @_; # get an internal name for the whole repository my $darcs_repo = $location; $darcs_repo =~ s/\_darcs$//; $darcs_repo =~ s/^.*[:\/]//; # figure out if we need to get the repository my $command_co; if (! -e "../darcs-repos/$darcs_repo") { $command_co = "$darcs get $location 2>&1 ../darcs-repos/$darcs_repo"; &RunCommand($command_co, 1); } # link only the specified thorn my ($arrangement, $thorn) = split(/\//, $th); $command_co = "mkdir -p $arrangement"; &RunCommand($command_co, 1); $command_co = "ln -s ../../darcs-repos/$name/$th $arrangement/"; &RunCommand($command_co, 1); } #################################### sub GetOneThorn { my ($fleshrep, $options, $tag, $th, %thorns) = @_; my $client, $svn_repository; $answer = ""; print "--------------------------------------------------------------------\n\n"; if ($thorns{"$th REPOSITORY"} =~ m|cvs.cactuscode.org:/cactus|) { my $tp = $thorns{"$th REPOSITORY"}; my $fp = $fleshrep; $tp =~ s/.*\@//; $fp =~ s/.*\@//; #if ($thorns{"$th REPOSITORY"} ne $fleshrep) if ($tp ne $fp) { print "\n WARNING: Mixing stable and development repositories\n Flesh: <$fleshrep>\n $th: <$thorns{\"$th REPOSITORY\"}>\n\n Continue ? (h)elp, y)es, n)o) a)ll q)uit [yes] : "; # print "\n Do you still want to update $th ? h)elp y)es n)o a)ll q)uit [yes] : "; if ($ignore_mixing_repository_warning) { $answer = "yes"; print "\n"; } elsif ($defaults) { $answer = "yes"; print "\n"; } else { $answer = ; } if ($answer =~ /^q/i) { DIE("Leaving GetCactus script"); } elsif ($answer =~ /^n/i) { next; } elsif ($answer =~ /^a/i) { $ignore_mixing_repository_warning = 1; } } } # Check we're logged into this repository if ($thorns{"$th REPOSITORY"} =~ /pserver/) { @rep = &ParseCVSPasswordFile; $rep = join(" ",@rep); if ($rep !~ $thorns{"$th REPOSITORY"}) { $thorns{"$th REPOSITORY"} =~ /(.*:)(.*?)(\/.*)/; if ($2 eq "") { my $temprepos = "${1}2401${3}"; if ($rep !~ $temprepos) { ############# print "\n No login for CVS repository \n $thorns{\"$th REPOSITORY\"}\n\n"; do { print " Action: (q)uit, l)ogin, h)elp) [login] : "; if ( ($defaults && ($updatemode=~ /^a/i)) || (! $defaults) ) { $answer = ; } if ($answer =~ /^q/i) { DIE("Leaving GetCactus script"); } elsif ($answer =~ /^h/i) { &OtherRepositoriesHelp(); } else { &LoginRepository($thorns{"$th REPOSITORY"}); } } while ($answer =~ /^h/i); ########################## } # $rep !~... } # $2 eq ""... } # rep !~ $thorns{$th.... } # ... =~ /pserver... if ($thorns{"$th REPOSITORY"} =~ /ignore/) { $client = "ignore"; } elsif ($thorns{"$th REPOSITORY"} =~ /svn/) { if ($svn eq 0) { DIE("Did not find Subversion binary 'svn', but Subversion repository ". "checkout/update was requested."); } $client = "svn"; $svn_repository = $thorns{"$th REPOSITORY"}; # remove the possible 'svn:' from the repository name for the URL if ($svn_repository =~ /(.+) svn:(.+)/) { $svn_repository = "$1 $2"; } else { $svn_repository = "$1 svn://$2"; } } elsif ($thorns{"$th REPOSITORY"} =~ /\^git\^/) { $client = "git"; } elsif ($thorns{"$th REPOSITORY"} =~ /[.]darcs\^/) { $client = "darcs"; } else { $client = "cvs"; } $th =~ /(.*?)\//; my $cur_arrangement = $1; # get the arrangement directory and the arrangement doc directory. # we use the hash %arrangment_dirs to keep track to make sure we don't # do this for every thorn, but rather just once per arrangement if (! defined $arrangement_dirs{$cur_arrangement}) { # only for cvs arrangements for the moment if ($client eq "cvs") { $arrangement_dirs{$cur_arrangement} = 1; my $command = "$cvs $cvs_options checkout -l $cur_arrangement $tag 2>&1 "; &RunCommand($command, 0); $command = "$cvs $cvs_options checkout ${cur_arrangement}/doc $tag 2>&1 "; &RunCommand($command, 0); } } # Checkout or update if (-e $th) { if (! $defaults) { #print " Thorn already installed ... no overwrite\n"; print "\n Do you want to update $th from \n $thorns{\"$th REPOSITORY\"} y)es n)o a)ll [no] : "; $answer = ; } else { $answer = "yes"; } if ($answer =~ /^a/i) { $defaults = 1; $answer = "yes"; } if ($answer =~ /^y/i) { if ($client =~ /ignore/) { print " Ignoring $th\n"; } if ($client =~ /git/) { print " Updating using git is not supported by GetCactus ($th)\n"; } if ($client =~ /darcs/) { print " Updating using darcs is not supported by GetCactus ($th)\n"; } if ($client =~ /cvs/) { open(REP,"<$th/CVS/Root") || DIE("No CVS files for $th"); $installedrep = ; close(REP); } if ($client =~ /svn/) { $installedrep = 0; open(REP,"$svn info $th | "); while () { if (!/URL: (.*)$/) { my $url = $1; my $thorn_name = $th; $th =~ /([^\/]+)\/(.+)/; if ($2) { $thorn_name = $2; } # For the special case of one-thorn repositories: if ($thorns{"$th MODULE"} eq " ") { $thorn_name = $th; } my $tmp = quotemeta($thorn_name); if ($url =~ /(.*)\/$tmp/) { $installedrep = $1; } } } close(REP); if ($installedrep eq 0) { DIE("Could not figure out Subversion URL for $th ($svn info $th)"); } } chomp $installedrep; my $tp = $thorns{"$th REPOSITORY"}; $tp =~ s/.*\@//; $tp =~ s/ *--username +\w+ +//; $tp =~ s/^( *svn:)//; $installedrep =~ s/.*\@//; $installedrep =~ s/ *--username +\w+ +//; $installedrep =~ s/^( *svn:)//; # if (($thorns{"$th REPOSITORY"} !~ m:^$installedrep$:)) my $tmp = quotemeta($installedrep); if (($tp !~ /^$tmp/) && ($client !~ /ignore/) && ($client !~ /git/) && ($client !~ /darcs/)) { print "\n WARNING: GetCactus is refusing to update $th\n Thorn installed from different repository\n ($installedrep!=$tp)\n"; } else { # Give a bit of formatted info during the process my $rep = $thorns{"$th REPOSITORY"}; $rep =~ s/--username ([^ ]*) /$1@/g; print " Updating thorn $th\n repository: $rep\n module: $thorns{\"$th MODULE\"}\n\n"; if (($client =~ /ignore/) || ($client =~ /git/) || ($client =~ /darcs/)) { print " Skipped\n"; $command_up = ""; } if ($client =~ /cvs/) { $command_up = "$cvs $cvs_options -d $thorns{\"$th REPOSITORY\"} update -d $tag $th 2>&1"; } if ($client =~ /svn/) { $command_up = "$svn $svn_options update $th 2>&1"; } if ($debug != 1) { &RunCommand($command_up, 1); #open(CVSCO,$command_up); #while () #{ # print $_; #} #close CVSCO; } else { print "\n DEBUG: $command_up\n\n"; } } } } else { # Give a bit of formatted info during the process my $rep = $thorns{"$th REPOSITORY"}; print " Checking out thorn $th\n repository: $rep\n module: $thorns{\"$th MODULE\"}\n\n"; my $check_dir = ""; if ($client =~ /svn/) { # If the given thorn name consists of "arrangement_name/thorn_name", # parse for the two parts if ($th =~ /^([^\/]*)\/(.*)/) { $check_dir = $1."/"; $call_thorn= $2; } # For the special case of one-thorn repositories: if ($thorns{"$th MODULE"} eq " ") { $call_thorn = $th; } } # If the checkout should have another name than the repository suggests, users can set # the Module name. Note, that it can also be " " (a single space) for one-thorn # repositories if ($th eq $thorns{"$th MODULE"}) { if ($client =~ /ignore/) { print " Skipped\n"; $command_co = ""; } if ($client =~ /cvs/) { $command_co = "$cvs $cvs_options -d $thorns{\"$th REPOSITORY\"} co $CHECKOUT_OPTIONS $tag $th 2>&1"; } if ($client =~ /svn/) { $command_co = "$svn $svn_options co $CHECKOUT_OPTIONS $tag $svn_repository/$call_thorn $call_thorn 2>&1"; } if ($client =~ /git/) { my ($location, $name) = split(/\^git\^/, $thorns{"$th REPOSITORY"}); &GetOneThornGit($location, $name, $th, $git); $command_co = ""; } if ($client =~ /darcs/) { my ($location, $name) = split(/\^/, $thorns{"$th REPOSITORY"}); $location =~ s/[.]darcs$//; &GetOneThornDarcs($location, $name, $th, $darcs); $command_co = ""; } } else { $th =~ m:^(.*)/(.*):; $check_dir = $1; $call_thorn = $2; if ($client =~ /ignore/) { print " Skipped\n"; $command_co = ""; $check_dir = ""; } if ($client =~ /cvs/) { $command_co = "$cvs $cvs_options -d $thorns{\"$th REPOSITORY\"} co -d $call_thorn $tag $thorns{\"$th MODULE\"} 2>&1"; } if ($client =~ /svn/) { $command_co = "$svn $svn_options co $CHECKOUT_OPTIONS $tag $svn_repository/$thorns{\"$th MODULE\"} $call_thorn 2>&1"; } if ($client =~ /git/) { my ($location, $name) = split(/\^/, $thorns{"$th REPOSITORY"}); &GetOneThornGit($location, $name, $th, $git); $command_co = ""; } if ($client =~ /darcs/) { my ($location, $name) = split(/\^/, $thorns{"$th REPOSITORY"}); $location =~ s/[.]darcs$//; &GetOneThornDarcs($location, $name, $th, $darcs); $command_co = ""; } } if ($debug != 1) { # Check that the repository exists # DIE("Repository $thorns{\"$th REPOSITORY\"} not found \n Are you connected to the network?\n Is the repository name spelt right in your thornlist file?") if (!&RepositoryExists($thorns{"$th REPOSITORY"})); # Create arrangement directory if needbe if ($check_dir !~ m:^$: && !(-e $check_dir)) { mkdir($check_dir,0755) || DIE("Could not make directory $check_dir"); } if ($check_dir !~ m:^$:) { $arrangement_dir = `pwd`; chomp ($arrangement_dir); chdir $check_dir; } &RunCommand($command_co, 1); #open(CVSCO,$command_co); #while () #{ # print $_; #} #close CVSCO; if ($check_dir !~ m:^$:) { chdir $arrangement_dir; } } else { print "\n DEBUG: $command_co\n\n"; } } } sub RunCommand { my $command = shift; my $display_results = shift; if ($command =~ /^$/) { return; } if ($display_results) { (system($command) == 0 )|| DIE("Could not run command: $command, because of $!"); } else { $command.=" |"; open (CVSCO, $command) || DIE("Could not run command: $command, because of $!"); close CVSCO; } } #/*@@ # @routine # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Get options to be passed to CVS/Subversion # @enddesc # @calls # @calledby # @history Sep 2007, Frank Loeffler, modified to include subversion options # # @endhistory # #@@*/ sub CheckoutOptions { my($answer,$cvs_options,$svn_options); # Chose information or not do { $verbose = "no" if (($defaults) && (! defined $verbose)); print "\n Verbose checkout (y)es, n)o, h)elp) [no] : "; if (! defined $verbose) { $answer = } else { $answer = $verbose; print "$answer\n"; } if ($answer =~ /^h/i) { VerboseCheckoutHelp(); } elsif ($answer =~ /^y/i) { $cvs_options = " -z9 "; $svn_options = ""; } else { $cvs_options = " -Q -z9 "; $svn_options = " -q"; } } while ($answer =~ /^h/i); return ($cvs_options, $svn_options); } sub VerboseCheckoutHelp { print "\n\n"; print " CactusCode checkout options\n"; print " -------------------------------\n\n"; print " By default, all checkouts using this script use the option -z9\n"; print " for CVS which transfers a compressed version of each file across the \n"; print " network\n\n"; print " Choosing verbose checkout provides a report of all the files\n"; print " as they are checked out from the chosen repository, by using \n"; print " the option -Q for CVS and -q fuer Subversion\n\n"; print " cvs -z9 [-Q] -d checkout \n"; print " svn [-q] method:// co \n\n"; } #/*@@ # @routine GetCactusDir # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Get directory for Cactus installation # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub GetCactusDir { $mydir = `pwd`; chomp($mydir); print "\n\n Directory for Cactus installation [Cactus] : "; if (defined $install) { print " $install\n"; } $install = "" if (($defaults) && (! defined $install)); if (! $install) { $install = ; } if ($install =~ /^$/) { $install = "$mydir/Cactus"; } chomp($install); # Needed for Cygwin. $install =~ s,^//(.)/,$1:/,; # Chop of the last word if ($install =~ m:^(.*)/+([^/]+)$:) { $install = $1; $cactusdir = $2; } else { $cactusdir = $install; $install = "."; } #just spacees if ($install =~ m:^\s*$:) { $install = "."; } DIE("Directory $install not found") if (! -e $install); return ($install,$cactusdir); } #/*@@ # @routine GetThornList # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Get the full path of the thorn list # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub GetThornList { my($thornlist) = @_; my($mydir,$outlist); # Maybe user forgot to give a ThornList if (!$thornlist) { print "\n Give ThornList if required [none] : "; $thornlist=; chomp $thornlist; if ($thornlist =~ m:^\s*$:) { undef $thornlist; print "\n No ThornList given, checking out Cactus flesh only.\n"; } } while ($thornlist) { if ($thornlist !~ m:^/:) { $mydir = `pwd`; chomp($mydir); $outlist = $mydir."/".$thornlist; } else { $outlist = $thornlist; } # Needed for cygwin $outlist =~ s,^//(.)/,$1:/,; if (! -e $outlist) { print "\n ThornList $outlist not found!\n"; print "\n Give ThornList if required [quit] : "; $thornlist=; chomp $thornlist; if ($thornlist =~ m:^\s*$: || $thornlist =~ m:quit:i) { undef $thornlist; DIE("Leaving GetCactus"); } } else { undef $thornlist; } } return $outlist; } #/*@@ # @routine ParseThornList # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Read the thorn names and repositories from the thorn list # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub ParseThornList { my($thornlist,$user,$name,$tag) = @_; my($directive,$value); my($parfile); my($repository_user,$repository_location,$repository_name,$repository_port); my $saved_repositoryr_name = ""; $parfile = 0; $repository_tag = "$tag"; $repository_type = "pserver"; $repository_location = "cvs.cactuscode.org"; $repository_user = $user; $repository_name = $name; $repository_module = ""; $repository_port = ""; $repository_user = "cvs_anon" if ($repository_user =~ /^$/); open(THORNLIST,"<$thornlist"); while () { if ($parfile) { if (m:^\s*\!*\s*$endstring:) { $parfile = 0; &WriteParameterFile($filename,$parfiledata); next; } else { if (m:^\s*\#(.*)$:) { $parfiledata .= "$1\n"; next; } } } # Skip blank lines and comments next if (m:^\s*$:); next if (m:^\s*\#.*$:); # Parse directives if (m:^\s*\!\s*(\w+)\s(.*)$:) { $directive = &StripSpaces($1); $value = &StripSpaces($2); # Global directives if ($directive =~ "DESC") { $description = $value; next; } # Thorn directives elsif ($directive =~ "REPOSITORY_TYPE") { $repository_type = $value; next; } elsif ($directive =~ "REPOSITORY_TAG") { $repository_tag = $value; next; } elsif ($directive =~ "REPOSITORY_LOCATION") { $repository_location = $value; next; } elsif ($directive =~ "REPOSITORY_USER") { $repository_user = $value; next; } elsif ($directive =~ "REPOSITORY_NAME") { $repository_name = $value; next; } elsif ($directive =~ "REPOSITORY_MODULE") { $repository_module = $value; next; } elsif ($directive =~ "REPOSITORY_PORT") { if ( $repository_type =~ /svn/ ) { $repository_port = $value; } else { if ($value ne "2401") { $repository_port = $value; } } next; } elsif ($directive =~ "PARAMETER_FILE") { $value =~ m:([\w._]*)\s*<<\s*(\w*)\s*$:; $parfile = 1; $filename = $1; $endstring = $2; $parfiledata = ""; # print "Parameter file $filename\n"; # print "End string $endstring\n"; next; } } # Thorn name m:^([^#]*):; $name = &StripSpaces($1); my $arrpat = '@ARRANGEMENT@'; my $thopat = '@THORN@'; # To maintain the old lists of thorns, create a special rule for # thorns as repositories: # If the name starts with "T:" and contains a "*", the "*" is # replaced by the arrangement and thorn name and this thorn is # checked out. if ( $repository_name =~ /T:([^\*]*)\*(.*)/ ) { $saved_repository_name = $repository_name; $repository_name = "$1$name$2"; $repository_module = " "; } # A slightly more generic mechanism replaces placeholders # @ARRANGEMENT@ and @THORN@ by the arrangement and thorn names, # respectively. elsif ($repository_name =~ /$arrpat/ || $repository_name =~ /$thopat/) { my ($arr,$tho) = $name =~ m+^([^/]*)/([^/]*)$+; die unless defined $arr and defined $tho; $saved_repository_name = $repository_name; $repository_name =~ s/$arrpat/$arr/g; $repository_name =~ s/$thopat/$tho/g; $repository_module = " "; } # Thorn repository my $auth_options = "--username $repository_user"; if ($repository_user eq 'cvs_anon') { $auth_options .= ' --password anon --no-auth-cache'; } if ( $repository_type =~ /svn$/ ) { $rep = " $auth_options $repository_type://$repository_location:${repository_port}${repository_name}"; } elsif ( $repository_type =~ /svn:/ ) { $rep = " $auth_options $repository_type$repository_location:${repository_port}${repository_name}"; } elsif ( $repository_type =~ /^git$/ ) { $rep = "$repository_location^git^${repository_name}"; } elsif ( $repository_type =~ /^darcs$/ ) { $rep = "${repository_location}.darcs^${repository_name}"; } else { $rep = ":$repository_type:$repository_user\@$repository_location:${repository_port}${repository_name}"; } # Set the repository name back in case we changed it temporarily if ($saved_repository_name ne "") { $repository_name = $saved_repository_name; $saved_repository_name = ""; } if ($name && $rep) { $thorns{"THORNS"} .= " $name" if (! defined $thorns{"$name REPOSITORY"}); $thorns{"$name REPOSITORY"} = $rep; if ($repository_module !~ m:^$:) { $thorns{"$name MODULE"} = $repository_module; } else { $thorns{"$name MODULE"} = $name; } $repository_module = ""; } else { # Ignore: blank line print "WHY AM I HERE?"; } } close(THORNLIST); return %thorns; } #/*@@ # @routine DIE # @date Sat Mar 11 15:31:55 CET 2000 # @author Gabrielle Allen # @desc # Tidy up and die # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub DIE { my($message) = @_; chdir $mydir; die "\n $message\n\n"; } #/*@@ # @routine AnonymousCheckoutHelp # @date Wed Mar 29 21:31:55 CET 2000 # @author Gabrielle Allen # @desc # Print help about login name # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub AnonymousCheckoutHelp { print "\n\n"; print " Login name for CVS checkout\n"; print " ---------------------------\n\n"; print " Access to the CactusCode CVS repositories can be either anonymous\n"; print " or by a personal username.\n\n"; print " If you access the repositories anonymously, you have read access to\n"; print " the CactusCode flesh and all the released CactusCode thorns in both\n"; print " the stable and development repositories.\n"; print " The anonymous user name is cvs_anon, and the anonymous password is\n"; print " anon. If you use this script to get the CactusCode, you will not need\n"; print " to type your password, since it is automatically added to the file\n"; print " .cvspass in your home directory,\n\n"; print " Personal usernames are assigned to developers who need commit \n"; print " privileges to the repositories. \n\n" } #/*@@ # @routine GetCactusHelp # @date Wed Mar 29 21:31:55 CET 2000 # @author Gabrielle Allen # @desc # Print help about using this script # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub GetCactusHelp { print "\n\n"; print " Using GetCactus\n"; print " ---------------\n"; print "\n This installer guides you through checking out the core (flesh)\n"; print " and modules (thorns) of the Cactus Code from the Cactus CVS server.\n\n"; print " To be able to checkout the code, you must have CVS (Concurrent \n"; print " Versioning System) installed on your machine, and an internet \n"; print " connection.\n\n"; print " To check if CVS is properly installed on your machine, type\n\n"; print " cvs -v\n\n"; print " If CVS is installed, and in your path, this command will tell you\n"; print " the version of CVS you will be using. If CVS is not installed, it \n"; print " can be freely obtained from \n\n"; print " http://www.cyclic.com\n\n"; print " To checkout just the Cactus flesh, type\n\n"; print " ./GetCactus\n\n"; print " The flesh will compile without any thorns being present, but you will\n"; print " not be able to run any applications. Compiling the flesh on it's own\n"; print " can be useful for checking the compilation procedure on a new machine\n"; print " The script will prompt you for the information needed for the checkout,\n"; print " at most prompts you can type \"h\" or \"help\" for more information\n\n"; print " To checkout the Cactus flesh and a selection of thorns, the script can\n"; print " can be passed a thorn list, type\n\n"; print " ./GetCactus \n\n"; print " where is the name of any text file containing a list of \n"; print " thorn names, and a number of directives which determine the repositories \n"; print " from which to check them out from.\n\n"; print " See below for a complete description of the thorn list syntax\n\n"; print " For thorns released as part of the Cactus Code, the repository name will\n"; print " either be the repository holding the last stable release, \n\n"; print " :pserver:\@cvs.cactuscode.org:/cactus\n\n"; print " or the repository holding the development version\n\n"; print " :pserver:\@cvs.cactuscode.org:/cactusdevcvs\n\n"; print " See below for more information about the name and the difference between\n"; print " these two repositories\n\n"; print " If you are using thorns from other repositories, just insert the name of the \n"; print " repository where the thorn is located. Note that for this script to work, the\n"; print " module names of the thorns in the repository must be \n\n"; print " /.\n\n"; print " Sample thorn lists are provided on the Cactus Code web pages at \n\n"; print " www.cactuscode.org/Download/ThornLists/index.html\n\n"; print " This script also supports thorns in Subversion rather than CVS. In order\n"; print " to use this, Subversion has to be properly installed on your machine. You\n"; print " can check that by typing\n\n"; print " svn --version\n\n"; print " This should give you information about the version of Subversion which is\n"; print " installed. If it is not installed, you can freely obtain it from\n\n"; print " http://subversion.tigris.org/\n\n"; print " The latest release of the Cactus Code (flesh and thorns) can also\n"; print " be obtained as a tar file from our web site at \n\n"; print " http://www.cactuscode.org\n"; GetRepositoryHelp(); AnonymousCheckoutHelp(); ThornListSyntax(); UsingCactusHelp(); print "\n For more information, or for suggestions for improvements or additional\n"; print " features for this script, please contact cactusmaint\@cactuscode.org\n\n"; DIE("Leaving GetCactus script"); } #/*@@ # @routine UsingCactusHelp # @date Wed Mar 29 21:31:55 CET 2000 # @author Gabrielle Allen # @desc # Print help about using Cactus # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub UsingCactusHelp { print "\n\n"; print " Using the Cactus Code\n"; print " ---------------------\n\n"; print " For full instructions on compiling and running Cactus, read\n"; print " the Users Guide. Both an online and printable version can be found \n"; print " on our web pages at\n\n"; print " www.cactuscode.org/Documentation.html\n\n"; print " Alternatively, if you have installed the Cactus flesh, type\n\n"; print " gmake UsersGuide\n\n"; print " in the Cactus directory to create the postscript version UsersGuide.ps\n\n"; print " For the impatient, a Quick Start guide, describing how to run a simple\n"; print " application is available at\n\n"; print " www.cactuscode.org/Documentation/HOWTO/QuickStart-HOWTO\n\n"; } #/*@@ # @routine ThornListSyntax # @date Sun Apr 2 21:31:55 CET 2000 # @author Gabrielle Allen # @desc # Print help about the syntax for the thorn list # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub ThornListSyntax { print "\n\n"; print " Syntax for the Input Thorn List\n"; print " -------------------------------\n\n"; print " GetCactus can be passed a optional file containing an list of thorns to \n"; print " be checked out from CVS repositories (a ThornList). Directives in the \n"; print " ThornList specify which repository to use, etc. If no directives are used,\n"; print " the thorns will be checked out from the same repository as the Flesh.\n\n"; print " Directives:\n\n"; print " Directives in the ThornList are identified by a ! at the start of the line,\n\n"; print " and are assigned the value of the text after the space, \n\n"; print " ! \n\n"; print " Directives are applied from the point they are assigned in the file.\n\n"; print " DESCRIPTION \n"; print " Description of the thornlist\n"; print " REPOSITORY_TYPE \n"; print " e.g. pserver, svn, svn:http://, svn:https://\n"; print " REPOSITORY_TAG \n"; print " tag to use when checking out\n"; print " REPOSITORY_USER \n"; print " user name for checking out\n"; print " REPOSITORY_NAME \n"; print " name of repository (location in filesystem)\n"; print " REPOSITORY_LOCATION \n"; print " server machine\n"; print " REPOSITORY_PORT\n"; print " server port number, defaults to 2401 for CVS. For Subversion\n"; print " you can enter the port directly into REPOSITORY_LOCATION. Use\n"; print " REPOSITORY_PORT after REPOSITORY_TYPE.\n\n"; } #/*@@ # @routine WriteParameterFile # @date Sun Apr 2 21:31:55 CET 2000 # @author Gabrielle Allen # @desc # Write parameter file # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub WriteParameterFile { my($filename,$data) = @_; my($answer); print "\n Extracting embedded parameter file $filename\n"; if (-e $filename) { print "\n Parameter file $filename exists, overwrite [n] : "; $answer = if (! $defaults); if ($answer !~ /^y/i) { return; } } open(FILE,">$filename") || DIE("Could not open $filename"); print FILE $data; close(FILE); } #/*@@ # @routine OtherRepositoriesHelp # @date Sun Apr 2 21:31:55 CET 2000 # @author Gabrielle Allen # @desc # Print help about using custom repositories # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub OtherRepositoriesHelp { print "\n\n"; print " Using Non Cactus Repositories\n"; print " -----------------------------\n\n"; print " Thorn lists can also be used to checkout thorns from\n"; print " other CVS or Subversion repositories. These repositories may, or may not,\n"; print " require you to give a username and password depending on their\n"; print " access mechanism.\n\n"; } #/*@@ # @routine ShouldWeUpdate # @date Oct 22 22:24:38 CEST 2001 # @author Ian Kelley # @desc # Sees if we should update thorns at the very beginning of checkout. # @enddesc # @calls # @calledby # @history # # @endhistory # #@@*/ sub ShouldWeUpdate { my ($arrangementsdir,$thorns) = @_; my (@thorns) = split/\s+/, $thorns; my @toupdate; my @new; my $currentdir = `pwd`; chomp($currentdir); $currentdir .= '/' if ($currentdir !~ /\/$/); foreach my $th (@thorns) { next if ($th =~ /^$/); my $dir = $currentdir . $arrangementsdir . $th; if (-d $dir) { push @toupdate, $th; } else { push @new, $th; } } # if we have something to process if (@toupdate > 0) { # just to let people see what ones will be new, if they want to if ((@new > 0) && ($shownewthorns)) { print "\nGetCactus will checkout the following thorns:"; foreach (@new) { print "\n\t$_"; } print "\n"; } print "\n The following thorns already exist in checkout:"; foreach (@toupdate) { print "\n\t$_"; } $updatemode = "all" if ($defaults); print "\n Update Mode : (a)ll, (n)one (i)nteractive [none] : "; if (! defined $updatemode) { $updatemode = ; } else { print "$updatemode\n"; } if ($updatemode =~ /^a/i) { if ($defaults) { $defaults = 1; } else { # we make it 2, because we want to know if we started it here or at command line $defaults = 2; } } elsif ($updatemode =~ /^i/i) { $defaults = 0; } else { foreach (@toupdate) { $thorns =~ s/\b$_\b//; } } } $thorns =~ s/\s+/ /g; $thorns =~ s/^s+//; $thorns =~ s/\s+$//; return $thorns; }