windows-nt/Source/XPSP1/NT/base/win32/fusion/tools/fusionsd.bat

818 lines
19 KiB
Batchfile
Raw Normal View History

2020-09-26 03:20:57 -05:00
@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl -x -S "%0" %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
goto endofperl
@rem ';
#!perl
#line 14
#
# fusionsd.bat (Perl)
#
# a collection of source depot related utilities, mainly
# involving the mainentance and building of a private branch
#
# example usages:
# fusionsd $parentBranch='lab01_n' ; $branch='lab01_fusion' ; Integrate()
# does some of the integration steps, and prints out what is left to be done manually
# fusionsd $parentBranch='lab01_n' ; $branch='lab01_fusion' ; QueryIntegrate()
# reports information as to when publics were last checked in and what build they correspond to
# fusionsd LikePopulate(); # not implemented
# fusionsd LikePopulatePlusSymbols(); # not implemented
# fusionsd ReverseIntegrate(); # not implemented
#
# Integrate should be able to determine the branches from its environment, that
# code is working, just not hooked up to Integrate.
#
# April 2001 Jay Krell (JayKrell)
#
#use strict;
use English;
@procs = qw(ia64 x86);
@chkfres = qw(chk fre);
sub CleanPath
{
#
# a general ambiguously named function
# for now removes .\ from the start, \. from the end and converts \.\ to \ in between
# and lowercases, just in case
#
my($x) = ($ARG[0]);
my($y) = (MakeLower($x));
$y =~ s/\\\.$//;
$y =~ s/\\\.\\/\\/g;
$y =~ s/^.\\//;
#Log('CleanPath(' . $x . ') is ' . $y);
return $y;
}
sub TrimSpace
{
#
# remove whitespace from start and end of a string
#
my($x) = ($ARG[0]);
$x =~ s/^\s+//;
$x =~ s/\s+$//;
return $x;
}
sub NormalizeSpace
{
#
# remove whitespace from start and end of a string
# convert all whitespace (tab, newline, etc.) to space
# convert runs of spaces to single spaces
#
my($x) = ($ARG[0]);
$x =~ s/\s/ /g;
$x =~ s/^ +//;
$x =~ s/ +$//;
$x =~ s/ +/ /;
return $x;
}
sub JoinPaths
{
#
# given an array of strings, put a path seperator between them
#
my($result) = join('\\', @ARG);
$result = CleanPath($result);
#Log('JoinPaths() is ' . $result);
return $result;
}
#
# not really used currently, but might be
#
%KnownSdVariables =
(
#
# stuff in sd.map/sd.ini that are not names of projects
#
'branch' => 1,
'client' => 1,
'codebase' => 1,
'codebasetype' => 1,
'depots' => 1,
);
#
# unused -- comments later, it does not appear to be worth
# making this distinction. We can derive branch graph from sd.
#
#%PublicBranches =
#(
# 'lab01_n' => '1',
# 'lab02_n' => '1',
# 'lab03_n' => '1',
# 'lab04_n' => '1',
# 'lab05_n' => '1',
# 'lab06_n' => '1',
# 'lab07_n' => '1',
# 'lab08_n' => '1',
# 'lab09_n' => '1',
#);
#
# unused -- might be useful for Integrate, maybe only for
# sanity checking. We have the data in "mixed" enlistments which
# project is in which branch, but we don't use it.
#
# sdx integrate gives a nice quick error, so we may get by with doing nothing
# (UNDONE: need to sync the other projects correctly)
#
#%ImportantProjectsForBranch =
#(
# 'lab01_n' => ( 'root' , 'base' ),
#);
$sdxroot = $ENV{'SDXROOT'};
#
# not used, see next (next)
#
# map private branch to parent public branch
#
#%PrivateBranches=
#{
# 'lab01_fusion' => 'lab01_n'
#};
#
# not used, see next
#
#sub IsPublicBranch
#{
# my ($x) = ($ARG[0]);
#
# return $PublicBranches{$x};
#}
#
# not used -- such an exact distinction is not worth making
# instead, you can find a branch's parent, and you know if a branch
# has an associated set of build machines.
#
#sub IsPrivateBranch
#{
# my ($x) = ($ARG[0]);
# my($y);
#
# $y = $PrivateBranches{$x};
# if ($y)
# {
# return $y;
# }
#
# #
# # we could look for 'private' in the name, but then how do we map to its parent?
# #
# return 0;
#}
#
# unused -- we can determine this dynamically
#
#sub PublicParentOfPrivateBranch
#{
# my ($x) = ($ARG[0]);
# my($y);
#
# $y = $PrivateBranches{$x};
# return $y;
#}
sub MakeLower
{
my($x) = ($ARG[0]);
$x =~ tr/A-Z/a-z/;
return $x;
}
sub MakeUpper
{
my($x) = ($ARG[0]);
$x =~ tr/a-z/A-Z/;
return $x;
}
sub MakeTitlecase
{
my($x) = ($ARG[0]);
$x = MakeUpper(substr($x, 0, 1)) . MakeLower(substr($x, 1));
return $x;
}
sub SdxRoot { return $ENV{'SDXROOT'}; }
sub SdMapPath { return JoinPaths(SdxRoot(),'sd.map'); }
sub Log
{
my($x) = ($ARG[0]);
$x =~ s/[ \t\n]+$//; # get rid of trailing whitespace, including new lines
print('REM FusionSd.bat ' . $x . $endl);
}
sub Suggest
{
#
# Tell the user to run a command.
#
my($x) = ($ARG[0]);
$x =~ s/[ \t\n]+$//; # get rid of trailing whitespace, including new lines
print('' . $x . $endl);
}
sub Error
{
my($x) = ($ARG[0]);
$x =~ s/[ \t\n]+$//; # get rid of trailing whitespace, including new lines
print('NMAKE : U1234 : FusionSd.bat ' . $x . $endl);
}
sub ErrorExit
{
my($x) = ($ARG[0]);
Error($x);
exit(-1);
}
sub ReadSdMap
{
my($sdmapFileHandle);
if ($SdMap)
{
return;
}
open(sdmapFileHandle, '< ' . SdMapPath()) || Error('Unable to open ' . SdMapPath());
#
# the file is a bunch of
# name = string
# with some blank lines and # comments
#
# any line with a =, make the assignment happen in the $SdMap{} hashtable
#
while (<sdmapFileHandle>)
{
s/^ +//g;
s/ +$//g;
s/ +/ /g;
if (!/^#/ && /(\w+) *= *(.+)/)
{
$SdMap{MakeLower($1)} = MakeLower($2);
}
}
foreach (sort(keys(SdMap)))
{
if (!$KnownSdVariables{$ARG})
{
$Projects{$ARG} = $SdMap{$ARG};
}
else
{
Log(' ' . $ARG . ' = ' . $SdMap{$ARG});
}
}
Log('enlisted in projects: ' . join(' ' , sort(keys(Projects))));
foreach (sort(keys(Projects)))
{
Log(' project ' . $ARG . ' is at ' . JoinPaths(SdxRoot(), $Projects{$ARG}));
}
}
sub GetBranch
{
my($x) = ($ARG[0]);
my($y);
$x = NormalizeSpace(MakeLower($x));
$y = $x;
#Log($y);
$y =~ s/^\/\/depot\///i;
#Log($y);
$y =~ s/^\/?private\///i;
#Log($y);
$y =~ s/\/.+//i;
#Log($y);
#Log('GetBranch(' . $x . ') is ' . $y);
return $y;
}
#
# UNDONE This works. Integrate should use it.
#
sub GetParentBranch
{
my($project, $branchName) = ($ARG[0], $ARG[1]);
my($cmd) = ' sd branch -o ' . $branchName;
open(sdbranch, $cmd . ' | ') || Error('Unable to run ' . $cmd);
Log($cmd);
#Log(' project is ' . $project);
while (<sdbranch>)
{
if (/^ *View: *$/)
{
return GetBranch(<sdbranch>);
}
}
}
#
# UNDONE LikePopulate will use this
#
sub ReadBuildMachines
{
my($filepath) = JoinPaths(SdxRoot(), 'tools', 'buildmachines.txt');
}
#
# UNDONE This works. Integrate should use it.
#
sub ReadClient
{
my($function) = 'ReadClient';
my($sdclientName);
my($sdinipath);
my($project);
my($sdmapRoot);
my($sdclientRoot);
#
# UNDONE ping the depots
#
#
# read in all the sd.ini files, make sure each
# contains one and only one SDCLIENT=foo line.
#
foreach $project (sort(keys(Projects)))
{
$sdinipath = JoinPaths(SdxRoot(), $Projects{$project}, $sd_ini);
open(sdini, '< ' . $sdinipath) || Error('Unable to open ' . $sdinipath);
$sdclientName = '';
while (<sdini>)
{
if (/^ *SDCLIENT *= *(.+)$/)
{
if ($Projects{$project}{'SDCLIENT'})
{
Error('Multiple SDCLIENTS in ' . $sdinipath);
ErrorExit($function);
}
$sdclientName = $1;
$Projects{$project}{'SDCLIENT'} = $sdclientName;
}
}
if (!$sdclientName)
{
Error('SDCLIENT not found ' . $sdinipath);
ErrorExit($function);
}
}
#
# check that project is using the same client (not sure we really care anymore)
#
foreach $project (sort(keys(Projects)))
{
if ($sdclientName ne $Projects{$project}{'SDCLIENT'})
{
Error('SDCLIENT is ' . $sdclientName);
Error('SDCLIENT(' . $project . ') is ' . $Projects{$project}{'SDCLIENT'});
Error('SDCLIENT not the same across all projects');
ErrorExit($function);
}
}
foreach $project (sort(keys(Projects)))
{
my($sdmapRoot) = JoinPaths(SdxRoot(), $Projects{$project});
my($sdclientRoot);
my($sdclientView);
my($sdclientViewLocal);
my($sdclientViewDepot);
my($sdclientCommand);
my($branch);
my($parentBranch);
chdir($sdmapRoot);
Log('cd /d ' . $sdmapRoot);
#$sdclientCommand = 'sd client -o ' . $sdclientName;
$sdclientCommand = 'sd client -o ';
open(sdclient, $sdclientCommand . ' | ');
Log(' SDCLIENT is ' . $sdclientName);
while (<sdclient>)
{
#Log;
#
# verify that the root is what we expect
#
if (/^ *Root: *(.+)$/)
{
$sdclientRoot = TrimSpace($1);
Log(' sdmapRoot is ' . $sdmapRoot);
Log(' sdclientRoot is ' . $sdclientRoot);
if ($sdclientRoot ne JoinPaths(SdxRoot(), $Projects{$project}))
{
Error('sd.map and sd client roots do not agree (' . $sdmapRoot . ', ' . $sdclientRoot . ')');
ErrorExit($function);
}
}
#
# and get the view
#
if (/^ *View: *$/)
{
$branch = GetBranch(<sdclient>);
#Log(' branch is ' . $branch);
$Projects{'branch'} = $branch;
Log(' ' . $project . ' in ' . $branch . ' branch ');
}
}
if (!$branch)
{
ErrorExit('branch not detected');
}
if ($branch eq 'main')
{
$parentBranch = 'main';
}
else
{
$parentBranch = GetParentBranch($project, $branch);
}
if (!$parentBranch)
{
ErrorExit('parentBranch not detected');
}
Log(' parent of ' . $branch . ' is ' . $parentBranch);
#
# enumerate all branches
#
open(sdbranches, 'sd branches | ');
while (<sdbranches>)
{
$Projects{$project}{'branches'}{MakeLower((split(/ /))[1])} = 1;
}
$Projects{$project}{'branches'}{'main'} = 1; # this doesn't show up, and we do not care
if (!$Projects{$project}{'branches'}{$branch})
{
ErrorExit('detected branch is ' . $branch . ' but it is not listed in sd branches ');
}
if (!$Projects{$project}{'branches'}{$parentBranch})
{
ErrorExit('detected parentBranch is ' . $parentBranch . ' but it is not listed in sd branches ');
}
$Projects{$project}{'parentBranch'} = $parentBranch;
}
}
sub IsEnlistmentClean
{
my($cmd) = 'sdx opened';
my($okFiles) = 0;
my($opened) = 0;
Log('START ' . $cmd);
open(x, $cmd . ' | ') || ErrorExit('Unable to run ' . $cmd);
while (<x>)
{
Log($ARG);
if (/^\/\/depot/)
{
if (/[\\\/]([^\\\/]+\.bat)#\d+ - [^\\\/]+/)
{
$okFiles += 1;
Log('opened tool ' . $1 . ' ok');
}
}
elsif (/Open for .+:\s+(\d+)/)
{
}
elsif (/Total:\s+(\d+)/)
{
$opened = $1;
}
}
Log('END ' . $cmd);
return (($opened - $okFiles) == 0);
}
sub TimeToRevision
{
my($y,$mon,$d,$h,$min,$sec) = (@ARG);
my($s);
#
#Change 52625 on 2001/04/22 09:52:42 by NTDEV\ntvbl01@ROBSVBL4 'Public Changes for 010421-2000 '
# => @yyyy/mm/dd:hh:mm:ss
#
$s = sprintf("@%04d/%02d/%02d:%02d:%02d:%02d", $y, $mon, $d, $h, $min, $sec);
#Log('TimeToRevision is ' . $s);
return $s;
}
sub TimeToInteger
{
#
# This might be useful if 1) we need to compare dates, and 2) if it works, like if the numbers
# produced don't overflow. We are unlikely to need second or even minute resolution.
#
my($y,$mon,$d,$h,$min,$s) = (@ARG);
#Log('TimeToInteger year: ' . $y );
#Log('TimeToInteger mont: ' . $mon );
#Log('TimeToInteger date: ' . $d );
#Log('TimeToInteger hour: ' . $h );
#Log('TimeToInteger minu: ' . $min );
#Log('TimeToInteger seco: ' . $s );
$y -= 2000;
#my ($i) = ($s + (60 * ($min + (60 * ($h + (24 * ($d + (31 * ($mon + (12 * $y))))))))));
my ($i) = ($min + (60 * ($h + (24 * ($d + (31 * ($mon + (12 * $y))))))));
#my ($i) = ($h + (24 * ($d + (31 * ($mon + (12 * $y))))));
#Log('TimeToInteger() : ' . $i);
return $i;
}
sub TimeFromSdChangeLine
{
#
#Change 52625 on 2001/04/22 09:52:42 by NTDEV\ntvbl01@ROBSVBL4 'Public Changes for 010421-2000 '
# ^^^^^^^^^^^^^^^^^^^
my($x) = ($ARG[0]);
#Log('TimeFromSdChangeLine x: ' . $x );
my($y,$mon,$d,$h,$min,$s) = ($x =~ /^\s*Change\s+\d+\s+on\s+(\d+)\/(\d+)\/(\d+)\s+(\d+):(\d+):(\d+)\s+.+/i);
#Log('TimeFromSdChangeLine year: ' . $y );
#Log('TimeFromSdChangeLine mont: ' . $mon );
#Log('TimeFromSdChangeLine date: ' . $d );
#Log('TimeFromSdChangeLine hour: ' . $h );
#Log('TimeFromSdChangeLine minu: ' . $min );
#Log('TimeFromSdChangeLine seco: ' . $s );
return ($y,$mon,$d,$h,$min,$s);
}
sub SdSyncCommandFromPublicChangeLine
{
}
sub TimePartOfReleaseDirectoryNameFromSdChangeLine
{
#
#Change 52625 on 2001/04/22 09:52:42 by NTDEV\ntvbl01@ROBSVBL4 'Public Changes for 010421-2000 '
# ^^^^^^^^^^^
my($x) = ($ARG[0]);
my($y) = ($x);
$y =~ s/'//g;
$y = NormalizeSpace($y);
($y) = ($y =~ / ([0-9-]+)$/);
#Log('TimePartOfReleaseDirectoryNameFromSdChangeLine(' . $x . ') => ' . $y);
#Log('TimePartOfReleaseDirectoryNameFromSdChangeLine() => ' . $y);
return $y;
}
sub GetLastPublicChangeLine
{
my($branch) = ($ARG[0]);
my($cmd) = ' sd changes -m 1 //depot/' . $branch . '/root/public/... ';
chdir(JoinPaths(SdxRoot(), 'public'));
open(sdchange, $cmd . ' | ') || ErrorExit('Unable to run ' . $cmd);
Log($cmd);
my($x);
my($y);
$x = <sdchange>;
Log($x);
while ($y = <sdchange>)
{
Log($y);
}
$x = NormalizeSpace($x);
Log('LastPublicChangeLine : ' . $x);
return $x;
}
sub LikePopulatePlusSymbols
{
}
sub LikePopulate
{
}
sub RevertPublic
{
my($outline);
chdir(JoinPaths(SdxRoot(), 'public')) || ErrorExit('unable to chdir public');
Log('cd /d %sdxroot%\public');
my($cmd) = 'sd revert ...';
open(out, $cmd . ' 2>&1 | ') || ErrorExit('Unable to run ' . $cmd . $!);
Log($cmd);
while ($outline = <out>)
{
Log($outline);
}
return 1;
}
sub Pause
{
print('****************************************************************************' . $endl);
print('*********** Press a key to continue. ******************' . $endl);
print('*********** control-break maybe to abort (not control-c). ******************' . $endl);
print('****************************************************************************' . $endl);
my($cmd) = $ENV{'COMSPEC'} . ' /c pause ';
open(x, $cmd . ' | ') || ErrorExit('Unable to run ' . $cmd);
while (<x>)
{
}
return 1;
}
sub IntegrateRun
{
my($cmd) = ($ARG[0]);
Log('START ' . $cmd);
Pause() || ErrorExit('aborted');
open(out, $cmd . ' | ') || ErrorExit('Unable to run ' . $cmd);
while (<out>)
{
print;
}
Log('END ' . $cmd);
}
sub IntegrateDoNotRun
{
my($cmd) = ($ARG[0]);
Log($cmd);
}
sub GenericIntegrate
{
my($run) = ($ARG[0]);
my($cmd);
Log('START Integrate');
RevertPublic() || ErrorExit('unable to RevertPublic');
IsEnlistmentClean() || ErrorExit('enlistment is not clean');
chdir(SdxRoot()) || ErrorExit('unable to chdir root');
chdir(JoinPaths(SdxRoot(), 'public')) || ErrorExit('unable to chdir public');
Log('cd /d %sdxroot%');
my($lastPublicChange) = GetLastPublicChangeLine($parentBranch);
my($releaseTimeName) = TimePartOfReleaseDirectoryNameFromSdChangeLine($lastPublicChange);
my(@timeOfLastPublicChange) = TimeFromSdChangeLine($lastPublicChange);
my($revision) = TimeToRevision(@timeOfLastPublicChange);
Log('lastPublicChange is ' . $lastPublicChange);
Log('releaseTimeName is ' . $releaseTimeName);
Log('timeOfLastPublicChange is (' . NormalizeSpace(join(' ', @timeOfLastPublicChange)) . ')');
#Log('integralTimeOfLastPublicChange is ' . TimeToInteger(@timeOfLastPublicChange));
Log('revision is ' . $revision);
$cmd = 'sdx integrate -b ' . $branch . ' ' . $revision;
$run->($cmd);
#
# a side affect in the doNotRun case, oh well..
#
chdir(JoinPaths(SdxRoot(), 'public')) || ErrorExit('chdir public');
Log('cd /d %sdxroot%\public');
#
# Take the parent branch's publics.
#
$cmd = 'sd resolve -at ... ';
$run->($cmd);
#
# Do the simple merges automatically.
#
$cmd = 'sdx resolve -as ';
$run->($cmd);
#
# Adventures in Babysitting..
#
$cmd = 'sdx resolve -n ';
$run->($cmd);
# UNDONE Write "Banner" / "Box"..
Log('******************************************************');
Log('***** *******');
Log('***** manually sd resolve and build and submit *******');
Log('***** *******');
Log('******************************************************');
# UNDONE This list should be parameterized..
my(@PathsToBuild) = qw(published base\published base\crts base\ntos\rtl base\ntdll base\win32);
my($pathToBuild);
foreach $pathToBuild (@PathsToBuild)
{
Suggest('cd /d ' . JoinPaths(SdxRoot(), $pathToBuild));
Suggest('build -cZ');
}
Suggest('sdx submit -# integrate from ' . $parentBranch);
# UNDONE Learn the "format" feature to make these pretty
Log('******************************************************');
Log('***** lastPublicChange is ' . $lastPublicChange);
Log('***** releaseTimeName is ' . $releaseTimeName);
Log('***** timeOfLastPublicChange is (' . NormalizeSpace(join(' ', @timeOfLastPublicChange)) . ')');
#Log('***** integralTimeOfLastPublicChange is ' . TimeToInteger(@timeOfLastPublicChange));
Log('***** revision is ' . $revision);
Log('******************************************************');
}
sub Integrate
{
GenericIntegrate(\&IntegrateRun);
}
sub QueryIntegrate
{
GenericIntegrate(\&IntegrateDoNotRun);
}
#
# scary and done less often, probably not worth automating
#
sub ReverseIntegrate
{
}
#
# UNDONE (for LikePopulate and LikePopulatePlusSymbols)
#
sub FindDiskSpace
{
}
sub Main
{
$endl = "\n";
$sd_ini = $ENV{'SDCONFIG'};
if (!$sd_ini)
{
$sd_ini = 'sd.ini';
}
if (!SdxRoot())
{
ErrorExit('SDXROOT} not known');
}
Log('$SDXROOT is ' . SdxRoot());
Log('sd.map is ' . SdMapPath());
ReadSdMap();
#ReadClient();
}
Main();
Log(join(";", @ARGV));
eval(join(";", @ARGV));
__END__
:endofperl