windows-xp/Source/XPSP1/NT/tools/comlib.pm

#----------------------------------------------------------------//
# Script: comlib.pm
#
# (c) 2000 Microsoft Corporation. All rights reserved.
#
# Purpose: This script contains all the common perl routines.
#
# Version: <1.00> 07/28/2000 : Suemiao Rossognol
#----------------------------------------------------------------//
package comlib;

$VERSION = '1.00';

###-----Require section and extern modual.----------------------//

require 5.003;
use strict;
use lib $ENV{RazzleToolPath };
use lib "$ENV{RazzleToolPath }\\sp";
#no strict 'vars';
#no strict 'subs';
#no strict 'refs';

use Logmsg;
use cklang;
use hashtext;
use BuildName;
use LockProc;
use DfsMap;

#----------------------------------------------------------------//
#Function:   globex
#Parameter: (1) Search String
#Retuen:    (1) Array 
#----------------------------------------------------------------//
sub globex ($)
{
    my $match_criteria = shift;

    if ( !defined $match_criteria )
    {
   	errmsg( "Must specify parameter for globex") ;
	return 0;
    }

    # Need to use '/' for UNC paths, so just convert to all '/''s
    $match_criteria =~ s/\\/\//g;

    # Return the results, converting back to '\'
    return grep { s/\//\\/g } glob( $match_criteria );
}
#----------------------------------------------------------------//
#Function:   LockProcess
# Parameter: (1) Language
#            (2) Build Branch
#	     (3) Lock Object
#----------------------------------------------------------------//
sub LockProcess
{
    my ( $pLang, $pBranch, $pLockObj ) = @_;
 
    ##### Define Semaphore location
    my $lock_Location;
    if( !($lock_Location = &GetIniSetting::GetSettingEx( $pBranch, $pLang, "DFSSemaphore") ) )
    {
      	errmsg( "[DFSSemaphore] is undefined in INI file." );
      	return 0;
    }
    logmsg( "DFS Semaphore [$lock_Location]");

    ##### Acquire DFS Semaphore lock
    if( !(${$pLockObj} = new LockProc( $lock_Location, 60000) ) )
    {
      	errmsg( "Problem acquiring lock using [$lock_Location]" );
      	return 0;
    }
    logmsg( "Acquiring lock for exclusive DFS access..." );
    while ( !$$pLockObj->Lock() ) 
    {
 	errmsg ("Failed to acquire semaphore lock.");
        return 0;
    }
    return 1;
}
#----------------------------------------------------------------//
#Function:   TieDfsView
# Parameter: (1) Language
#            (2) Build Branch
#            (3) Tiehash Object
#----------------------------------------------------------------//
sub TieDfsView
{
    my ( $pLang, $pBranch, $pTieObj ) = @_;

    ##### Get DFS Root name
    my $dfsRoot; 
    if( !($dfsRoot = &GetIniSetting::GetSettingEx( $pBranch, $pLang,"DFSRootName" ) ) )
    {
      	errmsg( "[DFSRootName] undefined in INI file." );
      	return 0;
    }
    ##### Access DFS through a TIE hash
    logmsg( "Tie full DFS view [$dfsRoot] information." );
    if ( ! tie %$pTieObj, 'DfsMap', $dfsRoot ) 
    {
      	errmsg( "Error accessing DFS." );
      	return 0;
    }
    return 1;
}

#----------------------------------------------------------------//
#Function: ParseDfsMapText
# Parameter: (1) Sku (2) Build profile hash, key used:package
#            
# Return:    (1) Hash Array
#----------------------------------------------------------------//
sub ParseDfsMapText
{
    my ( $pSkus, $pbldInfo ) = @_;
    my ( @theHash, @rtary, $theRootShare, $theSubShare, $theRootDir, $theLink );
    
    my $dfsMapFile = "$ENV{razzletoolpath}\\sp\\raiseall.txt";
    @theHash=();
    &HashText::Read_Text_Hash( 1, $dfsMapFile, \@theHash );	
    my $extraLine;
    for my $line ( @theHash)
    { 
        next if( $pbldInfo->{"package"} && lc $pbldInfo->{"package"} ne lc $line->{ Package } );
	next if( $pbldInfo->{"pkgtarget"} && lc $pbldInfo->{"pkgtarget"} ne "all" && 
		 lc $line->{ Target } ne "all" && lc $pbldInfo->{"pkgtarget"} ne lc $line->{ Target } );
      	next if( %$pSkus && !exists( $pSkus->{$line->{Sku}}) );

	#### Handle Micro replacement
	&ReplaceMicro( \$line->{ RootShare }, $line->{Sku}, $pbldInfo );
	&ReplaceMicro( \$line->{ SubShare },  $line->{Sku}, $pbldInfo );
	&ReplaceMicro( \$line->{ RootDir },   $line->{Sku}, $pbldInfo );
	&ReplaceMicro( \$line->{ Link },      $line->{Sku}, $pbldInfo );
 
        push( @rtary, $line );	

	#### Add mapping for usa\<buildNO>\<archType>.cov links
        my %covUsaLine;
	if( $line->{Package} eq "OS" && lc $pbldInfo->{"lang"} eq "cov" )		
	{
	    %covUsaLine = %{$line};
	    $covUsaLine{Link} =~ s/$pbldInfo->{"lang"}/usa/;
	    $covUsaLine{Link} =~ s/$pbldInfo->{"arch"}$pbldInfo->{"type"}/$pbldInfo->{"arch"}$pbldInfo->{"type"}.cov/;
	    push( @rtary, \%covUsaLine );
	}

	#### Add mapping for Neutral mui builds with misc links
	my %miscMuiLine;
	if( $line->{Package} eq "Neutral" )
	{
	    %miscMuiLine = %{$line};
	    $miscMuiLine{Link} =~ s/$pbldInfo->{"lang"}/misc/;
	    push( @rtary, \%miscMuiLine );		    
	}	
    }   
    return ( @rtary );
}
#----------------------------------------------------------------//
#Function: ReplaceMicro
# Parameter: (1)String to be replaced (2)Sku (3)Build Profile Hash
#            
# Return:    none
#----------------------------------------------------------------//
sub ReplaceMicro
{
    my ( $pStr, $pSku, $pbldInfo ) =@_;
    $pbldInfo->{shareno} = $pbldInfo->{no} if( !$pbldInfo->{shareno} );
    $$pStr =~ s/\$\(BLANK\)//g;
    $$pStr =~ s/\$\(SKU\)/$pSku/g;
    $$pStr =~ s/\$\(SERVER\)/\\\\$pbldInfo->{server}/g;
    $$pStr =~ s/\$\(BUILD\)/$pbldInfo->{basename}/g;
    $$pStr =~ s/\$\(LANG\)/$pbldInfo->{lang}/g;
    $$pStr =~ s/\$\(BLDNO\)/$pbldInfo->{no}/g;
    $$pStr =~ s/\$\(SHARENO\)/$pbldInfo->{shareno}/g;
    $$pStr =~ s/\$\(BRANCH\)/$pbldInfo->{branch}/g;
    $$pStr =~ s/\$\(RELEASE\)/$pbldInfo->{release}/g;
    $$pStr =~ s/\$\(SYMREL\)/$pbldInfo->{symshare}/g;
    $$pStr =~ s/\$\(DFSBRANCH\)/$pbldInfo->{dfsbranch}/g;
    $$pStr =~ s/\$\(ARCH\)/$pbldInfo->{arch}/g;
    $$pStr =~ s/\$\(TYPE\)/$pbldInfo->{type}/g;   
}

#----------------------------------------------------------------//
#Function:   GetReleaseShareName
# Parameter: (1) Build Branch
#            (2) Language
#----------------------------------------------------------------//
sub GetReleaseShareName
{
    my ( $bldBranch, $lang ) = @_;
    my ($releaseShareName);

    my( @iniRequest ) = ( "AlternateReleaseDir", "ReleaseDir");
    for my $keyReleaseDir( @iniRequest )
    {
        $releaseShareName = &GetIniSetting::GetSettingEx( $bldBranch, $lang,$keyReleaseDir );
        last if( $releaseShareName );
    }				
    $releaseShareName = "release" if( !$releaseShareName );
    return ( $releaseShareName );
}
#----------------------------------------------------------------//
#Function: ParseNetShare
#Parameter: (1) Share name
#	    (2) Parsing String, such as "Path", "Permissions:"
#
# Return:    Share Path or access ID and permission in hash array
#----------------------------------------------------------------//
sub ParseNetShare
{
    my ( $pShareName, $pParseStr ) = @_;
    my ( @results, %shareInfo );

    if( $pShareName !~ /^\\\\(.+)\\(.+)$/ )
    {
	$pShareName = "\\\\$ENV{computername}\\$pShareName ";
    }
    my @tmpFile = `rmtshare $pShareName`;  
    my $match;
    for my $theLine ( @tmpFile )
    {
	chomp $theLine;
	next if( !$theLine );
        last if( $theLine =~ "The command completed successfully." );
	if( $theLine =~ /$pParseStr/i )
	{ 
	    if( $pParseStr =~ /Permissions:/i ){ $match = 1; next;}

	    ### parse path, return path
	    @results = split( /\s+/, $theLine );
	    return $results[1];	    
	}
	push ( @results, $theLine ) if( $match );	
    } 
    #### Parse permissions, return key-Access ID, value-permission
    for my $line ( @results )
    {
	my @tmp = split( /\:/, $line );
        for( @tmp )
	{ 
	    $_ =~ s/(\s+)?([^\s+]+)(\s+)?/$2/; 
	}
        $shareInfo{$tmp[0]}=$tmp[1];
    }
    return ( %shareInfo );
}
#----------------------------------------------------------------//
#Function: ParseSharePath
#Parameter: (1) Share name
#
# Return:    Share path
#----------------------------------------------------------------//
sub ParseSharePath
{
    my ( $pShareName ) = @_;
    my ( $sharePath );

    if( $pShareName !~ /^\\\\(.+)\\(.+)$/ )
    {
	$pShareName = "\\\\$ENV{computername}\\$pShareName ";
    }
      
    my $tmp = "$ENV{temp}\\tmp.txt"; 
    if( !system ("rmtshare $pShareName > $tmp" ) )
    {
	my @tmpFile= &comlib::ReadFile( $tmp );
	for my $theLine ( @tmpFile )
	{
            my @mCols = split( /\s+/, $theLine );
            if( $mCols[0] eq "Path" )
	    {
		$sharePath = $mCols[1];
                last;
	    }
	}
	unlink( $tmp );
    }
    return ( $sharePath );
}
#----------------------------------------------------------------//
#Function: ParseTable
# Parameter: (1) Group (2) Language (3) Architecture (4) Debug type
# Return:    Hash Array Table
#----------------------------------------------------------------//
sub ParseTable
{
    my ( $pGroup, $pLang, $pArch, $pType ) = @_;

    my @theHash=();
    &HashText::Read_Text_Hash( 1, "$ENV{RazzleToolPath}\\sp\\miscrel.txt", \@theHash );
    my @hashKey = qw( SourceDir DestDir );

    for (my $inx=0; $inx< @theHash ; $inx++)
    {
	my $theTarg = lc( $theHash[$inx]->{ Target } );
	my $theGroup = lc( $theHash[$inx]->{ Group } );
        my $theLang = lc( $theHash[$inx]->{ Lang } );
	my $theArch = lc( $theHash[$inx]->{ Arch } );
	my $theType = lc( $theHash[$inx]->{ Type } );

	if( $theGroup ne $pGroup )
        {
 	    splice( @theHash, $inx, 1); 
	    --$inx; 
	    next; 
	}
        
        if( $theLang ne "all" )
        {
	    if( !&cklang::CkLang( $pLang, $theLang ) )
	    { 
		splice( @theHash, $inx, 1); 
		--$inx; 
		next;
	    }
        }
	if( $theArch ne "all"  && $theArch ne $pArch )
        {
 	   splice( @theHash, $inx, 1); 
	   --$inx; 
	   next; 
	}
	if( $theType ne "all"  && $theType ne $pType )
        {
 	    splice( @theHash, $inx, 1); 
	    --$inx; 
	    next; 
	}
   }
   return @theHash;
}
#----------------------------------------------------------------//
#Function: CreateExcludeFile
# Parameter: (1) String with path sepearated by ;
# Return:    Exclude file contains all the excluded dirs
#----------------------------------------------------------------//
sub CreateExcludeFile
{
    my ( $pExcludeStr ) = @_;

    my $tmpfile = "$ENV{temp}\\tmpfile.$$";
    if( !open( TMP, ">$tmpfile" ) )
    {
	errmsg( "Fail to open [$tmpfile] for write." );
	return 0;
    }
    if( $pExcludeStr  )
    {
	my @tDirs = split( /\;/, $pExcludeStr );
	for ( @tDirs ) { print TMP "\\$_\\\n"; }
    } 
    close ( TMP );
    return $tmpfile;
}
#----------------------------------------------------------------//
#Function: ParsePrsListFile
# Parameter: (1) Language (2) Architecture (3) Debug type (4) Table File Name
# Return:    Hash Array Table
#----------------------------------------------------------------//
sub ParsePrsListFile
{
    my ( $pLang, $pArch, $pType, $pListFile ) = @_;
    my ( @theHash );

    @theHash=();
    &HashText::Read_Text_Hash( 1, $pListFile, \@theHash );	

    for (my $inx=0; $inx< @theHash; $inx++)
    {
        my $theFileName = lc( $theHash[$inx]->{ Filename } );
        my $theLang =     lc( $theHash[$inx]->{ ValidLangs } );
        my $excludLang =  lc( $theHash[$inx]->{ Exceptions} );
	my $theArch =     lc( $theHash[$inx]->{ ValidArchs } );
	my $theType =     lc( $theHash[$inx]->{ ValidDebug } );
	my $theAltName =  lc( $theHash[$inx]->{ AltName } );
        
        if( &cklang::CkLang( $pLang, $excludLang ) )
	{
 	   splice( @theHash, $inx, 1); 
	   --$inx; 
	   next; 
	}
        if( $theLang ne "all" )
        {
	    if( !&cklang::CkLang( $pLang, $theLang ) )
	    { 
		splice( @theHash, $inx, 1); 
		--$inx; 
		next; 
	    }
        }
	if( $theArch ne "all"  && $theArch ne lc($pArch) )
        {
 	   splice( @theHash, $inx, 1); 
	   --$inx;
	   next; 
	}
	if( $theType ne "all"  && $theType ne lc($pType) )
        {
 	    splice( @theHash, $inx, 1); 
	    --$inx; 
	    next; 
	}
	if( $theAltName eq "none" )
        {
	    my @tmpFile = split( /\\/, $theFileName);
            $theHash[$inx]->{ AltName } = $tmpFile[$#tmpFile];
	}  
        # Add to handle fusion special mui path
        # path with $(ARCH)
        my $tmpValue;
        while( $theHash[$inx]->{ Filename } =~ /^(.*)(\$\(ARCH)\)(.*)$/ )
        {
	    if( lc($pArch) eq "x86" ) { $tmpValue = "i386"; } else { $tmpValue = "ia64"; }
	    $theHash[$inx]->{ Filename }= $1.$tmpValue.$3;
        }
        # path with $(CD)
        my $stop=0;
        while( $theHash[$inx]->{ Filename } =~ /^(.*)(\$\(CD)\)(.*)$/ )
        {
	    if( $tmpValue = &Which_MuiCD( $pLang ) )
	    {
		$theHash[$inx]->{ Filename }= $1."CD$tmpValue".$3;
		next;
	    }
            errmsg( "[$theHash[$inx]->{ Filename }] is not valid for parsing" );
	    splice( @theHash, $inx, 1);
	    $stop =1;
	    last;
        } 
	next if( $stop );
        # path with $(LANG)
        while( $theHash[$inx]->{ Filename } =~ /^(.*)(\$\(LANG)\)(.*)$/ )
        {
	    $theHash[$inx]->{ Filename }= $1.$pLang.$3;
        }
         
    }
    return @theHash;
}

#----------------------------------------------------------------//
#Function: ParsePrsSubmitLog
#Parameter: (1) FileName (2) Parsing string
#
# Return:    Match Value
#----------------------------------------------------------------//
sub ParsePrsSubmitLog
{
    my ( $pSubmitLog, $pParseStr ) = @_;
    my $parseValue = 0;

    my @outfile = &ReadFile( $pSubmitLog );

    for my $theLine ( @outfile )
    {
	if( $theLine =~ /$pParseStr(.+)/ )
        {
	    $parseValue = $1;
	    last;
	}
    }
    
    return $parseValue;
}
#----------------------------------------------------------------//
#Function: ReadFile
# Parameter: (1) FileName
#
# Return:    Array of file content
#----------------------------------------------------------------//
sub ReadFile
{
    my ( $pFileName ) = @_;
    my ( @tmp );

    if( !open( TMP, $pFileName ) )
    {
	errmsg( "Fail on open [$pFileName] for read. Exit" );
        return 0;
    }
    chomp( @tmp = <TMP> );
    close( TMP );
    return @tmp;
}
#----------------------------------------------------------------//
#Function:    Which_MuiCD
# Parameter:  (1) Abbreviated language defined in the codes.txt
# Return:     (1) Number of CD - 0 is not found
#----------------------------------------------------------------//	
sub Which_MuiCD
{
    my ( $pLang ) = @_;
    my %muicdLayout = 
	( 1 => "CHS CHH FR GER JPN KOR",
	  2 => "ARA BR  ES HEB IT  NL SV",
	  3 => "CS  DA  FI NO RU",
	  4 => "EL  HU  PL PT TR",
          5 => "SK  SL" );

    for my $theCD( keys %muicdLayout )
    {
	my @tmp = split( /\s+/, $muicdLayout{$theCD} );
	for my $theLang ( @tmp )
	{
	    if( $theLang eq uc($pLang) ) { return $theCD; }
	}
    }
    return 0;
}                     
#----------------------------------------------------------------//
#Function:     CheckError
# Parameter:  (1)$pErrFile - the Error File Name with full path
# Return:     (0) - File exists and is not empty
#             (1) - File not exists or is empty
#----------------------------------------------------------------//
sub CheckError
{
    my(  $pErrFile, $pSucessStr )=@_;


    if( (-e $pErrFile) && `wc -l $pErrFile`>0 )
    {
        logmsg("Please check error at $pErrFile\n");
        return 0;

    }
    logmsg("$pSucessStr\n");
    return 1;
}
#------------------------------------------------------------------//
#Function:  ExecuteSystemX
#Parameter: (1) Command line for system call
#           (2) Extra string to be populated to error message
#------------------------------------------------------------------//
sub ExecuteSystemX
{
    my ( $pCmdLine, $pPowerLess)=@_;

    if( $pPowerLess )
    {
	if( defined $ENV{LOGFILE} ) { logmsg( $pCmdLine ); }
	return 1;
    }
    my $retry;
    while( $retry < 3 )
    {
     	return 1 if (&ExecuteSystem( $pCmdLine ));
	$retry++;
    }
    return 0;
}
#------------------------------------------------------------------//
#Function:  ExecuteSystem
#Parameter: (1) Command line for system call
#           (2) Extra string to be populated to error message
#------------------------------------------------------------------//

sub ExecuteSystem {

   my ( $pCmdLine, $pExtraStr)=@_;

   if( defined $ENV{LOGFILE} ) { logmsg("$pExtraStr$pCmdLine"); }
   system( $pCmdLine );
   if( $? )
   {
      my $rc = $? >> 8;
      if( defined $ENV{ERRFILE} ) { errmsg( "$pExtraStr$pCmdLine ($rc)" ); }
      return 0;
   }
   return 1;
}
#----------------------------------------------------------------//
sub ResetLogErrFile
{
    my ( $pFileName ) = @_;

    # Reset logfile and errfile
    $ENV{temp} =~ /^(.*)\\([^\\]+)$/;
    $ENV{temp} .= "\\$ENV{lang}" if( lc $ENV{lang} ne lc $2 );
    system( "md $ENV{temp}" ) if( !(-e $ENV{temp} ) );
    
    $ENV{LOGFILE} = "$ENV{temp}\\$pFileName.log";
    $ENV{ERRFILE} = "$ENV{temp}\\$pFileName.err";
    if(-e $ENV{LOGFILE} )
    {
	system( "copy $ENV{LOGFILE} $ENV{LOGFILE}.old");
	system( "del $ENV{LOGFILE}" );
    }
    if(-e $ENV{ERRFILE} )
    {
        system( "copy $ENV{ERRFILE} $ENV{ERRFILE}.old") ;
	system( "del $ENV{ERRFILE}" );
    }	           
}
#---------------------------------------------------------------------//
1;