@perl -x "%~dpnx0" %* @goto :EOF #!perl # --------------------------------------------------------------------------- # Script: snapbin.pl # # (c) 2000 Microsoft Corporation. All rights reserved. # # Purpose: Snapshot US binaries tree to INTL. # # Version: 1.00 (05/10/2000) : (bensont) Snap the binaries tree # 1.01 (05/10/2000) : (bensont) Create __BldInfo__usa__ file # Version: 1.5 (03/12/2001) : (SERGUEIK) snapbin.pl => snapbin.cmd # #--------------------------------------------------------------------- # Set Package package SnapBin; # Set the script name $ENV{script_name} = 'snapbin.cmd'; # Set version $VERSION = '1.5'; require 5.003; # Use section use lib $ENV{RAZZLETOOLPATH} . "\\PostBuildScripts"; use lib $ENV{RAZZLETOOLPATH}; use PbuildEnv; use ParseArgs; use File::DosGlob qw(glob); use GetParams; use GetIniSetting; use LocalEnvEx; use Logmsg; use strict; use vars qw($lang) ; use vars qw( $NETBIOS_COMMAND $NETVIEW $ROBOCOPYLOG $BUILD_NAME_MASK $DEBUG); use vars qw($BinarySnapServer $BinarySnapServers $BuildNum $_BuildArch $_BuildType $_BuildBranch $DFSAlternateBranchName $_BuildTimeStamp $_BldMarkerFile $SourceTree $SourceTreeChoice $TargetTree $RoboCopyCmd $RoboCopyLog $SnapList $Incremental ); use HashText; use GetIniSetting; my $NETBIOS_COMMAND = "NET VIEW computer"; my $BUILD_NAME_MASK = q(${BuildNum}.${_BuildArch}${_BuildType}.${_BuildBranch}.([0-9\-]+).${lang}); $BUILD_NAME_MASK =~ s/(\.|[^[]\\a-z0-9_{}()]+)/\Q$1\E/ig; # Main Function sub CmdMain { unless ( &GetIniSetting::CheckIniFile ) { exit errmsg( "Failed to find ini file ..." ); return; } $NETVIEW and &BinarySnapServer($BuildNum, $BinarySnapServer); return unless &PrepareRoboCopyCmd; &ExecuteRoboCopy; &ReExRobocopy($RoboCopyCmd, $RoboCopyCmd, $SourceTree, $TargetTree); my $dummy = ($NETVIEW) ? &GenerateBldInfo : &CreateBldInfo($_BuildBranch); &CountFiles; # /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ # End CmdMain code section # /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ } sub CountFiles{ &logmsg("DESTINATION CHECK: ". &BackTick(<[0]} map {[split /\s+/]} grep {/$BUILD_NAME_MASK/i} qx($NETBIOS_COMMAND)]; use strict 'refs'; } # &_BuildTimeStamp # filter out the time stamp part of the # build name sub _BuildTimeStamp{ no strict 'refs'; local ($_BuildTimeStamp, $BuildNum, $_BuildArch, $_BuildType, $_BuildBranch, $lang) = @_; my $BUILD_NAME_MASK = $BUILD_NAME_MASK; $BUILD_NAME_MASK =~ s/\$\{?(\w+)\b\}?/${$1}/egi; map {(s/$BUILD_NAME_MASK/$1/ig)} @$_BuildTimeStamp; $_BuildTimeStamp; use strict 'refs'; } sub BinarySnapServer{ # # 1. Clean the variables inherited from the default execution environment: # 2. Read the ini file to relate the build BinarySnapServer # BinarySnapServer label # suggested by MikeR # 3. Given the BinarySnapServer and the %_BUILD...% parameters, determine # the SourceTree and the _BuildTimeStamp. # # my $_BuildTimeStamps, $SourceTreeChoice; local $BuildNum = shift; $SourceTree = undef; $BinarySnapServer = shift; $BinarySnapServers = []; push @$BinarySnapServers, $BinarySnapServer if $BinarySnapServer; scalar @$BinarySnapServers or $BinarySnapServers = [split /\s/, &GetIniSetting::GetSetting( "BinarySnapServers")]; $DEBUG and print STDERR "Binary Snap Servers: @$BinarySnapServers\n"; foreach my $BinarySnapServer (@$BinarySnapServers){ my @arguments = ($BuildNum, $ENV{"_BuildArch"}, $ENV{"_BuildType"}, $ENV{"_BuildBranch"}, $ENV{"lang"}); $SourceTreeChoice = &SourceTree($BinarySnapServer, @arguments); scalar @$SourceTreeChoice or next; $SourceTree = "\\\\".$BinarySnapServer."\\".$SourceTreeChoice->[0]; $DEBUG and print STDERR "Source tree: " , $SourceTree, "\n"; $_BuildTimeStamps=&_BuildTimeStamp($SourceTreeChoice, @arguments); scalar @$_BuildTimeStamps or next; $_BuildTimeStamp = $_BuildTimeStamps->[0]; $DEBUG and print STDERR "Build time stamp: ", $_BuildTimeStamp, "\n"; # policy: pick the first available. $DEBUG or return; } $DEBUG or errmsg("unable to determine snap parameters for ". "binary Snap Servers: @$BinarySnapServers, ". "build number: $BuildNum, ". "giving up\n"); $DEBUG or exit (0); &logmsg($NETBIOS_COMMAND); &logmsg($BUILD_NAME_MASK); } # BackTick # sample usage: &BackTick("dir"); # &BackTick(< defined in string, evaluate by the order: global variable, environment variable. Report error if can not evaluate $SourceTree =~ s/\<(\w+)\>/(eval "defined \$SnapBin::$1") ? eval "\$SnapBin::$1":((exists $ENV{$1})? $ENV{$1}:errmsg("Unable to eval $1 in $SourceTree; verify your razzle environment"))/ge; $TargetTree =~ s/\<(\w+)\>/(eval "defined \$SnapBin::$1") ? eval "\$SnapBin::$1":((exists $ENV{$1})? $ENV{$1}:errmsg("Unable to eval $1 in $TargetTree; verify your razzle environment"))/ge; # If source tree not exist if (!-e $SourceTree) { exit errmsg("Source Tree: \"$SourceTree\" not found."); } # Any above error should stop (Fail) if ($ENV{errors} > 0) {return 0;} # Parse the hash-hash table snaplist foreach my $x_ (keys %snaplist) { $_ = $snaplist{$x_}->{Type}; $Excludedirs .= ($x_=~/\\/)? "$SourceTree\\$x_ ": "$x_ " if /\bD\b/; $Excludefiles .= ($x_=~/\\/)? "$SourceTree\\$x_ ": "$x_ " if (/\bF\b/); } $Excludefiles = join " ", map {glob($_)} split(" ", $Excludefiles) if ($Excludefiles); $DEBUG and print STDERR "Exclude files:", $Excludefiles, "\n"; # Check if incremental run. &ChkBabTree(\%snaplist) and exit; # Create RoboCopyLogName as %logfile%.RoboCopy $RoboCopyLog = `uniqfile $ENV{logfile}\.Robocopy`; if (defined $Incremental) { $Mirror = ""; # non-Mirror $OtherOptions = "/XO"; # Exclude Older files } # Prepare the robocopy statement $Cmd = "robocopy $Mirror /S /E $SourceTree $TargetTree $OtherOptions "; $Cmd .= "/XD $Excludedirs " if ($Excludedirs ne ''); $Cmd .= "/XF $Excludefiles " if ($Excludefiles ne ''); $RoboCopyCmd = $Cmd . " /LOG+:$RoboCopyLog"; 1; } # Verify that the snaplist.txt file does not contradict with # the actual contents of the $TargetTree. # usage: # &ChkBabTree(\%snapList) sub ChkBabTree{ my $snaplist = shift; my @report = (); my @children = grep {/\S/} split ("\n", qx ("dir /s/b/ad $TargetTree")); my ($childrenkeys, %hashchildren, $subdir, $lastdir, ); $DEBUG and print STDERR "$TargetTree ",scalar (@children), " subdirs\n"; return 0 unless @children; logmsg($TargetTree ." is not empty, possibly incremental run") if scalar(@children); map {$_ =~ s/\Q$TargetTree\E\\//} @children; my %hashchildren = map {$_=>$_} @children; $childrenkeys = \%hashchildren; map {$childrenkeys->{$_} =~ s/^.*\\//} @children; my @report = (); foreach $subdir (@children){ my $lastdir = $childrenkeys->{$subdir}; push @report, sprintf("%-30s%-30s",$lastdir,$subdir) # and delete ($snaplist->{$lastdir}) if ($snaplist->{$lastdir}->{Type}=~/\bD\b$/) or () ; } foreach $lastdir (keys(%$snaplist)){ next unless $snaplist->{$lastdir}->{Type}=~/\bD\b/ && $lastdir=~/\\/; my @subdir = grep {/\Q$lastdir\E/} @children; push @report, sprintf("%-30s%-30s",$lastdir,$subdir[0]) if scalar (@subdir); } unshift @report, "snaplist.txt %_NTTREE%\n". "-----------------------------------------------------" and print join ("\n", @report ), "\n\n" if scalar(@report); scalar(@report); 0; } # ExecuteRoboCopy # Purpose : Execute Robocopy Command ($RoboCopyCmd) # # Input : none # Output : none # # Note : The serious error or fatal error will be logged. sub ExecuteRoboCopy { my $status_; my $ROBOCOPY_ERROR = 8; my $ROBOCOPY_SERIOS_ERROR = 16; $RoboCopyCmd =~ s/\s+$//g; logmsg("ROBOCOPY: $RoboCopyCmd\n"); logmsg("SOURCE: $SourceTree"); logmsg("TARGET: $TargetTree"); logmsg("LOGFILE: $RoboCopyLog"); $DEBUG and return; $status_ = system($RoboCopyCmd) / 256; # Determine the return value if ($status_ > $ROBOCOPY_SERIOS_ERROR) { exit errmsg("Fatal robocopy error."); # Robocopy did not copy all files. This is either a usage error or an error due to # insufficient access privileges on the source or destination directions."; } elsif ($status_ > $ROBOCOPY_ERROR) { errmsg("Robocopy failed to copy some files or directories."); } } sub ReExRobocopy{ my @stack = @_; my ($f_, @flist,$d_,$c_); { open (F, "$SnapList"); my $startParse = 0; my @blist = (); my $flist = (); my @a = ; foreach (@a){ next if /^;/; if (/^Additional *$/){ $DEBUG and print "Additional directories:\n"; $startParse = 1; } $startParse=0 if ($startParse && $_ !~ /\S/); if ($startParse && /\S/){ my @alist = split(" ", $_); if ($#alist>=2){ $f_ = undef; $alist[0] =~ s/(.*)\\([^\\]+)/$1/g and $f_=$2 if $alist[1]=~/F/; push @flist, $f_; push @blist, $alist[0]; # &logmsg($alist[0]); } } } close(F); foreach $c_ (0..$#blist){ $d_ = $blist[$c_]; $f_ = $flist[$c_]; $DEBUG and print STDERR "$d_\n"; ($RoboCopyCmd, $RoboCopyLog, $SourceTree, $TargetTree) = @stack; $RoboCopyCmd =~ s/\\\\.*$//g; $RoboCopyLog =~ s|^.*(/LOG\+.*)$|$1.ADDED|g; chomp $RoboCopyLog; $SourceTree .= "\\$d_"; $TargetTree .= "\\$d_"; print "$SourceTree skipped\n" and next unless -d $SourceTree; $RoboCopyCmd = join(" ", $RoboCopyCmd, $SourceTree, $TargetTree, $RoboCopyLog, $f_); &ExecuteRoboCopy; } ($RoboCopyCmd, $RoboCopyLog, $SourceTree, $TargetTree) = @stack; } } # ParseLogFile # Purpose : Parse the log file which from argument and store to $ENV{logfile} with fully path # # Input : templogfile # Output : none # # Note : The log file will contain all file get copied and extra files removed. sub ParseLogFile { my ($templogfile) = @_; my ($type, $file, %slots, %fails, $path)=(); local *F; # Read temp logfile open(F, $templogfile) || return; for() { next if (/^\s*\-*\s*$/); if (/^ROBOCOPY/) {(%slots,%fails)=(); next;} chomp; # If is error message, add to previous line if (!/^\s/) { if ($#{$fails{$type}} eq '-1') { errmsg($_); } else { ${$fails{$type}}[$#{$fails{$type}}] .= "\n$_"; } next; } logmsg($_) if (defined $ROBOCOPYLOG); # Parse information according the format of robocopy log if (/^\s+(?:New Dir\s+)?(\d+)\s+([\w\:\\]+)$/) { $path = $2; next; } if (/^\s+((?:New File)|(?:Newer)|(?:\*EXTRA File)|(?:Older))\s+(\d+)\s+([\w\.]+)/) { ($type, $file) = ($1, $3); ((/100\%/)||(/\*EXTRA File/))?push(@{$slots{$type}}, $path . $file):push(@{$fails{$type}}, $path . $file); } } close(F); # Separate the log to success and fail logmsg("\n\[Copy Success\]"); for $type (keys %slots) { logmsg(" \[$type\]"); for $file (@{$slots{$type}}) { logmsg("\t$file"); } } if (scalar(%fails) ne 0) { errmsg("\n\[Copy Fails\]"); for $type (keys %fails) { errmsg(" \[$type\]"); for $file (@{$fails{$type}}) { errmsg("\t$file"); } } } # If Robocopy log include into the logfile, remove the robocopy its logfile if (defined $ROBOCOPYLOG) { unlink($templogfile); } else { logmsg("CHECK ROBOCOPY LOGFILE: $templogfile"); } } # GenerateBldInfo # A styripped down version of # CreateBldInfo used when snapping from US release server # sub GenerateBldInfo{ $_BuildTimeStamp = "??????-????" unless $_BuildTimeStamp !~ /[\d-]/ &logmsg("BUILD ${BuildNum} ($_BuildArch) TIMESTAMP: $_BuildTimeStamp"); open(F, ">$_BldMarkerFile"); print F "$BuildNum,$_BuildTimeStamp"; close(F); ###Copy __blddate__ and __bldnum__ from US release server map {qx("echo F|xcopy /V /F /R /Y $_ \%SDXROOT\%")} glob ("${SourceTree}\\congeal_scripts\\__bld*__"); 1; } # CreateBldInfo # Purpose : Create build number and time stamps to $_BldMarkerFile # # Input : none # Output : none # # Note : The file $_BldMarkerFile contain one line: ',