| 1 |
+ |
#!/usr/bin/env perl |
| 2 |
+ |
|
| 3 |
+ |
BEGIN |
| 4 |
+ |
{ |
| 5 |
+ |
use File::Basename; |
| 6 |
+ |
use Cwd; |
| 7 |
+ |
my $installdir=dirname($0); |
| 8 |
+ |
if ($installdir!~/^\//) |
| 9 |
+ |
{ |
| 10 |
+ |
$installdir=getcwd()."/${installdir}"; |
| 11 |
+ |
} |
| 12 |
+ |
$installdir=dirname($installdir); |
| 13 |
+ |
$ENV{'SCRAM_TOOL_HOME'}="${installdir}/src"; |
| 14 |
+ |
$ENV{'SCRAM'}=$0; |
| 15 |
+ |
unshift @INC,"$installdir", "${installdir}/src"; |
| 16 |
+ |
} |
| 17 |
+ |
|
| 18 |
+ |
use SCRAM::SCRAM_SITE; |
| 19 |
+ |
use SCRAM::SCRAM; |
| 20 |
+ |
use Getopt::Long (); |
| 21 |
+ |
|
| 22 |
+ |
#### SCRAM Installation Values ################# |
| 23 |
+ |
if ((!exists $ENV{SCRAM_VERSION}) || ($ENV{SCRAM_VERSION}=~/^\s*$/)) |
| 24 |
+ |
{ |
| 25 |
+ |
$ENV{'SCRAM_VERSION'}='@SCRAM_VERSION@'; |
| 26 |
+ |
} |
| 27 |
+ |
if (exists $ENV{SCRAM_USERLOOKUPDB} && -f "$ENV{SCRAM_USERLOOKUPDB}") |
| 28 |
+ |
{ |
| 29 |
+ |
$ENV{'SCRAM_LOOKUPDB'}=$ENV{SCRAM_USERLOOKUPDB}; |
| 30 |
+ |
print "Using $ENV{SCRAM_USERLOOKUPDB} as the database.","\n", if ($ENV{SCRAM_DEBUG}); |
| 31 |
+ |
} |
| 32 |
+ |
else |
| 33 |
+ |
{ |
| 34 |
+ |
$ENV{'SCRAM_LOOKUPDB'}='@SCRAM_LOOKUPDB_DIR@/project.lookup'; |
| 35 |
+ |
} |
| 36 |
+ |
#### Core settings #### |
| 37 |
+ |
$main::bold = ""; |
| 38 |
+ |
$main::normal = ""; |
| 39 |
+ |
$main::line = "-"x80; |
| 40 |
+ |
$main::lookupdb = ""; |
| 41 |
+ |
$main::error = ""; |
| 42 |
+ |
$main::good = ""; |
| 43 |
+ |
$main::prompt=""; |
| 44 |
+ |
$main::ORIG_ARGV=[]; |
| 45 |
+ |
push @$main::ORIG_ARGV,$ARGV; |
| 46 |
+ |
|
| 47 |
+ |
# Test whether the output from SCRAM is being redirected, or |
| 48 |
+ |
# not (prevents escape signals from being printed to STDOUT if |
| 49 |
+ |
# STDOUT is redirected to a file or piped): |
| 50 |
+ |
if ( -t STDIN && -t STDOUT && $^O !~ /MSWin32|cygwin/ ) |
| 51 |
+ |
{ |
| 52 |
+ |
$bold = "\033[1m"; |
| 53 |
+ |
$normal = "\033[0m"; |
| 54 |
+ |
$prompt = "\033[0;32;1m"; |
| 55 |
+ |
$fail = "\033[0;31;1m"; # Red |
| 56 |
+ |
$pass = "\033[0;33;1m"; # Yellow |
| 57 |
+ |
$good = $bold.$pass; # Status messages ([OK]) |
| 58 |
+ |
$error = $bold.$fail; # ([ERROR]) |
| 59 |
+ |
} |
| 60 |
+ |
|
| 61 |
+ |
# Start a SCRAM session: |
| 62 |
+ |
$scram = SCRAM::SCRAM->new(); |
| 63 |
+ |
|
| 64 |
+ |
# Getopt option variables: |
| 65 |
+ |
my %opts; |
| 66 |
+ |
my %options = |
| 67 |
+ |
("verbose\v=s" => sub { $ENV{SCRAM_VERBOSE} = $ENV{SCRAM_DEBUG} = 1; $scram->classverbosity($_[1]) }, |
| 68 |
+ |
"debug|d" => sub { $ENV{SCRAM_DEBUG} = 1; $scram->fullverbosity() }, |
| 69 |
+ |
"arch|a=s" => sub { $ENV{SCRAM_ARCH} = $_[1]; $scram->architecture($ENV{SCRAM_ARCH}) }, |
| 70 |
+ |
"noreturn|n" => sub { $opts{SCRAM_NORETURN} = 1 }, # Pause after returning (for download in NS) |
| 71 |
+ |
"force|f" => sub { $opts{SCRAM_FORCE} = 1 }, # A force flag for commands that might need it |
| 72 |
+ |
"help|h" => sub { $opts{SCRAM_HELP} = 1 } |
| 73 |
+ |
); |
| 74 |
+ |
|
| 75 |
+ |
# Get the options using Getopt: |
| 76 |
+ |
Getopt::Long::config qw(default no_ignore_case require_order bundling); |
| 77 |
+ |
|
| 78 |
+ |
if (! Getopt::Long::GetOptions(\%opts, %options)) |
| 79 |
+ |
{ |
| 80 |
+ |
$scram->scramfatal("Error parsing arguments. See \"scram help\" for usage info."); |
| 81 |
+ |
exit(1); |
| 82 |
+ |
} |
| 83 |
+ |
|
| 84 |
+ |
# Check for a valid command and execute it or show an error message: |
| 85 |
+ |
my $command=shift(@ARGV); |
| 86 |
+ |
|
| 87 |
+ |
# Handle help option: |
| 88 |
+ |
if ($opts{SCRAM_HELP} || ! $command) |
| 89 |
+ |
{ |
| 90 |
+ |
print $scram->usage(); |
| 91 |
+ |
exit(0); |
| 92 |
+ |
} |
| 93 |
+ |
|
| 94 |
+ |
# Now execute the desired command (the routine automatically |
| 95 |
+ |
# checks to make sure the command is valid): |
| 96 |
+ |
my $retval = $scram->execcommand($command,@ARGV); |
| 97 |
+ |
|
| 98 |
+ |
# Check to see if we have --noreturn set. If so, we may be running |
| 99 |
+ |
# as a helper application in a web browser: |
| 100 |
+ |
if ($opts{SCRAM_NORETURN}) |
| 101 |
+ |
{ |
| 102 |
+ |
print "\n"; |
| 103 |
+ |
my $dummy = <STDIN>; |
| 104 |
+ |
} |
| 105 |
+ |
|
| 106 |
+ |
exit($retval); |
| 107 |
+ |
#### End of SCRAM script #### |
