954 lines
26 KiB
Plaintext
954 lines
26 KiB
Plaintext
require "$tool/include/ctutils.pl" ;
|
|
|
|
# get list of all projects
|
|
sub CTAttachListProj {
|
|
if ($ctdebug ne "") {
|
|
print STDERR "in CTAttachListProj\n" ;
|
|
}
|
|
local( $ret ) = "" ;
|
|
local( $done ) = 0 ;
|
|
local( *DIRFILES ) ;
|
|
open( DIRFILES, "(cd /var/etc ; /bin/ls -1 *.vspec ; echo blahblah) |" ) ;
|
|
while ( ! $done ) {
|
|
$_ = <DIRFILES> ;
|
|
s/\n$// ;
|
|
if ( $_ eq "blahblah" ) {
|
|
$done = 1 ;
|
|
} else {
|
|
s/.vspec$// ;
|
|
$ret = $ret . " " . $_ ;
|
|
}
|
|
}
|
|
close( DIRFILES ) ;
|
|
if ($ctdebug ne "") {
|
|
print STDERR "out of CTAttachListProj\n" ;
|
|
}
|
|
$ret ;
|
|
}
|
|
|
|
# get list of flavors for a project
|
|
# $_[0] = project
|
|
sub CTAttachListFlav {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachListFlav\n" ;
|
|
}
|
|
local( $ret ) = "" ;
|
|
$vobname = $_[0] ;
|
|
if ( -e "/var/etc/$_[0].vspec" ) {
|
|
local( *SPECFILE ) ;
|
|
open( SPECFILE, "</var/etc/$_[0].vspec" ) ;
|
|
local( @partlist ) ;
|
|
while ( <SPECFILE> ) {
|
|
if ( $_ =~ /^VOBNAME/ ) {
|
|
@partlist = split( /=/ ) ;
|
|
$vobname = $partlist[1] ;
|
|
$vobname =~ s/\n$// ;
|
|
} else {
|
|
@partlist = split( /:/ ) ;
|
|
$ret = $ret . " " . $partlist[0] ;
|
|
}
|
|
}
|
|
close( SPECFILE ) ;
|
|
} else {
|
|
print STDERR "CTAttachListFlav: cannot locate '/var/etc/$_[0]'\n" ;
|
|
}
|
|
if ($ctdebug) {
|
|
print STDERR "out of CTAttachListFlav\n" ;
|
|
}
|
|
$ret ;
|
|
}
|
|
|
|
# get the flavor line for the given project
|
|
# $_[0] = project
|
|
# $_[1] = flavor
|
|
sub CTAttachFindFlav {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachFindFlav\n" ;
|
|
}
|
|
local( $ret ) = "" ;
|
|
$vobname = $_[0] ;
|
|
if ( -e "/var/etc/$_[0].vspec" ) {
|
|
local( *SPECFILE ) ;
|
|
open( SPECFILE, "</var/etc/$_[0].vspec" ) ;
|
|
local( $done ) = 0 ;
|
|
local( @partlist ) ;
|
|
while (( $_ = <SPECFILE> ) && ! $done ) {
|
|
s/\n$// ;
|
|
if ( $_ =~ /^VOBNAME/ ) {
|
|
@partlist = split( /=/ ) ;
|
|
$vobname = $partlist[1] ;
|
|
} else {
|
|
@partlist = split( /:/ ) ;
|
|
if ( $partlist[0] eq $_[1] ) {
|
|
$done = 1 ;
|
|
$ret = join( " ", @partlist );
|
|
}
|
|
}
|
|
}
|
|
close( SPECFILE ) ;
|
|
} else {
|
|
print STDERR "CTAttachFindFlav: cannot locate '/var/etc/$_[0]'\n" ;
|
|
}
|
|
if ($ctdebug) {
|
|
if ($ret ne "") {
|
|
print STDERR "found flavor " . $_[1] . " of project " . $_[0] . "\n" ;
|
|
} else {
|
|
print STDERR "did not find flavor " . $_[1] . " of project " . $_[0] . "\n" ;
|
|
}
|
|
print STDERR "out of CTAttachFindFlav\n" ;
|
|
}
|
|
$ret ;
|
|
}
|
|
|
|
# given the project and flavor, resolve the final config line
|
|
# $_[0] = project
|
|
# $_[1] = flavor
|
|
sub CTAttachResolve {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachResolve\n" ;
|
|
}
|
|
local( $spec ) = &CTAttachFindFlav( $_[0], $_[1] ) ;
|
|
local( $ret ) = "" ;
|
|
if ( $spec ne "" ) {
|
|
local( @speclist ) ;
|
|
@speclist = split( / +/, $spec ) ;
|
|
if ( $speclist[1] eq "root" ) {
|
|
$ret = join( " " , @speclist ) ;
|
|
if ($ctdebug) {
|
|
print STDERR "resolved to a 'root'\n" ;
|
|
}
|
|
} elsif ( $speclist[1] eq "vroot" ) {
|
|
if ( $ENV{"HAVE_ATRIA"} ne "" ) {
|
|
$ret = join( " " , @speclist ) ;
|
|
if ($ctdebug) {
|
|
print STDERR "resolved to a 'vroot'\n" ;
|
|
}
|
|
}
|
|
} elsif ( $speclist[1] eq "ref" ) {
|
|
local( $tmp ) = &CTUShellEval( $speclist[2] ) ;
|
|
if ($ctdebug) {
|
|
print STDERR "resolved to a 'ref', recursing\n" ;
|
|
}
|
|
$ret = &CTAttachResolve( $_[0], $tmp ) ;
|
|
} else {
|
|
print STDERR "CTAttachResolve: unknown flavor type '$speclist[1]'\n" ;
|
|
}
|
|
}
|
|
if ($ctdebug) {
|
|
print STDERR "out of CTAttachResolve\n" ;
|
|
}
|
|
$ret ;
|
|
}
|
|
|
|
# given the config line, determine the view name
|
|
# $_[0] = config line
|
|
sub CTAttachComputeView {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachComputeView\n" ;
|
|
}
|
|
local( $ret ) = "" ;
|
|
if ( $_[0] ne "" ) {
|
|
local( @speclist ) ;
|
|
@speclist = split( / +/, $_[0] ) ;
|
|
if ( $speclist[1] eq "vroot" ) {
|
|
local( $vname ) = $speclist[0] ;
|
|
shift( @speclist ) ;
|
|
shift( @speclist ) ;
|
|
local( $item ) ;
|
|
local( @itemlist ) ;
|
|
foreach $item ( @speclist ) {
|
|
@itemlist = split( /=/, $item ) ;
|
|
if ( $itemlist[0] eq "VN" ) {
|
|
$vname = $itemlist[1] ;
|
|
}
|
|
}
|
|
$ret = &CTUShellEval( $vname ) ;
|
|
}
|
|
}
|
|
if ($ctdebug) {
|
|
print STDERR "config line '" . $_[0] . "' yields view name '" . $ret . "'\n" ;
|
|
print STDERR "out of CTAttachComputeView\n" ;
|
|
}
|
|
$ret ;
|
|
}
|
|
|
|
# given the config line, determine the branch name
|
|
# $_[0] = config line
|
|
sub CTAttachComputeBranch {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachComputeBranch\n" ;
|
|
}
|
|
local( $ret ) = "" ;
|
|
if ( $_[0] ne "" ) {
|
|
local( @speclist ) ;
|
|
@speclist = split( / +/, $_[0] ) ;
|
|
if ( $speclist[1] eq "vroot" ) {
|
|
local( $bname ) = &CTAttachComputeView( $_[0] ) ;
|
|
shift( @speclist ) ;
|
|
shift( @speclist ) ;
|
|
local( $item ) ;
|
|
local( @itemlist ) ;
|
|
foreach $item ( @speclist ) {
|
|
@itemlist = split( /=/, $item ) ;
|
|
if ( $itemlist[0] eq "BN" ) {
|
|
$bname = $itemlist[1] ;
|
|
}
|
|
}
|
|
$ret = &CTUShellEval( $bname ) ;
|
|
}
|
|
}
|
|
if ($ctdebug) {
|
|
print STDERR "config line '" . $_[0] . "' yields branch name '" . $ret . "'\n" ;
|
|
print STDERR "out of CTAttachComputeBranch\n" ;
|
|
}
|
|
$ret ;
|
|
}
|
|
|
|
# given the config line, determine the label name
|
|
# $_[0] = config line
|
|
sub CTAttachComputeLabel {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachComputeLabel\n" ;
|
|
}
|
|
local( $ret ) = "" ;
|
|
if ( $_[0] ne "" ) {
|
|
local( @speclist ) ;
|
|
@speclist = split( / +/, $_[0] ) ;
|
|
if ( $speclist[1] eq "vroot" ) {
|
|
local( $lname ) = &CTAttachComputeView( $_[0] ) ;
|
|
shift( @speclist ) ;
|
|
shift( @speclist ) ;
|
|
local( $item ) ;
|
|
local( @itemlist ) ;
|
|
foreach $item ( @speclist ) {
|
|
@itemlist = split( /=/, $item ) ;
|
|
if ( $itemlist[0] eq "LB" ) {
|
|
$lname = $itemlist[1] ;
|
|
}
|
|
}
|
|
$ret = &CTUShellEval( $lname ) ;
|
|
$ret =~ tr/a-z/A-Z/ ;
|
|
}
|
|
}
|
|
if ($ctdebug) {
|
|
print STDERR "config line '" . $_[0] . "' yields label name '" . $ret . "'\n" ;
|
|
print STDERR "out of CTAttachComputeLabel\n" ;
|
|
}
|
|
$ret ;
|
|
}
|
|
|
|
# given the project name and config line, determine the root of the project
|
|
# $_[0] = project
|
|
# $_[1] = config line
|
|
sub CTAttachComputeRoot {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachComputeRoot\n" ;
|
|
}
|
|
local( $ret ) = "" ;
|
|
if ( $_[1] ne "" ) {
|
|
local( @speclist ) ;
|
|
@speclist = split( / +/, $_[1] ) ;
|
|
if ( $speclist[1] eq "root" ) {
|
|
$ret = $speclist[2] ;
|
|
} elsif ( $speclist[1] eq "vroot" ) {
|
|
$ret = &CTAttachComputeView( $_[1] ) ;
|
|
$ret = "/view/$ret/vobs/$vobname" ;
|
|
} else {
|
|
print STDERR "CTAttachComputeRoot: unknown flavor type '$speclist[1]'\n" ;
|
|
}
|
|
}
|
|
if ($ctdebug) {
|
|
print STDERR "out of CTAttachComputeRoot\n" ;
|
|
}
|
|
$ret ;
|
|
}
|
|
|
|
# given the project name and config line, determine the root of the project as
|
|
# needed by the config spec.
|
|
# $_[0] = project
|
|
# $_[1] = config line
|
|
sub CTAttachComputeElemRoot {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachComputeElemRoot\n" ;
|
|
}
|
|
local( $ret ) = "" ;
|
|
if ( $_[1] ne "" ) {
|
|
local( @speclist ) ;
|
|
@speclist = split( / +/, $_[1] ) ;
|
|
if ( $speclist[1] eq "root" ) {
|
|
$ret = $speclist[2] ;
|
|
} elsif ( $speclist[1] eq "vroot" ) {
|
|
$ret = &CTAttachComputeView( $_[1] ) ;
|
|
$ret = "/vobs/$vobname" ;
|
|
} else {
|
|
print STDERR "CTAttachComputeElemRoot: unknown flavor type '$speclist[1]'\n" ;
|
|
}
|
|
}
|
|
if ($ctdebug) {
|
|
print STDERR "out of CTAttachComputeElemRoot\n" ;
|
|
}
|
|
$ret ;
|
|
}
|
|
|
|
# do whatever setup is needed for ClearCase
|
|
# input is in:
|
|
# $_[0] = project
|
|
# $_[1] = $spec
|
|
sub CTAttachCCSetup {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachCCSetup\n" ;
|
|
}
|
|
local( $root ) = &CTAttachComputeElemRoot( $_[0], $_[1] ) ;
|
|
local( $view ) = &CTAttachComputeView( $_[1] ) ;
|
|
local( $branch ) = &CTAttachComputeBranch( $_[1] ) ;
|
|
local( $label ) = &CTAttachComputeLabel( $_[1] ) ;
|
|
local( *CTINTERFACE ) ;
|
|
local( *TMPFILE ) ;
|
|
local( $tmpname ) = "/tmp/config.$$" ;
|
|
local( $emitted ) = 0 ;
|
|
|
|
if ($ctdebug) {
|
|
print STDERR "checking for existance of view '" . $view . "'\n" ;
|
|
}
|
|
open( CTINTERFACE, "/usr/atria/bin/cleartool lsview $view |" ) ;
|
|
$_ = <CTINTERFACE> ;
|
|
close( CTINTERFACE ) ;
|
|
if ( $_ eq "" ) { # need to make the view
|
|
if ($ctdebug) {
|
|
print STDERR "creating view '" . $view . "'\n" ;
|
|
}
|
|
system "umask 2 ; /usr/atria/bin/cleartool mkview -tag $view /var/views/$view.vws 2> /dev/null > /dev/null ; /usr/atria/bin/cleartool startview $view 2> /dev/null > /dev/null\n" ;
|
|
} elsif ( ! ( $_ =~ /\*/ )) { # need to start the view
|
|
if ($ctdebug) {
|
|
print STDERR "starting view '" . $view . "'\n" ;
|
|
}
|
|
system "/usr/atria/bin/cleartool startview $view 2> /dev/null > /dev/null &\n" ;
|
|
}
|
|
|
|
if ($ctdebug) {
|
|
print STDERR "making branch and label types for view " . $view . "\n" ;
|
|
}
|
|
system "/usr/atria/bin/cleartool mkbrtype -vob /vobs/$vobname -c \"Branch type for the $view view\" $branch 2> /dev/null > /dev/null &\n" ;
|
|
system "/usr/atria/bin/cleartool mklbtype -vob /vobs/$vobname -c \"Label type for the $view view\" $label 2> /dev/null > /dev/null &\n" ;
|
|
|
|
if ($ctdebug) {
|
|
print STDERR "creating/updating the config-spec for view " . $view . "\n" ;
|
|
}
|
|
open( CTINTERFACE, "/usr/atria/bin/cleartool catcs -tag $view |" ) ;
|
|
open( TMPFILE, "> $tmpname" ) ;
|
|
while ( <CTINTERFACE> ) {
|
|
if ( $_ =~ "CHECKEDOUT" ) {
|
|
print TMPFILE "$_" ;
|
|
} elsif (( $_ =~ /^element \*/ ) && ( $_ =~ "/main/LATEST" ) &&
|
|
!( $_ =~ /$_[0]/ )) {
|
|
if ( ! $emitted ) {
|
|
$emitted = 1 ;
|
|
print TMPFILE "element $root/... .../$branch/LATEST\n" ;
|
|
print TMPFILE "element $root/... $label -mkbranch $branch\n" ;
|
|
print TMPFILE "element $root/... /main/LATEST -mkbranch $branch\n" ;
|
|
}
|
|
print TMPFILE "$_" ;
|
|
} elsif ( $_ =~ /$_[0]/ ) {
|
|
if ( ! $emitted ) {
|
|
$emitted = 1 ;
|
|
print TMPFILE "element $root/... .../$branch/LATEST\n" ;
|
|
print TMPFILE "element $root/... $label -mkbranch $branch\n" ;
|
|
print TMPFILE "element $root/... /main/LATEST -mkbranch $branch\n" ;
|
|
}
|
|
} else {
|
|
print TMPFILE "$_" ;
|
|
}
|
|
}
|
|
close( CTINTERFACE ) ;
|
|
close( TMPFILE ) ;
|
|
system "/usr/atria/bin/cleartool setcs -tag $view $tmpname ; rm $tmpname &\n" ;
|
|
if ($ctdebug) {
|
|
print STDERR "out of CTAttachCCSetup\n" ;
|
|
}
|
|
}
|
|
|
|
# do whatever setup is needed for ClearCase, but do it in the background
|
|
# input is in:
|
|
# $_[0] = project
|
|
# $_[1] = $spec
|
|
sub CTAttachCCSetupBG {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachCCSetupBG\n" ;
|
|
}
|
|
local( $root ) = &CTAttachComputeElemRoot( $_[0], $_[1] ) ;
|
|
local( $view ) = &CTAttachComputeView( $_[1] ) ;
|
|
local( $branch ) = &CTAttachComputeBranch( $_[1] ) ;
|
|
local( $label ) = &CTAttachComputeLabel( $_[1] ) ;
|
|
|
|
system "$tool/bin/ctattachcc $root $view $branch $label $vobname $_[0]\n" ;
|
|
|
|
if ($ctdebug) {
|
|
print STDERR "out of CTAttachCCSetupBG\n" ;
|
|
}
|
|
}
|
|
|
|
# prepend an entry onto the envmod of the given key.
|
|
# input is in:
|
|
# $_[0] = key
|
|
# $_[1] = data
|
|
#
|
|
# output is in:
|
|
# %envmod = has 'data' prepended at 'key'
|
|
sub CTAttachPrependMod {
|
|
if ( $envmod{$_[0]} eq "" ) {
|
|
$envmod{$_[0]} = $_[1] ;
|
|
} else {
|
|
$envmod{$_[0]} = $_[1] . " " . $envmod{$_[0]} ;
|
|
}
|
|
}
|
|
|
|
# postpend an entry onto the envmod of the given key.
|
|
# input is in:
|
|
# $_[0] = key
|
|
# $_[1] = data
|
|
#
|
|
# output is in:
|
|
# %envmod = has 'data' postpended at 'key'
|
|
sub CTAttachPostpendMod {
|
|
if ( $envmod{$_[0]} eq "" ) {
|
|
$envmod{$_[0]} = $_[1] ;
|
|
} else {
|
|
$envmod{$_[0]} = $envmod{$_[0]} . " " . $_[1] ;
|
|
}
|
|
}
|
|
|
|
# pre/post-pend an entry onto the envmod of the given key, as set/controlled
|
|
# by envpospend, et al.
|
|
# input is in:
|
|
# $_[0] = key
|
|
# $_[1] = data
|
|
#
|
|
# output is in:
|
|
# %envmod = data pre/post pended at the given key
|
|
sub CTAttachAddToMod {
|
|
if ($envpostpend{$_[0]} ne "") {
|
|
&CTAttachPostpendMod( $_[0], $_[1] ) ;
|
|
} else {
|
|
&CTAttachPrependMod( $_[0], $_[1] ) ;
|
|
}
|
|
}
|
|
|
|
# prepend the given entry to the envset of the given key
|
|
# input is in:
|
|
# $_[0] = key
|
|
# $_[1] = data
|
|
#
|
|
# output is in:
|
|
# %envset = prepended at key with data
|
|
sub CTAttachPrependSet {
|
|
local( $sep ) = " " ;
|
|
if ( $envsep{$_[0]} ne "" ) {
|
|
$sep = $envsep{$_[0]} ;
|
|
}
|
|
if ($envset{$_[0]} ne "") {
|
|
$envset{$_[0]} = $_[1] . $sep . $envset{$_[0]} ;
|
|
} else {
|
|
$envset{$_[0]} = $_[1] ;
|
|
}
|
|
}
|
|
|
|
# postpend the given entry to the envset of the given key
|
|
# input is in:
|
|
# $_[0] = key
|
|
# $_[1] = data
|
|
#
|
|
# output is in:
|
|
# %envset = postpended at key with data
|
|
sub CTAttachPostpendSet {
|
|
local( $sep ) = " " ;
|
|
if ( $envsep{$_[0]} ne "" ) {
|
|
$sep = $envsep{$_[0]} ;
|
|
}
|
|
if ($envset{$_[0]} ne "") {
|
|
$envset{$_[0]} = $envset{$_[0]} . $sep . $_[1] ;
|
|
} else {
|
|
$envset{$_[0]} = $_[1] ;
|
|
}
|
|
}
|
|
|
|
# pre/post-pend an entry onto the envset of the given key, as set/controlled
|
|
# by envpospend, et al.
|
|
# input is in:
|
|
# $_[0] = key
|
|
# $_[1] = data
|
|
#
|
|
# output is in:
|
|
# %envset = data pre/post pended at the given key
|
|
sub CTAttachAddToSet {
|
|
if ($envpostpend{$_[0]} ne "") {
|
|
&CTAttachPostpendSet( $_[0], $_[1] ) ;
|
|
} else {
|
|
&CTAttachPrependSet( $_[0], $_[1] ) ;
|
|
}
|
|
}
|
|
|
|
$docnt = 0 ;
|
|
@attachqueue = () ;
|
|
|
|
require "$tool/include/ctquery.pl" ;
|
|
|
|
# given the project and flavor, build the lists of variables to set/modify
|
|
# input is in:
|
|
# $_[0] = project
|
|
# $_[1] = flavor
|
|
# $_[2] = is some kind of default?
|
|
#
|
|
# output is in:
|
|
# return value is config line
|
|
# %envmod = environment variables to modify
|
|
# %envset = environment variables to outright set
|
|
# %envsep = seperator
|
|
# %envcmd = set or setenv
|
|
# %envdo = direct commands to add to attach script
|
|
# %envpostpend = flag that variable should be postpended
|
|
sub CTAttachCompute {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachCompute\n" ;
|
|
}
|
|
local( $done ) = 0 ;
|
|
local( $flav ) = $_[1] ;
|
|
local( $prevflav ) = &CTQueryProj( $_[0] ) ;
|
|
local( $spec ) ;
|
|
local( $root ) ;
|
|
if ( $_[2] && ( $prevflav ne "" )) {
|
|
# short circuit attaching, we're already there.
|
|
$done = 1 ;
|
|
}
|
|
while ( ! $done ) {
|
|
$spec = &CTAttachResolve( $_[0], $flav ) ;
|
|
if ( $ctdebug ne "" ) {
|
|
print STDERR "spec line = '$spec'\n" ;
|
|
}
|
|
if ( $spec ne "" ) {
|
|
$root = &CTAttachComputeRoot( $_[0], $spec ) ;
|
|
if ( -e $root ) {
|
|
$done = 1 ;
|
|
if ( $spec =~ /vroot/ ) {
|
|
&CTAttachCCSetupBG( $_[0], $spec ) ;
|
|
}
|
|
} elsif ( $spec =~ /vroot/ ) {
|
|
&CTAttachCCSetup( $_[0], $spec ) ;
|
|
if ( -e $root ) {
|
|
$done = 1 ;
|
|
}
|
|
}
|
|
}
|
|
if (( ! $done ) && $_[2] ) {
|
|
if ( $flav eq "install" ) {
|
|
# oh my! are we ever in trouble
|
|
print STDERR "you are in a strange alien universe\n" ;
|
|
$spec = "" ;
|
|
$done = 1 ;
|
|
} elsif ( $flav eq "release" ) {
|
|
$flav = "install" ;
|
|
} elsif ( $flav eq "ship" ) {
|
|
$flav = "release" ;
|
|
} else {
|
|
$flav = "ship" ;
|
|
}
|
|
}
|
|
}
|
|
|
|
if ( $spec ne "" ) {
|
|
local( $proj ) = $_[0] ;
|
|
$proj =~ tr/a-z/A-Z/ ;
|
|
local( $view ) = &CTAttachComputeView( $spec ) ;
|
|
|
|
if ($ctdebug) {
|
|
print STDERR "extending paths\n" ;
|
|
}
|
|
|
|
&CTAttachAddToMod( "PATH", $root . "/bin" ) ;
|
|
&CTAttachAddToMod( "LD_LIBRARY_PATH", $root . "/lib" ) ;
|
|
&CTAttachAddToMod( "CDPATH", $root . "/src/all" ) ;
|
|
&CTAttachAddToMod( "CT_INCLUDE_PATH", $root . "/include" ) ;
|
|
&CTAttachAddToMod( "DC_PATH", $root . "/etc" ) ;
|
|
&CTAttachAddToMod( "PFPATH", $root . "/etc/models" ) ;
|
|
&CTAttachAddToMod( "SSPATH", $root . "/lib/ss" ) ;
|
|
&CTAttachAddToMod( "STKPATH", $root . "/lib/stk" ) ;
|
|
&CTAttachAddToMod( "CTPROJS", $proj . ":" . $flav ) ;
|
|
$envset{$proj} = $root;
|
|
|
|
# if ( $view ne "" ) {
|
|
# &CTAttachCCSetup( $_[0], $spec ) ;
|
|
# }
|
|
|
|
if ( -e "$root/etc/$_[0].init" ) {
|
|
if ($ctdebug) {
|
|
print STDERR "scanning .init file\n" ;
|
|
}
|
|
local( @linesplit ) ;
|
|
local( $linetmp ) ;
|
|
local( $loop );
|
|
local( *INITFILE ) ;
|
|
if ( -x "$root/etc/$_[0].init" ) {
|
|
open( INITFILE, "$root/etc/$_[0].init $_[0] $_[1] $root |" ) ;
|
|
} else {
|
|
open( INITFILE, "< $root/etc/$_[0].init" ) ;
|
|
}
|
|
while ( <INITFILE> ) {
|
|
s/\n$// ;
|
|
if ( $_ =~ /^MODABS/ ) {
|
|
@linesplit = split ;
|
|
$linetmp = $linesplit[1] ;
|
|
shift( @linesplit ) ;
|
|
shift( @linesplit ) ;
|
|
&CTAttachPostpendMod( $linetmp, &CTUShellEval(join(" ", @linesplit))) ;
|
|
} elsif ( $_ =~ /^MODREL/ ) {
|
|
@linesplit = split ;
|
|
$linetmp = $linesplit[1] ;
|
|
shift( @linesplit ) ;
|
|
shift( @linesplit ) ;
|
|
foreach $loop ( @linesplit ) {
|
|
&CTAttachPostpendMod( $linetmp, $root . "/" . &CTUShellEval($loop)) ;
|
|
}
|
|
} elsif ( $_ =~ /^SETABS/ ) {
|
|
@linesplit = split ;
|
|
$linetmp = $linesplit[1] ;
|
|
shift( @linesplit ) ;
|
|
shift( @linesplit ) ;
|
|
&CTAttachPrependSet( $linetmp, &CTUShellEval(join(" ", @linesplit))) ;
|
|
} elsif ( $_ =~ /^SETREL/ ) {
|
|
@linesplit = split ;
|
|
$linetmp = $linesplit[1] ;
|
|
shift( @linesplit ) ;
|
|
shift( @linesplit ) ;
|
|
foreach $loop ( @linesplit ) {
|
|
&CTAttachPrependSet( $linetmp, $root . "/" . &CTUShellEval($loop)) ;
|
|
}
|
|
} elsif ( $_ =~ /^SEP/ ) {
|
|
@linesplit = split ;
|
|
$envsep{$linesplit[1]} = $linesplit[2] ;
|
|
} elsif ( $_ =~ /^CMD/ ) {
|
|
@linesplit = split ;
|
|
$envcmd{$linesplit[1]} = $linesplit[2] ;
|
|
} elsif ( $_ =~ /^DO/ ) {
|
|
@linesplit = split ;
|
|
shift( @linesplit ) ;
|
|
$envdo{$docnt} = join( " ", @linesplit ) ;
|
|
$docnt++ ;
|
|
} elsif ( $_ =~ /^POSTPEND/ ) {
|
|
@linesplit = split ;
|
|
$envpospend{$linesplit[1]} = 1 ;
|
|
} elsif ( $_ =~ /^ATTACH/ ) {
|
|
@linesplit = split ;
|
|
shift( @linesplit ) ;
|
|
foreach $loop ( @linesplit ) {
|
|
push( @attachqueue, $loop ) ;
|
|
}
|
|
} else {
|
|
print STDERR "Unknown .init directive '$_'\n" ;
|
|
}
|
|
}
|
|
close( INITFILE ) ;
|
|
}
|
|
|
|
# save mods away until after sub-attach
|
|
local( %locmod ) ;
|
|
local( $item ) ;
|
|
|
|
foreach $item ( keys %envmod ) {
|
|
$locmod{$item} = $envmod{$item} ;
|
|
delete $envmod{$item} ;
|
|
}
|
|
|
|
# do sub-attaches
|
|
while ( @attachqueue != () ) {
|
|
$item = shift( @attachqueue ) ;
|
|
&CTAttachCompute( $item, $defflav, 1 ) ;
|
|
}
|
|
|
|
# restore saved mods and merge them in with existing
|
|
foreach $item ( keys %locmod ) {
|
|
$envmod{$item} = $locmod{$item} ;
|
|
delete $locmod{$item} ;
|
|
}
|
|
|
|
&CTAttachCheckVars( $_[0], $spec ) ;
|
|
}
|
|
if ($ctdebug) {
|
|
print STDERR "out of CTAttachCompute\n" ;
|
|
}
|
|
$spec ;
|
|
}
|
|
|
|
# take a mod list and merge it into set. Uniqueifying as we go.
|
|
# input is in:
|
|
# $_[0] = mod list
|
|
# $_[1] = key
|
|
#
|
|
# output is:
|
|
# %envset = now has the mod line merged in with it.
|
|
sub CTAttachMergeToSet {
|
|
if ( $ctdebug ) {
|
|
print STDERR "trying to add '$_[0]' to '$envset{$_[1]}'\n" ;
|
|
}
|
|
local( @splitlist ) ;
|
|
local( $loop ) ;
|
|
local( $sep ) = " " ;
|
|
if ( $envsep{$_[1]} ne "" ) {
|
|
$sep = $envsep{$_[1]} ;
|
|
}
|
|
@splitlist = split( / /, $_[0] ) ;
|
|
foreach $loop ( @splitlist ) {
|
|
if ( ! (( $envset{$_[1]} eq $loop ) ||
|
|
( $envset{$_[1]} =~ /^$loop$sep/ ) ||
|
|
( $envset{$_[1]} =~ /$sep$loop$/ ) ||
|
|
( $envset{$_[1]} =~ /$sep$loop$sep/ ))) {
|
|
&CTAttachPostpendSet( $_[1], $loop ) ;
|
|
}
|
|
}
|
|
if ( $ctdebug ) {
|
|
print STDERR "yielding '$envset{$_[1]}'\n" ;
|
|
}
|
|
}
|
|
|
|
# Perform cleanup operations on the variable that are going to be set/modified
|
|
# eg:
|
|
# * check to see if we're already attached to the project, and alter sets
|
|
# based on that
|
|
# * move mods of pre-existing variables to sets w/ the changes included
|
|
# * move mods of non-existing variables to sets
|
|
#
|
|
# input:
|
|
# $_[0] = project
|
|
# $_[1] = config line
|
|
sub CTAttachCheckVars {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachCheckVars\n" ;
|
|
}
|
|
local( $prevflav ) = &CTQueryProj( $_[0] ) ;
|
|
local( $proj ) = $_[0] ;
|
|
$proj =~ tr/a-z/A-Z/ ;
|
|
local( $atria ) = "/usr/atria/bin" ;
|
|
if ( $ENV{"HAVE_ATRIA"} ne "" ) {
|
|
if ( !( $ENV{"PATH"} =~ /$atria/ )) {
|
|
$envmod{"PATH"} = "$atria " . $envmod{"PATH"} ;
|
|
}
|
|
}
|
|
if ( $prevflav ne "" ) { # are already attached to the project
|
|
if ( $ctdebug ne "" ) {
|
|
print STDERR "am already attached\n" ;
|
|
}
|
|
local( $prevspec ) = &CTAttachResolve( $_[0], $prevflav ) ;
|
|
local( $prevroot ) = &CTAttachComputeRoot( $_[0], $prevspec ) ;
|
|
local( $root ) = &CTAttachComputeRoot( $_[0], $_[1] ) ;
|
|
local( $loop ) ;
|
|
local( $item ) ;
|
|
local( @splitlist ) ;
|
|
local( $modsave ) ;
|
|
foreach $item ( keys %envmod ) {
|
|
if ( $ENV{$item} ne "" ) {
|
|
if ( $ctdebug ne "" ) {
|
|
print STDERR "'$item' is already in the environment\n" ;
|
|
}
|
|
if ( $item eq "CTPROJS" ) {
|
|
local( $prevmark ) = $proj . ":" . $prevflav ;
|
|
local( $curmark ) = $envmod{$item} ;
|
|
if ( $ctdebug ne "" ) {
|
|
print STDERR "changing '$prevmark' to '$curmark' yielding " ;
|
|
}
|
|
if ( ! $gotenv{$item} ) {
|
|
$envset{$item} = $ENV{$item} ;
|
|
}
|
|
$envset{$item} =~ s/$prevmark/$curmark/ ;
|
|
if ( $ctdebug ne "" ) {
|
|
print STDERR "'$envset{$item}'\n" ;
|
|
}
|
|
delete $envmod{$item} ;
|
|
} else {
|
|
local( $src ) ;
|
|
if ( $gotenv{$item} ) {
|
|
$src = $envset{$item} ;
|
|
} else {
|
|
$src = $ENV{$item} ;
|
|
}
|
|
if ( $envsep{$item} ne "" ) {
|
|
@splitlist = split( $envsep{$item}, $src ) ;
|
|
} else {
|
|
@splitlist = split( / +/, $src ) ;
|
|
}
|
|
$modsave = $envmod{$item} ;
|
|
delete $envmod{$item} ;
|
|
foreach $loop ( @splitlist ) {
|
|
$loop =~ s/$prevroot/$root/ ;
|
|
&CTAttachPostpendMod( $item, $loop ) ;
|
|
}
|
|
if ( $ctdebug ne "" ) {
|
|
print STDERR "env '$src' -> '$envmod{$item}'\n" ;
|
|
}
|
|
@splitlist = split( / +/, $modsave ) ;
|
|
foreach $loop ( @splitlist ) {
|
|
if ( ! (( $envmod{$item} eq $loop ) ||
|
|
( $envmod{$item} =~ /^$loop / ) ||
|
|
( $envmod{$item} =~ / $loop$/ ) ||
|
|
( $envmod{$item} =~ / $loop / ))) {
|
|
&CTAttachAddToMod( $item, $loop ) ;
|
|
}
|
|
}
|
|
if ( $ctdebug ne "" ) {
|
|
print STDERR "env final = '$envmod{$item}'\n" ;
|
|
}
|
|
}
|
|
}
|
|
if ( $envmod{$item} ne "" ) {
|
|
$envset{$item} = $envmod{$item} ;
|
|
if ( $envsep{$item} ne "" ) {
|
|
$envset{$item} =~ s/ /$envsep{$item}/g ;
|
|
}
|
|
# &CTAttachMergeToSet( $envmod{$item}, $item ) ;
|
|
delete $envmod{$item} ;
|
|
$gotenv{$item} = 1 ;
|
|
}
|
|
}
|
|
} else { # not already attached. mods -> sets
|
|
if ( $ctdebug ne "" ) {
|
|
print STDERR "am not already attached\n" ;
|
|
}
|
|
local( $item ) ;
|
|
local( $loop ) ;
|
|
local( $modsave ) ;
|
|
local( @splitlist ) ;
|
|
foreach $item ( keys %envmod ) {
|
|
if ( $ENV{$item} ne "" ) {
|
|
local( $src ) ;
|
|
if ( $gotenv{$item} ) {
|
|
$src = $envset{$item} ;
|
|
} else {
|
|
$src = $ENV{$item} ;
|
|
}
|
|
if ( $envsep{$item} ne "" ) {
|
|
@splitlist = split( $envsep{$item}, $src ) ;
|
|
} else {
|
|
@splitlist = split( / +/, $src ) ;
|
|
}
|
|
$modsave = $envmod{$item} ;
|
|
delete $envmod{$item} ;
|
|
foreach $loop ( @splitlist ) {
|
|
&CTAttachPostpendMod( $item, $loop ) ;
|
|
}
|
|
if ( $ctdebug ne "" ) {
|
|
print STDERR "env '$src' -> '$envmod{$item}'\n" ;
|
|
}
|
|
@splitlist = split( / +/, $modsave ) ;
|
|
foreach $loop ( @splitlist ) {
|
|
if ( ! (( $envmod{$item} eq $loop ) ||
|
|
( $envmod{$item} =~ /^$loop / ) ||
|
|
( $envmod{$item} =~ / $loop$/ ) ||
|
|
( $envmod{$item} =~ / $loop / ))) {
|
|
&CTAttachAddToMod( $item, $loop ) ;
|
|
}
|
|
}
|
|
if ( $ctdebug ne "" ) {
|
|
print STDERR "env final = '$envmod{$item}'\n" ;
|
|
}
|
|
}
|
|
$envset{$item} = $envmod{$item} ;
|
|
if ( $envsep{$item} ne "" ) {
|
|
$envset{$item} =~ s/ /$envsep{$item}/g ;
|
|
}
|
|
# &CTAttachMergeToSet( $envmod{$item}, $item ) ;
|
|
delete $envmod{$item} ;
|
|
$gotenv{$item} = 1 ;
|
|
}
|
|
}
|
|
if ($ctdebug) {
|
|
print STDERR "out of CTAttachCheckVars\n" ;
|
|
}
|
|
}
|
|
|
|
# write a script to NOT change the environment
|
|
# Input is:
|
|
# $_[0] = filename
|
|
sub CTAttachWriteNullScript {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachWriteNullScript\n" ;
|
|
}
|
|
local( *OUTFILE ) ;
|
|
open( OUTFILE, ">$_[0]" ) ;
|
|
print OUTFILE "#!/bin/csh -f\n" ;
|
|
print OUTFILE "echo No attachment actions performed\n" ;
|
|
print OUTFILE "/sbin/rm $_[0]\n" ;
|
|
close( OUTFILE ) ;
|
|
if ($ctdebug) {
|
|
print STDERR "out of CTAtachWriteNullScript\n" ;
|
|
}
|
|
}
|
|
|
|
# write a script to setup the environment
|
|
# Input is:
|
|
# $_[0] = filename
|
|
sub CTAttachWriteScript {
|
|
if ($ctdebug) {
|
|
print STDERR "in CTAttachWriteScript\n" ;
|
|
}
|
|
local( *OUTFILE ) ;
|
|
open( OUTFILE, ">$_[0]" ) ;
|
|
print OUTFILE "#!/bin/csh -f\n" ;
|
|
local( $item ) ;
|
|
foreach $item ( keys %envset ) {
|
|
if ( $envcmd{$item} ne "" ) {
|
|
print OUTFILE $envcmd{$item} . " $item " ;
|
|
if ( $envcmd{$item} eq "set" ) {
|
|
print OUTFILE "= " ;
|
|
}
|
|
print OUTFILE $envset{$item} . "\n" ;
|
|
} else {
|
|
print OUTFILE "setenv $item \"$envset{$item}\"\n" ;
|
|
}
|
|
}
|
|
foreach $item ( keys %envmod ) {
|
|
print STDERR "SHOULD NOT BE HERE\n" ;
|
|
if ( $envcmd{$item} ne "" ) {
|
|
print OUTFILE $envcmd{$item} . " $item " ;
|
|
if ( $envcmd{$item} eq "set" ) {
|
|
print OUTFILE "= ( " ;
|
|
} else {
|
|
print OUTFILE "\"" ;
|
|
}
|
|
} else {
|
|
print OUTFILE "setenv $item \"" ;
|
|
}
|
|
if ( $envsep{$item} ne "" ) {
|
|
@itemlist = split( / +/, $envmod{$item} ) ;
|
|
foreach $tmp ( @itemlist ) {
|
|
print OUTFILE $tmp . $envsep{$item} ;
|
|
}
|
|
} else {
|
|
print OUTFILE $envmod{$item} ;
|
|
}
|
|
if ( $envcmd{$item} ne "" ) {
|
|
if ( $envcmd{$item} eq "set" ) {
|
|
print OUTFILE ")" ;
|
|
} else {
|
|
print OUTFILE "\"" ;
|
|
}
|
|
print OUTFILE "\n" ;
|
|
} else {
|
|
print OUTFILE $ENV{$item} . "\"\n" ;
|
|
}
|
|
}
|
|
if (( $envset{"CDPATH"} ne "" ) || ( $envmod{"CDPATH"} ne "" )) {
|
|
print OUTFILE "set cdpath = ( \$" . "CDPATH )\n" ;
|
|
}
|
|
foreach $item ( keys %envdo ) {
|
|
print OUTFILE $envdo{$item} . "\n" ;
|
|
}
|
|
if (! $ctdebug) {
|
|
print OUTFILE "/sbin/rm $_[0]\n" ;
|
|
} else {
|
|
print STDERR "no self-destruct script '" . $_[0] . "'\n" ;
|
|
}
|
|
close( OUTFILE ) ;
|
|
if ($ctdebug) {
|
|
print STDERR "out of CTAttachWriteScript\n" ;
|
|
}
|
|
}
|
|
|
|
1;
|