windows-server-2003/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 }\\PostBuildScripts";
#no strict 'vars';
#no strict 'subs';
#no strict 'refs';

use Logmsg;
use cklang;
use hashtext;
use DfsMap;


#----------------------------------------------------------------//
#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}\\PostBuildScripts\\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;   
    $$pStr =~ s/\$\(TS\)/$pbldInfo->{ts}/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 key-path text, value-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: 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}\\PostBuildScripts\\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;
                        if ($pLang!~/usa/i){
                            # fix for like $(lang)\asms\6000\msft\vcrtlint\vcrtlint.cat in combined_fusionlist.txt


                            &dbgmsg("renamed ". $theHash[$inx]->{ Filename }) if $theHash[$inx]->{ Filename } =~/^$pLang\\/i;
                            $theHash[$inx]->{ Filename } =~ s/^$pLang\\//ig; 
                            if ($pLang =~ /mir/i){
                                my $pseudoLang = $pLang;
                                # my $pseudoLang =   &cklang::FieldByName($Special_Lang, "PSEUDOLANG");
                                $pseudoLang ="ARA" ;
                                $theHash[$inx]->{ Filename } =~ s/\b$pLang\b/$pseudoLang/ig;
                                &dbgmsg("renamed ". $theHash[$inx]->{ Filename });
                            }
                        }

        }
         
    }
    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:  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( $? )
   {
      if( defined $ENV{ERRFILE} ) { errmsg( "$pExtraStr$pCmdLine" ); }
      return 0;
   }
   return 1;
}

#----------------------------------------------------------------//
1;