| 1 |
< |
#!/usr/local/bin/perl5 -I$ENV{SCRAM_HOME}/src |
| 1 |
> |
#!/usr/local/bin/perl5 -w |
| 2 |
|
# |
| 3 |
|
# User Interface |
| 4 |
|
# |
| 5 |
|
|
| 6 |
< |
$inputcmd=shift; |
| 7 |
< |
$found='false'; |
| 8 |
< |
@allowed_commands=qw(project build env install version list arch); |
| 9 |
< |
|
| 10 |
< |
foreach $command ( @allowed_commands ) { |
| 11 |
< |
do { &$command; $found='true'; last;} if ( $inputcmd=~/^$command\Z/i); |
| 12 |
< |
} |
| 13 |
< |
|
| 14 |
< |
if ( ! ( $found=~/true/ ) ) { |
| 15 |
< |
print "scram help\n--------\n"; |
| 16 |
< |
print "Recognised Commands: \n"; |
| 17 |
< |
foreach $command ( @allowed_commands ) { |
| 18 |
< |
print " ".$command."\n"; |
| 19 |
< |
} |
| 20 |
< |
} |
| 21 |
< |
|
| 22 |
< |
sub build { |
| 23 |
< |
# is this a based or free release? |
| 24 |
< |
FullEnvInit(); |
| 25 |
< |
use BuildSetup; |
| 26 |
< |
BuildSetup($ENV{THISDIR},@ARGV); |
| 27 |
< |
# system("$ENV{TOOL_HOME}/BuildSetup",$ENV{THISDIR},@ARGV); |
| 28 |
< |
} |
| 29 |
< |
|
| 30 |
< |
sub project { |
| 31 |
< |
my $project=shift @ARGV; |
| 32 |
< |
my $version=shift @ARGV; |
| 33 |
< |
environmentinit(); |
| 34 |
< |
use File::Copy; |
| 35 |
< |
use Utilities::AddDir; |
| 36 |
< |
|
| 37 |
< |
print "Warning : - you are entering a development zone.". |
| 38 |
< |
" Don't complain if it don't work\n"; |
| 39 |
< |
use BootStrapProject; |
| 40 |
< |
# get the bootstrap files downloaded |
| 41 |
< |
BootStrapProject("$project\?\?$version"); |
| 42 |
< |
# Go setup the rest of the environement, now we can |
| 43 |
< |
chdir $ENV{LOCALTOP}; |
| 44 |
< |
&localtop; |
| 45 |
< |
LoadEnvFile(); |
| 46 |
< |
# |
| 47 |
< |
# Now create the directories specified in the interface |
| 48 |
< |
# |
| 49 |
< |
foreach $key ( keys %ENV ) { |
| 50 |
< |
if ( $key=~/^INT/ ) { |
| 51 |
< |
adddir($ENV{$key}); |
| 52 |
< |
} |
| 53 |
< |
} |
| 54 |
< |
use clientfile; |
| 55 |
< |
BuildClientFile( $ENV{SCRAM_ProjReqsDoc} ); |
| 56 |
< |
} |
| 57 |
< |
sub FullEnvInit { |
| 58 |
< |
environmentinit(); |
| 59 |
< |
localtop(); |
| 60 |
< |
LoadEnvFile(); |
| 61 |
< |
} |
| 62 |
< |
|
| 63 |
< |
sub environmentinit { |
| 64 |
< |
use Utilities::setarchitecture; |
| 65 |
< |
my $name; |
| 66 |
< |
my $value; |
| 67 |
< |
|
| 68 |
< |
$ENV{LatestBuildFile}=""; # stop recursive behaviour in make |
| 69 |
< |
setarch(); |
| 70 |
< |
$ENV{INTwork}="tmp/$ENV{SCRAM_ARCH}"; |
| 71 |
< |
$ENV{INTlib}="lib/$ENV{SCRAM_ARCH}"; |
| 72 |
< |
$ENV{INTsrc}="src"; |
| 73 |
< |
$ENV{INTbin}="bin/$ENV{SCRAM_ARCH}"; |
| 74 |
< |
$ENV{INTlog}="logs"; |
| 75 |
< |
|
| 76 |
< |
if ( ! ( exists $ENV{SCRAM_HOME}) ){ |
| 77 |
< |
$ENV{SCRAM_HOME}="/afs/cern.ch/user/w/williamc/public/ConfigMan"; |
| 78 |
< |
print "Warning : Environment Variable SCRAM_HOME not set.\n"; |
| 79 |
< |
print "Defaulting to $ENV{SCRAM_HOME}\n"; |
| 80 |
< |
} |
| 81 |
< |
if ( ! ( exists $ENV{SCRAM_CONFIG} ) ){ |
| 82 |
< |
$ENV{SCRAM_CONFIG}="$ENV{SCRAM_HOME}/configuration"; |
| 83 |
< |
} |
| 84 |
< |
if ( ! ( exists $ENV{TOOL_HOME} ) ){ |
| 85 |
< |
$ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/toolbox"; |
| 86 |
< |
} |
| 87 |
< |
if ( ! ( exists $ENV{SCRAM_LOOKUPDB} ) ){ |
| 88 |
< |
$ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup"; |
| 89 |
< |
} |
| 90 |
< |
} |
| 91 |
< |
|
| 92 |
< |
sub localtop { |
| 93 |
< |
# find localtop |
| 94 |
< |
use Cwd; |
| 95 |
< |
my $thispath=cwd; |
| 96 |
< |
block: { |
| 97 |
< |
do { |
| 98 |
< |
if ( -e "$thispath/.SCRAM" ) { |
| 99 |
< |
$ENV{LOCALTOP}=$thispath; |
| 100 |
< |
last block; |
| 101 |
< |
} |
| 102 |
< |
} while ( ( $thispath=~s/(.*)\/.*/$1/ )=~/./ ); |
| 103 |
< |
if ( ! (defined $ENV{LOCALTOP}) ) { |
| 104 |
< |
print "Unable to locate the top of local release. Exiting\n"; |
| 105 |
< |
exit 1 |
| 106 |
< |
} |
| 107 |
< |
} #end block |
| 108 |
< |
($ENV{THISDIR}=cwd)=~s/^$ENV{LOCALTOP}//; |
| 109 |
< |
$ENV{THISDIR}=~s/^\///; |
| 110 |
< |
$ENV{SCRAM_WORKDIR}="$ENV{LOCALTOP}/.SCRAM"; |
| 111 |
< |
} |
| 112 |
< |
|
| 113 |
< |
sub LoadEnvFile { |
| 114 |
< |
open ( SCRAMENV, "<$ENV{SCRAM_WORKDIR}/Environment" ) || |
| 115 |
< |
die "Cant find Environment file $!\n"; |
| 116 |
< |
while ( <SCRAMENV> ) { |
| 117 |
< |
chomp; |
| 118 |
< |
next if /^#/; |
| 119 |
< |
next if /^\s*$/ ; |
| 120 |
< |
($name, $value)=split /=/; |
| 121 |
< |
eval "\$ENV{${name}}=\"$value\""; |
| 122 |
< |
} |
| 123 |
< |
close SCRAMENV; |
| 124 |
< |
} |
| 125 |
< |
|
| 126 |
< |
sub env { |
| 127 |
< |
print "Sorry - Not yet\n"; |
| 128 |
< |
} |
| 129 |
< |
|
| 130 |
< |
# |
| 131 |
< |
# Create a lookup tag in the site database |
| 132 |
< |
# |
| 133 |
< |
sub install ( $tagname, $version ) { |
| 134 |
< |
my $tagname=shift @ARGV; |
| 135 |
< |
my $version=shift @ARGV; |
| 136 |
< |
|
| 137 |
< |
# create database entry |
| 138 |
< |
do { &help_install; } if $tagname=~/help/i; |
| 139 |
< |
&FullEnvInit; |
| 140 |
< |
if ( $version eq "" ) { |
| 141 |
< |
$version=$ENV{SCRAM_PROJVERSION}; |
| 142 |
< |
} |
| 143 |
< |
if ( $tagname eq "" ) { |
| 144 |
< |
$tagname=$ENV{SCRAM_PROJECTNAME}; |
| 145 |
< |
} |
| 146 |
< |
my $filename="$ENV{SCRAM_CONFIG}/project.lookup"; |
| 147 |
< |
my $outfile="$ENV{SCRAM_CONFIG}/project.lookup.tmp"; |
| 148 |
< |
open ( LOCALLOOKUPDB, "<$filename" ); |
| 149 |
< |
open ( OUTFILE , ">$outfile" ); |
| 150 |
< |
while ( <LOCALLOOKUPDB> ) { |
| 151 |
< |
if ( /^$tagname/ ) { |
| 152 |
< |
print "Related tag :".$_."\n"; |
| 153 |
< |
if ( /$version/) { |
| 154 |
< |
print "$tagname $version already exists. Overwrite (y/n)\n"; |
| 155 |
< |
if ( ! (<STDIN>=~/y/i ) ) { |
| 156 |
< |
print "Aborting install ...\n"; |
| 157 |
< |
close OUTFILE; |
| 158 |
< |
close LOCALLOOKUPDB; |
| 159 |
< |
exit 1; |
| 160 |
< |
} |
| 161 |
< |
} |
| 162 |
< |
else { |
| 163 |
< |
print OUTFILE $_; |
| 164 |
< |
} |
| 165 |
< |
} |
| 166 |
< |
else { |
| 167 |
< |
print OUTFILE $_; |
| 168 |
< |
} |
| 169 |
< |
} |
| 170 |
< |
print OUTFILE "$tagname:$version:file:$ENV{LOCALTOP}". |
| 171 |
< |
"/.SCRAM/InstallFile\n"; |
| 172 |
< |
close OUTFILE; |
| 173 |
< |
close LOCALLOOKUPDB; |
| 174 |
< |
copy ( "$outfile", "$filename" ) |
| 175 |
< |
|| die "Unable to copy $! \n"; |
| 176 |
< |
|
| 177 |
< |
} |
| 178 |
< |
|
| 179 |
< |
sub help_install() { |
| 180 |
< |
|
| 181 |
< |
helpheader("install"); |
| 182 |
< |
print <<ENDTEXT; |
| 183 |
< |
Associates a label with the current release in the SCRAM database. |
| 184 |
< |
This allows other users to refer to a centrally installed project by |
| 185 |
< |
this label rather than a remote url reference. |
| 186 |
< |
|
| 187 |
< |
Usage: |
| 188 |
< |
|
| 189 |
< |
scram install [[label] [version]] |
| 190 |
< |
|
| 191 |
< |
label : override default label (the project name of the current release) |
| 192 |
< |
version : the version tag of the current release. If version is not |
| 193 |
< |
specified the base release version will be taken by default. |
| 194 |
< |
|
| 195 |
< |
ENDTEXT |
| 196 |
< |
exit; |
| 197 |
< |
} |
| 198 |
< |
|
| 199 |
< |
sub helpheader ($label) { |
| 200 |
< |
my $label=shift; |
| 201 |
< |
print <<ENDTEXT; |
| 202 |
< |
************************************************************************* |
| 203 |
< |
SCRAM HELP --------- $label |
| 204 |
< |
************************************************************************* |
| 205 |
< |
ENDTEXT |
| 206 |
< |
} |
| 207 |
< |
|
| 208 |
< |
sub version { |
| 209 |
< |
print "Scram version : prototype\n"; |
| 210 |
< |
} |
| 211 |
< |
|
| 212 |
< |
sub list { |
| 213 |
< |
&environmentinit; |
| 214 |
< |
my $filename="$ENV{SCRAM_CONFIG}/project.lookup"; |
| 215 |
< |
open ( LOCALLOOKUPDB, "<$filename" ); |
| 216 |
< |
print "Installed Projects\n"; |
| 217 |
< |
print "------------------\n"; |
| 218 |
< |
print "|Project Name | Project Version |\n"; |
| 219 |
< |
print "----------------------------------\n"; |
| 220 |
< |
while ( <LOCALLOOKUPDB> ) { |
| 221 |
< |
( $name, $version, $type, $url ) = split ":", $_; |
| 222 |
< |
printf "%1s",$name; |
| 223 |
< |
printf "%25s\n",$version; |
| 224 |
< |
printf "--> %25s\n",$type.":".$url; |
| 225 |
< |
} |
| 226 |
< |
close LOCALLOOKUPDB; |
| 227 |
< |
} |
| 228 |
< |
|
| 229 |
< |
sub arch { |
| 230 |
< |
&environmentinit(); |
| 231 |
< |
print "$ENV{SCRAM_ARCH}\n"; |
| 232 |
< |
} |
| 6 |
> |
#use Scram::SCRAM; |
| 7 |
> |
use ActiveDoc::CommandLineInterface; |
| 8 |
> |
use ActiveDoc::SimpleUserInterface; |
| 9 |
> |
use Utilities::PathMod; |
| 10 |
> |
use Configuration::Tool; |
| 11 |
> |
|
| 12 |
> |
# Set up our scram objects |
| 13 |
> |
$self={}; |
| 14 |
> |
$self->{UI}=ActiveDoc::SimpleUserInterface->new(); |
| 15 |
> |
# Search for configuration resource file |
| 16 |
> |
$self->{configpath}="$ENV{HOME}:$ENV{SCRAM_HOME}/configuration"; |
| 17 |
> |
$self->{PathMod}=Utilities::PathMod->new(); |
| 18 |
> |
$self->{file}=$self->{PathMod}->SearchPath( |
| 19 |
> |
$self->{configpath},".scramrc"); |
| 20 |
> |
|
| 21 |
> |
#$self->{cli}=ActiveDoc::CommandLineInterface->new(qw(Scram::SCRAM ActiveDoc::UserInterface_basic)); |
| 22 |
> |
$self->{cli}=ActiveDoc::CommandLineInterface->new(qw(Scram::SCRAM), $self->{UI}); |
| 23 |
> |
$self->{cli}->parse(@ARGV) |
