dtool: Remove 'attach'
See #244 for discussion. It's really old, hasn't been used in almost a decade, and doesn't support the current Git workflow either.
This commit is contained in:
Sam Edwards
parent
a5beccc99e
commit
c3106411f5
|
|
@ -1,33 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
if ($#ARGV != -1) {
|
||||
exit print "Usage: ctihave\n" ;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "not configured for using CTtools\n" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$projs = $ENV{"CTPROJS"} ;
|
||||
@projsplit = split( / +/, $projs ) ;
|
||||
|
||||
foreach $item ( @projsplit ) {
|
||||
@items = split( /:/, $item ) ;
|
||||
$thisproj = $items[0] ;
|
||||
$thisflav = $items[1] ;
|
||||
$thisspec = &CTResolveSpec( $thisproj, $thisflav ) ;
|
||||
$result = $result . &CTCMIHave( $thisproj, $thisflav, $thisspec ) ;
|
||||
}
|
||||
if ( $result ne "" ) {
|
||||
@splitlist = split( /\n/, $result ) ;
|
||||
foreach $item ( @splitlist ) {
|
||||
print $item . "\n" ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,150 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# acceptable forms:
|
||||
# ctattach - give usage message
|
||||
# ctattach project - attach to the personal flavor of the project
|
||||
# ctattach project flavor - attach to a specific flavor of the project
|
||||
# ctattach - - list projects that can be attached to
|
||||
# ctattach project - - list flavors of a given project
|
||||
# ctattach - flavor - list projects with a certain flavor
|
||||
# ctattach -def project flavor - attach to project, setting CTDEFAULT_FLAV
|
||||
# to flavor for the scope of this attach
|
||||
|
||||
sub CTAttachUsage {
|
||||
print STDERR "Usage: ctattach -def project flavor -or-\n" ;
|
||||
print STDERR " ctattach project [flavor] -or-\n" ;
|
||||
print STDERR " ctattach project - -or-\n" ;
|
||||
print STDERR " ctattach - [flavor]\n" ;
|
||||
&CTAttachWriteNullScript( $tmpname ) ;
|
||||
print $tmpname . "\n" ;
|
||||
exit;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "\$" . "DTOOL environment must be set to use CTtools\n" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctattch.pl" ;
|
||||
|
||||
$tmpname = "/tmp/script.$$" ;
|
||||
|
||||
if ( $#ARGV == -1 ) {
|
||||
&CTUDebug( "got no arguments\n" ) ;
|
||||
&CTAttachUsage ;
|
||||
}
|
||||
|
||||
$idx = 0 ;
|
||||
$proj = "" ;
|
||||
$flav = "" ;
|
||||
$noflav = 0 ;
|
||||
$defflav = "" ;
|
||||
$spread = 0 ;
|
||||
$anydef = 0 ;
|
||||
|
||||
#
|
||||
# parse arguemnts
|
||||
#
|
||||
|
||||
if ( $ARGV[$idx] eq "-def" ) {
|
||||
&CTUDebug( "got '-def' parameter\n" ) ;
|
||||
if ( $#ARGV < ($idx + 2) ) {
|
||||
&CTUDebug( "not enough arguments after -def\n" ) ;
|
||||
&CTAttachUsage ;
|
||||
}
|
||||
$defflav = $ARGV[$idx+2] ;
|
||||
$spread = 1;
|
||||
&CTUDebug( "spread default flavor is '$defflav'\n" ) ;
|
||||
$idx++ ;
|
||||
} else {
|
||||
if ( $ENV{"CTDEFAULT_FLAV"} ne "" ) {
|
||||
$defflav = $ENV{"CTDEFAULT_FLAV"} ;
|
||||
&CTUDebug( "environment default flavor is '$defflav'\n" ) ;
|
||||
}
|
||||
}
|
||||
|
||||
$proj = $ARGV[$idx] ;
|
||||
&CTUDebug( "project is '$proj'\n" ) ;
|
||||
|
||||
if ( $defflav eq "" ) {
|
||||
$defflav = "default" ;
|
||||
&CTUDebug( "no environmental default, using 'default'\n" ) ;
|
||||
}
|
||||
|
||||
if ( $#ARGV > $idx ) {
|
||||
$flav = $ARGV[$idx+1] ;
|
||||
&CTUDebug( "provided flavor is '$flav'\n" ) ;
|
||||
} else {
|
||||
if ( $proj ne "-" ) {
|
||||
$flav = $defflav;
|
||||
&CTUDebug( "using environment default flavor '$flav'\n" ) ;
|
||||
$noflav = 1 ;
|
||||
}
|
||||
}
|
||||
|
||||
if (( $noflav == 1 ) || ( $flav eq "default" )) {
|
||||
$anydef = 1 ;
|
||||
}
|
||||
|
||||
#
|
||||
# act on the arguments we got
|
||||
#
|
||||
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
|
||||
if (( $proj eq "-" ) || ( $flav eq "-" )) {
|
||||
if ( $#ARGV == 0 ) {
|
||||
# list projects that can be attached to
|
||||
print STDERR "Projects that can be attached to:\n" ;
|
||||
$_ = &CTListAllProjects ;
|
||||
@projlist = split ;
|
||||
foreach $item ( @projlist ) {
|
||||
print STDERR " $item\n" ;
|
||||
}
|
||||
} elsif ( $proj eq "-" ) {
|
||||
# list project that have a given flavor
|
||||
print STDERR "Projects that have a '$flav' flavor:\n" ;
|
||||
$_ = &CTListAllProjects ;
|
||||
@projlist = split ;
|
||||
foreach $item ( @projlist ) {
|
||||
$tmp = &CTResolveSpec( $item, $flav ) ;
|
||||
if ( $tmp ne "" ) {
|
||||
print STDERR " $item\n" ;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
# list flavors of a given project
|
||||
print STDERR "Flavors of project '$proj':\n" ;
|
||||
$_ = &CTListAllFlavors( $proj ) ;
|
||||
@flavlist = split ;
|
||||
foreach $item ( @flavlist ) {
|
||||
print STDERR " $item\n" ;
|
||||
}
|
||||
}
|
||||
&CTAttachWriteNullScript( $tmpname ) ;
|
||||
print $tmpname . "\n" ;
|
||||
} else {
|
||||
# output a real attachment
|
||||
$curflav = &CTQueryProj( $proj ) ;
|
||||
if (( $curflav eq "" ) || ( $noflav == 0 )) {
|
||||
$envsep{"PATH"} = ":" ;
|
||||
$envsep{"LD_LIBRARY_PATH"} = ":" ;
|
||||
$envsep{"DYLD_LIBRARY_PATH"} = ":" ;
|
||||
$envsep{"PFPATH"} = ":" ;
|
||||
$envsep{"SSPATH"} = ":" ;
|
||||
$envsep{"STKPATH"} = ":" ;
|
||||
$envsep{"DC_PATH"} = ":" ;
|
||||
$spec = &CTAttachCompute( $proj, $flav, $anydef ) ;
|
||||
if ( $spec eq "" ) {
|
||||
&CTAttachWriteNullScript( $tmpname ) ;
|
||||
print $tmpname . "\n" ;
|
||||
} else {
|
||||
&CTAttachWriteScript( $tmpname ) ;
|
||||
print $tmpname . "\n" ;
|
||||
}
|
||||
} else {
|
||||
&CTAttachWriteNullScript( $tmpname ) ;
|
||||
print $tmpname . "\n" ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,86 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
if ( $#ARGV != 5 ) {
|
||||
print STDERR "This is for internal use by attach ONLY\n" ;
|
||||
exit ;
|
||||
}
|
||||
|
||||
$root = $ARGV[0] ;
|
||||
$view = $ARGV[1] ;
|
||||
$branch = $ARGV[2] ;
|
||||
$label = $ARGV[3] ;
|
||||
$vobname = $ARGV[4] ;
|
||||
$proj = $ARGV[5] ;
|
||||
$tmpname = "/tmp/config.$$" ;
|
||||
|
||||
$emitted = 0 ;
|
||||
|
||||
$ctdebug = $ENV{"CTATTACH_DEBUG"} ;
|
||||
|
||||
if ($ctdebug) {
|
||||
print STDERR "Params:\n 0: '$root'\n 1: '$view'\n 2: '$branch'\n" ;
|
||||
print STDERR " 3: '$label'\n 4: '$vobname'\n 5: '$proj'\n" ;
|
||||
print STDERR "making branch and label types for view " . $view . "\n" ;
|
||||
print STDERR "executing: /usr/atria/bin/cleartool mkbrtype -vob /vobs/$vobname -c \"Branch type for the $view view\" $branch 2> /dev/null > /dev/null\n" ;
|
||||
print STDERR "executing: /usr/atria/bin/cleartool mklbtype -vob /vobs/$vobname -c \"Label type for the $view view\" $label 2> /dev/null > /dev/null\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" ) {
|
||||
if ($ctdebug) {
|
||||
print STDERR "case 1:\noutputting: '$_'\n" ;
|
||||
}
|
||||
print TMPFILE "$_" ;
|
||||
} elsif (( $_ =~ /^element \*/ ) && ( $_ =~ "/main/LATEST" ) &&
|
||||
!( $_ =~ /\/$proj\// )) {
|
||||
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" ;
|
||||
if ($ctdebug) {
|
||||
print STDERR "case 2:\n" ;
|
||||
print STDERR "outputting: 'element $root/... .../$branch/LATEST'\n" ;
|
||||
print STDERR "outputting: 'element $root/... $label -mkbranch $branch'\n" ;
|
||||
print STDERR "outputting: 'element $root/... /main/LATEST -mkbranch $branch'\n" ;
|
||||
}
|
||||
}
|
||||
if ($ctdebug) {
|
||||
print STDERR "case 3:\n" ;
|
||||
print STDERR "outputting: '$_'\n" ;
|
||||
}
|
||||
print TMPFILE "$_" ;
|
||||
} elsif ( $_ =~ /\/$proj\// ) {
|
||||
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" ;
|
||||
if ($ctdebug) {
|
||||
print STDERR "case 4:\n" ;
|
||||
print STDERR "outputting: 'element $root/... .../$branch/LATEST'\n" ;
|
||||
print STDERR "outputting: 'element $root/... $label -mkbranch $branch'\n" ;
|
||||
print STDERR "outputting: 'element $root/... /main/LATEST -mkbranch $branch'\n" ;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if ($ctdebug) {
|
||||
print STDERR "case 5:\n" ;
|
||||
print STDERR "outputting: '$_'\n" ;
|
||||
}
|
||||
print TMPFILE "$_" ;
|
||||
}
|
||||
}
|
||||
close( CTINTERFACE ) ;
|
||||
close( TMPFILE ) ;
|
||||
if ($ctdebug) {
|
||||
print STDERR "output to execute: '/usr/atria/bin/cleartool setcs -tag $view $tmpname ; rm $tmpname'\n" ;
|
||||
}
|
||||
system "/usr/atria/bin/cleartool setcs -tag $view $tmpname ; rm $tmpname\n" ;
|
||||
|
|
@ -1,530 +0,0 @@
|
|||
require "$tool/built/include/ctutils.pl" ;
|
||||
|
||||
$shell_type = "csh" ;
|
||||
if ( $ENV{"SHELL_TYPE"} ne "" ) {
|
||||
if ( $ENV{"SHELL_TYPE"} eq "sh" ) {
|
||||
$shell_type = "sh" ;
|
||||
}
|
||||
}
|
||||
|
||||
$docnt = 0 ;
|
||||
@attachqueue = () ;
|
||||
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
|
||||
# force set a variable in the 'new' environment
|
||||
# input is in:
|
||||
# $_[0] = variable
|
||||
# $_[1] = value
|
||||
#
|
||||
# output is in:
|
||||
# %newenv = variable marked to be set to value
|
||||
sub CTAttachSet {
|
||||
if ( ( $_[0] ne "" ) && ( $_[1] ne "" ) ) {
|
||||
&CTUDebug( "setting " . $_[0] . " to '" . $_[1] . "'\n" ) ;
|
||||
$newenv{$_[0]} = $_[1] ;
|
||||
}
|
||||
}
|
||||
|
||||
# get a variable from the environment and split it out to unified format
|
||||
# (ie: space separated)
|
||||
# input is in:
|
||||
# $_[0] = variable to get
|
||||
#
|
||||
# output is in:
|
||||
# string returned with value
|
||||
sub CTSpoolEnv {
|
||||
local( $ret ) = $ENV{$_[0]} ;
|
||||
if ( $envsep{$_[0]} ne "" ) {
|
||||
local( @splitlist ) = split( $envsep{$_[0]}, $ret );
|
||||
$ret = join( " ", @splitlist ) ;
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# modify a possibly existing variable to have a value in the 'new' environment
|
||||
# input is in:
|
||||
# $_[0] = variable
|
||||
# $_[1] = value
|
||||
# $_[2] = root
|
||||
# $_[3] = project
|
||||
#
|
||||
# output is in:
|
||||
# %newenv = variable adjusted to have the new value
|
||||
sub CTAttachMod {
|
||||
&CTUDebug( "in CTAttachMod\n" ) ;
|
||||
if ( $_[0] eq "CTPROJS" ) {
|
||||
# as part of the system, this one is special
|
||||
&CTUDebug( "doing a mod on $CTPROJS\n" ) ;
|
||||
if ( $newenv{$_[0]} eq "" ) {
|
||||
$newenv{$_[0]} = $ENV{$_[0]} ;
|
||||
}
|
||||
local( $proj ) = $_[3] ;
|
||||
$proj =~ tr/A-Z/a-z/ ;
|
||||
local( $curflav ) = &CTQueryProj( $proj ) ;
|
||||
if ( $curflav ne "" ) {
|
||||
local( $tmp ) = $_[3] . ":" . $curflav ;
|
||||
if ( $newenv{$_[0]} =~ /$tmp/ ) {
|
||||
local( $hold ) = $newenv{$_[0]} ;
|
||||
$hold =~ s/$tmp/$_[1]/ ;
|
||||
&CTUDebug( "already attached to " . $_[3] . " changing '" .
|
||||
$tmp . "' to '" . $_[1] . "' yielding '" . $hold .
|
||||
"'\n" ) ;
|
||||
$newenv{$_[0]} = $hold ;
|
||||
} else {
|
||||
&CTUDebug( "prepending '" . $_[1] . "' to CTPROJS\n" ) ;
|
||||
$newenv{$_[0]} = $_[1] . " " . $newenv{$_[0]} ;
|
||||
}
|
||||
} else {
|
||||
&CTUDebug( "writing '" . $_[1] . "' to CTPROJS\n" ) ;
|
||||
if ( $newenv{$_[0]} eq "" ) {
|
||||
$newenv{$_[0]} = $_[1] ;
|
||||
} else {
|
||||
$newenv{$_[0]} = $_[1] . " " . $newenv{$_[0]} ;
|
||||
}
|
||||
}
|
||||
} elsif ( ( $_[0] ne "" ) && ( $_[1] ne "" ) ) {
|
||||
local( $dosimple ) = 0 ;
|
||||
if ( $newenv{$_[0]} eq "" ) {
|
||||
# not in our 'new' environment yet, add it.
|
||||
# may still be empty
|
||||
$newenv{$_[0]} = &CTSpoolEnv( $_[0] ) ;
|
||||
}
|
||||
if ( ! ( $newenv{$_[0]} =~ /$_[1]/ )) {
|
||||
&CTUDebug( "'" . $_[1] . "' exists in " . $_[0] .
|
||||
" testing for simple modification\n" ) ;
|
||||
# if it's in there already, we're done before we started.
|
||||
if ( $_[1] =~ /^$_[2]/ ) {
|
||||
&CTUDebug( "new value contains root '" . $_[2] .
|
||||
"', may not be able to do simple edit\n" ) ;
|
||||
# damn, might need to do an in-place edit
|
||||
local( $curroot ) = $ENV{$_[3]} ;
|
||||
&CTUDebug( "current root for '" . $_[3] . "' is '" .
|
||||
$curroot . "'\n" ) ;
|
||||
if ( $curroot eq "" ) {
|
||||
&CTUDebug( "can do simple edit\n" ) ;
|
||||
$dosimple = 1 ;
|
||||
} else {
|
||||
local( $test ) = $_[1] ;
|
||||
$test =~ s/^$_[2]// ;
|
||||
$test = $curroot . $test ;
|
||||
if ( $newenv{$_[0]} =~ /$test/ ) {
|
||||
# there it is. in-place edit
|
||||
local( $foo ) = $newenv{$_[0]} ;
|
||||
$foo =~ s/$test/$_[1]/ ;
|
||||
&CTUDebug( "doing in-place edit on " . $_[0] .
|
||||
" changing '" . $test . "' to '" .
|
||||
$_[1] . "' yielding '" . $foo . "'\n" ) ;
|
||||
$newenv{$_[0]} = $foo ;
|
||||
} else {
|
||||
&CTUDebug( "'" . $test . "' did not appear in $_[0]." .
|
||||
" Simple edit\n" ) ;
|
||||
$dosimple = 1 ;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
&CTUDebug( "new value does not contain root '" . $_[2] .
|
||||
"', can do simple edit\n" ) ;
|
||||
# don't have to sweat in-place edits
|
||||
$dosimple = 1 ;
|
||||
}
|
||||
}
|
||||
if ( $dosimple ) {
|
||||
if ( $newenv{$_[0]} eq "" ) {
|
||||
&CTUDebug( "no pre-existing value in " . $_[0] .
|
||||
" setting it to '" . $_[1] . "'\n" ) ;
|
||||
$newenv{$_[0]} = $_[1] ;
|
||||
} elsif ( $envpostpend{$_[0]} ) {
|
||||
&CTUDebug( "post-pending '" . $_[1] . "' to " . $_[0] .
|
||||
"\n" ) ;
|
||||
$newenv{$_[0]} = $newenv{$_[0]} . " " . $_[1] ;
|
||||
} elsif ( $envpostpendexceptions{$_[0]}{$_[1]} ) {
|
||||
&CTUDebug( "post-pending (by exception) '" . $_[1] . "' to '" . $_[0] .
|
||||
"'\n" ) ;
|
||||
$newenv{$_[0]} = $newenv{$_[0]} . " " . $_[1] ;
|
||||
} else {
|
||||
&CTUDebug( "pre-pending '" . $_[1] . "' to " . $_[0] .
|
||||
"\n" ) ;
|
||||
$newenv{$_[0]} = $_[1] . " " . $newenv{$_[0]} ;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctcm.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
|
||||
# %newenv = an image of those parts of the environment we want to change
|
||||
# %envsep = seperator
|
||||
# %envcmd = set or setenv
|
||||
# %envdo = direct commands to add to attach script
|
||||
# %envpostpend = flag that variable should be postpended
|
||||
sub CTAttachCompute {
|
||||
&CTUDebug( "in CTAttachCompute\n" ) ;
|
||||
local( $done ) = 0 ;
|
||||
local( $flav ) = $_[1] ;
|
||||
local( $prevflav ) = &CTQueryProj( $_[0] ) ;
|
||||
local( $spec ) ;
|
||||
local( $root ) ;
|
||||
if ( $_[2] && ( $prevflav ne "" )) {
|
||||
# want some form of default attachment, and are already attached. Short
|
||||
# circuit.
|
||||
$done = 1 ;
|
||||
}
|
||||
|
||||
#
|
||||
# choose real flavor and find/validate root
|
||||
#
|
||||
while ( ! $done ) {
|
||||
$spec = &CTResolveSpec( $_[0], $flav ) ;
|
||||
#print STDERR "spec line '" . $spec . "' flav: '" . $flav ."'\n";
|
||||
&CTUDebug( "spec line = '$spec'\n" ) ;
|
||||
if ( $spec ne "" ) {
|
||||
$root = &CTComputeRoot( $_[0], $flav, $spec ) ;
|
||||
&CTCMSetup( $_[0], $spec, $flav ) ;
|
||||
if ( -e $root ) {
|
||||
$done = 1 ;
|
||||
}
|
||||
} else {
|
||||
print STDERR "could not resolve '" . $flav . "'\n" ;
|
||||
$done = 1 ;
|
||||
}
|
||||
if (( ! $done ) && $_[2] ) {
|
||||
if ( $flav eq "install" ) {
|
||||
# oh my! are we ever in trouble
|
||||
# want some sort of default, but couldn't get to what we wanted
|
||||
print STDERR "ctattach to install failed\n" ;
|
||||
$spec = "" ;
|
||||
$done = 1 ;
|
||||
} elsif ( $flav eq "release" ) {
|
||||
$flav = "install" ;
|
||||
} elsif ( $flav eq "ship" ) {
|
||||
$flav = "release" ;
|
||||
} else {
|
||||
$flav = "install" ;
|
||||
}
|
||||
} elsif ( ! $done ) {
|
||||
$spec = "" ;
|
||||
print STDERR "resolved '" . $flav . "' but '" . $root .
|
||||
"' does not exist\n" ;
|
||||
$done = 1 ;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# start real work
|
||||
#
|
||||
if ( $spec ne "" ) {
|
||||
local( $proj ) = $_[0] ;
|
||||
$proj =~ tr/a-z/A-Z/ ;
|
||||
local( $item ) ;
|
||||
|
||||
# we scan the .init file first because if there are needed sub-attaches
|
||||
# they must happen before the rest of our work
|
||||
local( $init ) = "$root/built/etc/$_[0].init" ;
|
||||
local( %localmod );
|
||||
local( %localset );
|
||||
local( %localsep );
|
||||
local( %localcmd );
|
||||
local( %localdo );
|
||||
local( $localdocnt ) = 0 ;
|
||||
local( %localpost );
|
||||
local( %localpostexceptions ) = () ;
|
||||
if ( -e $init ) {
|
||||
&CTUDebug( "scanning " . $_[0] . ".init\n" ) ;
|
||||
local( @linesplit ) ;
|
||||
local( $linetmp ) ;
|
||||
local( $loop ) ;
|
||||
local( $looptmp ) ;
|
||||
local( *INITFILE ) ;
|
||||
open( INITFILE, "< $init" ) ;
|
||||
while ( <INITFILE> ) {
|
||||
s/\n$// ;
|
||||
@linesplit = split( /\#/ ) ;
|
||||
$_ = $linesplit[0] ;
|
||||
if ( $_ =~ /^MODABS/ ) {
|
||||
@linesplit = split ;
|
||||
$linetmp = $linesplit[1] ;
|
||||
shift( @linesplit ) ;
|
||||
shift( @linesplit ) ;
|
||||
$linesplitjoin = join( " ", @linesplit ) ;
|
||||
if ( $linesplit[0] eq "-" ) {
|
||||
shift( @linesplit ) ;
|
||||
$linesplitjoin = join( " ", @linesplit ) ;
|
||||
$localpostexceptions{$linetmp}{$linesplitjoin} = 1 ;
|
||||
&CTUDebug( "Creating post-pend exception for '" .
|
||||
$linetmp . "':'" . $linesplitjoin . "'\n" ) ;
|
||||
}
|
||||
if ( $localmod{$linetmp} eq "" ) {
|
||||
$localmod{$linetmp} = $linesplitjoin ;
|
||||
} else {
|
||||
$localmod{$linetmp} = $localmod{$linetmp} . " " .
|
||||
$linesplitjoin ;
|
||||
}
|
||||
} elsif ( $_ =~ /^MODREL/ ) {
|
||||
@linesplit = split ;
|
||||
$linetmp = $linesplit[1] ;
|
||||
shift( @linesplit ) ;
|
||||
shift( @linesplit ) ;
|
||||
$postexception = 0 ;
|
||||
foreach $loop ( @linesplit ) {
|
||||
if ( $loop eq "-" ) {
|
||||
$postexception = 1 ;
|
||||
next ;
|
||||
}
|
||||
$looptmp = $root . "/" . &CTUShellEval($loop) ;
|
||||
if ( $postexception ) {
|
||||
$localpostexceptions{$linetmp}{$looptmp} = 1 ;
|
||||
&CTUDebug( "Creating post-pend exception for '" .
|
||||
$linetmp . "':'" . $looptmp . "'\n" ) ;
|
||||
}
|
||||
if ( -e $looptmp ) {
|
||||
if ( $localmod{$linetmp} eq "" ) {
|
||||
$localmod{$linetmp} = $looptmp ;
|
||||
} else {
|
||||
$localmod{$linetmp} = $localmod{$linetmp} . " " .
|
||||
$looptmp ;
|
||||
}
|
||||
}
|
||||
}
|
||||
} elsif ( $_ =~ /^SETABS/ ) {
|
||||
@linesplit = split ;
|
||||
$linetmp = $linesplit[1] ;
|
||||
shift( @linesplit ) ;
|
||||
shift( @linesplit ) ;
|
||||
if ( $localset{$linetmp} eq "" ) {
|
||||
$localset{$linetmp} = join( " ", @linesplit ) ;
|
||||
} else {
|
||||
$localset{$linetmp} = $localset{$linetmp} . " " .
|
||||
join( " ", @linesplit ) ;
|
||||
}
|
||||
} elsif ( $_ =~ /^SETREL/ ) {
|
||||
@linesplit = split ;
|
||||
$linetmp = $linesplit[1] ;
|
||||
shift( @linesplit ) ;
|
||||
shift( @linesplit ) ;
|
||||
foreach $loop ( @linesplit ) {
|
||||
$looptmp = $root . "/" . &CTUShellEval($loop) ;
|
||||
if ( -e $looptmp ) {
|
||||
if ( $localset{$linetmp} eq "" ) {
|
||||
$localset{$linetmp} = $looptmp ;
|
||||
} else {
|
||||
$localset{$linetmp} = $localset{$linetmp} . " " .
|
||||
$looptmp ;
|
||||
}
|
||||
}
|
||||
}
|
||||
} elsif ( $_ =~ /^SEP/ ) {
|
||||
@linesplit = split ;
|
||||
$localsep{$linesplit[1]} = $linesplit[2] ;
|
||||
} elsif ( $_ =~ /^CMD/ ) {
|
||||
@linesplit = split ;
|
||||
$localcmd{$linesplit[1]} = $linesplit[2] ;
|
||||
} elsif ( $_ =~ /^DOCSH/ ) {
|
||||
if ( $shell_type ne "sh" ) {
|
||||
@linesplit = split ;
|
||||
shift( @linesplit ) ;
|
||||
$localdo{$localdocnt} = join( " ", @linesplit ) ;
|
||||
$localdocnt++ ;
|
||||
}
|
||||
} elsif ( $_ =~ /^DOSH/ ) {
|
||||
if ( $shell_type eq "sh" ) {
|
||||
@linesplit = split ;
|
||||
shift( @linesplit ) ;
|
||||
$localdo{$localdocnt} = join( " ", @linesplit ) ;
|
||||
$localdocnt++ ;
|
||||
}
|
||||
} elsif ( $_ =~ /^DO/ ) {
|
||||
@linesplit = split ;
|
||||
shift( @linesplit ) ;
|
||||
$localdo{$localdocnt} = join( " ", @linesplit ) ;
|
||||
$localdocnt++ ;
|
||||
} elsif ( $_ =~ /^POSTPEND/ ) {
|
||||
@linesplit = split ;
|
||||
$localpost{$linesplit[1]} = 1 ;
|
||||
} elsif ( $_ =~ /^ATTACH/ ) {
|
||||
@linesplit = split ;
|
||||
shift( @linesplit ) ;
|
||||
foreach $loop ( @linesplit ) {
|
||||
push( @attachqueue, $loop ) ;
|
||||
}
|
||||
} elsif ( $_ ne "" ) {
|
||||
print STDERR "Unknown .init directive '$_'\n" ;
|
||||
}
|
||||
}
|
||||
close( INITFILE ) ;
|
||||
}
|
||||
|
||||
# now handle sub-attaches
|
||||
&CTUDebug( "performing sub-attaches\n" ) ;
|
||||
while ( @attachqueue != () ) {
|
||||
$item = shift( @attachqueue ) ;
|
||||
&CTUDebug( "attaching to " . $item . "\n" ) ;
|
||||
&CTAttachCompute( $item, $defflav, 1 ) ;
|
||||
}
|
||||
|
||||
# now we will do our extentions, then apply the mods from the .init
|
||||
# file, if any
|
||||
&CTUDebug( "extending paths\n" ) ;
|
||||
local( $type ) = &CTSpecType( $spec ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
&CTAttachMod( "PATH", "/usr/atria/bin", $root, $proj ) ;
|
||||
}
|
||||
|
||||
# For now, we will not check whether the various /bin, /lib,
|
||||
# /inc directories exist before adding them to the paths. This
|
||||
# helps when attaching to unitialized trees that do not have
|
||||
# these directories yet (but will shortly).
|
||||
|
||||
# However, we *will* filter out any trees whose name ends in
|
||||
# "MODELS". These don't have subdirectories that we care about
|
||||
# in the normal sense.
|
||||
if ( ! ( $proj =~ /MODELS$/ ) ) {
|
||||
|
||||
$item = $root . "/built/bin" ;
|
||||
#if ( -e $item ) {
|
||||
&CTAttachMod( "PATH", $item, $root, $proj ) ;
|
||||
#}
|
||||
|
||||
$item = $root . "/built/lib" ;
|
||||
#if ( -e $item ) {
|
||||
&CTAttachMod( "PATH", $item, $root, $proj ) ;
|
||||
&CTAttachMod( "LD_LIBRARY_PATH", $item, $root, $proj ) ;
|
||||
&CTAttachMod( "DYLD_LIBRARY_PATH", $item, $root, $proj ) ;
|
||||
#}
|
||||
|
||||
$item = $root . "/built/include" ;
|
||||
#if ( -e $item ) {
|
||||
&CTAttachMod( "CT_INCLUDE_PATH", $item, $root, $proj ) ;
|
||||
#}
|
||||
|
||||
$item = $root . "/built/etc" ;
|
||||
#if ( -e $item ) {
|
||||
&CTAttachMod( "ETC_PATH", $item, $root, $proj ) ;
|
||||
#}
|
||||
}
|
||||
|
||||
&CTAttachMod( "CTPROJS", $proj . ":" . $flav, $root, $proj ) ;
|
||||
&CTAttachSet( $proj, $root ) ;
|
||||
|
||||
# run thru the stuff saved up from the .init file
|
||||
foreach $item ( keys %localsep ) {
|
||||
$envsep{$item} = $localsep{$item} ;
|
||||
}
|
||||
foreach $item ( keys %localpost ) {
|
||||
$envpostpend{$item} = $localpost{$item} ;
|
||||
}
|
||||
%envpostpendexceptions = %localpostexceptions;
|
||||
foreach $item ( keys %localmod ) {
|
||||
local( @splitthis ) = split( / +/, $localmod{$item} ) ;
|
||||
local( $thing ) ;
|
||||
foreach $thing ( @splitthis ) {
|
||||
&CTAttachMod( $item, $thing, $root, $proj ) ;
|
||||
}
|
||||
}
|
||||
foreach $item ( keys %localset ) {
|
||||
&CTAttachSet( $item, $localset{$item} ) ;
|
||||
}
|
||||
foreach $item ( keys %localcmd ) {
|
||||
$envcmd{$item} = $localcmd{$item} ;
|
||||
}
|
||||
for ($item = 0; $item < $localdocnt; $item++) {
|
||||
$envdo{$docnt} = $localdo{$item} ;
|
||||
$docnt++ ;
|
||||
}
|
||||
%envpostpendexceptions = () ;
|
||||
}
|
||||
|
||||
&CTUDebug( "out of CTAttachCompute\n" ) ;
|
||||
$spec ;
|
||||
}
|
||||
|
||||
# write a script to NOT change the environment
|
||||
# Input is:
|
||||
# $_[0] = filename
|
||||
sub CTAttachWriteNullScript {
|
||||
&CTUDebug( "in CTAttachWriteNullScript\n" ) ;
|
||||
local( *OUTFILE ) ;
|
||||
open( OUTFILE, ">$_[0]" ) ;
|
||||
print OUTFILE "#!/bin/" . $shell_type . " -f\n" ;
|
||||
print OUTFILE "echo No attachment actions performed\n" ;
|
||||
print OUTFILE "rm -f $_[0]\n" ;
|
||||
close( OUTFILE ) ;
|
||||
&CTUDebug( "out of CTAtachWriteNullScript\n" ) ;
|
||||
}
|
||||
|
||||
# write a script to setup the environment
|
||||
# Input is:
|
||||
# $_[0] = filename
|
||||
sub CTAttachWriteScript {
|
||||
&CTUDebug( "in CTAttachWriteScript\n" ) ;
|
||||
local( *OUTFILE ) ;
|
||||
open( OUTFILE, ">$_[0]" ) ;
|
||||
print OUTFILE "#!/bin/" . $shell_type . " -f\n" ;
|
||||
local( $item ) ;
|
||||
|
||||
foreach $item ( keys %newenv ) {
|
||||
local( $sep ) = " " ;
|
||||
if ( $envsep{$item} ne "" ) {
|
||||
$sep = $envsep{$item} ;
|
||||
}
|
||||
local( @splitlist ) = split( / +/, $newenv{$item} ) ;
|
||||
local( $outval ) = join( $sep, @splitlist ) ;
|
||||
|
||||
if ( $shell_type eq "sh" ) {
|
||||
print OUTFILE "$item=\"" . $outval . "\"\n" ;
|
||||
if ( $envcmd{$item} ne "set" ) {
|
||||
print OUTFILE "export $item\n" ;
|
||||
}
|
||||
} else {
|
||||
if ( $envcmd{$item} ne "" ) {
|
||||
print OUTFILE $envcmd{$item} . " $item " ;
|
||||
if ( $envcmd{$item} eq "set" ) {
|
||||
print OUTFILE "= ( " ;
|
||||
}
|
||||
print OUTFILE $outval ;
|
||||
if ( $envcmd{$item} eq "set" ) {
|
||||
print OUTFILE ")" ;
|
||||
}
|
||||
print OUTFILE "\n" ;
|
||||
} else {
|
||||
print OUTFILE "setenv $item \"$outval\"\n" ;
|
||||
if ( $ctdebug ) {
|
||||
print OUTFILE "echo setting " . $item . " to '" . $outval . "'\n" ;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#if ( $newenv{"CDPATH"} ne "" ) {
|
||||
# if ( $shell_type ne "sh" ) {
|
||||
# print OUTFILE "set cdpath = ( \$" . "CDPATH )\n" ;
|
||||
# if ( $ctdebug ) {
|
||||
# print OUTFILE "echo assigning cdpath\n" ;
|
||||
# }
|
||||
# }
|
||||
#}
|
||||
for ($item = 0; $item < $docnt; $item++) {
|
||||
print OUTFILE $envdo{$item} . "\n" ;
|
||||
if ( $ctdebug ) {
|
||||
print OUTFILE "echo doing '" . $envdo{$item} . "'\n" ;
|
||||
}
|
||||
}
|
||||
if (! $ctdebug) {
|
||||
print OUTFILE "rm -f $_[0]\n" ;
|
||||
} else {
|
||||
print OUTFILE "echo end of script $_[0]\n" ;
|
||||
print STDERR "no self-destruct script '" . $_[0] . "'\n" ;
|
||||
}
|
||||
close( OUTFILE ) ;
|
||||
&CTUDebug( "out of CTAttachWriteScript\n" ) ;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,954 +0,0 @@
|
|||
require "$tool/built/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/built/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( "DYLD_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;
|
||||
|
|
@ -1,430 +0,0 @@
|
|||
# given the config line, determine the view name
|
||||
# $_[0] = config line
|
||||
# $_[1] = flavor
|
||||
# $_[2] = project
|
||||
sub CTAttachComputeView {
|
||||
&CTUDebug( "in CTAttachComputeView\n" ) ;
|
||||
local( $ret ) = &CTResolveSpecName( $_[2], $_[1] ) ;
|
||||
local( $options ) = &CTSpecOptions( $_[0] ) ;
|
||||
if ( $options ne "" ) {
|
||||
local( $name ) = &CTSpecFindOption( $options, "name" ) ;
|
||||
if ( $name ne "" ) {
|
||||
&CTUDebug( "found a name '" . $name . "'\n" ) ;
|
||||
$ret = $name ;
|
||||
} else {
|
||||
&CTUDebug( "no name option found, going with default\n" ) ;
|
||||
}
|
||||
}
|
||||
&CTUDebug( "config line '" . $_[0] . "' yields view name '" . $ret .
|
||||
"'\n" . "out of CTAttachComputeView\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# given the config line, determine the branch name
|
||||
# $_[0] = config line
|
||||
# $_[1] = flavor
|
||||
# $_[2] = project
|
||||
sub CTAttachComputeBranch {
|
||||
&CTUDebug( "in CTAttachComputeBranch\n" ) ;
|
||||
local( $ret ) = &CTAttachComputeView( $_[0], $_[1], $_[2] ) ;
|
||||
&CTUDebug( "config line '" . $_[0] . "' yields branch name '" . $ret .
|
||||
"'\n" . "out of CTAttachComputeBranch\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# given the config line, determine the label name
|
||||
# $_[0] = config line
|
||||
# $_[1] = flavor
|
||||
# $_[2] = project
|
||||
sub CTAttachComputeLabel {
|
||||
&CTUDebug( "in CTAttachComputeLabel\n" ) ;
|
||||
local( $ret ) = &CTAttachComputeView( $_[0], $_[1], $_[2] ) ;
|
||||
$ret =~ tr/a-z/A-Z/ ;
|
||||
&CTUDebug( "config line '" . $_[0] . "' yields label name '" . $ret .
|
||||
"'\n" . "out of CTAttachComputeLabel\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
|
||||
# $_[2] = flavor
|
||||
sub CTAttachComputeElemRoot {
|
||||
&CTUDebug( "in CTAttachComputeElemRoot\n" ) ;
|
||||
local( $ret ) = "/vobs/$_[0]" ;
|
||||
&CTUDebug( "out of CTAttachComputeElemRoot\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# do whatever setup is needed for ClearCase
|
||||
# input is in:
|
||||
# $_[0] = project
|
||||
# $_[1] = $spec
|
||||
# $_[2] = flavor
|
||||
sub CTAttachCCSetup {
|
||||
&CTUDebug( "in CTAttachCCSetup\n" ) ;
|
||||
local( $root ) = &CTAttachComputeElemRoot( $_[0], $_[1], $_[2] ) ;
|
||||
local( $view ) = &CTAttachComputeView( $_[1], $_[2], $_[0] ) ;
|
||||
local( $branch ) = &CTAttachComputeBranch( $_[1], $_[2], $_[0] ) ;
|
||||
local( $label ) = &CTAttachComputeLabel( $_[1], $_[2], $_[0] ) ;
|
||||
local( *CTINTERFACE ) ;
|
||||
local( *TMPFILE ) ;
|
||||
local( $tmpname ) = "/tmp/config.$$" ;
|
||||
local( $emitted ) = 0 ;
|
||||
|
||||
&CTUDebug( "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
|
||||
&CTUDebug( "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
|
||||
&CTUDebug( "starting view '" . $view . "'\n" ) ;
|
||||
system "/usr/atria/bin/cleartool startview $view 2> /dev/null > /dev/null &\n" ;
|
||||
}
|
||||
|
||||
&CTUDebug( "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" ;
|
||||
|
||||
&CTUDebug( "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 -f $tmpname &\n" ;
|
||||
&CTUDebug( "out of CTAttachCCSetup\n" ) ;
|
||||
}
|
||||
|
||||
# do whatever setup is needed for ClearCase, but do it in the background
|
||||
# input is in:
|
||||
# $_[0] = project
|
||||
# $_[1] = $spec
|
||||
# $_[2] = flavor
|
||||
sub CTAttachCCSetupBG {
|
||||
&CTUDebug( "in CTAttachCCSetupBG\n" ) ;
|
||||
local( $root ) = &CTAttachComputeElemRoot( $_[0], $_[1], $_[2] ) ;
|
||||
local( $view ) = &CTAttachComputeView( $_[1], $_[2], $_[0] ) ;
|
||||
local( $branch ) = &CTAttachComputeBranch( $_[1], $_[2], $_[0] ) ;
|
||||
local( $label ) = &CTAttachComputeLabel( $_[1], $_[2], $_[0] ) ;
|
||||
|
||||
system "$tool/bin/ctattachcc $root $view $branch $label $vobname $_[0]\n" ;
|
||||
|
||||
&CTUDebug( "out of CTAttachCCSetupBG\n" ) ;
|
||||
}
|
||||
|
||||
# given a possibly empty string, format it into a comment or -nc
|
||||
# input is in:
|
||||
# $_[0] = possible comment string
|
||||
#
|
||||
# output is:
|
||||
# string for use by ClearCase functions
|
||||
sub CTCcaseFormatComment {
|
||||
local( $ret ) = "" ;
|
||||
if ( $_[0] eq "" ) {
|
||||
$ret = "-nc" ;
|
||||
} else {
|
||||
$ret = "-c \"" . $_[0] . "\"" ;
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# make a versioned directory
|
||||
# input is in:
|
||||
# $_[0] = directory to create
|
||||
# $_[1] = curr dir
|
||||
# $_[2] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCcaseMkdir {
|
||||
&CTUDebug( "in CTCcaseMkdir\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $dir ) = $_[0] ;
|
||||
if ( ! ( $dir =~ /^\// )) {
|
||||
$dir = $_[1] . "/" . $dir ;
|
||||
}
|
||||
local( $comment) = &CTCcaseFormatComment( $_[2] ) ;
|
||||
# first we have to check out the parent directory
|
||||
local( @alist ) = split( /\//, $dir ) ;
|
||||
pop( @alist ) ;
|
||||
local( $parent ) = join( "/", @alist ) ;
|
||||
&CTUDebug( "parent directory of '" . $dir . "' is '" . $parent . "'\n" ) ;
|
||||
$ret = system( "cleartool co -nc $parent\n" ) ;
|
||||
if ( $ret == 0 ) {
|
||||
# now make the dir
|
||||
$ret = &CTURetCode( system( "cleartool mkdir " . $comment .
|
||||
" $dir\n" )) ;
|
||||
} else {
|
||||
$ret = 0 ;
|
||||
}
|
||||
&CTUDebug( "out of CTCcaseMkdir\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# make a versioned element
|
||||
# input is in:
|
||||
# $_[0] = element to version
|
||||
# $_[1] = curr dir
|
||||
# $_[2] = possible comment
|
||||
# $_[3] = possible eltype
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCcaseMkelem {
|
||||
&CTUDebug( "in CTCcaseMkelem\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $elem ) = $_[0] ;
|
||||
if ( ! ( $elem =~ /^\// )) {
|
||||
$elem = $_[1] . "/" . $elem ;
|
||||
}
|
||||
local( $comment) = &CTCcaseFormatComment( $_[2] ) ;
|
||||
local( $eltype ) = $_[3] ;
|
||||
if ( $eltype ne "" ) {
|
||||
$eltype = "-eltype " . $eltype ;
|
||||
}
|
||||
# first we have to check out the parent directory
|
||||
local( @alist ) = split( /\//, $elem ) ;
|
||||
pop( @alist ) ;
|
||||
local( $parent ) = join( "/", @alist ) ;
|
||||
&CTUDebug( "parent directory of '" . $elem . "' is '" . $parent . "'\n" ) ;
|
||||
$ret = system( "cleartool co -nc $parent\n" ) ;
|
||||
if ( $ret != 0 ) {
|
||||
&CTUDebug( "checking out the dirctory gave return code: " . $ret .
|
||||
"\n" ) ;
|
||||
$ret = 0 ;
|
||||
}
|
||||
# now make the elem
|
||||
$ret = &CTURetCode( system( "cleartool mkelem " . $comment . " " .
|
||||
$eltype . " $elem\n" )) ;
|
||||
&CTUDebug( "out of CTCcaseMkelem\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# done here so there will be coherence if multiple deltas are done
|
||||
require "ctime.pl" ;
|
||||
$timestamp = &ctime(time) ;
|
||||
$timestamp =~ s/\n$// ;
|
||||
@timelist = split( /\s+/, $timestamp ) ;
|
||||
$timestamp = $timelist[2] . $timelist[1] . $timelist[5] . "_" . $timelist[3] ;
|
||||
$timestamp =~ s/:/_/g ;
|
||||
|
||||
# delta an element
|
||||
# input is in:
|
||||
# $_[0] = element to delta
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCcaseDelta {
|
||||
require "$tool/built/include/ctdelta.pl" ;
|
||||
|
||||
&CTUDebug( "in CTCcaseDelta\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# this is ripped from the old ctdelta script
|
||||
&CTDeltaCheckin( $_[0] ) ;
|
||||
local( $ver ) = &CTDeltaGetVersion( $_[0] ) ;
|
||||
&CTUDebug( "got version '" . $ver . "'\n" ) ;
|
||||
if ( &CTDeltaOk( $ver )) {
|
||||
local( @verlist ) = split( /\//, $ver ) ;
|
||||
pop( @verlist ) ;
|
||||
pop( @verlist ) ;
|
||||
local( $ver2 ) = join( "/", @verlist ) ;
|
||||
&CTUDebug( "ver2 = '" . $ver2 . "'\n" ) ;
|
||||
&CTDeltaSafeMerge( $_[0], $ver, $ver2 ) ;
|
||||
system "cleartool checkin -nc $_[0] 2> /dev/null > /dev/null" ;
|
||||
&CTUDebug( "merge complete, doing branch check\n" ) ;
|
||||
&CTDeltaBranchCheck( $_[0], $ver, $timestamp ) ;
|
||||
&CTUDebug( "logging potentially felonious activity for future" .
|
||||
" incrimination\n" ) ;
|
||||
&CTDeltaLog( $_[0], $ver, $ver2 ) ;
|
||||
# better detection needs to be done
|
||||
$ret = 1 ;
|
||||
} else {
|
||||
&CTUDebug( "cannot merge '" . $_[0] . "', no branches.\n" ) ;
|
||||
}
|
||||
&CTUDebug( "out of CTCcaseDelta\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# checkout an element
|
||||
# input is in:
|
||||
# $_[0] = element to checkout
|
||||
# $_[1] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCcaseCheckout {
|
||||
&CTUDebug( "in CTCcaseCheckout\n" ) ;
|
||||
local( $comment) = &CTCcaseFormatComment( $_[1] ) ;
|
||||
local( $ret ) = &CTURetCode( system( "cleartool co " . $comment .
|
||||
" $_[0]\n" )) ;
|
||||
&CTUDebug( "out of CTCcaseCheckout\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# checkin an element
|
||||
# input is in:
|
||||
# $_[0] = element to checkin
|
||||
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCcaseCheckin {
|
||||
&CTUDebug( "in CTCcaseCheckin\n" ) ;
|
||||
local( $comment) = &CTCcaseFormatComment( $_[1] ) ;
|
||||
local( $ret ) = &CTURetCode( system( "cleartool ci " . $comment .
|
||||
" $_[0]\n" )) ;
|
||||
&CTUDebug( "out of CTCcaseCheckin\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# uncheckout an element
|
||||
# input is in:
|
||||
# $_[0] = element to uncheckout
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCcaseUncheckout {
|
||||
require "$tool/built/include/unco.pl" ;
|
||||
&CTUDebug( "in CTCcaseUncheckout\n" ) ;
|
||||
local( $ret ) = 1 ;
|
||||
# need better error checking on this
|
||||
system( "cleartool unco -rm $_[0]\n" ) ;
|
||||
&CTUncoDoIt( $_[0] ) ;
|
||||
&CTUDebug( "out of CTCcaseUncheckout\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# figure out what all I have checked out or on my branch
|
||||
# input is in:
|
||||
# $_[0] = project
|
||||
# $_[1] = flavor
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return a \n serperated list of elements checked out
|
||||
sub CTCcaseIHave {
|
||||
&CTUDebug( "in CTCcaseIHave\n" ) ;
|
||||
local( $ret ) = "" ;
|
||||
local( $branch ) = &CTAttachComputeBranch( $_[2], $_[1], $_[0] ) ;
|
||||
local( $root ) = &CTProjRoot( $_[0] ) ;
|
||||
local( *OUTPUT ) ;
|
||||
open( OUTPUT, "cleartool find " . $root . " -element \"brtype(" .
|
||||
$branch . ")\" -nxn -print |" ) ;
|
||||
while ( <OUTPUT> ) {
|
||||
$ret = $ret . $_ ;
|
||||
}
|
||||
close( OUTPUT ) ;
|
||||
&CTUDebug( "out of CTCcaseIHave\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# remove a versioned element
|
||||
# input is in:
|
||||
# $_[0] = element to remove
|
||||
# $_[1] = curr dir
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCcaseRmElem {
|
||||
&CTUDebug( "in CTCcaseRmElem\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $elem ) = $_[0] ;
|
||||
if ( ! ( $elem =~ /^\// )) {
|
||||
$elem = $_[1] . "/" . $elem ;
|
||||
}
|
||||
# first we have to check out the parent directory
|
||||
local( @alist ) = split( /\//, $elem ) ;
|
||||
pop( @alist ) ;
|
||||
local( $parent ) = join( "/", @alist ) ;
|
||||
&CTUDebug( "parent directory of '" . $elem . "' is '" . $parent . "'\n" ) ;
|
||||
$ret = system( "cleartool co -nc $parent\n" ) ;
|
||||
if ( $ret == 0 ) {
|
||||
# now nuke the element
|
||||
$ret = &CTURetCode( system( "cleartool rmname $elem\n" )) ;
|
||||
} else {
|
||||
$ret = 0 ;
|
||||
}
|
||||
&CTUDebug( "out of CTCcaseRmElem\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# mv a versioned element from one name to another
|
||||
# input is in:
|
||||
# $_[0] = from element
|
||||
# $_[1] = to element
|
||||
# $_[2] = current directory
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCcaseMv {
|
||||
&CTUDebug( "in CTCcaseMv\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $elem ) = $_[0] ;
|
||||
if ( ! ( $elem =~ /^\// )) {
|
||||
$elem = $_[2] . "/" . $elem ;
|
||||
}
|
||||
# first we have to check out the parent directory
|
||||
local( @alist ) = split( /\//, $elem ) ;
|
||||
pop( @alist ) ;
|
||||
local( $parent ) = join( "/", @alist ) ;
|
||||
&CTUDebug( "parent directory of '" . $elem . "' is '" . $parent . "'\n" ) ;
|
||||
local( $elem2 ) = $_[1] ;
|
||||
if ( ! ( $elem2 =~ /^\// )) {
|
||||
$elem2 = $_[2] . "/" . $elem2 ;
|
||||
}
|
||||
local( @alist ) = split( /\//, $elem2 ) ;
|
||||
pop( @alist ) ;
|
||||
local( $parent2 ) = join( "/", @alist ) ;
|
||||
&CTUDebug( "parent directory of '" . $elem2 . "' is '" . $parent2 .
|
||||
"'\n" ) ;
|
||||
system( "cleartool co -nc $parent\n" ) ;
|
||||
system( "cleartool co -nc $parent2\n" ) ;
|
||||
$ret = &CTURetCode( system( "cleartool mv $elem $elem2\n" )) ;
|
||||
&CTUDebug( "out of CTCcaseMv\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# build a list of targets
|
||||
# input is in:
|
||||
# $_[0] = targets
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCcaseMake {
|
||||
&CTUDebug( "in CTCcaseMake\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $line ) = "clearmake -C gnu " . $_[0] .
|
||||
" |& grep -v \"^clearmake: Warning: Config\"\n" ;
|
||||
&CTUDebug( "line = '" . $line . "'\n" ) ;
|
||||
$ret = &CTURetCode( system( $line )) ;
|
||||
&CTUDebug( "out of CTCcaseMake\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,70 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
sub CTCiUsage {
|
||||
print STDERR "Usage: ctci [-c \"comment\"] [-nc] element-name [...]\n" ;
|
||||
print STDERR "Options:\n" ;
|
||||
print STDERR " -c \"comment\" : provide a comment about this action\n" ;
|
||||
print STDERR " -nc : expect no comment on this action\n" ;
|
||||
exit;
|
||||
}
|
||||
|
||||
if ( $#ARGV < 0 ) {
|
||||
&CTCiUsage ;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "Environment not configured for CTtools" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$comment = "" ;
|
||||
|
||||
$skip = 0 ;
|
||||
|
||||
@files = () ;
|
||||
|
||||
foreach $item ( @ARGV ) {
|
||||
if ( $skip == 0 ) {
|
||||
if ( $item eq "-nc" ) {
|
||||
&CTUDebug( "-nc processed\n" ) ;
|
||||
} elsif ( $item eq "-c" ) {
|
||||
$skip = 1 ;
|
||||
} else {
|
||||
push( @files, $item ) ;
|
||||
&CTUDebug( "added '" . $item . "' to files to be processed\n" ) ;
|
||||
}
|
||||
} elsif ( $skip == 1 ) {
|
||||
$comment = $item ;
|
||||
&CTUDebug( "setting comment to '" . $comment . "'\n" ) ;
|
||||
$skip = 0 ;
|
||||
} else {
|
||||
&CTUDebug( "got to unknown skip value! (" . $skip . ")\n" ) ;
|
||||
$skip = 0 ;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if ($#files < 0 ) {
|
||||
&CTCiUsage ;
|
||||
}
|
||||
|
||||
$projname = &CTProj ;
|
||||
$projname =~ tr/A-Z/a-z/ ;
|
||||
$flav = &CTQueryProj( $projname ) ;
|
||||
$spec = &CTResolveSpec( $projname, $flav ) ;
|
||||
|
||||
foreach $item ( @files ) {
|
||||
if ( -e $item ) {
|
||||
if ( ! &CTCMCheckin( $item, $projname, $spec, $comment ) ) {
|
||||
print STDERR "Could not checkin '$item'\n" ;
|
||||
}
|
||||
} else {
|
||||
print STDERR "No such file '$item'.\n" ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,579 +0,0 @@
|
|||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
|
||||
# given a spec line, do the 'correct' setup for it
|
||||
# input is in:
|
||||
# $_[0] = project
|
||||
# $_[1] = spec line
|
||||
# $_[2] = flavor
|
||||
sub CTCMSetup {
|
||||
local( $type ) = &CTSpecType( $_[1] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
&CTUDebug( "running setup for an atria tree\n" ) ;
|
||||
if ( $ENV{"HAVE_ATRIA"} eq "yes" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
&CTAttachCCSetup( $_[0], $_[1], $_[2] ) ;
|
||||
} else {
|
||||
&CTUDebug( "don't HAVE_ATRIA!\n" ) ;
|
||||
}
|
||||
# if we don't have atria, and it's a vroot, well..
|
||||
} elsif ( $type eq "croot" ) {
|
||||
&CTUDebug( "running setup for CVS\n" ) ;
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
local( $serve ) = &CTCvsServerLine( $_[0], $_[1] ) ;
|
||||
local( $thing ) = &CTCvsLogin( $serve ) ;
|
||||
if ( ! $thing ) {
|
||||
print STDERR "CVS login failed given server line '" . $serve .
|
||||
"'\n" ;
|
||||
}
|
||||
}
|
||||
# no other types have any work that needs to be done at this time
|
||||
}
|
||||
|
||||
# given a directory, make sure it's versioned
|
||||
# input is in:
|
||||
# $_[0] = directory
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
# $_[3] = comment (optional, "" if none)
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCMMkdir {
|
||||
&CTUDebug( "in CTCMMkdir\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# first check that the directory is in the project, and is not the root
|
||||
local( $flav ) = &CTQueryProj( $_[1] ) ;
|
||||
local( $root ) = &CTComputeRoot( $_[1], $flav, $_[2] ) ;
|
||||
local( $pwd ) = &CTUCurrDir() ;
|
||||
local( $isok ) = 0 ;
|
||||
if ( $_[0] =~ /^\// ) {
|
||||
# starts with a /, might not be in the project we are
|
||||
if (( $_[0] =~ /^$root/ ) && ( $_[0] ne $root )) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
} else {
|
||||
# are we sitting in the project?
|
||||
if ( $pwd =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
}
|
||||
if ( $isok ) {
|
||||
# ok, it is. Does one already exist?
|
||||
if ( -e $_[0] ) {
|
||||
# already one there, nothing to do
|
||||
&CTUDebug( "directory '" . $_[0] . "' already exists\n" ) ;
|
||||
$ret = 1 ;
|
||||
} else {
|
||||
# now switch off on how to actually do it
|
||||
local( $type ) = &CTSpecType( $_[2] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
$ret = &CTCcaseMkdir( $_[0], $pwd, $_[3] ) ;
|
||||
} elsif ( $type eq "root" ) {
|
||||
require "$tool/built/include/ctntool.pl" ;
|
||||
$ret = &CTNtoolMkdir( $_[0], $pwd, $_[3] ) ;
|
||||
} elsif ( $type eq "croot" ) {
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
$ret = &CTCvsMkdir( $_[0], $_[1], $_[2], $_[3] ) ;
|
||||
} else {
|
||||
print STDERR "CTCMMkdir::error! got invalid spec type '" .
|
||||
$type . "'\n" ;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print STDERR "directory '" . $_[0] . "' not in project '" . $_[1] .
|
||||
"' or is the root.\n" ;
|
||||
}
|
||||
&CTUDebug( "out of CTCMMkdir\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# given a file, make sure it's versioned
|
||||
# input is in:
|
||||
# $_[0] = file
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
# $_[3] = comment (optional, "" if none)
|
||||
# $_[4] = eltype (optional, "" if none)
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCMMkelem {
|
||||
&CTUDebug( "in CTCMMkelem\n" ) ;
|
||||
local( $ret ) = 0;
|
||||
# first check that the directory is in the project
|
||||
local( $flav ) = &CTQueryProj( $_[1] ) ;
|
||||
local( $root ) = &CTComputeRoot( $_[1], $flav, $_[2] ) ;
|
||||
local( $isok ) = 0 ;
|
||||
local( $pwd ) = &CTUCurrDir() ;
|
||||
# synth an eltype if there is none
|
||||
if ( ! -e $_[0] ) {
|
||||
# need it to already exist
|
||||
$isok = 0 ;
|
||||
} else {
|
||||
if ( -d $_[0] ) {
|
||||
# wrong command for a directory
|
||||
$isok = 0 ;
|
||||
} else {
|
||||
if ( $_[0] =~ /^\// ) {
|
||||
# starts with a /, might not be in the project we are
|
||||
if ( $_[0] =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
} else {
|
||||
# are we sitting in the project?
|
||||
if ( $pwd =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $isok ) {
|
||||
# now switch off on how to actually do the work
|
||||
local( $type ) = &CTSpecType( $_[2] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
$ret = &CTCcaseMkelem( $_[0], $pwd, $_[3], $_[4] ) ;
|
||||
} elsif ( $type eq "root" ) {
|
||||
require "$tool/built/include/ctntool.pl" ;
|
||||
$ret = &CTNtoolMkelem( $_[0], $pwd, $_[3], $_[4] ) ;
|
||||
} elsif ( $type eq "croot" ) {
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
$ret = &CTCvsMkelem( $_[0], $_[1], $_[2], $_[3] ) ;
|
||||
} else {
|
||||
print STDERR "CTCMMkelem::error! got invalid spec type '" .
|
||||
$type . "'\n" ;
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCMMkelem\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# given an element, delta it in
|
||||
# input is in:
|
||||
# $_[0] = element
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCMDelta {
|
||||
&CTUDebug( "in CTCMDelta\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# first check that the element is in the project
|
||||
local( $flav ) = &CTQueryProj( $_[1] ) ;
|
||||
local( $root ) = &CTComputeRoot( $_[1], $flav, $_[2] ) ;
|
||||
local( $pwd ) = &CTUCurrDir() ;
|
||||
local( $isok ) = 0 ;
|
||||
if ( ! -e $_[0] ) {
|
||||
# can't delta something that doesn't exist
|
||||
$isok = 0 ;
|
||||
} else {
|
||||
if ( $_[0] =~ /^\// ) {
|
||||
# starts with a /, might not be in the project we are
|
||||
if ( $_[0] =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
} else {
|
||||
# are we sitting in the project?
|
||||
if ( $pwd =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $isok ) {
|
||||
# now switch off on how to actually do the work
|
||||
local( $type ) = &CTSpecType( $_[2] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
$ret = &CTCcaseDelta( $_[0] ) ;
|
||||
} elsif ( $type eq "root" ) {
|
||||
require "$tool/built/include/ctntool.pl" ;
|
||||
$ret = &CTNtoolDelta( $_[0] ) ;
|
||||
} elsif ( $type eq "croot" ) {
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
$ret = &CTCvsDelta( $_[0], $_[1], $_[2] ) ;
|
||||
} else {
|
||||
print STDERR "CTCMDelta::error! got invalid spec type '" . $type .
|
||||
"'\n" ;
|
||||
}
|
||||
} else {
|
||||
&CTUDebug( "failed delta pre-checks\n" ) ;
|
||||
}
|
||||
&CTUDebug( "out of CTCMDelta\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# given an element, check it out
|
||||
# input is in:
|
||||
# $_[0] = element
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
# $_[3] = comment (optional, "" if none)
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCMCheckout {
|
||||
&CTUDebug( "in CTCMCheckout\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# first check that the element is in the project
|
||||
local( $flav ) = &CTQueryProj( $_[1] ) ;
|
||||
local( $root ) = &CTComputeRoot( $_[1], $flav, $_[2] ) ;
|
||||
local( $pwd ) = &CTUCurrDir() ;
|
||||
local( $isok ) = 0 ;
|
||||
if ( ! -e $_[0] ) {
|
||||
# can't checkout something that doesn't exist
|
||||
$isok = 0 ;
|
||||
} else {
|
||||
if ( $_[0] =~ /^\// ) {
|
||||
# starts with a /, might not be in the project we are
|
||||
if ( $_[0] =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
} else {
|
||||
# are we sitting in the project?
|
||||
if ( $pwd =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $isok ) {
|
||||
# now switch off on how to actually do the work
|
||||
local( $type ) = &CTSpecType( $_[2] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
$ret = &CTCcaseCheckout( $_[0], $_[3] ) ;
|
||||
} elsif ( $type eq "root" ) {
|
||||
require "$tool/built/include/ctntool.pl" ;
|
||||
$ret = &CTNtoolCheckout( $_[0], $_[3] ) ;
|
||||
} elsif ( $type eq "croot" ) {
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
$ret = &CTCvsCheckout( $_[0], $_[1], $_[2], $_[3] ) ;
|
||||
} else {
|
||||
print STDERR "CTCMCheckout::error! got invalid spec type '" .
|
||||
$type . "'\n" ;
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCMCheckout\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# given an element, check it in
|
||||
# input is in:
|
||||
# $_[0] = element
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
# $_[3] = comment (optional, "" if none)
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCMCheckin {
|
||||
&CTUDebug( "in CTCMCheckin\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# first check that the element is in the project
|
||||
local( $flav ) = &CTQueryProj( $_[1] ) ;
|
||||
local( $root ) = &CTComputeRoot( $_[1], $flav, $_[2] ) ;
|
||||
local( $pwd ) = &CTUCurrDir() ;
|
||||
local( $isok ) = 0 ;
|
||||
if ( ! -e $_[0] ) {
|
||||
# can't checkin something that doesn't exist
|
||||
$isok = 0 ;
|
||||
} else {
|
||||
if ( $_[0] =~ /^\// ) {
|
||||
# starts with a /, might not be in the project we are
|
||||
if ( $_[0] =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
} else {
|
||||
# are we sitting in the project?
|
||||
if ( $pwd =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $isok ) {
|
||||
# now switch off on how to actually do the work
|
||||
local( $type ) = &CTSpecType( $_[2] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
$ret = &CTCcaseCheckin( $_[0], $_[3] ) ;
|
||||
} elsif ( $type eq "root" ) {
|
||||
require "$tool/built/include/ctntool.pl" ;
|
||||
$ret = &CTNtoolCheckin( $_[0], $_[3] ) ;
|
||||
} elsif ( $type eq "croot" ) {
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
$ret = &CTCvsCheckin( $_[0], $_[1], $_[2], $_[3] ) ;
|
||||
} else {
|
||||
print STDERR "CTCMCheckin::error! got invalid spec type '" .
|
||||
$type . "'\n" ;
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCMCheckin\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# given an element, uncheck it out
|
||||
# input is in:
|
||||
# $_[0] = element
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCMUncheckout {
|
||||
&CTUDebug( "in CTCMUncheckout\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# first check that the element is in the project
|
||||
local( $flav ) = &CTQueryProj( $_[1] ) ;
|
||||
local( $root ) = &CTComputeRoot( $_[1], $flav, $_[2] ) ;
|
||||
local( $pwd ) = &CTUCurrDir() ;
|
||||
local( $isok ) = 0 ;
|
||||
if ( ! -e $_[0] ) {
|
||||
# can't uncheckout something that doesn't exist
|
||||
$isok = 0 ;
|
||||
} else {
|
||||
if ( $_[0] =~ /^\// ) {
|
||||
# starts with a /, might not be in the project we are
|
||||
if ( $_[0] =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
} else {
|
||||
# are we sitting in the project?
|
||||
if ( $pwd =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $isok ) {
|
||||
# now switch off on how to actually do the work
|
||||
local( $type ) = &CTSpecType( $_[2] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
$ret = &CTCcaseUncheckout( $_[0] ) ;
|
||||
} elsif ( $type eq "root" ) {
|
||||
require "$tool/built/include/ctntool.pl" ;
|
||||
$ret = &CTNtoolUncheckout( $_[0] ) ;
|
||||
} elsif ( $type eq "croot" ) {
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
$ret = &CTCvsUncheckout( $_[0], $_[1], $_[2] ) ;
|
||||
} else {
|
||||
print STDERR "CTCMUncheckout::error! got invalid spec type '" .
|
||||
$type . "'\n" ;
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCMUncheckout\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# figure out what all I have checked out in a project
|
||||
# input is in:
|
||||
# $_[0] = project
|
||||
# $_[1] = flavor
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return a \n serperated list of elements checked out
|
||||
sub CTCMIHave {
|
||||
&CTUDebug( "in CTCMIHave\n" ) ;
|
||||
local( $ret ) = "" ;
|
||||
local( $type ) = &CTSpecType( $_[2] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
$ret = &CTCcaseIHave( $_[0], $_[1], $_[2] ) ;
|
||||
} elsif ( $type eq "root" ) {
|
||||
require "$tool/built/include/ctntool.pl" ;
|
||||
$ret = &CTNtoolIHave( $_[0], $_[1], $_[2] ) ;
|
||||
} elsif ( $type eq "croot" ) {
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
$ret = &CTCvsIHave( $_[0], $_[1], $_[2] ) ;
|
||||
} else {
|
||||
print STDERR "CTCMIHave::error! got invalid spec type '" . $type .
|
||||
"'\n" ;
|
||||
}
|
||||
&CTUDebug( "out of CTCMIHave\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# given an element, remove it from the repository
|
||||
# input is in:
|
||||
# $_[0] = element
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCMRmElem {
|
||||
&CTUDebug( "in CTCMRmElem\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# first check that the element is in the project
|
||||
local( $flav ) = &CTQueryProj( $_[1] ) ;
|
||||
local( $root ) = &CTComputeRoot( $_[1], $flav, $_[2] ) ;
|
||||
local( $pwd ) = &CTUCurrDir() ;
|
||||
local( $isok ) = 0 ;
|
||||
if ( ! -e $_[0] ) {
|
||||
# can't rmname something that doesn't exist
|
||||
$isok = 0 ;
|
||||
} else {
|
||||
if ( $_[0] =~ /^\// ) {
|
||||
# starts with a /, might not be in the project we are
|
||||
if ( $_[0] =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
} else {
|
||||
# are we sitting in the project?
|
||||
if ( $pwd =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $isok ) {
|
||||
# now switch off on how to actually do the work
|
||||
local( $type ) = &CTSpecType( $_[2] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
$ret = &CTCcaseRnElem( $_[0], $pwd ) ;
|
||||
} elsif ( $type eq "root" ) {
|
||||
require "$tool/built/include/ctntool.pl" ;
|
||||
$ret = &CTNtoolRmElem( $_[0], $pwd ) ;
|
||||
} elsif ( $type eq "croot" ) {
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
$ret = &CTCvsRmElem( $_[0], $_[1], $_[2] ) ;
|
||||
} else {
|
||||
print STDERR "CTCMRmElem::error! got invalid spec type '" .
|
||||
$type . "'\n" ;
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCMRmElem\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# move an element from one name to another
|
||||
# input is in:
|
||||
# $_[0] = from element
|
||||
# $_[1] = to element
|
||||
# $_[2] = project
|
||||
# $_[3] = spec line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCMMv {
|
||||
&CTUDebug( "in CTCMMv\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# first check that the from and to are in the project
|
||||
local( $flav ) = &CTQueryProj( $_[2] ) ;
|
||||
local( $root ) = &CTComputeRoot( $_[2], $flav, $_[3] ) ;
|
||||
local( $pwd ) = &CTUCurrDir() ;
|
||||
local( $isok ) = 0 ;
|
||||
if ( $_[0] =~ /^\// ) {
|
||||
# starts with a /, might not be in the project we are
|
||||
if ( $_[0] =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
} else {
|
||||
# are we sitting in the project?
|
||||
if ( $pwd =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
}
|
||||
if ( $isok ) {
|
||||
if ( $_[1] =~ /^\// ) {
|
||||
# starts with a /, might not be in the project we are
|
||||
if ( $_[1] =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
} else {
|
||||
# are we sitting in the project?
|
||||
if ( $pwd =~ /^$root/ ) {
|
||||
$isok = 1 ;
|
||||
} else {
|
||||
$isok = 0 ;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $isok ) {
|
||||
# now switch off on how to actually do the work
|
||||
local( $type ) = &CTSpecType( $_[3] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
$ret = &CTCcaseMv( $_[0], $_[1], $pwd ) ;
|
||||
} elsif ( $type eq "root" ) {
|
||||
require "$tool/built/include/ctntool.pl" ;
|
||||
$ret = &CTNtoolMv( $_[0], $_[1], $pwd ) ;
|
||||
} elsif ( $type eq "croot" ) {
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
$ret = &CTCvsMv( $_[0], $_[1], $_[2], $_[3] ) ;
|
||||
} else {
|
||||
print STDERR "CTCMMv::error! got invalid spec type '" .
|
||||
$type . "'\n" ;
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCMMv\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# give a list of targets, build them
|
||||
# input is in:
|
||||
# $_[0] = targets
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCMMake {
|
||||
&CTUDebug( "in CTCMMake\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# now switch off on how to actually do the work
|
||||
local( $type ) = &CTSpecType( $_[2] ) ;
|
||||
if ( $type eq "vroot" ) {
|
||||
require "$tool/built/include/ctccase.pl" ;
|
||||
$ret = &CTCcaseMake( $_[0] ) ;
|
||||
} elsif ( $type eq "root" ) {
|
||||
require "$tool/built/include/ctntool.pl" ;
|
||||
$ret = &CTNtoolMake( $_[0] ) ;
|
||||
} elsif ( $type eq "croot" ) {
|
||||
require "$tool/built/include/ctcvs.pl" ;
|
||||
$ret = &CTCvsMake( $_[0] ) ;
|
||||
} else {
|
||||
print STDERR "CTCMMake::error! got invalid spec type '" . $type .
|
||||
"'\n" ;
|
||||
}
|
||||
&CTUDebug( "out of CTCMMake\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,69 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
sub CTCoUsage {
|
||||
print STDERR "Usage: ctco [-c \"comment\"] [-nc] element-name [...]\n" ;
|
||||
print STDERR "Options:\n" ;
|
||||
print STDERR " -c \"comment\" : provide a comment about this action\n" ;
|
||||
print STDERR " -nc : expect no comment on this action\n" ;
|
||||
exit;
|
||||
}
|
||||
|
||||
if ( $#ARGV < 0 ) {
|
||||
&CTCoUsage ;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "Environment not configured for CTtools" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$comment = "" ;
|
||||
|
||||
$skip = 0 ;
|
||||
|
||||
@files = () ;
|
||||
|
||||
foreach $item ( @ARGV ) {
|
||||
if ( $skip == 0 ) {
|
||||
if ( $item eq "-nc" ) {
|
||||
&CTUDebug( "-nc processed\n" ) ;
|
||||
} elsif ( $item eq "-c" ) {
|
||||
$skip = 1 ;
|
||||
} else {
|
||||
push( @files, $item ) ;
|
||||
&CTUDebug( "added '" . $item . "' to files to be processed\n" ) ;
|
||||
}
|
||||
} elsif ( $skip == 1 ) {
|
||||
$comment = $item ;
|
||||
&CTUDebug( "setting comment to '" . $comment . "'\n" ) ;
|
||||
$skip = 0 ;
|
||||
} else {
|
||||
&CTUDebug( "got to unknown skip value! (" . $skip . ")\n" ) ;
|
||||
$skip = 0 ;
|
||||
}
|
||||
}
|
||||
|
||||
if ( $#files < 0 ) {
|
||||
&CTCoUsage ;
|
||||
}
|
||||
|
||||
$projname = &CTProj ;
|
||||
$projname =~ tr/A-Z/a-z/ ;
|
||||
$flav = &CTQueryProj( $projname ) ;
|
||||
$spec = &CTResolveSpec( $projname, $flav ) ;
|
||||
|
||||
foreach $item ( @files ) {
|
||||
if ( -e $item ) {
|
||||
if ( ! &CTCMCheckout( $item, $projname, $spec, $comment ) ) {
|
||||
print STDERR "Could not checkout '$item'\n" ;
|
||||
}
|
||||
} else {
|
||||
print STDERR "No such file '$item'.\n" ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,451 +0,0 @@
|
|||
# given a possibly empty string, format it into a comment or -nc
|
||||
# input is in:
|
||||
# $_[0] = possible comment string
|
||||
#
|
||||
# output is:
|
||||
# string for use by CVS functions
|
||||
sub CTCvsFormatComment {
|
||||
local( $ret ) = "" ;
|
||||
if ( $_[0] ne "" ) {
|
||||
$ret = "-m \"" . $_[0] . "\"" ;
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# given a project and spec line, compute the server line
|
||||
# input is in:
|
||||
# $_[0] = project
|
||||
# $_[1] = spec line
|
||||
#
|
||||
# output:
|
||||
# return a sever line, or "" if not a croot
|
||||
sub CTCvsServerLine {
|
||||
&CTUDebug( "in CTCvsServerLine\n" ) ;
|
||||
local( $ret ) = "" ;
|
||||
local( $type ) = &CTSpecType( $_[1] ) ;
|
||||
if ( $type eq "croot" ) {
|
||||
local( $options ) = &CTSpecOptions( $_[1] ) ;
|
||||
local( $sline ) = &CTSpecFindOption( $options, "server" ) ;
|
||||
if ( $sline ne "" ) {
|
||||
$ret = join( ":", split( /,/, $sline ));
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCvsServerLine\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# if needed log into a cvs server
|
||||
# input is in:
|
||||
# $_[0] = server line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsLogin {
|
||||
&CTUDebug( "in CTCvsLogin\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
&CTUDebug( "server line is '" . $_[0] . "'\n" ) ;
|
||||
if ( $_[0] ne "" ) {
|
||||
# ok. we actually have something, lets look in .cvspass
|
||||
local( $path ) ;
|
||||
local( *PASSFILE ) ;
|
||||
if ( $ENV{"PENV"} eq "WIN32" ) {
|
||||
$path = $ENV{"HOME"} . "/.cvspass" ;
|
||||
} else {
|
||||
# $path = "~/.cvspass" ;
|
||||
$path = $ENV{"HOME"} . "/.cvspass" ;
|
||||
}
|
||||
&CTUDebug( "looking for '" . $path . "'\n" ) ;
|
||||
if ( -e $path ) {
|
||||
local( $passdone ) = 0 ;
|
||||
local( $ok ) = 0 ;
|
||||
open( PASSFILE, "< $path" ) ;
|
||||
while ( <PASSFILE> ) {
|
||||
s/\n$// ;
|
||||
local( @line ) = split ;
|
||||
# ok, the server line is in [0] and the password in [1].
|
||||
&CTUDebug( "server line from .cvspass is '" . $line[0] .
|
||||
"'\n" ) ;
|
||||
if ( $line[0] eq $_[0] ) {
|
||||
# we're fine, we're already logged in to that
|
||||
$ret = 1 ;
|
||||
$passdone = 1;
|
||||
}
|
||||
}
|
||||
if ( ! $passdone ) {
|
||||
# ran out of lines in the file
|
||||
local( $line ) = "cvs -d " . $_[0] . " login >/dev/null" ;
|
||||
&CTUDebug( "about to run '" . $line . "'\n" ) ;
|
||||
$ret = &CTURetCode( system( $line )) ;
|
||||
}
|
||||
} else {
|
||||
&CTUDebug( $path . " file does not exist\n" ) ;
|
||||
local( $line ) = "cvs -d " . $_[0] . " login >/dev/null" ;
|
||||
&CTUDebug( "about to run '" . $line . "'\n" ) ;
|
||||
$ret = &CTURetCode( system( $line )) ;
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCvsLogin\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
|
||||
# add a versioned element to the repository
|
||||
# input is in:
|
||||
# $_[0] = element
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
# $_[3] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsAdd {
|
||||
&CTUDebug( "in CTCvsAdd\n" ) ;
|
||||
# first we need to 'login' to the repository
|
||||
local( $comment ) = &CTCvsFormatComment( $_[3] ) ;
|
||||
local( $serve ) = &CTCvsServerLine( $_[1], $_[2] ) ;
|
||||
local( $ret ) = &CTCvsLogin( $serve ) ;
|
||||
if ( $ret ) {
|
||||
# now issue the add command
|
||||
local( $root ) = &CTProjRoot( $_[1] ) ;
|
||||
local( $line ) = "" ;
|
||||
local( $elem ) = $_[0] ;
|
||||
if ( $elem =~ /^\// ) {
|
||||
local( $proj ) = $_[1] ;
|
||||
$proj =~ tr/a-z/A-Z/ ;
|
||||
$line = "cd \$" . $proj . "; " ;
|
||||
$elem =~ s/^$root\/// ;
|
||||
}
|
||||
$line = $line . "cvs -d " . $serve . " add " . $comment . " $elem" ;
|
||||
&CTUDebug( "about to execute '" . $line . "'\n" ) ;
|
||||
$ret = &CTURetCode( system( $line )) ;
|
||||
}
|
||||
&CTUDebug( "out of CTCvsAdd\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# ci a versioned element to the repository
|
||||
# input is in:
|
||||
# $_[0] = element
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
# $_[3] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsCi {
|
||||
&CTUDebug( "in CTCvsCi\n" ) ;
|
||||
# first we need to 'login' to the repository
|
||||
local( $comment ) = &CTCvsFormatComment( $_[3] ) ;
|
||||
local( $serve ) = &CTCvsServerLine( $_[1], $_[2] ) ;
|
||||
local( $ret ) = &CTCvsLogin( $serve ) ;
|
||||
if ( $ret ) {
|
||||
# now issue the add command
|
||||
local( $root ) = &CTProjRoot( $_[1] ) ;
|
||||
local( $line ) = "" ;
|
||||
local( $elem ) = $_[0] ;
|
||||
if ( $elem =~ /^\// ) {
|
||||
local ( $proj ) = $_[1] ;
|
||||
$proj =~ tr/a-z/A-Z/ ;
|
||||
$line = "cd \$" . $proj . "; " ;
|
||||
$elem =~ s/^$root\/// ;
|
||||
}
|
||||
$line = $line . "cvs -d " . $serve . " ci " . $comment . " $elem" ;
|
||||
&CTUDebug( "about to execute '" . $line . "'\n" ) ;
|
||||
$ret = &CTURetCode( system( $line )) ;
|
||||
}
|
||||
&CTUDebug( "out of CTCvsCi\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# rm a versioned element from the repository
|
||||
# input is in:
|
||||
# $_[0] = element
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsRm {
|
||||
&CTUDebug( "in CTCvsRm\n" ) ;
|
||||
# first we need to 'login' to the repository
|
||||
local( $serve ) = &CTCvsServerLine( $_[1], $_[2] ) ;
|
||||
local( $ret ) = &CTCvsLogin( $serve ) ;
|
||||
if ( $ret ) {
|
||||
# now issue the add command
|
||||
$ret = &CTURetCode( system( "cvs -d " . $serve . " rm $_[0]\n" )) ;
|
||||
}
|
||||
&CTUDebug( "out of CTCvsRm\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# make a versioned directory
|
||||
# input is in:
|
||||
# $_[0] = directory to create
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
# $_[3] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsMkdir {
|
||||
&CTUDebug( "in CTCvsMkdir\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# first make the dir
|
||||
$ret = &CTURetCode( system( "mkdir $_[0]\n" )) ;
|
||||
if ( $ret ) {
|
||||
# now version it
|
||||
$ret = &CTCvsAdd( $_[0], $_[1], $_[2], $_[3] ) ;
|
||||
} else {
|
||||
&CTUDebug( "could not create directory '" . $_[0] . "'\n" ) ;
|
||||
$ret = 0 ;
|
||||
}
|
||||
&CTUDebug( "out of CTCvsMkdir\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# make a versioned element
|
||||
# input is in:
|
||||
# $_[0] = element to version
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
# $_[3] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsMkelem {
|
||||
&CTUDebug( "in CTCvsMkelem\n" ) ;
|
||||
# first cvs add the file
|
||||
local( $ret ) = &CTCvsAdd( $_[0], $_[1], $_[2], $_[3] ) ;
|
||||
if ( $ret ) {
|
||||
# now commit it
|
||||
$ret = &CTCvsCi( $_[0], $_[1], $_[2], $_[3] ) ;
|
||||
} else {
|
||||
&CTUDebug( "could not CVS add '" . $_[0] . "'\n" ) ;
|
||||
$ret = 0 ;
|
||||
}
|
||||
&CTUDebug( "out of CTCvsMkelem\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# delta an element
|
||||
# input is in:
|
||||
# $_[0] = element to delta
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsDelta {
|
||||
&CTUDebug( "in CTCvsDelta\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# for lack of better idea, this is going to be just checkin for now
|
||||
if ( -d $_[0] ) {
|
||||
# we don't version directories in CVS
|
||||
$ret = 1 ;
|
||||
} else {
|
||||
$ret = &CTCvsCi( $_[0], $_[1], $_[2] ) ;
|
||||
}
|
||||
&CTUDebug( "out of CTCvsDelta\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# checkout an element
|
||||
# input is in:
|
||||
# $_[0] = element to checkout
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
# $_[3] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsCheckout {
|
||||
&CTUDebug( "in CTCvsCheckout\n" ) ;
|
||||
local( $ret ) = 1 ;
|
||||
# for my limited understanding of CVS, there doesn't seem to be any
|
||||
# 'checkout' for it.
|
||||
&CTUDebug( "out of CTCvsCheckout\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# checkin an element
|
||||
# input is in:
|
||||
# $_[0] = element to checkin
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
# $_[3] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsCheckin {
|
||||
&CTUDebug( "in CTCvsCheckin\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
if ( -d $_[0] ) {
|
||||
# we don't version directories in CVS
|
||||
$ret = 1 ;
|
||||
} else {
|
||||
$ret = &CTCvsCi( $_[0], $_[1], $_[2], $_[3] ) ;
|
||||
}
|
||||
&CTUDebug( "out of CTCvsCheckin\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# uncheckout an element
|
||||
# input is in:
|
||||
# $_[0] = element to uncheckout
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsUncheckout {
|
||||
&CTUDebug( "in CTCvsUncheckout\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
if ( -d $_[0] ) {
|
||||
# we don't version directories in CVS
|
||||
$ret = 1 ;
|
||||
} else {
|
||||
$ret = &CTURetCode( system( "rm $_[0]" ) ) ;
|
||||
if ( $ret ) {
|
||||
local( $serve ) = &CTCvsServerLine( $_[1], $_[2] ) ;
|
||||
$ret = &CTCvsLogin( $serve ) ;
|
||||
if ( $ret ) {
|
||||
$ret = &CTURetCode( system( "cvs -d " . $serve . " update " .
|
||||
$_[0] )) ;
|
||||
}
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCvsUncheckout\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# figure out what all I have checked out
|
||||
# input is in:
|
||||
# $_[0] = project
|
||||
# $_[1] = flavor
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return a \n serperated list of elements checked out
|
||||
sub CTCvsIHave {
|
||||
&CTUDebug( "in CTCvsIHave\n" ) ;
|
||||
local( $ret ) = "" ;
|
||||
local( $proj ) = $_[0] ;
|
||||
$proj =~ tr/a-z/A-Z/ ;
|
||||
local( $line ) = "cd \$" . $proj . "; " ;
|
||||
local( $serve ) = &CTCvsServerLine( $_[0], $_[2] ) ;
|
||||
local( $ok ) = &CTCvsLogin( $serve ) ;
|
||||
if ( $ok ) {
|
||||
$line = $line . "cvs -n -d " . $serve . " update 2>/dev/null" ;
|
||||
local( $hold ) = "";
|
||||
local( *OUTPUT ) ;
|
||||
open( OUTPUT, $line . " |" ) ;
|
||||
while ( <OUTPUT> ) {
|
||||
$hold = $hold . $_ ;
|
||||
}
|
||||
close( OUTPUT ) ;
|
||||
local( @lines ) = split( /\n/, $hold ) ;
|
||||
local( $item ) ;
|
||||
foreach $item ( @lines ) {
|
||||
if ( $item =~ /^\?/ ) {
|
||||
# things that start with a ? are ignored
|
||||
} elsif ( $item =~ /^cvs/ ) {
|
||||
# messages from the server are also ignored
|
||||
} elsif ( $item =~ /^P/ ) {
|
||||
# new files are ignored
|
||||
} elsif ( $item =~ /^U/ ) {
|
||||
# updates are ignored
|
||||
} elsif ( $item =~ /^M/ ) {
|
||||
# here's one we modified
|
||||
local( @foo ) = split( / /, $item ) ;
|
||||
$ret = $ret . $foo[1] . "\n" ;
|
||||
} else {
|
||||
# don't what this means, better complain
|
||||
local( @foo ) = split( / /, $item ) ;
|
||||
print STDERR "got unknown update code '" . $foo[0] .
|
||||
"' for file '" . $foo[1] . "'\n" ;
|
||||
}
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCvsIHave\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# remove an element from the repository
|
||||
# input is in:
|
||||
# $_[0] = element to uncheckout
|
||||
# $_[1] = project
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsRmElem {
|
||||
&CTUDebug( "in CTCvsRmElem\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
if ( -d $_[0] ) {
|
||||
# CVS doesn't really do this. If there are no files in the directory,
|
||||
# the next time an update -P is run, it will be deleted.
|
||||
$ret = 1 ;
|
||||
} else {
|
||||
$ret = &CTURetCode( system( "rm $_[0]" ) ) ;
|
||||
if ( $ret ) {
|
||||
$ret = &CTCvsRm( $_[0], $_[1], $_[2] ) ;
|
||||
if ( $ret ) {
|
||||
$ret = &CTCvsCi( $_[0], $_[1], $_[2] ) ;
|
||||
}
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCvsRmElem\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# move a versioned element from one name to another
|
||||
# input is in:
|
||||
# $_[0] = from element
|
||||
# $_[1] = to element
|
||||
# $_[2] = project
|
||||
# $_[3] = spec line
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsMv {
|
||||
&CTUDebug( "in CTCvsMv\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
if ( -d $_[0] ) {
|
||||
# don't have code to do directories yet. See pp 54 of the CVS book
|
||||
$ret = 0 ;
|
||||
} else {
|
||||
$ret = &CTURetCode( system( "mv $_[0] $_[1]" ) ) ;
|
||||
if ( $ret ) {
|
||||
$ret = &CTCvsRm( $_[0], $_[2], $_[3] ) ;
|
||||
if ( $ret ) {
|
||||
$ret = &CTCvsAdd( $_[1], $_[2], $_[3] );
|
||||
if ( $ret ) {
|
||||
$ret = &CTCvsCi( $_[0], $_[2], $_[3] ) ;
|
||||
if ( $ret ) {
|
||||
$ret = &CTCvsCi( $_[1], $_[2], $_[3] ) ;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTCvsMv\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# build a list of targets
|
||||
# input is in:
|
||||
# $_[0] = targets
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTCvsMake {
|
||||
&CTUDebug( "in CTCvsMake\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $line ) = "make " . $_[0] . "\n" ;
|
||||
$ret = &CTURetCode( system( $line )) ;
|
||||
&CTUDebug( "out of CTCvsMake\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,57 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
if ($#ARGV < 0) {
|
||||
exit print "Usage: ctdelta element-name [...]\n" ;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "not configured for using ct-tools\n" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$comment = "" ;
|
||||
$skip = 0 ;
|
||||
|
||||
@files = () ;
|
||||
|
||||
foreach $item ( @ARGV ) {
|
||||
if ( $skip == 0 ) {
|
||||
if ( $item eq "-nc" ) {
|
||||
&CTUDebug( "-nc processed\n" ) ;
|
||||
} elsif ( $item eq "-c" ) {
|
||||
$skip = 1 ;
|
||||
} else {
|
||||
push( @files, $item ) ;
|
||||
&CTUDebug( "added '" . $item . "' to files to be processed\n" ) ;
|
||||
}
|
||||
} elsif ( $skip == 1 ) {
|
||||
$comment = $item ;
|
||||
&CTUDebug( "setting comment to '" . $comment . "'\n" ) ;
|
||||
$skip = 0 ;
|
||||
} else {
|
||||
&CTUDebug( "got to unknown skip value! (" . $skip . ")\n" ) ;
|
||||
$skip = 0 ;
|
||||
}
|
||||
}
|
||||
|
||||
$projname = &CTProj ;
|
||||
$projname =~ tr/A-Z/a-z/ ;
|
||||
$flav = &CTQueryProj( $projname ) ;
|
||||
$spec = &CTResolveSpec( $projname, $flav ) ;
|
||||
|
||||
foreach $item ( @files ) {
|
||||
if ( -e $item ) {
|
||||
&CTCMCheckin( $item, $projname, $spec ) ;
|
||||
if ( ! &CTCMDelta( $item, $projname, $spec ) ) {
|
||||
print STDERR "Could not delta '$item'\n" ;
|
||||
}
|
||||
} else {
|
||||
print STDERR "No such file '$item'.\n" ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,232 +0,0 @@
|
|||
# Check in element if needed
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
sub CTDeltaCheckin {
|
||||
local( $cmd ) = "cleartool ci -nc $_[0] 2> /dev/null > /dev/null" ;
|
||||
system $cmd ;
|
||||
}
|
||||
|
||||
# get the version of an element
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
sub CTDeltaGetVersion {
|
||||
local( *CMDFILE ) ;
|
||||
open( CMDFILE, "cleartool describe -short $_[0] |" ) ;
|
||||
$_ = <CMDFILE> ;
|
||||
close( CMDFILE ) ;
|
||||
s/\n$// ;
|
||||
s/^.*@@// ;
|
||||
s/\"$// ;
|
||||
$_ ;
|
||||
}
|
||||
|
||||
# Is it ok to try a merge on this version?
|
||||
# Input is:
|
||||
# $_[0] = version
|
||||
sub CTDeltaOk {
|
||||
local( $ret ) ;
|
||||
local( @verlist ) ;
|
||||
@verlist = split( /\//, $_[0] ) ;
|
||||
pop( @verlist ) ;
|
||||
if ( $#verlist > 1 ) {
|
||||
$ret = 1 ;
|
||||
} else {
|
||||
$ret = 0 ;
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# get the comments from a version of an element
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
# $_[1] = version
|
||||
#
|
||||
# output in:
|
||||
# @CTDeltaComments
|
||||
sub CTDeltaGetComments {
|
||||
local( *CMDFILE ) ;
|
||||
local( $done ) = 0 ;
|
||||
local( $end ) = " element type:" ;
|
||||
local( $tmp ) = "cleartool describe $_[0]" . "@@" . "$_[1] |" ;
|
||||
open( CMDFILE, $tmp ) ;
|
||||
$_ = <CMDFILE> ;
|
||||
$_ = <CMDFILE> ;
|
||||
while ( ! $done ) {
|
||||
$_ = <CMDFILE> ;
|
||||
if ( $_ =~ /^$end/ ) {
|
||||
$done = 1 ;
|
||||
} else {
|
||||
s/^ // ;
|
||||
s/^ // ;
|
||||
s/^\"// ;
|
||||
s/\n$// ;
|
||||
s/\"$// ;
|
||||
push( @CTDeltaComments, $_ ) ;
|
||||
}
|
||||
}
|
||||
close( CMDFILE ) ;
|
||||
}
|
||||
|
||||
# try automatic merge. If it fails, use xmerge
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
# $_[1] = source version
|
||||
# $_[2] = target version
|
||||
sub CTDeltaSafeMerge {
|
||||
@CTDeltaComments = ();
|
||||
&CTDeltaGetComments($_[0], $_[1]);
|
||||
local( $ret ) ;
|
||||
$ret = "cleartool checkout -branch $_[2] -nc $_[0] 2> /dev/null > /dev/null" ;
|
||||
$ret = system $ret ;
|
||||
if ( $ret != 0 ) {
|
||||
print STDERR "got return value $ret from checkout on '$_[0]" . "@@" . "$_[2]'\n" ;
|
||||
exit -1;
|
||||
}
|
||||
local( $item ) ;
|
||||
foreach $item ( @CTDeltaComments ) {
|
||||
$ret = "cleartool chevent -append -c \"" . $item . "\" $_[0]" . "@@" . "$_[2]" . "/LATEST 2> /dev/null > /dev/null" ;
|
||||
system $ret ;
|
||||
}
|
||||
print STDERR "merging '$_[0]'...\n" ;
|
||||
$ret = "cleartool merge -abort -to $_[0] -version $_[1] 2> /dev/null > /dev/null" ;
|
||||
$ret = system $ret ;
|
||||
if ( $ret != 0 ) {
|
||||
$ret = system "cleartool xmerge -to $_[0] -version $_[1]" ;
|
||||
}
|
||||
if ( ! -d $_[0] ) {
|
||||
system "rm $_[0]" . ".contrib" ;
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# test a branch for 'triviality'
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
# $_[1] = branch name
|
||||
#
|
||||
# Output is:
|
||||
# true/false
|
||||
sub CTDeltaTestBranch {
|
||||
local( *CTCMD ) ;
|
||||
local( $ret ) ;
|
||||
local( $done ) = 0 ;
|
||||
local( $bfrom ) ;
|
||||
local( @blist ) ;
|
||||
local( $bto ) ;
|
||||
local( $bdiff ) ;
|
||||
local( $blast ) ;
|
||||
@blist = split( /\//, $_[1] ) ;
|
||||
pop( @blist ) ;
|
||||
$ret = join( "/", @blist ) ;
|
||||
$ret = "cleartool describe $_[0]" . "@@" . "$ret |" ;
|
||||
open( CTCMD, $ret ) ;
|
||||
while ( ! $done ) {
|
||||
$_ = <CTCMD> ;
|
||||
if ( $_ =~ /^ branched from version/ ) {
|
||||
$done = 1 ;
|
||||
}
|
||||
}
|
||||
close( CTCMD ) ;
|
||||
s/^ branched from version: // ;
|
||||
s/\n$// ;
|
||||
$bfrom = $_ ;
|
||||
@blist = split( /\//, $_ ) ;
|
||||
pop( @blist ) ;
|
||||
push( @blist, "LATEST" ) ;
|
||||
$ret = join( "/", @blist ) ;
|
||||
$ret = "cleartool describe $_[0]" . "@@" . "$ret |" ;
|
||||
open( CTCMD, $ret ) ;
|
||||
$_ = <CTCMD> ;
|
||||
close( CTCMD ) ;
|
||||
s/\n$// ;
|
||||
s/^.*@@// ;
|
||||
s/\"$// ;
|
||||
$bto = $_ ;
|
||||
@blist = split( /\//, $bfrom ) ;
|
||||
$bfrom = pop( @blist ) ;
|
||||
@blist = split( /\//, $bto ) ;
|
||||
$bto = pop( @blist ) ;
|
||||
$bdiff = $bto - $bfrom ;
|
||||
$ret = "cleartool describe $_[0]" . "@@" . "$_[1] |" ;
|
||||
open( CTCMD, $ret ) ;
|
||||
$_ = <CTCMD> ;
|
||||
close( CTCMD ) ;
|
||||
s/\n$// ;
|
||||
s/^.*@@// ;
|
||||
s/\"$// ;
|
||||
@blist = split( /\//, $_ ) ;
|
||||
$blast = pop( @blist ) ;
|
||||
if (( $bdiff > 1 ) || ( $blast > 1 )) {
|
||||
$ret = 0 ;
|
||||
} else {
|
||||
$ret = 1 ;
|
||||
}
|
||||
}
|
||||
|
||||
# check for trivial branch elimination
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
# $_[1] = last branch version
|
||||
# $_[2] = timestamp string
|
||||
sub CTDeltaBranchCheck {
|
||||
local( $test ) = &CTDeltaTestBranch( $_[0], $_[1] ) ;
|
||||
local( $cmd ) ;
|
||||
local( @blist ) ;
|
||||
local( $branch ) ;
|
||||
@blist = split( /\//, $_[1] ) ;
|
||||
if ( $test ) {
|
||||
pop( @blist ) ;
|
||||
$cmd = join( "/", @blist ) ;
|
||||
$branch = join( "/", @blist ) ;
|
||||
$cmd = "cleartool rmbranch -force $_[0]" . "@@" . "$cmd 2> /dev/null > /dev/null" ;
|
||||
print STDERR "deleting branch '$branch'...\n" ;
|
||||
system $cmd ;
|
||||
} else {
|
||||
pop( @blist ) ;
|
||||
$branch = join( "/", @blist ) ;
|
||||
$test = pop( @blist ) ;
|
||||
$test = $test . $_[2] ;
|
||||
$cmd = "cleartool mkbrtype -c \"non-trivial branch\" $test 2> /dev/null > /dev/null" ;
|
||||
system $cmd ;
|
||||
$cmd = "cleartool chtype -c \"renaming non-trivial branch\" $test $_[0]" . "@@" . "$branch 2> /dev/null > /dev/null" ;
|
||||
print STDERR "renaming branch '$branch'...\n" ;
|
||||
system $cmd ;
|
||||
}
|
||||
}
|
||||
|
||||
# log merge to /usr/local/etc/delta_log
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
# $_[1] = source version
|
||||
# $_[2] = target version
|
||||
sub CTDeltaLog {
|
||||
local( *LOGFILE ) ;
|
||||
local( *CMDFILE ) ;
|
||||
local( $cmd ) ;
|
||||
open( LOGFILE, ">>/usr/local/etc/delta_log" ) ;
|
||||
print LOGFILE $_[0] . ": " . $_[1] . " -> " . $_[2] . " : " ;
|
||||
if ( $ctdebug ne "" ) {
|
||||
print STDERR "CTDeltaLog: outputting '" . $_[0] . ": " . $_[1] . " -> " . $_[2] . " : '\n" ;
|
||||
}
|
||||
$cmd = "ypmatch `whoami` passwd | cut -d: -f5 |" ;
|
||||
open( CMDFILE, $cmd ) ;
|
||||
$_ = <CMDFILE> ;
|
||||
s/\n$//;
|
||||
print LOGFILE $_ . " " ;
|
||||
if ( $ctdebug ne "" ) {
|
||||
print STDERR "CTDeltaLog: outputting '" . $_ . " '\n" ;
|
||||
}
|
||||
close( CMDFILE ) ;
|
||||
$cmd = "/bin/date '+%m/%d/%y %H:%M:%S' |" ;
|
||||
open( CMDFILE, $cmd ) ;
|
||||
$_ = <CMDFILE> ;
|
||||
s/\n$//;
|
||||
print LOGFILE $_ . "\n" ;
|
||||
if ( $ctdebug ne "" ) {
|
||||
print STDERR "CTDeltaLog: outputting '" . $_ . " '\n" ;
|
||||
}
|
||||
close( CMDFILE ) ;
|
||||
close( LOGFILE ) ;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,232 +0,0 @@
|
|||
# Check in element if needed
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
sub CTDeltaCheckin {
|
||||
local( $cmd ) = "cleartool ci -nc $_[0] 2> /dev/null > /dev/null" ;
|
||||
system $cmd ;
|
||||
}
|
||||
|
||||
# get the version of an element
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
sub CTDeltaGetVersion {
|
||||
local( *CMDFILE ) ;
|
||||
open( CMDFILE, "cleartool describe -short $_[0] |" ) ;
|
||||
$_ = <CMDFILE> ;
|
||||
close( CMDFILE ) ;
|
||||
s/\n$// ;
|
||||
s/^.*@@// ;
|
||||
s/\"$// ;
|
||||
$_ ;
|
||||
}
|
||||
|
||||
# Is it ok to try a merge on this version?
|
||||
# Input is:
|
||||
# $_[0] = version
|
||||
sub CTDeltaOk {
|
||||
local( $ret ) ;
|
||||
local( @verlist ) ;
|
||||
@verlist = split( /\//, $_[0] ) ;
|
||||
pop( @verlist ) ;
|
||||
if ( $#verlist > 1 ) {
|
||||
$ret = 1 ;
|
||||
} else {
|
||||
$ret = 0 ;
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# get the comments from a version of an element
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
# $_[1] = version
|
||||
#
|
||||
# output in:
|
||||
# @CTDeltaComments
|
||||
sub CTDeltaGetComments {
|
||||
local( *CMDFILE ) ;
|
||||
local( $done ) = 0 ;
|
||||
local( $end ) = " element type:" ;
|
||||
local( $tmp ) = "cleartool describe $_[0]" . "@@" . "$_[1] |" ;
|
||||
open( CMDFILE, $tmp ) ;
|
||||
$_ = <CMDFILE> ;
|
||||
$_ = <CMDFILE> ;
|
||||
while ( ! $done ) {
|
||||
$_ = <CMDFILE> ;
|
||||
if ( $_ =~ /^$end/ ) {
|
||||
$done = 1 ;
|
||||
} else {
|
||||
s/^ // ;
|
||||
s/^ // ;
|
||||
s/^\"// ;
|
||||
s/\n$// ;
|
||||
s/\"$// ;
|
||||
push( @CTDeltaComments, $_ ) ;
|
||||
}
|
||||
}
|
||||
close( CMDFILE ) ;
|
||||
}
|
||||
|
||||
# try automatic merge. If it fails, use xmerge
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
# $_[1] = source version
|
||||
# $_[2] = target version
|
||||
sub CTDeltaSafeMerge {
|
||||
@CTDeltaComments = ();
|
||||
&CTDeltaGetComments($_[0], $_[1]);
|
||||
local( $ret ) ;
|
||||
$ret = "cleartool checkout -branch $_[2] -nc $_[0] 2> /dev/null > /dev/null" ;
|
||||
$ret = system $ret ;
|
||||
if ( $ret != 0 ) {
|
||||
print STDERR "got return value $ret from checkout on '$_[0]" . "@@" . "$_[2]'\n" ;
|
||||
exit -1;
|
||||
}
|
||||
local( $item ) ;
|
||||
foreach $item ( @CTDeltaComments ) {
|
||||
$ret = "cleartool chevent -append -c \"" . $item . "\" $_[0]" . "@@" . "$_[2]" . "/LATEST 2> /dev/null > /dev/null" ;
|
||||
system $ret ;
|
||||
}
|
||||
print STDERR "merging '$_[0]'...\n" ;
|
||||
$ret = "cleartool merge -abort -to $_[0] -version $_[1] 2> /dev/null > /dev/null" ;
|
||||
$ret = system $ret ;
|
||||
if ( $ret != 0 ) {
|
||||
$ret = system "cleartool xmerge -to $_[0] -version $_[1]" ;
|
||||
}
|
||||
if ( ! -d $_[0] ) {
|
||||
system "rm $_[0]" . ".contrib" ;
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# test a branch for 'triviality'
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
# $_[1] = branch name
|
||||
#
|
||||
# Output is:
|
||||
# true/false
|
||||
sub CTDeltaTestBranch {
|
||||
local( *CTCMD ) ;
|
||||
local( $ret ) ;
|
||||
local( $done ) = 0 ;
|
||||
local( $bfrom ) ;
|
||||
local( @blist ) ;
|
||||
local( $bto ) ;
|
||||
local( $bdiff ) ;
|
||||
local( $blast ) ;
|
||||
@blist = split( /\//, $_[1] ) ;
|
||||
pop( @blist ) ;
|
||||
$ret = join( "/", @blist ) ;
|
||||
$ret = "cleartool describe $_[0]" . "@@" . "$ret |" ;
|
||||
open( CTCMD, $ret ) ;
|
||||
while ( ! $done ) {
|
||||
$_ = <CTCMD> ;
|
||||
if ( $_ =~ /^ branched from version/ ) {
|
||||
$done = 1 ;
|
||||
}
|
||||
}
|
||||
close( CTCMD ) ;
|
||||
s/^ branched from version: // ;
|
||||
s/\n$// ;
|
||||
$bfrom = $_ ;
|
||||
@blist = split( /\//, $_ ) ;
|
||||
pop( @blist ) ;
|
||||
push( @blist, "LATEST" ) ;
|
||||
$ret = join( "/", @blist ) ;
|
||||
$ret = "cleartool describe $_[0]" . "@@" . "$ret |" ;
|
||||
open( CTCMD, $ret ) ;
|
||||
$_ = <CTCMD> ;
|
||||
close( CTCMD ) ;
|
||||
s/\n$// ;
|
||||
s/^.*@@// ;
|
||||
s/\"$// ;
|
||||
$bto = $_ ;
|
||||
@blist = split( /\//, $bfrom ) ;
|
||||
$bfrom = pop( @blist ) ;
|
||||
@blist = split( /\//, $bto ) ;
|
||||
$bto = pop( @blist ) ;
|
||||
$bdiff = $bto - $bfrom ;
|
||||
$ret = "cleartool describe $_[0]" . "@@" . "$_[1] |" ;
|
||||
open( CTCMD, $ret ) ;
|
||||
$_ = <CTCMD> ;
|
||||
close( CTCMD ) ;
|
||||
s/\n$// ;
|
||||
s/^.*@@// ;
|
||||
s/\"$// ;
|
||||
@blist = split( /\//, $_ ) ;
|
||||
$blast = pop( @blist ) ;
|
||||
if (( $bdiff > 1 ) || ( $blast > 1 )) {
|
||||
$ret = 0 ;
|
||||
} else {
|
||||
$ret = 1 ;
|
||||
}
|
||||
}
|
||||
|
||||
# check for trivial branch elimination
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
# $_[1] = last branch version
|
||||
# $_[2] = timestamp string
|
||||
sub CTDeltaBranchCheck {
|
||||
local( $test ) = &CTDeltaTestBranch( $_[0], $_[1] ) ;
|
||||
local( $cmd ) ;
|
||||
local( @blist ) ;
|
||||
local( $branch ) ;
|
||||
@blist = split( /\//, $_[1] ) ;
|
||||
if ( $test ) {
|
||||
pop( @blist ) ;
|
||||
$cmd = join( "/", @blist ) ;
|
||||
$branch = join( "/", @blist ) ;
|
||||
$cmd = "cleartool rmbranch -force $_[0]" . "@@" . "$cmd 2> /dev/null > /dev/null" ;
|
||||
print STDERR "deleting branch '$branch'...\n" ;
|
||||
system $cmd ;
|
||||
} else {
|
||||
pop( @blist ) ;
|
||||
$branch = join( "/", @blist ) ;
|
||||
$test = pop( @blist ) ;
|
||||
$test = $test . $_[2] ;
|
||||
$cmd = "cleartool mkbrtype -c \"non-trivial branch\" $test 2> /dev/null > /dev/null" ;
|
||||
system $cmd ;
|
||||
$cmd = "cleartool chtype -c \"renaming non-trivial branch\" $test $_[0]" . "@@" . "$branch 2> /dev/null > /dev/null" ;
|
||||
print STDERR "renaming branch '$branch'...\n" ;
|
||||
system $cmd ;
|
||||
}
|
||||
}
|
||||
|
||||
# log merge to /var/etc/delta_log
|
||||
# Input is:
|
||||
# $_[0] = element name
|
||||
# $_[1] = source version
|
||||
# $_[2] = target version
|
||||
sub CTDeltaLog {
|
||||
local( *LOGFILE ) ;
|
||||
local( *CMDFILE ) ;
|
||||
local( $cmd ) ;
|
||||
open( LOGFILE, ">>/var/etc/delta_log" ) ;
|
||||
print LOGFILE $_[0] . ": " . $_[1] . " -> " . $_[2] . " : " ;
|
||||
if ( $ctdebug ne "" ) {
|
||||
print STDERR "CTDeltaLog: outputting '" . $_[0] . ": " . $_[1] . " -> " . $_[2] . " : '\n" ;
|
||||
}
|
||||
$cmd = "ypmatch `whoami` passwd | cut -d: -f5 |" ;
|
||||
open( CMDFILE, $cmd ) ;
|
||||
$_ = <CMDFILE> ;
|
||||
s/\n$//;
|
||||
print LOGFILE $_ . " " ;
|
||||
if ( $ctdebug ne "" ) {
|
||||
print STDERR "CTDeltaLog: outputting '" . $_ . " '\n" ;
|
||||
}
|
||||
close( CMDFILE ) ;
|
||||
$cmd = "/bin/date '+%m/%d/%y %H:%M:%S' |" ;
|
||||
open( CMDFILE, $cmd ) ;
|
||||
$_ = <CMDFILE> ;
|
||||
s/\n$//;
|
||||
print LOGFILE $_ . "\n" ;
|
||||
if ( $ctdebug ne "" ) {
|
||||
print STDERR "CTDeltaLog: outputting '" . $_ . " '\n" ;
|
||||
}
|
||||
close( CMDFILE ) ;
|
||||
close( LOGFILE ) ;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
if ($#ARGV != -1) {
|
||||
exit print "Usage: ctihave\n" ;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "not configured for using CTtools\n" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$projname = &CTProj ;
|
||||
$projname =~ tr/A-Z/a-z/ ;
|
||||
$flav = &CTQueryProj( $projname ) ;
|
||||
$spec = &CTResolveSpec( $projname, $flav ) ;
|
||||
|
||||
if ( $projname eq "" ) {
|
||||
exit print "Not currently in any project tree\n" ;
|
||||
}
|
||||
|
||||
$result = &CTCMIHave( $projname, $flav, $spec ) ;
|
||||
if ( $result ne "" ) {
|
||||
@splitlist = split( /\n/, $result ) ;
|
||||
foreach $item ( @splitlist ) {
|
||||
print $item . "\n" ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "not configured for using ct-tools\n" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$projname = &CTProj ;
|
||||
$projname =~ tr/A-Z/a-z/ ;
|
||||
$flav = &CTQueryProj( $projname ) ;
|
||||
$spec = &CTResolveSpec( $projname, $flav ) ;
|
||||
|
||||
$line = join( " ", @ARGV ) ;
|
||||
|
||||
if ( ! &CTCMMake( $line, $projname, $spec ) ) {
|
||||
print STDERR "Could not make '$line'\n" ;
|
||||
}
|
||||
|
|
@ -1,55 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
sub CTMkDirUsage {
|
||||
print STDERR "Usage: ctmkdir [-c \"comment\"] [-nc] dir-name [...]\n" ;
|
||||
print STDERR "Options:\n" ;
|
||||
print STDERR " -c \"comment\" : provide a comment about this action\n" ;
|
||||
print STDERR " -nc : expect no comment on this action\n" ;
|
||||
exit ;
|
||||
}
|
||||
|
||||
if ( $#ARGV < 0 ) {
|
||||
&CTMkDirUsage ;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "Environment not configured for CTtools" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$comment = "" ;
|
||||
if ( $ARGV[0] eq "-nc" ) {
|
||||
shift( @ARGV ) ;
|
||||
&CTUDebug( "-nc processed\n" ) ;
|
||||
}
|
||||
if ( $ARGV[0] eq "-c" ) {
|
||||
shift( @ARGV ) ;
|
||||
$comment = $ARGV[0] ;
|
||||
shift( @ARGV ) ;
|
||||
&CTUDebug( "setting comment to '" . $comment . "'\n" ) ;
|
||||
}
|
||||
|
||||
if ( $#ARGV < 0 ) {
|
||||
&CTMkDirUsage ;
|
||||
}
|
||||
|
||||
$projname = &CTProj ;
|
||||
$projname =~ tr/A-Z/a-z/ ;
|
||||
$flav = &CTQueryProj( $projname ) ;
|
||||
$spec = &CTResolveSpec( $projname, $flav ) ;
|
||||
|
||||
foreach $item ( @ARGV ) {
|
||||
if ( -e $item ) {
|
||||
print STDERR "Name collision on directory '$item'\n" ;
|
||||
} else {
|
||||
if ( ! &CTCMMkdir( $item, $projname, $spec, $comment ) ) {
|
||||
print STDERR "Could name make directory '$item'\n" ;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -1,78 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
sub CTMkElemUsage {
|
||||
print STDERR "Usage: ctmkelem [-c \"comment\"] [-nc] [-eltype type] element-name [...]\n" ;
|
||||
print STDERR "Options:\n" ;
|
||||
print STDERR " -c \"comment\" : provide a comment about this action\n" ;
|
||||
print STDERR " -nc : expect no comment on this action\n" ;
|
||||
print STDERR " -eltype type : element type\n" ;
|
||||
exit ;
|
||||
}
|
||||
|
||||
if ( $#ARGV < 0 ) {
|
||||
&CTMkElemUsage ;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "Environment not configured for CTtools" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$comment = "" ;
|
||||
$eltype = "" ;
|
||||
|
||||
$done = 0 ;
|
||||
|
||||
while ( ! $done ) {
|
||||
$done = 1 ;
|
||||
if ( $ARGV[0] eq "-nc" ) {
|
||||
shift( @ARGV ) ;
|
||||
&CTUDebug( "-nc processed\n" ) ;
|
||||
$done = 0 ;
|
||||
}
|
||||
if ( $ARGV[0] eq "-c" ) {
|
||||
shift( @ARGV ) ;
|
||||
$comment = $ARGV[0] ;
|
||||
shift( @ARGV ) ;
|
||||
&CTUDebug( "setting comment to '" . $comment . "'\n" ) ;
|
||||
$done = 0 ;
|
||||
}
|
||||
if ( $ARGV[0] eq "-eltype" ) {
|
||||
shift( @ARGV ) ;
|
||||
$eltype = $ARGV[0] ;
|
||||
shift( @ARGV ) ;
|
||||
&CTUDebug( "setting eltype to '" . $eltype . "'\n" ) ;
|
||||
$done = 0 ;
|
||||
}
|
||||
}
|
||||
|
||||
if ( $#ARGV < 0 ) {
|
||||
&CTMkElemUsage ;
|
||||
}
|
||||
|
||||
$projname = &CTProj ;
|
||||
$projname =~ tr/A-Z/a-z/ ;
|
||||
$flav = &CTQueryProj( $projname ) ;
|
||||
$spec = &CTResolveSpec( $projname, $flav ) ;
|
||||
|
||||
foreach $item ( @ARGV ) {
|
||||
if ( -e $item ) {
|
||||
if ( -d $item ) {
|
||||
print STDERR "Cannot mkelem on an existing directory." .
|
||||
" Ctmkdir it first.\n" ;
|
||||
} else {
|
||||
if ( ! &CTCMMkelem( $item, $projname, $spec, $comment, $eltype )) {
|
||||
print STDERR "Could not make a versioned element of '" .
|
||||
$item . "'\n" ;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print STDERR "No such file '$item'.\n" ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
if ( $#ARGV != 1 ) {
|
||||
exit print "Usage: ctmv from-element to-element\n" ;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "Environment not configured for CTtools" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$projname = &CTProj ;
|
||||
$projname =~ tr/A-Z/a-z/ ;
|
||||
$flav = &CTQueryProj( $projname ) ;
|
||||
$spec = &CTResolveSpec( $projname, $flav ) ;
|
||||
|
||||
$from = $ARGV[0] ;
|
||||
$to = $ARGV[1] ;
|
||||
|
||||
if ( -e $from ) {
|
||||
if ( -e $to ) {
|
||||
print STDERR "'$to' already exists.\n" ;
|
||||
} else {
|
||||
if ( ! &CTCMMv( $from, $to, $projname, $spec ) ) {
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print STDERR "No such element '$from'.\n" ;
|
||||
}
|
||||
|
|
@ -1,258 +0,0 @@
|
|||
# given a possibly empty string, format it into a comment or -nc
|
||||
# input is in:
|
||||
# $_[0] = possible comment string
|
||||
#
|
||||
# output is:
|
||||
# string for use by neartool functions
|
||||
sub CTNtoolFormatComment {
|
||||
local( $ret ) = "" ;
|
||||
if ( $_[0] eq "" ) {
|
||||
$ret = "-nc" ;
|
||||
} else {
|
||||
$ret = "-c \"" . $_[0] . "\"" ;
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# make a versioned directory
|
||||
# input is in:
|
||||
# $_[0] = directory to create
|
||||
# $_[1] = curr dir
|
||||
# $_[2] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTNtoolMkdir {
|
||||
&CTUDebug( "in CTNtoolMkdir\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $dir ) = $_[0] ;
|
||||
if ( ! ( $dir =~ /^\// )) {
|
||||
$dir = $_[1] . "/" . $dir ;
|
||||
}
|
||||
local( $comment ) = &CTNtoolFormatComment( $_[2] ) ;
|
||||
# first we have to check out the parent directory
|
||||
local( @alist ) = split( /\//, $dir ) ;
|
||||
pop( @alist ) ;
|
||||
local( $parent ) = join( "/", @alist ) ;
|
||||
&CTUDebug( "parent directory of '" . $dir . "' is '" . $parent . "'\n" ) ;
|
||||
$ret = system( "neartool co -nc $parent\n" ) ;
|
||||
if ( $ret == 0 ) {
|
||||
# now make the dir
|
||||
$ret = &CTURetCode( system( "neartool mkdir " . $comment .
|
||||
" $dir\n" )) ;
|
||||
} else {
|
||||
$ret = 0 ;
|
||||
}
|
||||
&CTUDebug( "out of CTNtoolMkdir\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# make a versioned element
|
||||
# input is in:
|
||||
# $_[0] = element to version
|
||||
# $_[1] = curr dir
|
||||
# $_[2] = possible comment
|
||||
# $_[3] = possible eltype
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTNtoolMkelem {
|
||||
&CTUDebug( "in CTNtoolMkelem\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $elem ) = $_[0] ;
|
||||
if ( ! ( $elem =~ /^\// )) {
|
||||
$elem = $_[1] . "/" . $elem ;
|
||||
}
|
||||
local( $comment ) = &CTNtoolFormatComment( $_[2] ) ;
|
||||
local( $eltype ) = $_[3] ;
|
||||
if ( $eltype ne "" ) {
|
||||
$eltype = "-eltype " . $eltype ;
|
||||
}
|
||||
local( $line ) = "neartool mkelem " . $comment . " " . $eltype . " " .
|
||||
$elem . "\n" ;
|
||||
&CTUDebug( $line ) ;
|
||||
$ret = &CTURetCode( system( $line )) ;
|
||||
&CTUDebug( "out of CTNtoolMkelem\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# delta an element
|
||||
# input is in:
|
||||
# $_[0] = element to delta
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTNtoolDelta {
|
||||
&CTUDebug( "in CTNtoolDelta\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
# as Dave points out, when working off-line, delta is the same as checkin
|
||||
$ret = &CTURetCode( system( "neartool ci " . $_[0] )) ;
|
||||
&CTUDebug( "out of CTNtoolDelta\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# checkout an element
|
||||
# input is in:
|
||||
# $_[0] = element to checkout
|
||||
# $_[1] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTNtoolCheckout {
|
||||
&CTUDebug( "in CTNtoolCheckout\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $comment ) = &CTNtoolFormatComment( $_[1] ) ;
|
||||
if ( ! -d $_[0] ) {
|
||||
$ret = &CTURetCode( system( "neartool co " . $comment . " " .
|
||||
$_[0] )) ;
|
||||
} else {
|
||||
# neartool doesn't do anything about checking out directories
|
||||
$ret = 1 ;
|
||||
}
|
||||
&CTUDebug( "out of CTNtoolCheckout\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# checkin an element
|
||||
# input is in:
|
||||
# $_[0] = element to checkin
|
||||
# $_[1] = possible comment
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTNtoolCheckin {
|
||||
&CTUDebug( "in CTNtoolCheckin\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $comment ) = &CTNtoolFormatComment( $_[1] ) ;
|
||||
$ret = &CTURetCode( system( "neartool ci " . $comment . " " . $_[0] )) ;
|
||||
&CTUDebug( "out of CTNtoolCheckin\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# uncheckout an element
|
||||
# input is in:
|
||||
# $_[0] = element to uncheckout
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTNtoolUncheckout {
|
||||
&CTUDebug( "in CTNtoolUncheckout\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
$ret = &CTURetCode( system( "neartool unco " . $_[0] )) ;
|
||||
&CTUDebug( "out of CTNtoolUncheckout\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# figure out what all I have checked out
|
||||
# input is in:
|
||||
# $_[0] = project
|
||||
# $_[1] = flavor
|
||||
# $_[2] = spec line
|
||||
#
|
||||
# output:
|
||||
# return a \n serperated list of elements checked out
|
||||
sub CTNtoolIHave {
|
||||
&CTUDebug( "in CTNtoolIHave\n" ) ;
|
||||
local( $ret ) = "" ;
|
||||
local( $root ) = &CTProjRoot( $_[0] ) ;
|
||||
local( *OUTPUT ) ;
|
||||
open( OUTPUT, "neartool find " . $root . " |" ) ;
|
||||
while ( <OUTPUT> ) {
|
||||
$ret = $ret . $_ ;
|
||||
}
|
||||
close( OUTPUT ) ;
|
||||
&CTUDebug( "out of CTNToolIHave\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# remove a versioned element
|
||||
# input is in:
|
||||
# $_[0] = element to remove
|
||||
# $_[1] = curr dir
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTNtoolRmElem {
|
||||
&CTUDebug( "in CTNtoolRmElem\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $elem ) = $_[0] ;
|
||||
if ( ! ( $elem =~ /^\// )) {
|
||||
$elem = $_[1] . "/" . $elem ;
|
||||
}
|
||||
# first we have to check out the parent directory
|
||||
local( @alist ) = split( /\//, $elem ) ;
|
||||
pop( @alist ) ;
|
||||
local( $parent ) = join( "/", @alist ) ;
|
||||
&CTUDebug( "parent directory of '" . $elem . "' is '" . $parent . "'\n" ) ;
|
||||
$ret = system( "neartool co -nc $parent\n" ) ;
|
||||
if ( $ret == 0 ) {
|
||||
# now nuke the element
|
||||
$ret = &CTURetCode( system( "neartool rmname $elem\n" )) ;
|
||||
} else {
|
||||
$ret = 0 ;
|
||||
}
|
||||
&CTUDebug( "out of CTNtoolRmElem\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# mv a versioned element from one name to another
|
||||
# input is in:
|
||||
# $_[0] = from element
|
||||
# $_[1] = to element
|
||||
# $_[2] = current directory
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTNtoolMv {
|
||||
&CTUDebug( "in CTNtoolMv\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $elem ) = $_[0] ;
|
||||
if ( ! ( $elem =~ /^\// )) {
|
||||
$elem = $_[2] . "/" . $elem ;
|
||||
}
|
||||
# first we have to check out the parent directory
|
||||
local( @alist ) = split( /\//, $elem ) ;
|
||||
pop( @alist ) ;
|
||||
local( $parent ) = join( "/", @alist ) ;
|
||||
&CTUDebug( "parent directory of '" . $elem . "' is '" . $parent . "'\n" ) ;
|
||||
local( $elem2 ) = $_[1] ;
|
||||
if ( ! ( $elem2 =~ /^\// )) {
|
||||
$elem2 = $_[2] . "/" . $elem2 ;
|
||||
}
|
||||
@alist = split( /\//, $elem2 ) ;
|
||||
pop( @alist ) ;
|
||||
local( $parent2 ) = join( "/", @alist ) ;
|
||||
&CTUDebug( "parent directory of '" . $elem2 . "' is '" . $parent2 .
|
||||
"'\n" ) ;
|
||||
$ret = system( "neartool co -nc $parent\n" ) ;
|
||||
if ( $ret == 0 ) {
|
||||
$ret = system( "neartool co -nc $parent2\n" ) ;
|
||||
if ( $ret == 0 ) {
|
||||
# now move the element
|
||||
$ret = &CTURetCode( system( "neartool mv $elem $elem2\n" )) ;
|
||||
} else {
|
||||
$ret = 0 ;
|
||||
}
|
||||
} else {
|
||||
$ret = 0 ;
|
||||
}
|
||||
&CTUDebug( "out of CTNtoolMv\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# build a list of targets
|
||||
# input is in:
|
||||
# $_[0] = targets
|
||||
#
|
||||
# output:
|
||||
# return success or failure
|
||||
sub CTNtoolMake {
|
||||
&CTUDebug( "in CTNtoolMake\n" ) ;
|
||||
local( $ret ) = 0 ;
|
||||
local( $line ) = "make " . $_[0] . "\n" ;
|
||||
$ret = &CTURetCode( system( $line )) ;
|
||||
&CTUDebug( "out of CTNtoolMake\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,60 +0,0 @@
|
|||
require "$tool/built/include/ctutils.pl" ;
|
||||
|
||||
# return the root of the given project.
|
||||
sub CTProjRoot {
|
||||
local( $CTPRtmp ) = $_[0] ;
|
||||
$CTPRtmp =~ tr/a-z/A-Z/ ;
|
||||
local( $CTPRret ) = $ENV{ $CTPRtmp } ;
|
||||
$CTPRret ;
|
||||
}
|
||||
|
||||
# return the package we're currently in.
|
||||
# input:
|
||||
# $_[0] = project
|
||||
sub CTProjPkg {
|
||||
local( $CTPPret ) = &CTUCurrDir() ;
|
||||
local( $CTPPtmp ) = $_[0] ;
|
||||
$CTPPtmp =~ tr/a-z/A-Z/ ;
|
||||
$CTPPret =~ s/$ENV{ $CTPPtmp }// ;
|
||||
$CTPPret =~ s/\/src\/// ;
|
||||
$CTPPret =~ s/\/metalibs\/// ;
|
||||
$CTPPret ;
|
||||
}
|
||||
|
||||
# reutrn the project containing the given directory. If no directory is given,
|
||||
# return the project containing the current directory.
|
||||
sub CTProj {
|
||||
local( $CTPdir ) ;
|
||||
if ($_[0] eq "") {
|
||||
$CTPdir = &CTUCurrDir() ;
|
||||
} else {
|
||||
# provided directory
|
||||
$CTPdir = $_[0] ;
|
||||
}
|
||||
local( $CTPprojs ) = $ENV{"CTPROJS"} ;
|
||||
local( $CTPdone ) = "" ;
|
||||
local( @CTPlist ) ;
|
||||
@CTPlist = split( / /, $CTPprojs ) ;
|
||||
local( @CTPlist2 ) ;
|
||||
local( $CTPtry ) ;
|
||||
while (( $CTPdone eq "" ) && ( @CTPlist != () )){
|
||||
# pop the first one off the list
|
||||
$CTPtmp = $CTPlist[0] ;
|
||||
shift( @CTPlist ) ;
|
||||
# split the project from it's flavor
|
||||
@CTPlist2 = split( /:/, $CTPtmp );
|
||||
$CTPtry = &CTProjRoot( $CTPlist2[0] ) ;
|
||||
# is CTPtry prefix of CTPdir? if so we have our winner
|
||||
if ( $CTPdir =~ /^$CTPtry/ ) {
|
||||
$CTPdone = "yep" ;
|
||||
}
|
||||
}
|
||||
if ( $CTPdone eq "" ) {
|
||||
$CTPtry = "" ;
|
||||
} else {
|
||||
$CTPtry = $CTPlist2[0] ;
|
||||
}
|
||||
$CTPtry ;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,42 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# acceptable forms:
|
||||
# ctquery - list all attached projects and flavors
|
||||
# ctquery project - list the attached flavor of the named project
|
||||
# ctquery - flavor - list all attached projects who are attached with a
|
||||
# given flavor
|
||||
|
||||
$projs = $ENV{"CTPROJS"} ;
|
||||
@projlist = split( / +/, $projs ) ;
|
||||
|
||||
if ( $#ARGV == -1 ) {
|
||||
# list all projects and flavors
|
||||
print "Currently attached projects (and flavors):\n" ;
|
||||
foreach $pair ( @projlist ) {
|
||||
@pairlist = split( /:/, $pair ) ;
|
||||
( $pairtmp = $pairlist[0] ) =~ tr/A-Z/a-z/ ;
|
||||
print " $pairtmp ($pairlist[1])\n" ;
|
||||
}
|
||||
} elsif (( $#ARGV == 0 ) && !($ARGV[0] =~ /^\-/)) {
|
||||
# list the attached flavor of the named project
|
||||
foreach $pair ( @projlist ) {
|
||||
@pairlist = split( /:/, $pair ) ;
|
||||
( $pairtmp = $pairlist[0] ) =~ tr/A-Z/a-z/ ;
|
||||
if ( $pairtmp eq $ARGV[0] ) {
|
||||
print "$pairlist[1]\n" ;
|
||||
}
|
||||
}
|
||||
} elsif (( $#ARGV == 1 ) && ( $ARGV[0] eq "-" )){
|
||||
# list all attached projects who are attached with a given flavor
|
||||
foreach $pair ( @projlist ) {
|
||||
@pairlist = split( /:/, $pair ) ;
|
||||
if ( $pairlist[1] eq $ARGV[1] ) {
|
||||
$pairlist[0] =~ tr/A-Z/a-z/ ;
|
||||
print "$pairlist[0]\n" ;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print "Usage: ctquery [project] -or-\n" ;
|
||||
print " ctquery - flavor\n" ;
|
||||
exit ;
|
||||
}
|
||||
|
|
@ -1,37 +0,0 @@
|
|||
# return the attached flavor of given project (or empty string)
|
||||
sub CTQueryProj {
|
||||
local( $projs ) = $ENV{"CTPROJS"} ;
|
||||
local( @projlist ) ;
|
||||
@projlist = split( / +/, $projs ) ;
|
||||
local( $pair ) ;
|
||||
local( @pairlist ) ;
|
||||
local( $ret ) = "" ;
|
||||
foreach $pair ( @projlist ) {
|
||||
@pairlist = split( /:/, $pair ) ;
|
||||
$pairlist[0] =~ tr/A-Z/a-z/ ;
|
||||
if ( $pairlist[0] eq $_[0] ) {
|
||||
$ret = $pairlist[1] ;
|
||||
}
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# return all projects attached with a given flavor
|
||||
sub CTQueryFlav {
|
||||
local( $projs ) = $ENV{"CTPROJS"} ;
|
||||
local( @projlist ) ;
|
||||
@projlist = split( / +/, $projs ) ;
|
||||
local( $pair ) ;
|
||||
local( @pairlist ) ;
|
||||
local( $ret ) = "" ;
|
||||
foreach $pair ( @projlist ) {
|
||||
@pairlist = split( /:/, $pair ) ;
|
||||
if ( $pairlist[1] eq $_[0] ) {
|
||||
$pairlist[0] =~ tr/A-Z/a-z/ ;
|
||||
$ret = $ret . " $pairlist[0]" ;
|
||||
}
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
if ( $#ARGV < 0 ) {
|
||||
exit print "Usage: ctrmelem element-name [...]\n" ;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "Environment not configured for CTtools" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$projname = &CTProj ;
|
||||
$projname =~ tr/A-Z/a-z/ ;
|
||||
$flav = &CTQueryProj( $projname ) ;
|
||||
$spec = &CTResolveSpec( $projname, $flav ) ;
|
||||
|
||||
foreach $item ( @ARGV ) {
|
||||
if ( -e $item ) {
|
||||
if ( ! &CTCMRmElem( $item, $projname, $spec ) ) {
|
||||
print STDERR "Could not rmname '$item'\n" ;
|
||||
}
|
||||
} else {
|
||||
print STDERR "No such file '$item'.\n" ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,43 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "Environment not configured to run CTtools" ;
|
||||
}
|
||||
|
||||
sub CTSanityUsage {
|
||||
print STDERR "Usage: ctsanity [-v]\n" ;
|
||||
print STDERR "Options:\n" ;
|
||||
print STDERR " -v : sanity check the .vspec files \n" ;
|
||||
exit ;
|
||||
}
|
||||
|
||||
if ( $#ARGV == -1 ) {
|
||||
&CTSanityUsage ;
|
||||
}
|
||||
|
||||
$check_vspecs = 0 ;
|
||||
|
||||
foreach $item ( @ARGV ) {
|
||||
if ( $item eq "-v" ) {
|
||||
$check_vspecs = 1 ;
|
||||
} else {
|
||||
print STDERR "unknown option '" . $item . "'\n" ;
|
||||
$CTSanityUsage ;
|
||||
}
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
|
||||
if ( $check_vspecs ) {
|
||||
local( $projs ) = &CTListAllProjects ;
|
||||
local( @projlist ) = split( / +/, $projs ) ;
|
||||
local( $item ) ;
|
||||
foreach $item ( @projlist ) {
|
||||
print STDERR "checking " . $item . ".vspec:\n" ;
|
||||
local( $ctsavedebug ) = $ctdebug ;
|
||||
$ctdebug = 1 ;
|
||||
&CTReadVSpec( $item ) ;
|
||||
$ctdebug = $ctsavedebug ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,43 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
if ($#ARGV < 0) {
|
||||
exit print "Usage: cttimewarp [-clear] label [time]\n" ;
|
||||
}
|
||||
|
||||
@arglist = @ARGV ;
|
||||
|
||||
$clear = 0 ;
|
||||
|
||||
if ( $arglist[0] =~ /^-c/ ) {
|
||||
$clear = 1 ;
|
||||
shift( @arglist ) ;
|
||||
}
|
||||
|
||||
if ( @arglist == () ) {
|
||||
if ( $clear ) {
|
||||
exit print "Usage: cttimewarp -clear label\n" ;
|
||||
} else {
|
||||
exit print "Usage: cttimewarp label time\n" ;
|
||||
}
|
||||
}
|
||||
|
||||
$label = $arglist[0] ;
|
||||
shift( @arglist ) ;
|
||||
|
||||
if (( ! $clear ) && ( @arglist == () )) {
|
||||
exit print "Usage: cttimewarp label time\n" ;
|
||||
}
|
||||
|
||||
$time = $arglist[0] ;
|
||||
|
||||
if ( $clear ) {
|
||||
$cmd = "cleartool find . -version \"lbtype(" . $label .
|
||||
")\" -exec 'cleartool rmlabel -c \"untimewarping\" " . $label .
|
||||
' $CLEARCASE_XPN' . "'\n" ;
|
||||
system( $cmd ) ;
|
||||
} else {
|
||||
$cmd = "cleartool mklabel -replace -recurse -c \"rolling time back to " .
|
||||
$time . "\" -version /main/'{\!created_since(" . $time . ")}' " .
|
||||
$label . " .\n" ;
|
||||
system( $cmd ) ;
|
||||
}
|
||||
|
|
@ -1,49 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# acceptable forms:
|
||||
# ctunattach project - attach to the personal flavor of the project
|
||||
|
||||
sub CTUnattachUsage {
|
||||
print STDERR "Usage: ctattach project(s)\n" ;
|
||||
&CTAttachWriteNullScript( $tmpname ) ;
|
||||
print $tmpname . "\n" ;
|
||||
exit;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
|
||||
require "$tool/built/include/ctattch.pl" ;
|
||||
require "$tool/built/include/ctunattach.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
|
||||
$tmpname = "/tmp/script.$$" ;
|
||||
|
||||
if ( $#ARGV == -1 ) {
|
||||
&CTUnattachUsage ;
|
||||
}
|
||||
|
||||
foreach $proj ( @ARGV ) {
|
||||
&CTUDebug( "project is '$proj'\n" ) ;
|
||||
|
||||
$curflav = &CTQueryProj( $proj ) ;
|
||||
if ( $curflav ne "" ) {
|
||||
$envsep{"PATH"} = ":" ;
|
||||
$envsep{"LD_LIBRARY_PATH"} = ":" ;
|
||||
$envsep{"DYLD_LIBRARY_PATH"} = ":" ;
|
||||
$envsep{"PFPATH"} = ":" ;
|
||||
$envsep{"SSPATH"} = ":" ;
|
||||
$envsep{"STKPATH"} = ":" ;
|
||||
$envsep{"DC_PATH"} = ":" ;
|
||||
$spec = &CTUnattachCompute( $proj, $curflav ) ;
|
||||
if ( $spec eq "" ) {
|
||||
&CTAttachWriteNullScript( $tmpname ) ;
|
||||
print $tmpname . "\n" ;
|
||||
} else {
|
||||
&CTUnattachWriteScript( $tmpname ) ;
|
||||
print $tmpname . "\n" ;
|
||||
}
|
||||
} else {
|
||||
&CTAttachWriteNullScript( $tmpname ) ;
|
||||
print $tmpname . "\n" ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,251 +0,0 @@
|
|||
require "$tool/built/include/ctquery.pl" ;
|
||||
|
||||
$shell_type = "csh" ;
|
||||
if ( $ENV{"SHELL_TYPE"} ne "" ) {
|
||||
if ( $ENV{"SHELL_TYPE"} eq "sh" ) {
|
||||
$shell_type = "sh" ;
|
||||
}
|
||||
}
|
||||
|
||||
# remove a value from a variable. If it is the only thing remaining in the
|
||||
# variable, add it to the unset list.
|
||||
# input is in:
|
||||
# $_[0] = variable
|
||||
# $_[1] = value
|
||||
#
|
||||
# output is in:
|
||||
# %newenv = an image of how we want the environment to be
|
||||
# @unset = a list of variables to unset
|
||||
sub CTUnattachMod {
|
||||
&CTUDebug( "in CTUnattachMod\n" ) ;
|
||||
local( $done ) = 0 ;
|
||||
# if we didn't get any data, nothing really to do
|
||||
if ( $_[0] eq "" ) { $done = 1 ; }
|
||||
if ( $_[1] eq "" ) { $done = 1 ; }
|
||||
# if the variable is already set to be unset, nothing really to do
|
||||
if ( join( " ", @unset ) =~ /$_[0]/ ) { $done = 1 ; }
|
||||
# if the variable isn't in newenv, move it there, if it's empty mark it
|
||||
# for unsetting
|
||||
if ( $newenv{$_[0]} eq "" ) {
|
||||
$newenv{$_[0]} = &CTSpoolEnv( $_[0] ) ;
|
||||
if ( $newenv{$_[0]} eq "" ) {
|
||||
push( @unset, $_[0] ) ;
|
||||
delete $newenv{$_[0]} ;
|
||||
$done = 1 ;
|
||||
}
|
||||
}
|
||||
# if the value does not appear in the variable, nothing really to do
|
||||
if ( ! ( $newenv{$_[0]} =~ /$_[1]/ ) ) { $done = 1 ; }
|
||||
# now down to the real work
|
||||
if ( ! $done ) {
|
||||
# if the variable is exactly the value, mark it for unsetting
|
||||
if ( $newenv{$_[0]} eq $_[1] ) {
|
||||
push( @unset, $_[0] ) ;
|
||||
delete $newenv{$_[0]} ;
|
||||
} elsif ( $newenv{$_[0]} =~ / $_[1]/ ) {
|
||||
local( $tmp ) = $newenv{$_[0]} ;
|
||||
$tmp =~ s/ $_[1]// ;
|
||||
$newenv{$_[0]} = $tmp ;
|
||||
} elsif ( $newenv{$_[0]} =~ /$_[1] / ) {
|
||||
local( $tmp ) = $newenv{$_[0]} ;
|
||||
$tmp =~ s/$_[1] // ;
|
||||
$newenv{$_[0]} = $tmp ;
|
||||
} else {
|
||||
print STDERR "ERROR: variable '" . $_[0] . "' contains '" .
|
||||
$_[1] . "' (in '" . $newenv{$_[0]} .
|
||||
"'), but I am too stupid to figure out how to remove it.\n" ;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# given the project and flavor, build the lists of variables to set/modify
|
||||
# input is in:
|
||||
# $_[0] = project
|
||||
# $_[1] = flavor
|
||||
#
|
||||
# output is in:
|
||||
# return value is config line
|
||||
# %newenv = an image of what we want the environment to look like
|
||||
# @unset = list of variables to be unset
|
||||
# %envsep = seperator
|
||||
# %envcmd = set or setenv
|
||||
# %envpostpend = flag that variable should be postpended
|
||||
sub CTUnattachCompute {
|
||||
&CTUDebug( "in CTUnattachCompute\n" ) ;
|
||||
local( $flav ) = $_[1] ;
|
||||
local( $spec ) = &CTResolveSpec( $_[0], $flav ) ;
|
||||
local( $root ) = &CTComputeRoot( $_[0], $flav, $spec ) ;
|
||||
|
||||
if ( $spec ne "" ) {
|
||||
local( $proj ) = $_[0] ;
|
||||
$proj =~ tr/a-z/A-Z/ ;
|
||||
local( $item ) ;
|
||||
|
||||
# since we don't have to worry about sub-attaches, it doesn't matter
|
||||
# if we scan the .init file first or not. So we won't.
|
||||
&CTUDebug( "extending paths\n" ) ;
|
||||
|
||||
$item = $root . "/built/bin" ;
|
||||
&CTUnattachMod( "PATH", $item ) ;
|
||||
$item = $root . "/built/lib" ;
|
||||
if ( $ENV{"PENV"} eq "WIN32" ) {
|
||||
&CTUnattachMod( "PATH", $item ) ;
|
||||
}
|
||||
&CTUnattachMod( "LD_LIBRARY_PATH", $item ) ;
|
||||
&CTUnattachMod( "DYLD_LIBRARY_PATH", $item ) ;
|
||||
#$item = $root . "/src/all" ;
|
||||
#&CTUnattachMod( "CDPATH", $item ) ;
|
||||
$item = $root . "/built/include" ;
|
||||
&CTUnattachMod( "CT_INCLUDE_PATH", $item ) ;
|
||||
$item = $root . "/built/etc" ;
|
||||
&CTUnattachMod( "ETC_PATH", $item ) ;
|
||||
$item = $proj . ":" . $flav ;
|
||||
&CTUnattachMod( "CTPROJS", $item ) ;
|
||||
push( @unset, $proj ) ;
|
||||
|
||||
if ( -e "$root/built/etc/$_[0].init" ) {
|
||||
&CTUDebug( "scanning $_[0].init file\n" ) ;
|
||||
local( @linesplit ) ;
|
||||
local( $linetmp ) ;
|
||||
local( $loop );
|
||||
local( *INITFILE ) ;
|
||||
if ( -x "$root/built/etc/$_[0].init" ) {
|
||||
open( INITFILE, "$root/built/etc/$_[0].init $_[0] $_[1] $root |" ) ;
|
||||
} else {
|
||||
open( INITFILE, "< $root/built/etc/$_[0].init" ) ;
|
||||
}
|
||||
while ( <INITFILE> ) {
|
||||
s/\n$// ;
|
||||
@linesplit = split( /\#/ ) ;
|
||||
$_ = $linesplit[0] ;
|
||||
if ( $_ =~ /^MODABS/ ) {
|
||||
@linesplit = split ;
|
||||
$linetmp = $linesplit[1] ;
|
||||
shift( @linesplit ) ;
|
||||
shift( @linesplit ) ;
|
||||
foreach $loop ( @linesplit ) {
|
||||
&CTUnattachMod( $linetmp, $loop ) ;
|
||||
}
|
||||
} elsif ( $_ =~ /^MODREL/ ) {
|
||||
@linesplit = split ;
|
||||
$linetmp = $linesplit[1] ;
|
||||
shift( @linesplit ) ;
|
||||
shift( @linesplit ) ;
|
||||
foreach $loop ( @linesplit ) {
|
||||
&CTUnattachMod( $linetmp, $root . "/" . $loop ) ;
|
||||
}
|
||||
} elsif ( $_ =~ /^SETABS/ ) {
|
||||
@linesplit = split ;
|
||||
$linetmp = $linesplit[1] ;
|
||||
push( @unset, $linetmp ) ;
|
||||
} elsif ( $_ =~ /^SETREL/ ) {
|
||||
@linesplit = split ;
|
||||
$linetmp = $linesplit[1] ;
|
||||
push( @unset, $linetmp ) ;
|
||||
} elsif ( $_ =~ /^SEP/ ) {
|
||||
@linesplit = split ;
|
||||
$envsep{$linesplit[1]} = $linesplit[2] ;
|
||||
} elsif ( $_ =~ /^CMD/ ) {
|
||||
@linesplit = split ;
|
||||
$envcmd{$linesplit[1]} = $linesplit[2] ;
|
||||
} elsif ( $_ =~ /^DOCSH/ ) {
|
||||
&CTUDebug( "ignoring DO command in .init file\n" ) ;
|
||||
} elsif ( $_ =~ /^DOSH/ ) {
|
||||
&CTUDebug( "ignoring DO command in .init file\n" ) ;
|
||||
} elsif ( $_ =~ /^DO/ ) {
|
||||
&CTUDebug( "ignoring DO command in .init file\n" ) ;
|
||||
} elsif ( $_ =~ /^POSTPEND/ ) {
|
||||
@linesplit = split ;
|
||||
$envpospend{$linesplit[1]} = 1 ;
|
||||
} elsif ( $_ =~ /^ATTACH/ ) {
|
||||
&CTUDebug( "ignoring ATTACH command in .init file\n" ) ;
|
||||
} else {
|
||||
print STDERR "Unknown .init directive '$_'\n" ;
|
||||
}
|
||||
}
|
||||
close( INITFILE ) ;
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTUnattachCompute\n" ) ;
|
||||
$spec ;
|
||||
}
|
||||
|
||||
# write a script to setup the environment
|
||||
# Input is:
|
||||
# $_[0] = filename
|
||||
sub CTUnattachWriteScript {
|
||||
&CTUDebug( "in CTAttachWriteScript\n" ) ;
|
||||
local( *OUTFILE ) ;
|
||||
open( OUTFILE, ">$_[0]" ) ;
|
||||
print OUTFILE "#!/bin/" . $shell_type . " -f\n" ;
|
||||
local( $item ) ;
|
||||
#local( $unsetcdpath ) = 0 ;
|
||||
#local( $modcdpath ) = 0 ;
|
||||
|
||||
foreach $item ( @unset ) {
|
||||
#if ( $item eq "CDPATH" ) { $unsetcdpath = 1 ; }
|
||||
|
||||
if ( $shell_type eq "sh" ) {
|
||||
print OUTFILE "$item=\n" ;
|
||||
if ( $envcmd{$item} ne "set" ) {
|
||||
print OUTFILE "export $item\n" ;
|
||||
}
|
||||
} else {
|
||||
if ( $envcmd{$item} ne "" ) {
|
||||
print OUTFILE "un" . $envcmd{$item} . " $item\n" ;
|
||||
} else {
|
||||
print OUTFILE "unsetenv $item\n" ;
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach $item ( keys %newenv ) {
|
||||
#if ( $item eq "CDPATH" ) { $modcdpath = 1 ; }
|
||||
|
||||
local( $sep ) = " " ;
|
||||
if ( $envsep{$item} ne "" ) {
|
||||
$sep = $envsep{$item} ;
|
||||
}
|
||||
local( @splitlist ) = split( / +/, $newenv{$item} ) ;
|
||||
local( $outval ) = join( $sep, @splitlist ) ;
|
||||
|
||||
if ( $shell_type eq "sh" ) {
|
||||
print OUTFILE "$item=\"" . $outval . "\"\n" ;
|
||||
if ( $envcmd{$item} ne "set" ) {
|
||||
print OUTFILE "export $item\n" ;
|
||||
}
|
||||
} else {
|
||||
if ( $envcmd{$item} ne "" ) {
|
||||
PRINT OUTFILE $envcmd{$item} . " $item " ;
|
||||
if ( $envcmd{$item} eq "set" ) {
|
||||
print OUTFILE " = ( " ;
|
||||
}
|
||||
print OUTFILE $outval ;
|
||||
if ( $envcmd{$item} eq "set" ) {
|
||||
print OUTFILE ")" ;
|
||||
}
|
||||
print OUTFILE "\n" ;
|
||||
} else {
|
||||
print OUTFILE "setenv $item \"$outval\"\n" ;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if ( $unsetcdpath ) {
|
||||
# if ( $shell_type ne "sh" ) {
|
||||
# print OUTFILE "unset cdpath\n" ;
|
||||
# }
|
||||
#} elsif ( $modcdpath ) {
|
||||
# if ( $shell_type ne "sh" ) {
|
||||
# print OUTFILE "set cdpath = ( \$" . "CDPATH )\n" ;
|
||||
# }
|
||||
#}
|
||||
|
||||
if (! $ctdebug) {
|
||||
print OUTFILE "rm -f $_[0]\n" ;
|
||||
} else {
|
||||
print STDERR "no self-destruct script '" . $_[0] . "'\n" ;
|
||||
}
|
||||
close( OUTFILE ) ;
|
||||
&CTUDebug( "out of CTUnattachWriteScript\n" ) ;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
if ( $#ARGV < 0 ) {
|
||||
exit print "Usage ctunco element-name [...]\n" ;
|
||||
}
|
||||
|
||||
$tool = $ENV{"DTOOL"} ;
|
||||
if ( $tool eq "" ) {
|
||||
die "not configured for using CTtools" ;
|
||||
}
|
||||
|
||||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctvspec.pl" ;
|
||||
require "$tool/built/include/ctquery.pl" ;
|
||||
require "$tool/built/include/ctproj.pl" ;
|
||||
require "$tool/built/include/ctcm.pl" ;
|
||||
|
||||
$projname = &CTProj ;
|
||||
$projname =~ tr/A-Z/a-z/ ;
|
||||
$flav = &CTQueryProj( $projname ) ;
|
||||
$spec = &CTResolveSpec( $projname, $flav ) ;
|
||||
|
||||
foreach $item ( @ARGV ) {
|
||||
if ( -e $item ) {
|
||||
if ( ! &CTCMUncheckout( $item, $projname, $spec ) ) {
|
||||
print STDERR "Could not uncheckout '$item'\n" ;
|
||||
}
|
||||
} else {
|
||||
print STDERR "No such file '$item'.\n" ;
|
||||
}
|
||||
}
|
||||
|
|
@ -1,47 +0,0 @@
|
|||
# evaluate the given parameter to expand shell variables
|
||||
sub CTUShellEval {
|
||||
local( *CTUSEFILE ) ;
|
||||
open( CTUSEFILE, "echo $_[0] |" ) ;
|
||||
local( $CTUSEret ) = <CTUSEFILE> ;
|
||||
close( CTUSEFILE ) ;
|
||||
$CTUSEret =~ s/\n$// ;
|
||||
$CTUSEret ;
|
||||
}
|
||||
|
||||
# if debug is on, print the argument
|
||||
sub CTUDebug {
|
||||
if ( $ctdebug ) {
|
||||
print STDERR $_[0] ;
|
||||
}
|
||||
}
|
||||
|
||||
use Cwd ;
|
||||
# get current directory
|
||||
sub CTUCurrDir {
|
||||
local( $pwd ) = getcwd() ;
|
||||
if ( $pwd =~ /^\/vobs/ ) {
|
||||
local( *VFILE ) ;
|
||||
open( VFILE, "cleartool pwv -short |" ) ;
|
||||
local( $view ) = <VFILE> ;
|
||||
close( VFILE ) ;
|
||||
$view =~ s/\n$// ;
|
||||
$pwd = "/view/" . $view . $pwd ;
|
||||
}
|
||||
$pwd ;
|
||||
}
|
||||
|
||||
# turn a shell return code into a success/fail flag
|
||||
sub CTURetCode {
|
||||
local( $ret ) ;
|
||||
if ( $_[0] == 0 ) {
|
||||
$ret = 1 ;
|
||||
} else {
|
||||
$ret = 0 ;
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
$ctdebug = $ENV{"CTATTACH_DEBUG"} ;
|
||||
$ctvspec_path = '/usr/local/etc' unless $ctvspec_path = $ENV{'CTVSPEC_PATH'};
|
||||
|
||||
1;
|
||||
|
|
@ -1,360 +0,0 @@
|
|||
require "$tool/built/include/ctutils.pl" ;
|
||||
|
||||
# read a .vspec file into a map
|
||||
# $_[0] = project
|
||||
# on exit $ctvspecs{} will contain the data
|
||||
#
|
||||
# vspec format:
|
||||
# tag:type:other data
|
||||
#
|
||||
# type: ref, root, vroot, croot
|
||||
# other data:
|
||||
# ref: name=_____ - required, take to refference
|
||||
# root: path=_____ - required, path of tree root
|
||||
# vroot: name=_____ - optional, name of view to use (if not tag)
|
||||
# croot: path=_____ - required, local path of tree root
|
||||
# server=_____ - required, CVS server string, ',' for ':'
|
||||
|
||||
sub CTReadVSpec {
|
||||
&CTUDebug( "reading vspec file for project " . $_[0] . "\n" ) ;
|
||||
local( $ret ) = "" ;
|
||||
local( $thisproj ) = $_[0] ;
|
||||
if ( -e "$ctvspec_path/$thisproj.vspec" ) {
|
||||
%ctvspecs = () ;
|
||||
local( *SPECFILE ) ;
|
||||
open( SPECFILE, "<$ctvspec_path/$thisproj.vspec" ) ;
|
||||
local( @partlist ) ;
|
||||
while ( $_ = <SPECFILE> ) {
|
||||
s/\n$// ;
|
||||
@partlist = split( /\#/ ) ;
|
||||
$_ = $partlist[0] ;
|
||||
if ( $_ ne "" ) {
|
||||
@partlist = split( /:/ );
|
||||
local( $tag ) = $partlist[0] ;
|
||||
shift( @partlist ) ;
|
||||
local( $spec ) = join( ":", @partlist ) ;
|
||||
if ( &CTValidateSpec( $spec ) ) {
|
||||
$ctvspecs{$tag} = $spec ;
|
||||
if ( $ctdebug ) {
|
||||
print STDERR "tag(" . $tag . ") = " . $spec . "\n" ;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
close( SPECFILE ) ;
|
||||
$ctvspec_read = $_[0] ;
|
||||
} else {
|
||||
print STDERR "CTReadVSpec: cannot locate '$ctvspec_path/$thisproj.vspec'\n" ;
|
||||
print STDERR "(did you forget to run the \$WINTOOLS/cp_vspec script?)\n" ;
|
||||
}
|
||||
}
|
||||
|
||||
# given a spec line return it's type
|
||||
# $_[0] = spec line
|
||||
|
||||
sub CTSpecType {
|
||||
local( @speclist ) = split( /:/, $_[0] ) ;
|
||||
$speclist[0] ;
|
||||
}
|
||||
|
||||
# given a spec line return it's options if any
|
||||
# $_[0] = spec line
|
||||
|
||||
sub CTSpecOptions {
|
||||
local( @speclist ) = split( /:/, $_[0] ) ;
|
||||
shift( @speclist ) ;
|
||||
join( ":", @speclist ) ;
|
||||
}
|
||||
|
||||
# given the options part of a spec line, find a given option
|
||||
# $_[0] = options line
|
||||
# $_[1] = desired option
|
||||
|
||||
sub CTSpecFindOption {
|
||||
local( $ret ) = "" ;
|
||||
local( @options ) = split( /:/, $_[0] ) ;
|
||||
local( $item ) ;
|
||||
local( @itemlist ) ;
|
||||
foreach $item ( @options ) {
|
||||
@itemlist = split( /=/, $item ) ;
|
||||
if ( $itemlist[0] eq $_[1] ) {
|
||||
$ret = $itemlist[1] ;
|
||||
}
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# resolve a final spec line for a given flavor
|
||||
# $_[0] = project
|
||||
# $_[1] = flavor
|
||||
|
||||
sub CTResolveSpec {
|
||||
&CTUDebug( "in CTResolveSpec\n" ) ;
|
||||
local( $proj ) = $_[0] ;
|
||||
$proj =~ tr/A-Z/a-z/ ;
|
||||
if ( $ctvspec_read ne $proj ) {
|
||||
&CTReadVSpec( $proj ) ;
|
||||
}
|
||||
local( $spec ) = $ctvspecs{$_[1]} ;
|
||||
local( $ret ) = "" ;
|
||||
if ( $spec ne "" ) {
|
||||
local( $type ) = &CTSpecType( $spec ) ;
|
||||
local( @speclist ) = split( /:/, &CTSpecOptions( $spec ) ) ;
|
||||
if ( $type eq "ref" ) {
|
||||
local( @optionlist ) = split( /=/, $speclist[0] ) ;
|
||||
if ( $optionlist[0] ne "name" ) {
|
||||
print STDERR "bad data attached to flavor " . $_[1] .
|
||||
" of project " . $proj . "\n" ;
|
||||
} else {
|
||||
local( $tmp ) = &CTUShellEval( $optionlist[1] ) ;
|
||||
if ( $ctdebug ) {
|
||||
print STDERR "resolved a 'ref' to " . $tmp .
|
||||
", recuring\n" ;
|
||||
}
|
||||
$ret = &CTResolveSpec( $proj, $tmp ) ;
|
||||
}
|
||||
} else {
|
||||
$ret = $spec ;
|
||||
}
|
||||
}
|
||||
if ( $ret eq "" ) {
|
||||
print STDERR "unknown flavor " . $_[1] . " of project " . $proj .
|
||||
"\n" ;
|
||||
}
|
||||
&CTUDebug( "out of CTResolveSpec\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# resolve the final name for a given flavor
|
||||
# $_[0] = project
|
||||
# $_[1] = flavor
|
||||
|
||||
sub CTResolveSpecName {
|
||||
&CTUDebug( "in CTResolveSpecName\n" ) ;
|
||||
local( $proj ) = $_[0] ;
|
||||
$proj =~ tr/A-Z/a-z/ ;
|
||||
if ( $ctvspec_read ne $proj ) {
|
||||
&CTReadVSpec( $proj ) ;
|
||||
}
|
||||
local( $spec ) = $ctvspecs{$_[1]} ;
|
||||
local( $ret ) = $_[1] ;
|
||||
if ( $spec ne "" ) {
|
||||
local( $type ) = &CTSpecType( $spec ) ;
|
||||
local( @speclist ) = split( /:/, &CTSpecOptions( $spec ) ) ;
|
||||
if ( $type eq "ref" ) {
|
||||
local( @optionlist ) = split( /=/, $speclist[0] ) ;
|
||||
if ( $optionlist[0] ne "name" ) {
|
||||
print STDERR "bad data attached to flavor " . $_[1] .
|
||||
" of project " . $proj . "\n" ;
|
||||
} else {
|
||||
local( $tmp ) = &CTUShellEval( $optionlist[1] ) ;
|
||||
if ( $ctdebug ) {
|
||||
print STDERR "resolved a 'ref' to " . $tmp .
|
||||
", recuring\n" ;
|
||||
}
|
||||
$ret = &CTResolveSpecName( $proj, $tmp ) ;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $ret eq "" ) {
|
||||
print STDERR "unknown flavor " . $_[1] . " of project " . $proj .
|
||||
"\n" ;
|
||||
}
|
||||
&CTUDebug( "out of CTResolveSpecName\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# validate a spec line
|
||||
# $_[0] = spec line
|
||||
|
||||
sub CTValidateSpec {
|
||||
local( $ret ) = 0 ;
|
||||
local( $type ) = &CTSpecType( $_[0] ) ;
|
||||
local( @speclist ) = split( /:/, &CTSpecOptions( $_[0] ) ) ;
|
||||
local( $have_error ) = 0 ;
|
||||
local( $item ) ;
|
||||
local( @itemlist ) ;
|
||||
if ( $type eq "ref" ) {
|
||||
local( $have_name ) = 0 ;
|
||||
foreach $item ( @speclist ) {
|
||||
@itemlist = split( /=/, $item ) ;
|
||||
if ( $itemlist[0] eq "name" ) {
|
||||
if ( $have_name ) {
|
||||
$have_error = 1;
|
||||
&CTUDebug( "multiple name options on 'ref'\n" ) ;
|
||||
}
|
||||
$have_name = 1;
|
||||
} else {
|
||||
&CTUDebug( "invalid option on 'ref' = " . $item . "\n" ) ;
|
||||
$have_error = 1 ;
|
||||
}
|
||||
}
|
||||
if ( ! $have_error ) {
|
||||
if ( $have_name ) {
|
||||
$ret = 1 ;
|
||||
}
|
||||
}
|
||||
} elsif ( $type eq "root" ) {
|
||||
local( $have_path ) = 0 ;
|
||||
foreach $item ( @speclist ) {
|
||||
@itemlist = split( /=/, $item ) ;
|
||||
if ( $itemlist[0] eq "path" ) {
|
||||
if ( $have_path ) {
|
||||
$have_error = 1 ;
|
||||
&CTUDebug( "multiple path options on 'root'\n" ) ;
|
||||
}
|
||||
$have_path = 1 ;
|
||||
} else {
|
||||
&CTUDebug( "invalid option on 'root' = " . $item . "\n" ) ;
|
||||
$have_error = 1 ;
|
||||
}
|
||||
}
|
||||
if ( ! $have_error ) {
|
||||
if ( $have_path ) {
|
||||
$ret = 1 ;
|
||||
}
|
||||
}
|
||||
} elsif ( $type eq "vroot" ) {
|
||||
local( $have_name ) = 0 ;
|
||||
foreach $item ( @speclist ) {
|
||||
@itemlist = split( /=/, $item ) ;
|
||||
if ( $itemlist[0] eq "name" ) {
|
||||
if ( $have_name ) {
|
||||
$have_error = 1 ;
|
||||
&CTUDebug( "multiple name options on 'vroot'\n" ) ;
|
||||
}
|
||||
$have_name = 1 ;
|
||||
} else {
|
||||
&CTUDebug( "invalid option on 'vroot' = " . $item . "\n" ) ;
|
||||
$have_error = 1 ;
|
||||
}
|
||||
}
|
||||
if ( ! $have_error ) {
|
||||
$ret = 1 ;
|
||||
}
|
||||
} elsif ( $type eq "croot" ) {
|
||||
local( $have_path ) = 0 ;
|
||||
local( $have_server ) = 0 ;
|
||||
foreach $item ( @speclist ) {
|
||||
@itemlist = split( /=/, $item ) ;
|
||||
if ( $itemlist[0] eq "path" ) {
|
||||
if ( $have_path ) {
|
||||
$have_error = 1 ;
|
||||
&CTUDebug( "multiple path options on 'croot'\n" ) ;
|
||||
}
|
||||
$have_path = 1 ;
|
||||
} elsif ( $itemlist[0] eq "server" ) {
|
||||
if ( $have_server ) {
|
||||
$have_error = 1 ;
|
||||
&CTUDebug( "multiple server options on 'croot'\n" ) ;
|
||||
}
|
||||
$have_server = 1 ;
|
||||
} else {
|
||||
&CTUDebug( "invalid option on 'croot' = " . $item . "\n" ) ;
|
||||
$have_error = 1 ;
|
||||
}
|
||||
}
|
||||
if ( ! $have_error ) {
|
||||
if ( $have_path && $have_server ) {
|
||||
$ret = 1 ;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
&CTUDebug( "unknow spec type '" . $speclist[0] . "'\n" ) ;
|
||||
}
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# get a list of all projects
|
||||
|
||||
sub CTListAllProjects {
|
||||
&CTUDebug( "in CTListAllProjects\n" ) ;
|
||||
local( $ret ) = "" ;
|
||||
local( $done ) = 0 ;
|
||||
local( *DIRFILES ) ;
|
||||
open( DIRFILES, "(cd $ctvspec_path ; /bin/ls -1 *.vspec ; echo blahblah) |" ) ;
|
||||
while ( ! $done ) {
|
||||
$_ = <DIRFILES> ;
|
||||
s/\n$// ;
|
||||
if ( $_ eq "blahblah" ) {
|
||||
$done = 1 ;
|
||||
} else {
|
||||
s/.vspec$// ;
|
||||
if ( $_ ne "" ) {
|
||||
if ( $ret eq "" ) {
|
||||
$ret = $_ ;
|
||||
} else {
|
||||
$ret = $ret . " " . $_ ;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
close( DIRFILES ) ;
|
||||
&CTUDebug( "final list of projects '" . $ret . "'\n" .
|
||||
"out of CTListAllProjects\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# list all flavors of a project
|
||||
# $_[0] = project
|
||||
|
||||
sub CTListAllFlavors {
|
||||
&CTUDebug( "in CTListAllFlavors\n" ) ;
|
||||
local( $proj ) = $_[0] ;
|
||||
$proj =~ tr/A-Z/a-z/ ;
|
||||
if ( $ctvspec_read ne $proj ) {
|
||||
&CTReadVSpec( $proj ) ;
|
||||
}
|
||||
local( $ret ) = "";
|
||||
local( $item ) ;
|
||||
foreach $item ( keys %ctvspecs ) {
|
||||
if ( $ret eq "" ) {
|
||||
$ret = $item ;
|
||||
} else {
|
||||
$ret = $ret . " " . $item ;
|
||||
}
|
||||
}
|
||||
&CTUDebug( "out of CTListAllFlavors\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
# given a project and a spec, determine the local root of the project
|
||||
# $_[0] = project
|
||||
# $_[1] = flavor
|
||||
# $_[2] = spec line
|
||||
|
||||
sub CTComputeRoot {
|
||||
&CTUDebug( "in CTComputeRoot\n" ) ;
|
||||
local( $proj ) = $_[0] ;
|
||||
$proj =~ tr/A-Z/a-z/ ;
|
||||
if ( $ctvspec_read ne $proj ) {
|
||||
&CTReadVSpec( $proj ) ;
|
||||
}
|
||||
local( $ret ) = "" ;
|
||||
local( $type ) = &CTSpecType( $_[2] ) ;
|
||||
local( $options ) = &CTSpecOptions( $_[2] ) ;
|
||||
local( $vname ) = &CTResolveSpecName( $proj, $_[1] ) ;
|
||||
&CTUDebug( "type = '" . $type . "' with options '" . $options . "'\n" ) ;
|
||||
if ( $type eq "root" ) {
|
||||
$ret = &CTSpecFindOption( $options, "path" ) ;
|
||||
} elsif ( $type eq "vroot" ) {
|
||||
local( $name ) = &CTSpecFindOption( $options, "name" ) ;
|
||||
if ( $name ne "" ) {
|
||||
$ret = "/view/$name/vobs/$proj" ;
|
||||
} else {
|
||||
$ret = "/view/$vname/vobs/$proj" ;
|
||||
}
|
||||
} elsif ( $type eq "croot" ) {
|
||||
$ret = &CTSpecFindOption( $options, "path" ) ;
|
||||
} elsif ( $ctdebug) {
|
||||
print STDERR "unknown flavor type '" . $type . "'\n" ;
|
||||
}
|
||||
&CTUDebug( "returning '" . $ret . "'\n" ) ;
|
||||
&CTUDebug( "out of CTComputeRoot\n" ) ;
|
||||
$ret ;
|
||||
}
|
||||
|
||||
%ctvspecs = () ;
|
||||
$ctvspec_read = "" ;
|
||||
|
||||
1;
|
||||
|
|
@ -1,37 +0,0 @@
|
|||
#!/bin/csh -f
|
||||
|
||||
setenv OS `uname`
|
||||
setenv USER `whoami`
|
||||
|
||||
if ( -e $DTOOL/bin/neartool ) setenv HAVE_NEARTOOL "yes"
|
||||
if ( ! $?HAVE_NEARTOOL ) setenv HAVE_NEARTOOL "no"
|
||||
if ( ! $?HAVE_ATRIA ) setenv HAVE_ATRIA "no"
|
||||
|
||||
set host=$HOST
|
||||
if ( ! $?TERM ) setenv TERM "none"
|
||||
if ( $TERM == "iris-ansi" || $TERM == "iris-ansi-net" ) then
|
||||
alias ctshowprojs 'echo -n "\033P1.y"$USER"@"$host" -- "$CTPROJS"\033\\"; echo -n "\033P3.y"`echo $CTPROJS | cut -f1 -d:`\($host\)"\033\\"'
|
||||
else if ( $TERM == "xterm" || $TERM == "color-xterm" || $TERM == "cygwin" ) then
|
||||
alias ctshowprojs 'echo -n "\033]2;"$USER"@"$host" -- "$CTPROJS"\007"; echo -n "\033]1;"`echo $CTPROJS | cut -f1 -d:`\($host\)"\007"'
|
||||
else
|
||||
alias ctshowprojs 'echo $CTPROJS'
|
||||
endif
|
||||
|
||||
alias ctattach 'source `ctattach.drv \!*`; ctshowprojs'
|
||||
alias cta 'ctattach'
|
||||
alias cta-ship 'setenv CTSAVE $CTDEFAULT_FLAV ; setenv CTDEFAULT_FLAV ship ; ctattach \!* ; setenv CTDEFAULT_FLAV $CTSAVE ; unsetenv CTSAVE'
|
||||
alias cta-release 'setenv CTSAVE $CTDEFAULT_FLAV ; setenv CTDEFAULT_FLAV release ; ctattach \!* ; setenv CTDEFAULT_FLAV $CTSAVE ; unsetenv CTSAVE'
|
||||
alias cta-install 'setenv CTSAVE $CTDEFAULT_FLAV ; setenv CTDEFAULT_FLAV install ; ctattach \!* ; setenv CTDEFAULT_FLAV $CTSAVE ; unsetenv CTSAVE'
|
||||
alias ctunattach 'source `ctunattach.drv \!*`; ctshowprojs'
|
||||
alias ctuna 'ctunattach'
|
||||
|
||||
#Modifications to emacs alias by Jason
|
||||
#To allow for NTEmacs to run like emacs on unix boxes
|
||||
if (($OS == "CYGWIN_NT-4.0") || ($OS == "CYGWIN_NT-5.0" ) || ($OS == "CYGWIN_NT-5.1" )) then
|
||||
alias emacs 'emacs -T "$USER@$HOST $CTPROJS" -xrm "Emacs*iconName: `echo $CTPROJS | cut -f1 -d:`($HOST)" -bg #002040 -fg #00C0FF -cr yellow -ms yellow -l `cygpath -w ~/.emacs` $CTEMACS_OPTS'
|
||||
else
|
||||
alias emacs 'emacs -T "$USER@$HOST $CTPROJS" -xrm "Emacs*iconName: `echo $CTPROJS | cut -f1 -d:`($HOST)" $CTEMACS_OPTS'
|
||||
endif
|
||||
|
||||
alias rlogin 'rlogin \!*; ctshowprojs'
|
||||
alias telnet 'telnet \!*; ctshowprojs'
|
||||
|
|
@ -1,46 +0,0 @@
|
|||
#! /bin/sh
|
||||
|
||||
if [ -e $DTOOL/bin/neartool ]; then HAVE_NEARTOOL="yes"; fi
|
||||
if [ -z "$HAVE_NEARTOOL" ]; then HAVE_NEARTOOL="no"; fi
|
||||
export HAVE_NEARTOOL
|
||||
|
||||
if [ -z "$HAVE_ATRIA" ]; then HAVE_ATRIA="no"; fi
|
||||
export HAVE_ATRIA
|
||||
|
||||
if [ $HAVE_NEARTOOL = "yes" ]; then
|
||||
alias ct='neartool'
|
||||
else
|
||||
alias ct='cleartool'
|
||||
fi
|
||||
|
||||
alias ctshowprojs='echo -n "\033P1.y"$USER"@"$HOST" -- "$CTPROJS"\033\\"; echo -n "\033P3.y"`echo $CTPROJS | cut -f1 -d:`\(`uname -n`\)"\033\\"'
|
||||
alias ctattach='source `ctattach.drv $*`; ctshowprojs'
|
||||
alias cta='ctattach'
|
||||
alias cta-ship='setenv CTSAVE $CTDEFAULT_FLAV ; setenv CTDEFAULT_FLAV ship ; ctattach $* ; setenv CTDEFAULT_FLAV $CTSAVE ; unsetenv CTSAVE'
|
||||
alias cta-release='setenv CTSAVE $CTDEFAULT_FLAV ; setenv CTDEFAULT_FLAV release ; ctattach $* ; setenv CTDEFAULT_FLAV $CTSAVE ; unsetenv CTSAVE'
|
||||
alias cta-install='setenv CTSAVE $CTDEFAULT_FLAV ; setenv CTDEFAULT_FLAV install ; ctattach $* ; setenv CTDEFAULT_FLAV $CTSAVE ; unsetenv CTSAVE'
|
||||
alias ctunattach='source `ctunattach.drv $*`; ctshowprojs'
|
||||
alias ctuna='ctunattach'
|
||||
|
||||
if [ "$PENV" = "WIN32_DREAMCAST" ]; then
|
||||
alias ctci='neartool ci'
|
||||
alias ctco='neartool co'
|
||||
alias ctmake='gmake'
|
||||
alias emacs='/emacs/bin/runemacs'
|
||||
alias emacs='/emacs/bin/runemacs -T "`logname`@`uname -n` $CTPROJS" -xrm "Emacs*iconName: `echo $CTPROJS | cut -f1 -d:`(`uname -n`)" $CTEMACS_OPTS'
|
||||
|
||||
elif [ "$HAVE_NEARTOOL" = "yes" ]; then
|
||||
alias ctci='neartool ci'
|
||||
alias ctco='neartool co'
|
||||
alias ctmake='make'
|
||||
alias emacs='emacs -T "`logname`@`uname -n` $CTPROJS" -xrm "Emacs*iconName: `echo $CTPROJS | cut -f1 -d:`(`uname -n`)" $CTEMACS_OPTS'
|
||||
|
||||
elif [ "$HAVE_ATRIA" = "yes" ]; then
|
||||
alias ctci='cleartool ci'
|
||||
alias ctco='cleartool co'
|
||||
alias ctmake 'clearmake -C gnu $* |& grep -v "^clearmake: Warning: Config"'
|
||||
alias emacs='emacs -T "`logname`@`uname -n` $CTPROJS" -xrm "Emacs*iconName: `echo $CTPROJS | cut -f1 -d:`(`uname -n`)" $CTEMACS_OPTS'
|
||||
fi
|
||||
|
||||
alias rlogin='rlogin $*; ctshowprojs'
|
||||
alias telnet='telnet $*; ctshowprojs'
|
||||
|
|
@ -1,99 +0,0 @@
|
|||
#!/bin/csh -f
|
||||
|
||||
setenv OS `uname`
|
||||
|
||||
# careful, security exploit here
|
||||
setenv LD_LIBRARY_PATH "."
|
||||
setenv DYLD_LIBRARY_PATH "."
|
||||
|
||||
setenv CTEMACS_FOREHIGHLIGHT white
|
||||
setenv CTEMACS_BACKHIGHLIGHT blue
|
||||
|
||||
# Setup the initial path
|
||||
if ( $OS == "Linux" ) then
|
||||
set path = ( /bin /bin /usr/bin /sbin /usr/sbin /usr/bin/X11 \
|
||||
/usr/etc /usr/local/bin /var/local/bin ~/bin )
|
||||
else if ( $OS == "Darwin" ) then
|
||||
set path = ( /bin /usr/bin /sbin /usr/sbin /usr/local/bin ~/bin $path )
|
||||
else if ( $OS == "IRIX64" ) then
|
||||
set path = ( /var/local/bin ~/bin /usr/local/prman/bin \
|
||||
/usr/sbin /usr/bsd /sbin /usr/bin /bin /usr/bin/X11 /usr/etc \
|
||||
/usr/demos/bin /usr/local/bin )
|
||||
setenv LD_LIBRARY_PATH "/usr/local/lib:."
|
||||
else if (($OS == "CYGWIN_NT-6.1-WOW64") || ($OS == "CYGWIN_NT-6.1") || ($OS == "CYGWIN_NT-5.1") || ($OS == "CYGWIN_NT-6.0") || ($OS == "CYGWIN_NT-6.0-WOW64") || ($OS == "CYGWIN_NT-5.2-WOW64") || ($OS == "CYGWIN_NT-5.0") || ( $OS == "CYGWIN_NT-4.0" ) || ( $OS == "WINNT" )) then
|
||||
set path = ( /bin /usr/bin /usr/lib /usr/local/bin $path . )
|
||||
if ( $?LIB ) then
|
||||
setenv LIB "$LIB;"`cygpath -w /usr/lib`
|
||||
else
|
||||
setenv LIB `cygpath -w /usr/lib`
|
||||
endif
|
||||
else if (( $OS == "CYGWIN_98-4.10" ) || ( $OS == "WIN95" )) then
|
||||
set path = ( /bin /usr/local/bin /contrib/bin /msvc98/Bin \
|
||||
/mscommon/MSDev98/Bin /mscommon/Tools /usr/lib $path )
|
||||
setenv LIB `cygpath -w /msvc98/mfc/lib`\;`cygpath -w /msvc98/lib`\;`cygpath -w /usr/lib`
|
||||
setenv INCLUDE `cygpath -w /msvc98/Include`
|
||||
else
|
||||
set path = ( /var/local/bin ~/bin /usr/local/prman/bin \
|
||||
/usr/sbin /usr/bsd /sbin /usr/bin /bin /usr/bin/X11 /usr/etc \
|
||||
/usr/demos/bin /usr/local/bin )
|
||||
endif
|
||||
|
||||
# Setup the initial manpath
|
||||
#if ( $OS == "Linux" ) then
|
||||
#setenv MANPATH "/usr/local/man:/usr/man/preformat:/usr/man:/usr/X11R6/man"
|
||||
#else if ( $OS == "IRIX64" ) then
|
||||
#setenv MANPATH "/usr/share/catman:/usr/catman:/usr/local/share/catman:/usr/local/share/man:/usr/local/man"
|
||||
#else if (( $OS == "CYGWIN_NT-5.1") || ( $OS == "CYGWIN_NT-5.2-WOW64" ) || ( $OS == "CYGWIN_NT-5.0") || ( $OS == "CYGWIN_NT-4.0" ) || ( $OS == "CYGWIN_98-4.10" ) || ( $OS == "WIN95" )) then
|
||||
#setenv MANPATH "/usr/man:/contrib/man"
|
||||
#else
|
||||
#setenv MANPATH "/usr/share/catman:/usr/catman:/usr/local/share/catman:/usr/local/share/man:/usr/local/man"
|
||||
#endif
|
||||
|
||||
setenv CT_INCLUDE_PATH "."
|
||||
#set cdpath = ( . )
|
||||
#setenv CDPATH "."
|
||||
setenv DC_PATH "."
|
||||
setenv SSPATH "."
|
||||
setenv STKPATH "."
|
||||
|
||||
if ( ! $?HAVE_ATRIA ) then
|
||||
if ( -e /usr/atria ) then
|
||||
/usr/atria/bin/cleartool mount -all >& /dev/null
|
||||
if ( $status == 0 ) setenv HAVE_ATRIA "yes"
|
||||
endif
|
||||
endif
|
||||
|
||||
if ( ! $?CTDEFAULT_FLAV ) setenv CTDEFAULT_FLAV "default"
|
||||
if ( ! $?CTEMACS_OPTS ) setenv CTEMACS_OPTS ""
|
||||
|
||||
if ( -e /usr/atria/bin ) set path = ( /usr/atria/bin $path )
|
||||
rehash
|
||||
|
||||
if ( ! $?PENV ) then
|
||||
if ( $OS == "Linux" ) then
|
||||
setenv PENV "Linux"
|
||||
else if ( $OS == "IRIX64" ) then
|
||||
setenv PENV "SGI"
|
||||
else if (( $OS == "CYGWIN_NT-5.1") || ( $OS == "CYGWIN_NT-5.0") || ( $OS == "CYGWIN_NT-6.0")|| ( $OS == "CYGWIN_NT-4.0" ) || ( $OS == "CYGWIN_98-4.10" ) || ( $OS == "WIN95" )) then
|
||||
setenv PENV "WIN32"
|
||||
else
|
||||
setenv PENV "SGI"
|
||||
endif
|
||||
endif
|
||||
|
||||
if ( ! $?DTOOL ) setenv DTOOL /beta/player/bootstrap/dtool
|
||||
if ( $#argv == 0 ) then
|
||||
setenv SETUP_SCRIPT `$DTOOL/built/bin/ctattach.drv dtool default`
|
||||
else
|
||||
setenv SETUP_SCRIPT `$DTOOL/built/bin/ctattach.drv dtool $argv[1]`
|
||||
endif
|
||||
|
||||
if($SETUP_SCRIPT == "") then
|
||||
echo "error: ctattach.drv returned NULL string for setup_script filename!"
|
||||
echo " 'dtool/built/bin/ctattach.drv' probably doesnt exist, need to make install on dtool to copy it from dtool\src\attach"
|
||||
exit
|
||||
endif
|
||||
|
||||
source $SETUP_SCRIPT
|
||||
|
||||
|
||||
|
|
@ -1,295 +0,0 @@
|
|||
;; make the mouse pointer avoid the text point
|
||||
;; Actually, everyone really hates this.
|
||||
;(cond (window-system
|
||||
; (require 'avoid)
|
||||
; (mouse-avoidance-mode 'cat-and-mouse)))
|
||||
|
||||
;; Make sure utf-8 is at the top of the coding-system list; Panda's
|
||||
;; TextNode uses utf-8 encoding natively, so we may have some
|
||||
;; documents and code written in utf-8.
|
||||
|
||||
(prefer-coding-system 'utf-8)
|
||||
|
||||
|
||||
;; make sure we have the compile library available to us
|
||||
(load-library "compile")
|
||||
;; Comment given for last checkout command
|
||||
(setq last-co-comment "")
|
||||
;; Comment given for last checkin command
|
||||
(setq last-ci-comment "")
|
||||
;; Target given for the last local make
|
||||
(setq last-lm-target "realinstall")
|
||||
;; Target given for the last global make
|
||||
(setq last-gm-target "install")
|
||||
;; Host given for the last ctrelease
|
||||
(setq last-rel-host "")
|
||||
;; Host given for the last ctship
|
||||
(setq last-ship-host "")
|
||||
|
||||
;; check the environment
|
||||
(setq ct-tool (getenv "DTOOL"))
|
||||
(setq have-atria (let ((h-a (getenv "HAVE_ATRIA")))
|
||||
(if (string= h-a "yes") t '())))
|
||||
;; (setq have-neartool (let ((h-n (getenv "HAVE_NEARTOOL")))
|
||||
;; (if (string= h-n "yes") t '())))
|
||||
(setq is-cygwin (or (string= (getenv "OS") "CYGWIN_NT-4.0")
|
||||
(string= (getenv "OS") "CYGWIN_NT-5.0")
|
||||
(string= (getenv "OS") "CYGWIN_NT-5.1")))
|
||||
|
||||
;; (setq ct-command (cond
|
||||
;; (is-cygwin "bash /install/tool/bin/neartool")
|
||||
;; (have-atria "cleartool")
|
||||
;; (have-neartool "neartool")
|
||||
;; t nil))
|
||||
|
||||
;; Load the Hightlight coloring scheme
|
||||
(if is-cygwin
|
||||
;; (let ((filename (concat (getenv "CYGWIN_ROOT") "install\\tool\\etc\\color.emacs")))
|
||||
(let ((filename (concat (getenv "CYGWIN_ROOT") ct-tool "\\etc\\color.emacs")))
|
||||
(if (file-readable-p filename) (load filename))))
|
||||
|
||||
;; Checkout element in the current buffer
|
||||
(defun ct-checkout-curr (comment)
|
||||
"Checkout version in current buffer with COMMENT."
|
||||
(interactive (list (read-string "Comment: " last-co-comment)))
|
||||
(setq last-co-comment comment)
|
||||
(setq pname (file-name-nondirectory (buffer-file-name)))
|
||||
(ct-shell-command-verbose
|
||||
(concat "ctco -c " (ct-quote-string comment) " " pname))
|
||||
(ct-find-curr-file-again nil)
|
||||
)
|
||||
|
||||
;; Uncheckout element in the current buffer
|
||||
(defun ct-uncheckout-curr ()
|
||||
"Uncheckout version in current buffer and remove private data."
|
||||
(interactive)
|
||||
(if (y-or-n-p "Ok to un-checkout? ")
|
||||
(progn
|
||||
(setq pname (file-name-nondirectory (buffer-file-name)))
|
||||
(ct-shell-command-verbose (concat "ctunco " pname))
|
||||
(ct-find-curr-file-again t)
|
||||
)
|
||||
(progn
|
||||
(message "Uncheckout canceled.")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; Checkin element in the current buffer
|
||||
(defun ct-checkin-curr ()
|
||||
"Checkin version in current buffer."
|
||||
(interactive)
|
||||
(setq pname (file-name-nondirectory (buffer-file-name)))
|
||||
(setq option nil)
|
||||
(while (not option)
|
||||
(setq choice (read-string "Comment: s (same), n (new), l (list): " "s"))
|
||||
(cond
|
||||
((equal choice "s")
|
||||
(setq option "-nc"))
|
||||
((equal choice "n")
|
||||
(setq comment (read-string "Comment: " last-ci-comment))
|
||||
(setq last-ci-comment comment)
|
||||
(setq option (concat "-c " (ct-quote-string comment))))
|
||||
((equal choice "l")
|
||||
(ct-shell-command-verbose (concat "ctihave " pname)))
|
||||
(t
|
||||
(message (concat "Unrecognized choice: " choice "."))
|
||||
(sleep-for 2))))
|
||||
|
||||
(ct-shell-command-verbose (concat "ctci " option " " pname))
|
||||
(ct-find-curr-file-again t)
|
||||
)
|
||||
|
||||
;; Delta element in the current buffer
|
||||
(defun ct-delta-curr ()
|
||||
"Delta element in current buffer."
|
||||
(interactive)
|
||||
(if (y-or-n-p "Ok to delta? ")
|
||||
(progn
|
||||
(setq pname (file-name-nondirectory (buffer-file-name)))
|
||||
(ct-shell-command-verbose (concat "ctdelta " pname))
|
||||
(ct-find-curr-file-again t)
|
||||
)
|
||||
(progn
|
||||
(message "Delta canceled.")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; List element checkout data for the current buffer
|
||||
(defun ct-lscheckout-curr ()
|
||||
"List checkout for the current buffer."
|
||||
(interactive)
|
||||
(setq pname (file-name-nondirectory (buffer-file-name)))
|
||||
(ct-shell-command-verbose (concat "ctihave &"))
|
||||
)
|
||||
|
||||
;; List elements in the current directory that are checked out
|
||||
(defun ct-lscheckout-curr-dir ()
|
||||
"List checkouts for the current directory."
|
||||
(ct-shell-command-verbose (concat "ctihave &"))
|
||||
)
|
||||
|
||||
;; call clearmake in the local directory
|
||||
(defun ct-local-make ()
|
||||
"Build TARGET from the current directory."
|
||||
(interactive)
|
||||
(setq target (read-string "Local build target: " last-lm-target))
|
||||
(setq last-lm-target target)
|
||||
(if have-atria
|
||||
(compile-internal
|
||||
(concat "clearmake -C gnu " target
|
||||
" |& grep -v \"clearmake: Warning: Config\"")
|
||||
"No more errors.")
|
||||
(compile-internal
|
||||
(concat "make " target) "No more errors."))
|
||||
)
|
||||
|
||||
;; call clearmake in the project root directory
|
||||
(defun ct-global-make ()
|
||||
"Build TARGET from the project root."
|
||||
(interactive)
|
||||
(setq target (read-string "Global build target: " last-gm-target))
|
||||
(setq last-gm-target target)
|
||||
(cond
|
||||
(have-atria
|
||||
(compile-internal
|
||||
(concat "cd `ctproj -r` ; clearmake -C gnu " target
|
||||
" |& grep -v \"clearmake: Warning: Config\"")
|
||||
"No more errors."))
|
||||
(is-cygwin
|
||||
(compile-internal
|
||||
(concat "bash -f 'cd `ctproj -r` ; make " target "'") "No more errors."))
|
||||
(t
|
||||
(compile-internal
|
||||
(concat "cd `ctproj -r` ; make " target) "No more errors."))
|
||||
)
|
||||
)
|
||||
|
||||
;; Do an xdiff on the current buffer to see what is different about this
|
||||
;; file from the previous version.
|
||||
(defun ct-xdiff-curr ()
|
||||
"Show changes to element in current buffer from the previous version."
|
||||
(interactive)
|
||||
(setq pname (file-name-nondirectory (buffer-file-name)))
|
||||
(if is-cygwin
|
||||
(ct-shell-command-verbose (concat ct-command " xdiff -pre " pname))
|
||||
|
||||
; The is a hack to deal with the fact that diff returns 1 if the
|
||||
; two files do not match.
|
||||
(ct-shell-command-verbose (concat ct-command " xdiff -pre " pname ";:&")))
|
||||
)
|
||||
|
||||
|
||||
;; Make a new element for the current buffer
|
||||
(defun ct-mk-elem ()
|
||||
(interactive)
|
||||
(if (y-or-n-p (format "Make new element for %s? "
|
||||
(file-name-nondirectory (buffer-name))))
|
||||
(progn
|
||||
(write-file (buffer-file-name))
|
||||
(ct-shell-command-verbose
|
||||
(concat "ctmkelem -eltype text_file -c '' "
|
||||
(file-name-nondirectory (buffer-name))))
|
||||
)
|
||||
(progn
|
||||
(message "Make element canceled.")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; utility functions
|
||||
(defun ct-shell-command-verbose (command)
|
||||
"Execute COMMAND in shell with message."
|
||||
(interactive "Shell command: \n")
|
||||
(message (concat "Executing: " command " ..."))
|
||||
(shell-command command)
|
||||
(message "Done.")
|
||||
)
|
||||
|
||||
(defun ct-find-curr-file-again (read-only)
|
||||
"Read in the currect file again, READONLY (t) or not (nil)."
|
||||
(setq pname (buffer-file-name))
|
||||
(setq linenum (1+ (count-lines 1 (point))))
|
||||
(kill-buffer (buffer-name))
|
||||
(if read-only
|
||||
(find-file-read-only pname)
|
||||
(find-file pname))
|
||||
(goto-line linenum)
|
||||
)
|
||||
|
||||
(defun ct-quote-string (string)
|
||||
"Enclose STRING in single or double quotes."
|
||||
(setq has-double (string-match "\"" string))
|
||||
(setq has-single (string-match "'" string))
|
||||
(cond
|
||||
((or (and (not has-single) (not has-double))
|
||||
(and has-double (not has-single)))
|
||||
(concat "'" string "'"))
|
||||
((and has-single (not has-double))
|
||||
(concat "\"" string "\""))
|
||||
(t
|
||||
(message (concat "Can't quote string correctly: " string))
|
||||
(sleep-for 3)
|
||||
(concat "\"" string "\"")))
|
||||
)
|
||||
|
||||
;; default key bindings
|
||||
(global-set-key "\C-xco" 'ct-checkout-curr)
|
||||
(global-set-key "\C-xcu" 'ct-uncheckout-curr)
|
||||
(global-set-key "\C-xci" 'ct-checkin-curr)
|
||||
(global-set-key "\C-xcd" 'ct-delta-curr)
|
||||
(global-set-key "\C-xcl" 'ct-lscheckout-curr)
|
||||
(global-set-key "\C-xcL" 'ct-lscheckout-curr-dir)
|
||||
(global-set-key "\C-xcm" 'ct-local-make)
|
||||
(global-set-key "\C-xcM" 'ct-global-make)
|
||||
(global-set-key "\C-xcx" 'ct-xdiff-curr)
|
||||
(global-set-key "\C-xce" 'ct-mk-elem)
|
||||
|
||||
;; ok, lets make sure we load all other .emacs files we might need. This is
|
||||
;; attach related code.
|
||||
|
||||
(defun ct-load-project-emacs-file (proj-name)
|
||||
(if (string= proj-name "DTOOL") nil
|
||||
(let ((pre-name (getenv proj-name)))
|
||||
(if pre-name
|
||||
(let ((filename (concat pre-name "/built/etc/"
|
||||
(downcase proj-name) ".emacs")))
|
||||
(if (file-readable-p filename)
|
||||
(load filename))
|
||||
)))
|
||||
)
|
||||
)
|
||||
|
||||
(defun ct-break-space-colon-str (string)
|
||||
(if (string= string "")
|
||||
'()
|
||||
(let ((substr-end (string-match ":" string 0)))
|
||||
(cons (substring string 0 substr-end)
|
||||
(let ((new-string-start (string-match " " string 0)))
|
||||
(if (eq nil new-string-start)
|
||||
'()
|
||||
(ct-break-space-colon-str
|
||||
(strip-spaces (substring string (match-end 0)))))
|
||||
)))
|
||||
)
|
||||
)
|
||||
|
||||
(defun strip-spaces (string)
|
||||
(if (= (string-to-char string) 32)
|
||||
(if (= (length string) 1) ""
|
||||
(strip-spaces (substring string 1)))
|
||||
string)
|
||||
)
|
||||
|
||||
(defun ct-load-project-emacs-files ()
|
||||
"Load project specific .emacs files"
|
||||
(let ((ctprojs (getenv "CTPROJS")))
|
||||
(if ctprojs
|
||||
(mapcar 'ct-load-project-emacs-file
|
||||
(reverse (ct-break-space-colon-str ctprojs)))
|
||||
))
|
||||
)
|
||||
|
||||
;; get all of the project specific .emacs files
|
||||
(ct-load-project-emacs-files)
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
MODREL ETC_PATH built/etc
|
||||
DOCSH source $DTOOL/built/etc/dtool.alias
|
||||
DOCSH unsetenv LASTLOGIN
|
||||
DOCSH setenv OS_VER `uname -r`
|
||||
DOCSH ctshowprojs
|
||||
DOSH source $DTOOL/built/etc/dtool.alias-sh
|
||||
DOSH LASTLOGIN=
|
||||
DOSH export LASTLOGIN
|
||||
DOSH OS_VER=`uname -r`
|
||||
DOSH export OS_VER
|
||||
|
|
@ -1,81 +0,0 @@
|
|||
#! /bin/sh
|
||||
|
||||
OS=`uname`
|
||||
export OS
|
||||
|
||||
# Setup the initial path
|
||||
if [ $OS = "Linux" ]; then
|
||||
PATH=/var/local/bin:~/bin:.:/usr/sbin:/sbin:/usr/bin:/bin:/usr/bin/X11:/usr/etc:/usr/local/bin
|
||||
elif [ $OS = "IRIX64" ]; then
|
||||
PATH=/var/local/bin:/usr/local/bin/ptools:~/bin:/usr/local/prman/bin:.:/usr/sbin:/usr/bsd:/sbin:/usr/bin:/bin:/usr/bin/X11:/usr/etc:/usr/demos/bin:/usr/local/bin
|
||||
elif [ $OS = "CYGWIN_98-4.10" ]; then
|
||||
PATH=/usr/local/bin:/bin:/CYGNUS/CYGWIN~1/H-I586~1/BIN:/WINDOWS:/WINDOWS:/WINDOWS/COMMAND:/DMI/BIN:/KATANA/UTL/DEV/MAKE:/KATANA/UTL/DEV/HITACHI
|
||||
else
|
||||
PATH=/var/local/bin:/usr/local/bin/ptools:~/bin:/usr/local/prman/bin:.:/usr/sbin:/usr/bsd:/sbin:/usr/bin:/bin:/usr/bin/X11:/usr/etc:/usr/demos/bin:/usr/local/bin
|
||||
fi
|
||||
|
||||
# Setup the initial manpath
|
||||
#if [ $OS = "Linux" ]; then
|
||||
# MANPATH=/usr/local/man:/usr/man/preformat:/usr/man:/usr/X11R6/man
|
||||
#elif [ $OS = "IRIX64" ]; then
|
||||
# MANPATH=/usr/share/catman:/usr/catman:/usr/local/share/catman:/usr/local/share/man:/usr/local/man
|
||||
#elif [ $OS = "CYGWIN_98-4.10" ]; then
|
||||
# MANPATH=/usr/local/man
|
||||
#else
|
||||
# MANPATH=/usr/share/catman:/usr/catman:/usr/local/share/catman:/usr/local/share/man:/usr/local/man
|
||||
#fi
|
||||
#export MANPATH
|
||||
|
||||
LD_LIBRARY_PATH="."
|
||||
export LD_LIBRARY_PATH
|
||||
DYLD_LIBRARY_PATH="."
|
||||
export DYLD_LIBRARY_PATH
|
||||
CT_INCLUDE_PATH="."
|
||||
export CT_INCLUDE_PATH
|
||||
#cdpath=.
|
||||
#CDPATH="."
|
||||
#export CDPATH
|
||||
DC_PATH="."
|
||||
export DC_PATH
|
||||
SSPATH="."
|
||||
export SSPATH
|
||||
STKPATH="."
|
||||
export STKPATH
|
||||
SHELL_TYPE="sh"
|
||||
export SHELL_TYPE
|
||||
|
||||
if [ -e /usr/atria ]; then
|
||||
if /usr/atria/bin/cleartool mount -all > /dev/null 2>&1; then
|
||||
HAVE_ATRIA=yes
|
||||
export HAVE_ATRIA
|
||||
fi
|
||||
fi
|
||||
|
||||
if [ -z "$CTDEFAULT_FLAV" ]; then
|
||||
CTDEFAULT_FLAV="default"
|
||||
export CTDEFAULT_FLAV
|
||||
fi
|
||||
|
||||
if [ -z "$DTOOL" ]; then
|
||||
DTOOL=/beta/player/bootstrap/tool
|
||||
export DTOOL
|
||||
fi
|
||||
|
||||
if [ -z "$PENV" ]; then
|
||||
if [ $OS = "Linux" ]; then
|
||||
PENV="Linux"
|
||||
elif [ $OS = "IRIX64" ]; then
|
||||
PENV="SGI"
|
||||
elif [ $OS = "CYGWIN_98-4.10" ]; then
|
||||
PENV="WIN32_DREAMCAST"
|
||||
else
|
||||
PENV="SGI"
|
||||
fi
|
||||
fi
|
||||
export PENV
|
||||
|
||||
if [ -z "$1" ]; then
|
||||
source `$DTOOL/built/bin/ctattach.drv dtool default`
|
||||
else
|
||||
source `$DTOOL/built/bin/ctattach.drv dtool $1`
|
||||
fi
|
||||
|
|
@ -1,104 +0,0 @@
|
|||
#! /bin/sh
|
||||
#
|
||||
# get-cttree.sh
|
||||
#
|
||||
# Usage:
|
||||
#
|
||||
# get-cttree.sh [opts] output-file.tgz
|
||||
#
|
||||
# This script must be executed from within a project tree.
|
||||
#
|
||||
# Options:
|
||||
#
|
||||
# None at present.
|
||||
#
|
||||
#ENDCOMMENT
|
||||
|
||||
while getopts "h" flag; do
|
||||
case $flag in
|
||||
h) sed '/#ENDCOMMENT/,$d' <$0 >&2
|
||||
exit 1;;
|
||||
\?) exit 1;
|
||||
esac
|
||||
done
|
||||
|
||||
shift `expr $OPTIND - 1`
|
||||
output=$1
|
||||
projroot=`ctproj -r`
|
||||
|
||||
if [ -z "$projroot" ]; then
|
||||
echo ""
|
||||
echo "You must execute this script in a project tree."
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ -z "$output" ]; then
|
||||
sed '/#ENDCOMMENT/,$d' <$0 >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
|
||||
# Perform some sanity checks on input parameters.
|
||||
|
||||
if [ ! -d "$projroot" ]; then
|
||||
echo ""
|
||||
echo "$projroot is not a directory!"
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ `basename $output .tgz` = `basename $output` ]; then
|
||||
echo ""
|
||||
echo "$output should end in .tgz"
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ ! -d /usr/atria ]; then
|
||||
echo ""
|
||||
echo "This script is intended to be run on an actual ClearCase vobs."
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
|
||||
projname=`basename $projroot`
|
||||
projtop=`dirname $projroot`
|
||||
|
||||
if [ "$projname" = "tool" ]; then
|
||||
echo ""
|
||||
echo "This script should not be used on the tool tree."
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ -f "$output" ]; then
|
||||
if rm -i $output; then
|
||||
echo ""
|
||||
else
|
||||
echo "Not overwriting $output"
|
||||
exit 1
|
||||
fi
|
||||
elif [ -r "$output" -o -w "$output" ]; then
|
||||
echo "Cannot overwrite $output"
|
||||
exit 1
|
||||
else
|
||||
echo ""
|
||||
fi
|
||||
|
||||
# Check to make sure the local machine doesn't have anything checked out.
|
||||
cd $projroot
|
||||
outfile=/tmp/gc.$username.$projname.out
|
||||
cleartool lsco -s -me -recurse >$outfile
|
||||
if [ -s $outfile ]; then
|
||||
echo ""
|
||||
echo "Cannot build tarball; files still checked out in vobs:"
|
||||
sed 's/^/ /;s/\.ct0\.//' $outfile
|
||||
rm -f $outfile
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
rm -f $outfile
|
||||
|
||||
(cd $projtop; cleartool find $projname -nxn -print | grep -v '/lost+found' | cpio -H tar -v -o | gzip) >$output
|
||||
|
||||
|
|
@ -1,481 +0,0 @@
|
|||
#! /usr/local/bin/bash
|
||||
#
|
||||
# get-delta.sh
|
||||
#
|
||||
# Usage:
|
||||
#
|
||||
# get-delta.sh [opts] output-file.sh [file ...]
|
||||
#
|
||||
# This script must be executed from within a project tree. It
|
||||
# examines the set of files that have been checked out (via neartool)
|
||||
# and modified, and generates a script file that can be used to apply
|
||||
# the changes made back to the main ClearCase vobs.
|
||||
#
|
||||
# By default, it generates a script for all checked-out files. You
|
||||
# can restrict its operation to certain files and/or directories by
|
||||
# listing them on the command line.
|
||||
#
|
||||
# Options:
|
||||
#
|
||||
# -c collapse versioning information on local copy after completion.
|
||||
# Use this option with caution, as it is irreversible (and
|
||||
# noninterruptible). Once the versioning information has been
|
||||
# collapsed, it will be impossible to regenerate a script
|
||||
# representing the changes that have been made locally; you
|
||||
# should only do this when you are sure that your changes have
|
||||
# been successfully applied to the other end.
|
||||
#
|
||||
# On the other hand, if you forget to run get-delta with -c after
|
||||
# you have successfully applied your changes, you may
|
||||
# inadvertently attempt to apply them again if you subsequently
|
||||
# try to apply more changes.
|
||||
#
|
||||
#ENDCOMMENT
|
||||
|
||||
function usage {
|
||||
sed '/#ENDCOMMENT/,$d' <$0 >&2
|
||||
exit 1
|
||||
}
|
||||
|
||||
#
|
||||
# list_comments ( dirname basename )
|
||||
#
|
||||
# Writes to stdout any comments associated with checked-out versions of
|
||||
# the indicated file, in order.
|
||||
#
|
||||
function list_comments {
|
||||
local dirname=$1
|
||||
local basename=$2
|
||||
local filename=$dirname/$basename
|
||||
local file comment version
|
||||
|
||||
if [ -f $dirname/.ct0.$basename ]; then
|
||||
# Now look for comments, in version-number order.
|
||||
|
||||
# We use a series of ls commands so we don't try to sort the
|
||||
# filenames between the one-, two-, and three-digit version
|
||||
# numbers.
|
||||
|
||||
for file in `(cd $dirname; ls .ct[0-9].$basename; ls .ct[0-9][0-9].$basename; ls .ct[0-9][0-9][0-9].$basename) 2>/dev/null`; do
|
||||
version=`echo $file | sed "s/^\.ct\([0-9]*\).*$/\1/"`
|
||||
comment=$dirname/.ct${version}comment.$basename
|
||||
if [ -f $comment ]; then
|
||||
cat $comment
|
||||
fi
|
||||
done
|
||||
fi
|
||||
}
|
||||
|
||||
#
|
||||
# get_fullpath ( local_dir )
|
||||
#
|
||||
# Sets $fullpath to the fully-qualified pathname associated with $local_dir.
|
||||
#
|
||||
function get_fullpath {
|
||||
local local_dir=$1
|
||||
|
||||
if [ -z "$local_dir" ]; then
|
||||
fullpath=`pwd`
|
||||
else
|
||||
if [ ! -d "$local_dir" ]; then
|
||||
echo "Invalid directory: $local_dir" 1>&2
|
||||
exit 1
|
||||
fi
|
||||
# If we use pwd instead of /bin/pwd, $PWD will be used, which will give
|
||||
# the wrong answer
|
||||
fullpath=`(cd $local_dir; /bin/pwd)`
|
||||
fi
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# get_rel_dir ( root_dir local_dir )
|
||||
#
|
||||
# Sets $rel_dir to the string which represents $local_dir relative to
|
||||
# $root_dir. This is a simple string-prefix operation, and could fail
|
||||
# in some obscure cases.
|
||||
#
|
||||
function get_rel_dir {
|
||||
get_fullpath $1
|
||||
local root_dir=$fullpath
|
||||
|
||||
get_fullpath $2
|
||||
local local_dir=$fullpath
|
||||
|
||||
# Now remove the initial prefix.
|
||||
if [ "$root_dir" = "$local_dir" ]; then
|
||||
rel_dir="."
|
||||
else
|
||||
rel_dir=`echo $local_dir | sed 's:^'$root_dir/'::'`
|
||||
|
||||
if [ "$rel_dir" = "$local_dir" ]; then
|
||||
echo "$local_dir is not a directory within $root_dir." 1>&2
|
||||
exit 1
|
||||
fi
|
||||
fi
|
||||
}
|
||||
|
||||
|
||||
collapse=
|
||||
while getopts "ch" flag; do
|
||||
case $flag in
|
||||
c) collapse=y;;
|
||||
h) usage;;
|
||||
\?) exit 1;
|
||||
esac
|
||||
done
|
||||
|
||||
shift `expr $OPTIND - 1`
|
||||
output=$1
|
||||
shift
|
||||
projroot=`ctproj -r`
|
||||
|
||||
if [ -z "$projroot" ]; then
|
||||
echo "You must execute this script in a project tree."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ -z "$output" ]; then
|
||||
usage
|
||||
fi
|
||||
|
||||
|
||||
# Perform some sanity checks on input parameters.
|
||||
|
||||
if [ ! -d "$projroot" ]; then
|
||||
echo "$projroot is not a directory!"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ `basename $output .sh` = `basename $output` ]; then
|
||||
echo "$output should end in .sh"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ -f "$output" ]; then
|
||||
rm -i $output
|
||||
if [ -f "$output" ]; then
|
||||
echo "Not overwriting $output"
|
||||
exit 1
|
||||
fi
|
||||
elif [ -e "$output" ]; then
|
||||
echo "Cannot overwrite $output"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
echo ""
|
||||
|
||||
# Temporary files we'll build up as we process the files.
|
||||
|
||||
base=`basename $output`
|
||||
temp_ct0=/tmp/gd.ct0.$base
|
||||
temp_checkout=/tmp/gd.checkout.$base
|
||||
temp_dirs=/tmp/gd.dirs.$base
|
||||
temp_files=/tmp/gd.files.$base
|
||||
temp_diffs=/tmp/gd.diffs.$base
|
||||
|
||||
rm -f $temp_ct0 $temp_checkout $temp_dirs $temp_files $temp_diffs
|
||||
touch $temp_ct0 $temp_dirs $temp_files
|
||||
|
||||
|
||||
# Get the list of files we'll want to delta in.
|
||||
|
||||
if [ $# -eq 0 ]; then
|
||||
# No explicit files, get all of them.
|
||||
(cd $projroot; find . -name .ct0.\* -print) >>$temp_ct0
|
||||
else
|
||||
# An explicit list of files.
|
||||
for filename in $*; do
|
||||
if [ -f $filename ]; then
|
||||
dirname=`dirname $filename`
|
||||
basename=`basename $filename`
|
||||
|
||||
if [ -f $dirname/.ct0.$basename ]; then
|
||||
get_rel_dir $projroot $dirname
|
||||
echo ./$rel_dir/.ct0.$basename >>$temp_ct0
|
||||
else
|
||||
echo $filename has no versions.
|
||||
fi
|
||||
|
||||
elif [ -d $filename ]; then
|
||||
get_rel_dir $projroot $filename
|
||||
|
||||
(cd $projroot; find ./$rel_dir -name .ct0.\* -print) >>$temp_ct0
|
||||
|
||||
else
|
||||
echo $filename not found.
|
||||
fi
|
||||
done
|
||||
fi
|
||||
|
||||
|
||||
# Now start to build up the script.
|
||||
|
||||
echo "#! /bin/sh" >$output
|
||||
chmod 755 $output
|
||||
|
||||
if [ ! -w $output ]; then
|
||||
echo "Cannot write to $output!"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
projname=`basename $projroot`
|
||||
|
||||
# This part we cat in quoted, verbatim.
|
||||
cat << 'EOF' >>$output
|
||||
|
||||
any_opts=
|
||||
list=
|
||||
checkout=
|
||||
patch=
|
||||
cleanup=
|
||||
checkin=
|
||||
delta=
|
||||
help=
|
||||
while getopts "lopcidfh" flag; do
|
||||
any_opts=y
|
||||
only_list=y
|
||||
case $flag in
|
||||
l) list=y;;
|
||||
o) checkout=y; only_list=;;
|
||||
p) patch=y; only_list=;;
|
||||
c) cleanup=y; only_list=;;
|
||||
i) checkin=y; only_list=;;
|
||||
d) delta=y; only_list=;;
|
||||
f) checkout=y
|
||||
patch=y
|
||||
cleanup=y
|
||||
checkin=y
|
||||
delta=y
|
||||
only_list=;;
|
||||
h) help=y;;
|
||||
\?) exit 1;
|
||||
esac
|
||||
done
|
||||
|
||||
EOF
|
||||
|
||||
# This part we cat in unquoted, so we can substitute the projname
|
||||
# variable.
|
||||
|
||||
cat << EOFOUTER >>$output
|
||||
if [ \$help ]; then
|
||||
cat << 'EOF'
|
||||
|
||||
This patch file was generated using get-delta on a remote $projname tree.
|
||||
It's designed to be run one time to apply the changes made remotely
|
||||
back to the main branch of the tree.
|
||||
|
||||
It should be run from within your own view, somewhere within the
|
||||
$projname hierarchy on the ClearCase system.
|
||||
|
||||
Options:
|
||||
|
||||
-l List information about the patch file, including the creation
|
||||
date and the list of modified files.
|
||||
|
||||
-o Checkout all the relevant files and perform other ClearCase
|
||||
operations (like renaming, creating, and removing files).
|
||||
|
||||
-p Apply the relevant patches to all files after they have been
|
||||
checked out. If this operation fails, the rest of the script
|
||||
will not continue.
|
||||
|
||||
-c Cleanup after successfully patching by removing .orig and .rej
|
||||
files.
|
||||
|
||||
-i Checkin modified files after successfully patching.
|
||||
|
||||
-d Perform final merge by executing ctdelta on modified files.
|
||||
|
||||
-f Perform full checkout/patch/merge cycle. This is equivalent to
|
||||
specifying -opcid.
|
||||
|
||||
-h This help page.
|
||||
|
||||
If no options are specified, the default is -opc.
|
||||
|
||||
EOF
|
||||
exit 0
|
||||
fi
|
||||
|
||||
if [ -z "\$any_opts" ]; then
|
||||
checkout=y
|
||||
patch=y
|
||||
cleanup=y
|
||||
fi
|
||||
EOFOUTER
|
||||
|
||||
any_merged=
|
||||
|
||||
# We start with the commands given in the project's .ctcmds file.
|
||||
ctcmds=$projroot/.ctcmds
|
||||
if [ -f $ctcmds ]; then
|
||||
any_merged=y
|
||||
cat $ctcmds >>$temp_checkout
|
||||
if [ $collapse ]; then
|
||||
rm $ctcmds
|
||||
fi
|
||||
fi
|
||||
|
||||
|
||||
for ct0 in `cat $temp_ct0`; do
|
||||
dir=`dirname $ct0`
|
||||
base=`basename $ct0 | sed 's/^\.ct0\.//'`
|
||||
file=$dir/$base
|
||||
ctnew=$projroot/$dir/.ctnew.$base
|
||||
|
||||
if (cd $projroot; diff -u $ct0 $file >>$temp_diffs); then
|
||||
# If diff returned success, it means the files were identical. In
|
||||
# this case, don't bother checking it out.
|
||||
echo "$file is unchanged."
|
||||
|
||||
else
|
||||
# Otherwise, the files were genuinely different. Check it out on
|
||||
# the remote end.
|
||||
echo $file
|
||||
|
||||
if [ -f $ctnew ]; then
|
||||
# This file is newly created. We need to create an element for
|
||||
# it on the remote end.
|
||||
eltype=`cat $ctnew`
|
||||
if grep -x $dir $temp_dirs >/dev/null; then
|
||||
echo directory already checked out >/dev/null
|
||||
else
|
||||
echo "ctco -nc $dir" >>$temp_checkout
|
||||
echo $dir >> $temp_dirs
|
||||
fi
|
||||
echo "touch $file" >>$temp_checkout
|
||||
echo "ctmkelem -eltype $eltype $file << 'EOF' 2>/dev/null" >>$temp_checkout
|
||||
list_comments $projroot/$dir $base >>$temp_checkout
|
||||
echo EOF >>$temp_checkout
|
||||
|
||||
echo $file >> $temp_files
|
||||
else
|
||||
echo "ctco $file << 'EOF' 2>/dev/null" >>$temp_checkout
|
||||
list_comments $projroot/$dir $base >>$temp_checkout
|
||||
echo EOF >>$temp_checkout
|
||||
|
||||
echo $file >> $temp_files
|
||||
fi
|
||||
fi
|
||||
|
||||
if [ $collapse ]; then
|
||||
echo Collapsing $file
|
||||
neartool collapse $projroot/$file
|
||||
fi
|
||||
done
|
||||
echo ""
|
||||
|
||||
# Handle -l, list files modified
|
||||
echo "" >>$output
|
||||
echo 'if [ $list ]; then' >>$output
|
||||
echo ' echo ""' >>$output
|
||||
echo ' echo Patch file for '$projname' tree, built on '`date` >> $output
|
||||
echo ' echo File was built by '`whoami` on `hostname` >>$output
|
||||
echo ' echo ""' >>$output
|
||||
echo ' echo Affected files are:' >>$output
|
||||
echo ' cat <<EOF' >>$output
|
||||
sed "s/^\./ $projname/" $temp_files >>$output
|
||||
echo 'EOF' >>$output
|
||||
echo ' echo ""' >>$output
|
||||
echo 'fi' >>$output
|
||||
|
||||
# Everything else depends on being in the proper tree.
|
||||
|
||||
cat <<EOF >>$output
|
||||
if [ \$only_list ]; then
|
||||
exit 0
|
||||
fi
|
||||
|
||||
projroot=\`ctproj -r\`
|
||||
if [ -z "\$projroot" ]; then
|
||||
echo ""
|
||||
echo "You must execute this script within the $projname tree."
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
if [ \`basename \$projroot\` != "$projname" ]; then
|
||||
echo ""
|
||||
echo "This script is intended for the $projname tree."
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
if [ ! -d /usr/atria ]; then
|
||||
echo ""
|
||||
echo "This script is intended to be run on an actual ClearCase vobs."
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
tmpfile=\`whoami\`-merge-$projname.tmp
|
||||
cd \$projroot
|
||||
touch \$tmpfile
|
||||
EOF
|
||||
|
||||
|
||||
# Handle -o, checkout stuff (and perform general ClearCase changes)
|
||||
echo "" >>$output
|
||||
echo 'if [ $checkout ]; then' >>$output
|
||||
if [ -f $temp_checkout ]; then
|
||||
cat $temp_checkout >> $output
|
||||
else
|
||||
echo 'echo Nothing to checkout.' >>$output
|
||||
fi
|
||||
echo 'fi' >>$output
|
||||
|
||||
# Handle -p, apply patch
|
||||
echo "" >>$output
|
||||
echo 'if [ $patch ]; then' >>$output
|
||||
if [ -f $temp_diffs ]; then
|
||||
any_merged=y;
|
||||
|
||||
echo " echo ''" >> $output
|
||||
echo " echo Applying patches." >> $output
|
||||
echo " if sed 's/^X//' << 'EOF' | patch -fsu; then" >>$output
|
||||
|
||||
sed 's/^/X/' < $temp_diffs >>$output
|
||||
echo EOF >>$output
|
||||
|
||||
echo " echo All patches applied successfully." >>$output
|
||||
echo " echo ''" >>$output
|
||||
echo " else" >>$output
|
||||
echo " echo Some conflicts detected:" >>$output
|
||||
echo " find . -name '*.rej' -newer \$tmpfile -print" >>$output
|
||||
echo " rm -f \$tmpfile" >>$output
|
||||
echo " exit 1" >>$output
|
||||
echo " fi" >>$output
|
||||
else
|
||||
echo ' echo No patches to apply.' >>$output
|
||||
fi
|
||||
echo 'fi' >>$output
|
||||
echo "rm -f \$tmpfile" >>$output
|
||||
|
||||
# Handle -c, cleanup
|
||||
echo "" >>$output
|
||||
echo 'if [ $cleanup ]; then' >>$output
|
||||
sed 's/^\(.*\)$/ rm -f \1.orig \1.rej/' <$temp_files >>$output
|
||||
echo 'fi' >>$output
|
||||
|
||||
# Handle -i, checkin
|
||||
echo "" >>$output
|
||||
echo 'if [ $checkin ]; then' >>$output
|
||||
sed 's/^\(.*\)$/ ctci -nc \1/' <$temp_files >>$output
|
||||
sed 's/^\(.*\)$/ ctci -nc \1/' <$temp_dirs >>$output
|
||||
echo 'fi' >>$output
|
||||
|
||||
# Handle -d, delta
|
||||
echo "" >>$output
|
||||
echo 'if [ $delta ]; then' >>$output
|
||||
sed 's/^\(.*\)$/ ctdelta \1/' <$temp_files >>$output
|
||||
sed 's/^\(.*\)$/ ctdelta \1/' <$temp_dirs >>$output
|
||||
echo 'fi' >>$output
|
||||
|
||||
rm -f $temp_ct0 $temp_checkout $temp_dirs $temp_files $temp_diffs
|
||||
|
||||
if [ -z "$any_merged" ]; then
|
||||
echo "Nothing to do!"
|
||||
echo ""
|
||||
rm -f $output
|
||||
exit 1
|
||||
fi
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,31 +0,0 @@
|
|||
require "$tool/built/include/ctutils.pl" ;
|
||||
require "$tool/built/include/ctdelta.pl" ;
|
||||
|
||||
# Remove a branch for an element if needed
|
||||
# input is in:
|
||||
# $_[0] = element
|
||||
sub CTUncoDoIt {
|
||||
local( $elem ) = $_[0] ;
|
||||
local( $ver ) = &CTDeltaGetVersion( $elem ) ;
|
||||
if ( $ctdebug ne "" ) {
|
||||
print STDERR "Unco script: got version '" . $ver . "'\n" ;
|
||||
}
|
||||
local( @verlist ) ;
|
||||
@verlist = split( /\//, $ver ) ;
|
||||
local( $vlast ) = pop( @verlist ) ;
|
||||
if ( $ctdebug ne "" ) {
|
||||
print STDERR "Unco script: last part of version is '" . $vlast . "'\n" ;
|
||||
}
|
||||
if ( $#verlist > 1 ) {
|
||||
local( $branch ) = join( "/", @verlist ) ;
|
||||
if ( $vlast == 0 ) {
|
||||
local( $cmd ) = "cleartool rmbranch -force -nc $elem" . "@@" . "$branch" ;
|
||||
if ( $ctdebug ne "" ) {
|
||||
print STDERR "Unco script: command is '" . $cmd . "'\n" ;
|
||||
}
|
||||
system $cmd ;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,189 +0,0 @@
|
|||
#! /bin/sh
|
||||
#
|
||||
# update-cttree.sh
|
||||
#
|
||||
# Usage:
|
||||
#
|
||||
# update-cttree.sh [opts] hostname
|
||||
#
|
||||
# Uses rsh and rdist to update the indicated host with a fresh copy of the
|
||||
# current project tree.
|
||||
#
|
||||
# This script must be executed from within a project tree.
|
||||
#
|
||||
# Options:
|
||||
#
|
||||
# -u username Specify the login name on the remote host.
|
||||
#
|
||||
# -d dir Specify the player install dir on the remote host. This
|
||||
# the directory above the project-tree-specific directory
|
||||
# like 'panda' or 'tool'. The default is 'player'.
|
||||
#
|
||||
# -t Touch the build-request timestamp file after updating.
|
||||
# This assumes there's a cron job running on the remote
|
||||
# machine checking the date on this file from time to time.
|
||||
#
|
||||
# -f Assume the user knows what he/she is doing, and don't bother
|
||||
# to check that there are no files checked out in the vobs
|
||||
# before releasing. This can save considerable time when the
|
||||
# system is extremely slow; however, it can be dangerous
|
||||
# to accidentally release a checked-out file (because the
|
||||
# file will then be write-access on the remote host, and
|
||||
# neartool will not be able to track local changes made to it.)
|
||||
#
|
||||
#ENDCOMMENT
|
||||
|
||||
username=`whoami`
|
||||
dirname=player
|
||||
touch_request=
|
||||
cocky_user=
|
||||
|
||||
while getopts "u:d:tfh" flag; do
|
||||
case $flag in
|
||||
u) username=$OPTARG;;
|
||||
d) dirname=$OPTARG;;
|
||||
t) touch_request=y;;
|
||||
f) cocky_user=y;;
|
||||
h) sed '/#ENDCOMMENT/,$d' <$0 >&2
|
||||
exit 1;;
|
||||
\?) exit 1;
|
||||
esac
|
||||
done
|
||||
|
||||
shift `expr $OPTIND - 1`
|
||||
remote_host=$1
|
||||
projroot=`ctproj -r`
|
||||
|
||||
if [ -z "$projroot" ]; then
|
||||
echo ""
|
||||
echo "You must execute this script in a project tree."
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ -z "$remote_host" ]; then
|
||||
echo ""
|
||||
echo "You must specify a remote hostname. -h for help."
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ ! -d /usr/atria ]; then
|
||||
echo ""
|
||||
echo "This script is intended to be run on an actual ClearCase vobs."
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
|
||||
projname=`basename $projroot`
|
||||
projtop=`dirname $projroot`
|
||||
|
||||
if [ "$projname" = "tool" ]; then
|
||||
echo ""
|
||||
echo "This script should not be used on the tool tree."
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
|
||||
outfile=/tmp/uc.$username.$projname.$remote_host.out
|
||||
errfile=/tmp/uc.$username.$projname.$remote_host.err
|
||||
rm -f $outfile $errfile
|
||||
|
||||
# Check to make sure we can run rsh to the remote machine, and that
|
||||
# the remote machine doesn't have anything checked out.
|
||||
|
||||
if rsh $remote_host -l $username "cd $dirname; find $projname -name .ct0.\* -print" >$outfile 2>$errfile; then
|
||||
if [ ! -f $outfile ]; then
|
||||
echo ""
|
||||
echo "Error in processing; unable to generate $outfile."
|
||||
echo ""
|
||||
rm -f $outfile $errfile
|
||||
exit 1
|
||||
fi
|
||||
if [ ! -f $errfile ]; then
|
||||
echo ""
|
||||
echo "Error in processing; unable to generate $errfile."
|
||||
echo ""
|
||||
rm -f $outfile $errfile
|
||||
exit 1
|
||||
fi
|
||||
if [ -s $errfile ]; then
|
||||
echo ""
|
||||
echo "Unable to scan project tree $dirname/$projname on $remote_host."
|
||||
echo ""
|
||||
rm -f $outfile $errfile
|
||||
exit 1
|
||||
fi
|
||||
if [ -s $outfile ]; then
|
||||
echo ""
|
||||
echo "Cannot update $remote_host; files still checked out on remote:"
|
||||
sed 's/^/ /;s/\.ct0\.//' $outfile
|
||||
rm -f $outfile $errfile
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
else
|
||||
echo ""
|
||||
echo "Cannot rsh to $remote_host as $username."
|
||||
echo ""
|
||||
rm -f $outfile $errfile
|
||||
exit 1
|
||||
fi
|
||||
|
||||
# Check to make sure the local machine doesn't have anything checked out.
|
||||
if [ -z "$cocky_user" ]; then
|
||||
cd $projroot
|
||||
cleartool lsco -s -me -recurse >$outfile
|
||||
if [ -s $outfile ]; then
|
||||
echo ""
|
||||
echo "Cannot update from "`hostname`"; files still checked out in vobs:"
|
||||
sed 's/^/ /;s/\.ct0\.//' $outfile
|
||||
rm -f $outfile $errfile
|
||||
echo ""
|
||||
exit 1
|
||||
fi
|
||||
fi
|
||||
|
||||
rm -f $outfile $errfile
|
||||
|
||||
|
||||
#
|
||||
# Get the complete list of files in the tree we need to update.
|
||||
#
|
||||
cd $projtop
|
||||
filelist=${outfile}.files
|
||||
rm -f $filelist
|
||||
cleartool find $projname -nxn -print | grep -v '/lost+found' > $filelist
|
||||
|
||||
#
|
||||
# Now build up a number of rdist files, as needed, to update these files.
|
||||
# We have to do this in stages because there seems to be a limit of about
|
||||
# 2000 files in one rdist file.
|
||||
#
|
||||
numlines=`wc -l $filelist | awk '{ print $1 }'`
|
||||
echo $projname contains $numlines files.
|
||||
|
||||
startline=1
|
||||
while [ $startline -le $numlines ]; do
|
||||
echo "FILES = (" >> $outfile
|
||||
tail +$startline $filelist | head -2000 >> $outfile
|
||||
echo ")" >> $outfile
|
||||
|
||||
echo '${FILES} -> '$username@$remote_host >>$outfile
|
||||
echo " install $dirname;" >> $outfile
|
||||
|
||||
if [ $touch_request ]; then
|
||||
echo " cmdspecial \"touch $dirname/$projname/build-request\" ;" >>$outfile
|
||||
fi
|
||||
|
||||
if rdist -onochkowner,nochkgroup,numchkgroup,whole,nodescend -f $outfile; then
|
||||
rm -f $outfile
|
||||
else
|
||||
echo "Error in rdist."
|
||||
rm -f $outfile $filelist $errfile
|
||||
exit 1
|
||||
fi
|
||||
startline=`expr $startline + 2000`
|
||||
done
|
||||
|
||||
rm -f $filelist $errfile
|
||||
Loading…
Reference in New Issue