Subversion Repositories DevTools

Rev

Rev 255 | Rev 343 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 255 Rev 275
Line 19... Line 19...
19 
#......................................................................#
 19 
#......................................................................#
20 
 
 20 
 
21 
use strict;
 21 
use strict;
22 
use warnings;
 22 
use warnings;
23 
use File::Basename;
 23 
use File::Basename;
24 
use File::Path;
 - 
 
25 
use File::Copy;
 24 
use JatsCopy;
26 
 
 25 
 
27 
#
 26 
#
28 
#   Global data
 27 
#   Global data
29 
#
 28 
#
30 
my %Tiers;                              # Hash of Tiers already seen
 29 
my %Tiers;                              # Hash of Tiers already seen
Line 99... Line 98...
99 
    #
 98 
    #
100 
    return if ( ! ActivePlatform($platforms) );
 99 
    return if ( ! ActivePlatform($platforms) );
101 
    DebugPush("MugFiles");
 100 
    DebugPush("MugFiles");
102 
 
 101 
 
103 
    #
 102 
    #
- 
 
 103 
    #   Insert defaults
- 
 
 104 
    #
- 
 
 105 
    $muginfo{'ThxBase'} = 'thx';
- 
 
 106 
    $muginfo{'SubDirList'} = [ 'thx' ];
- 
 
 107 
 
- 
 
 108 
    #
104 
    #   Process directive arguments
 109 
    #   Process directive arguments
105 
    #
 110 
    #
106 
    for (@elements)
 111 
    for (@elements)
107 
    {
 112 
    {
108 
        if ( m/^--DeviceId=(.*)/ ) {
 113 
        if ( m/^--DeviceId=(.*)/ ) {
Line 113... Line 118...
113 
 
 118 
 
114 
        } elsif ( m/^--Tier=(.*)/ ) {
 119 
        } elsif ( m/^--Tier=(.*)/ ) {
115 
            $muginfo{'Tier'} = $1;
 120 
            $muginfo{'Tier'} = $1;
116 
            $tier = $1;
 121 
            $tier = $1;
117 
 
 122 
 
- 
 
 123 
        } elsif ( m/^--SubDirs=(.*)/ ) {
- 
 
 124 
            my @list = split( ',', $1 );
- 
 
 125 
            $muginfo{'SubDirList'} = \@list;
- 
 
 126 
 
118 
        } elsif ( m/^--Package=(.*)/ ) {
 127 
        } elsif ( m/^--Package=(.*)/ ) {
119 
            my $package_name = $1;
 128 
            my $package_name = $1;
120 
            my @dirs = 'thx';
 129 
            my $warn = 0;
- 
 
 130 
            my @dirs = @{$muginfo{'SubDirList'}};
121 
            if ( $package_name =~ m/(.*?),--Subdir=(.*)/ )
 131 
            if ( $package_name =~ m/(.*?),--Subdir=(.*)/ )
122 
            {
 132 
            {
123 
                $package_name = $1;
 133 
                $package_name = $1;
124 
                @dirs = split( ',', $2 );
 134 
                @dirs = split( ',', $2 );
- 
 
 135 
                $warn = 1;
125 
            }
 136 
            }
126 
 
 137 
 
127 
            my $package = LocatePackage( $package_name );
 138 
            my $package = GetPackageEntry( $package_name );
- 
 
 139 
            Error("MugFiles: Required Package cannot be located: $package_name") unless ( $package );
- 
 
 140 
 
128 
            foreach my $subdir ( @dirs )
 141 
            foreach my $subdir ( @dirs )
129 
            {
 142 
            {
130 
                my $dir = "$package->{'ROOT'}/$subdir";
 143 
                my $dir = "$package->{'ROOT'}/$subdir";
131 
                if ( -d $dir )
 144 
                if ( -d $dir )
132 
                {
 145 
                {
133 
                    UniquePush( \@{$muginfo{'Dirs'}}, $dir );
 146 
                    UniquePush( \@{$muginfo{'Dirs'}}, $dir );
134 
                }
 147 
                }
135 
                else
 148 
                else
136 
                {
 149 
                {
137 
                    Warning("Directory not found in package: $package_name, Subdir: $subdir")
 150 
                    Warning("Directory not found in package: $package_name, Subdir: $subdir")
138 
                        unless ( $subdir eq 'thx' );
 151 
                        if ( $warn );
139 
                }
 152 
                }
140 
            }
 153 
            }
141 
            UniquePush( \@{$muginfo{'Dirs'}}, "$package->{'ROOT'}" );
 154 
            UniquePush( \@{$muginfo{'Dirs'}}, "$package->{'ROOT'}" );
142 
 
 155 
 
143 
        } elsif ( m/^--Dir=(.*)/ ) {
 156 
        } elsif ( m/^--Dir=(.*)/ ) {
Line 154... Line 167...
154 
            foreach ( split( ',', lc($1)) )
 167 
            foreach ( split( ',', lc($1)) )
155 
            {
 168 
            {
156 
                $muginfo{'Exclude'}{$_} = 0;
 169 
                $muginfo{'Exclude'}{$_} = 0;
157 
            }
 170 
            }
158 
 
 171 
 
159 
 
 - 
 
160 
        } elsif ( m/^--ThxDir=(.*)/ ) {
 172 
        } elsif ( m/^--ThxDir=(.*)/ ) {
161 
            $muginfo{'ThxCopyDir'} = $1;
 173 
            $muginfo{'ThxCopyDir'} = $1;
162 
 
 174 
 
163 
        } elsif ( m{^--NoMugFiles} || m{^--ThxOnly}  ) {
 175 
        } elsif ( m{^--NoMugFiles} || m{^--ThxOnly}  ) {
164 
            $muginfo{'NoMug'} = 1;
 176 
            $muginfo{'NoMug'} = 1;
165 
 
 177 
 
- 
 
 178 
        } elsif ( m/^--File=(.*)/ ) {
- 
 
 179 
            UniquePush( \@{$muginfo{'RawFiles'}}, $1 );
- 
 
 180 
 
- 
 
 181 
        } elsif ( m/^--ThxBase=(.*)/ ) {
- 
 
 182 
            $muginfo{'ThxBase'} = $1;
- 
 
 183
166 
        } else {
 184 
        } else {
167 
            Error("Unknown option: $_ ");
 185 
            Error("Unknown option: $_ ");
168 
        }
 186 
        }
169 
    }
 187 
    }
170 
 
 188 
 
Line 197... Line 215...
197 
 
 215 
 
198 
    DebugPop();
 216 
    DebugPop();
199 
}
 217 
}
200 
 
 218 
 
201 
#-------------------------------------------------------------------------------
 219 
#-------------------------------------------------------------------------------
- 
 
 220 
# Function        : ThxFiles
- 
 
 221 
#
- 
 
 222 
# Description     : Simple wrapper to create a set of THX files
- 
 
 223 
#                   without mug files
- 
 
 224 
#
- 
 
 225 
# Inputs          : Same as for MugFiles
- 
 
 226 
#
- 
 
 227 
# Returns         : Same as for MugFiles
- 
 
 228 
#
- 
 
 229 
sub ThxFiles
- 
 
 230 
{
- 
 
 231 
    MugFiles     ( @_, '--NoMugFiles' );
- 
 
 232 
}
- 
 
 233 
 
- 
 
 234 
#-------------------------------------------------------------------------------
202 
# Function        : MugGenerate
 235 
# Function        : MugGenerate
203 
#
 236 
#
204 
# Description     : Process all the collected data and generate MUG files
 237 
# Description     : Process all the collected data and generate MUG files
205 
#
 238 
#
206 
#                   Create a genappa.ini file as required for genappa.exe
 239 
#                   Create a genappa.ini file as required for genappa.exe
Line 236... Line 269...
236 
    #   These will be popped later
 269 
    #   These will be popped later
237 
    #
 270 
    #
238 
    $verbose = DebugPush("MugGenerate", $verbose);
 271 
    $verbose = DebugPush("MugGenerate", $verbose);
239 
    Debug("Mugfiles: Set Verbosity: $verbose");
 272 
    Debug("Mugfiles: Set Verbosity: $verbose");
240 
 
 273 
 
- 
 
 274 
    #
- 
 
 275 
    #   Enable copy operation logging
- 
 
 276 
    #
- 
 
 277 
    SetCopyDirDefaults ('Log' => $verbose );
- 
 
 278 
 
241 
    if ( keys %Tiers )
 279 
    if ( keys %Tiers )
242 
    {
 280 
    {
243 
        #
 281 
        #
244 
        #   Ensure that utilities are available
 282 
        #   Ensure that utilities are available
245 
        #
 283 
        #
Line 382... Line 420...
382 
                print INI "e=o:$dos_path\n";
 420 
                print INI "e=o:$dos_path\n";
383 
            }
 421 
            }
384 
            close INI;
 422 
            close INI;
385 
        }
 423 
        }
386 
 
 424 
 
- 
 
 425 
        #
- 
 
 426 
        #   Expand the list namewd files
- 
 
 427 
        #   Search the packages for the files.
- 
 
 428 
        #
- 
 
 429 
        if ( $mugref->{'RawFiles'} )
- 
 
 430 
        {
- 
 
 431 
            my %files_found;
- 
 
 432 
            my @ffiles;
- 
 
 433 
            foreach my $dir ( @{$mugref->{'Dirs'}} )
- 
 
 434 
            {
- 
 
 435 
                Debug("Searching for specified files in directory: $dir");
- 
 
 436 
                foreach  ( @{$mugref->{'RawFiles'}} )
- 
 
 437 
                {
- 
 
 438 
                    my $full_path = "$dir/$_";
- 
 
 439 
                    next unless ( -f $full_path );
- 
 
 440 
 
- 
 
 441 
                    my $base = lc(basename($_));
- 
 
 442 
 
- 
 
 443 
                    #
- 
 
 444 
                    #   Test for duplicated files
- 
 
 445 
                    #
- 
 
 446 
                    if ( exists($files_found{$base}) )
- 
 
 447 
                    {
- 
 
 448 
                        Warning("Multiple instances a file ignored: $base",
- 
 
 449 
                                "Using file: $files_found{$base}",
- 
 
 450 
                                "Ignoring  : $_");
- 
 
 451 
                        next;
- 
 
 452 
                    }
- 
 
 453 
                    $files_found{$base} = $full_path;
- 
 
 454 
                    push @ffiles, $full_path;
- 
 
 455 
                    Debug2 ("   File: $_");
- 
 
 456
- 
 
 457 
                }
- 
 
 458 
            }
387 
 
 459 
 
- 
 
 460 
            #
- 
 
 461 
            #   Test for missing files
- 
 
 462 
            #
- 
 
 463 
            my @missing;
- 
 
 464 
            foreach  ( @{$mugref->{'RawFiles'}} )
- 
 
 465 
            {
- 
 
 466 
                unless ( exists ($files_found{ lc($_)})  )
- 
 
 467 
                {
- 
 
 468 
                    push @missing, $_;
- 
 
 469 
                }
- 
 
 470 
            }
- 
 
 471 
            Error ("The following named files could not be found", @missing )
- 
 
 472 
                if ( @missing );
- 
 
 473 
 
- 
 
 474 
            $mugref->{'RawFiles'} = \@ffiles;
- 
 
 475 
        }
- 
 
 476
388 
        #
 477 
        #
389 
        #   Transfer THX files into the package
 478 
        #   Transfer THX files into the package
390 
        #
 479 
        #
391 
        if ( $mugref->{'ThxCopyDir'} )
 480 
        if ( $mugref->{'ThxCopyDir'} )
392 
        {
 481 
        {
393 
            my $thxdir = "$::ScmRoot/pkg/$::ScmBuildPackage/thx/$mugref->{'ThxCopyDir'}";
 482 
            my $thxdir = "$::ScmRoot/pkg/$::ScmBuildPackage/$mugref->{'ThxBase'}/$mugref->{'ThxCopyDir'}";
394 
            $thxdir =~ s/-$//g;
 483 
            $thxdir =~ s/-$//g;
- 
 
 484 
            $thxdir =~ s~//~/~g;
- 
 
 485 
            $thxdir =~ s~/\./~/~g;
395 
            Debug("THX files will be placed in: $thxdir" );
 486 
            Debug("THX files will be placed in: $thxdir" );
- 
 
 487 
 
396 
            mkpath( $thxdir );
 488 
            CreateDir ( $thxdir );
397 
            foreach ( @{$mugref->{'Files'}}, @{$mugref->{'LoadFiles'}} )
 489 
            CopyFile ($mugref->{'Files'}        ,$thxdir );
398 
            {
 - 
 
399 
                Debug2("Copy Thx: $_" );
 490 
            CopyFile ($mugref->{'LoadFiles'}    ,$thxdir );
400 
                copy($_ ,$thxdir);
 491 
            CopyFile ($mugref->{'RawFiles'}     ,$thxdir );
401 
            }
 - 
 
402 
        }
 492 
        }
403 
 
 493 
 
404 
        DebugDumpData("Processed Mug", $mugref)
 494 
        DebugDumpData("Processed Mug", $mugref)
405 
            if $verbose > 2;
 495 
            if $verbose > 2;
406 
    }
 496 
    }
Line 461... Line 551...
461 
        #   This will create a directory full of MUG files
 551 
        #   This will create a directory full of MUG files
462 
        #   Generate the files directly into the pkg subdirectory
 552 
        #   Generate the files directly into the pkg subdirectory
463 
        #
 553 
        #
464 
        my $mugdir = "$::ScmRoot/pkg/$::ScmBuildPackage/mug";
 554 
        my $mugdir = "$::ScmRoot/pkg/$::ScmBuildPackage/mug";
465 
        Debug("Mugfiles will be placed in: $mugdir" );
 555 
        Debug("Mugfiles will be placed in: $mugdir" );
466 
        mkpath( $mugdir );
 556 
        CreateDir( $mugdir , 'DeleteFirst' => 1);
467 
 
 557 
 
468 
        #
 558 
        #
469 
        #   Extend the PATH to include the toolset extensions
 559 
        #   Extend the PATH to include the toolset extensions
470 
        #   to allow use to find genappa and modcrc
 560 
        #   to allow use to find genappa and modcrc
471 
        #
 561 
        #
Line 616... Line 706...
616 
 
 706 
 
617 
    $mugref->{'LoadList'} = \%filelist;
 707 
    $mugref->{'LoadList'} = \%filelist;
618 
 
 708 
 
619 
}
 709 
}
620 
 
 710 
 
621 
#-------------------------------------------------------------------------------
 - 
 
622 
# Function        : LocatePackage
 - 
 
623 
#
 - 
 
624 
# Description     : Locate a package entry
 - 
 
625 
#
 - 
 
626 
# Inputs          : $pname          - Name of the package
 - 
 
627 
#
 - 
 
628 
# Returns         : Ref to package data
 - 
 
629 
#
 - 
 
630 
sub LocatePackage
 - 
 
631 
{
 - 
 
632 
    my($pname) = @_;
 - 
 
633 
 
 - 
 
634 
    #
 - 
 
635 
    #   Locate the Package
 - 
 
636 
    #
 - 
 
637 
    my $packagebase = $::ScmBuildPkgRules{$::ScmPlatform};
 - 
 
638 
    my $package;
 - 
 
639 
 
 - 
 
640 
    foreach my $pptr ( @{$packagebase} )
 - 
 
641 
    {
 - 
 
642 
        if ( $pptr->{'NAME'} eq $pname )
 - 
 
643 
        {
 - 
 
644 
            $package = $pptr;
 - 
 
645 
            last;
 - 
 
646 
        }
 - 
 
647 
    }
 - 
 
648 
 
 - 
 
649 
    Error("Required Package cannot be located: $pname") unless ( $package );
 - 
 
650 
    return $package;
 - 
 
651 
}
 - 
 
652 
 
 - 
 
653 
 
 - 
 
654 
 
 - 
 
655 
1;
 711 
1;