Subversion Repositories DevTools

Rev

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

Rev 261 Rev 279
Line 21... Line 21...
21 
 
 21 
 
22 
package DescPkg;
 22 
package DescPkg;
23 
 
 23 
 
24 
our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
 24 
our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
25 
use Exporter;
 25 
use Exporter;
26 
use Sys::Hostname;                          # For hostname
 - 
 
27 
use JatsVersionUtils;
 26 
use JatsVersionUtils;
- 
 
 27 
use JatsEnv;
28 
 
 28 
 
29 
$VERSION = 1.00;
 29 
$VERSION = 1.00;
30 
@ISA = qw(Exporter);
 30 
@ISA = qw(Exporter);
31 
 
 31 
 
32 
# Symbols to autoexport (:DEFAULT tag)
 32 
# Symbols to autoexport (:DEFAULT tag)
Line 225... Line 225...
225 
    my ($src,$dest) = @_;
 225 
    my ($src,$dest) = @_;
226 
 
 226 
 
227 
    #
 227 
    #
228 
    #   Ensure that we have user and machine name
 228 
    #   Ensure that we have user and machine name
229 
    #
 229 
    #
230 
    my ($USER) = $ENV{"USER"} || return "Need JATS 'USER' environment variable";
 - 
 
231
- 
 
232 
    my $MACHINENAME = hostname;
 230 
    EnvImport( "USER");
233 
    return "Machine Name not determined" unless ( $MACHINENAME );
 - 
 
234 
    chomp( $MACHINENAME );
 231 
    EnvImport( "GBE_HOSTNAME");
235
232 
 
236 
    #
 233 
    #
237 
    #   Open files
 234 
    #   Open files
238 
    #
 235 
    #
239 
    open (DESCPKG, "<$src") || return "File not found [$src]";
 236 
    open (DESCPKG, "<$src") || return "File not found [$src]";
240 
    open (DESCPKGOUT, ">$dest")    || return "Failed to create file [$dest]";
 237 
    open (DESCPKGOUT, ">$dest")    || return "Failed to create file [$dest]";
Line 254... Line 251...
254 
        #   Manifest format
 251 
        #   Manifest format
255 
        #
 252 
        #
256 
        my $active = 'h';
 253 
        my $active = 'h';
257 
        my %attributes =
 254 
        my %attributes =
258 
                (
 255 
                (
259 
                    'Built By:'         => $USER,
 256 
                    'Built By:'         => $::USER,
260 
                    'Built On:'         => scalar( localtime()),
 257 
                    'Built On:'         => scalar( localtime()),
261 
                    'Build Machine:'    => $MACHINENAME,
 258 
                    'Build Machine:'    => $::GBE_HOSTNAME
262 
                );
 259 
                );
263 
 
 260 
 
264 
        while ( $line = <DESCPKG> )
 261 
        while ( $line = <DESCPKG> )
265 
        {
 262 
        {
266 
            $line =~ s~\s+$~~;                              # Kill DOS and UNIX line endings
 263 
            $line =~ s~\s+$~~;                              # Kill DOS and UNIX line endings
Line 318... Line 315...
318 
        #
 315 
        #
319 
        while ( $line = <DESCPKG> )
 316 
        while ( $line = <DESCPKG> )
320 
        {
 317 
        {
321 
            $line =~ s~\s+$~~;                              # Kill DOS and UNIX line endings
 318 
            $line =~ s~\s+$~~;                              # Kill DOS and UNIX line endings
322 
            if ( $line =~ m/^(Released By:\s+)/ ) {
 319 
            if ( $line =~ m/^(Released By:\s+)/ ) {
323 
                $line = $1 . $USER;
 320 
                $line = $1 . $::USER;
324 
 
 321 
 
325 
            }
 322 
            }
326 
            elsif ( $line =~ m/^(Released On:\s+)/ ) {
 323 
            elsif ( $line =~ m/^(Released On:\s+)/ ) {
327 
                $line = $1 . localtime();
 324 
                $line = $1 . localtime();
328 
            }
 325 
            }