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
            }