Subversion Repositories DevTools

Rev

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

Rev 261 Rev 263
Line -... Line 1...
-
 
1
########################################################################
1
#!/usr/local/bin/perl
2
# Copyright (C) 2008 ERG Limited, All rights reserved
2
#
3
#
3
# Copyright (C) 1998-2003 ERG Limited, All rights reserved
4
# Module name   : create_dpkg.pl
-
 
5
# Module type   : JATS Utility
-
 
6
# Compiler(s)   : Perl
-
 
7
# Environment(s): JATS
4
#
8
#
5
#========================================================
9
# Description   : This script is used to create a dpkg_archive.
6
# **** Source Information ****
-
 
7
#
10
#
8
# Source File Name    : create_dpkg.pl
11
# Usage         : See POD
9
#
12
#
10
# Source File Type    : Perl file
-
 
11
#
-
 
12
# Original Author(s)  : V.Chatzimichail(vasilic)
-
 
13
#                       D.D.Purdie(dpurdie)
-
 
14
#
-
 
15
# Description / Purpose:
-
 
16
#     This script is used to create a dpkg_archive. 
-
 
17
#
-
 
18
# References:
-
 
19
#    -None-
-
 
20
#
-
 
21
#========================================================
13
#......................................................................#
22
 
14
 
-
 
15
require 5.008_002;
23
 
16
 
24
# Include Standard Perl Functions
17
# Include Standard Perl Functions
25
#
18
#
26
use strict;
19
use strict;
-
 
20
use warnings;
27
use Cwd;
21
use Cwd;
28
use Getopt::Long;
22
use Getopt::Long;
29
use File::Basename;
23
use File::Basename;
30
use File::Find;
24
use File::Find;
31
use File::Path;
25
use File::Path;
32
use File::Copy;
26
use File::Copy;
33
use Pod::Usage;
27
use Pod::Usage;
-
 
28
use Digest::MD5;
34
 
29
 
35
use JatsError;
30
use JatsError;
-
 
31
use JatsEnv;
36
use DescPkg;
32
use DescPkg;
37
use FileUtils;
33
use FileUtils;
38
 
34
 
39
# define Global variables
35
# define Global variables
40
#
36
#
41
my $VERSION = "2.4.0";
37
my $VERSION = "2.4.1";
42
my $PROGNAME = "create_dpkg.pl";
38
my $PROGNAME = "create_dpkg.pl";
43
 
39
 
44
 
40
 
45
my $GBE_MACHTYPE = $ENV{'GBE_MACHTYPE'} ||
41
our $GBE_MACHTYPE;
46
                die "Need JATS 'GBE_MACHTYPE' environment variable\n";
-
 
47
                
-
 
48
my $DPKG_NAME     = "";
42
my $DPKG_NAME     = "";
49
my $DESC_NAME     = "";
43
my $DESC_NAME     = "";
50
my $DPKG_VERSION  = "";
44
my $DPKG_VERSION  = "";
51
my $DESCPKG_FILE  = "";
45
my $DESCPKG_FILE  = "";
52
my $DESCPKG_TYPE  = "";
46
my $DESCPKG_TYPE  = "";
53
my $CWD_DIR       = cwd;
47
my $CWD_DIR       = cwd;
54
my $SRC_ROOT;
48
my $SRC_ROOT;
55
my $DPKG_DIR;
49
my $DPKG_DIR;
56
my $DPKG_ROOT;
50
my $DPKG_ROOT;
57
my $e_repository = "";
51
my $e_repository = "";
-
 
52
my $bad_merge_count = 0;
58
 
53
 
59
#
54
#
60
#   Option variables
55
#   Option variables
61
#
56
#
62
my $opt_help = 0;
57
my $opt_help = 0;
Line 68... Line 63...
68
my $opt_archive;
63
my $opt_archive;
69
my $opt_generic;
64
my $opt_generic;
70
my $opt_pname;
65
my $opt_pname;
71
my $opt_pversion;
66
my $opt_pversion;
72
my $opt_test;
67
my $opt_test;
-
 
68
my $opt_md5 = 1;
73
 
69
 
74
 
70
 
75
#
71
#
76
#   Structure to translate -archive=xxx option to archive variable
72
#   Structure to translate -archive=xxx option to archive variable
77
#   These are the various dpkg_archives known to JATS
73
#   These are the various dpkg_archives known to JATS
Line 112... Line 108...
112
#
108
#
113
#------------------------------------------------------------------------------
109
#------------------------------------------------------------------------------
114
{
110
{
115
    # Process any command line arguements...
111
    # Process any command line arguements...
116
    my $result = GetOptions (
112
    my $result = GetOptions (
117
                "help+"         => \$opt_help,              # flag, multiple use allowed
113
                "help:+"        => \$opt_help,              # flag, multiple use allowed
118
                "manual"        => \$opt_manual,            # flag
114
                "manual:3"      => \$opt_help,              # flag
119
                "verbose+"      => \$opt_verbose,           # flag, multiple use allowed
115
                "verbose:+"     => \$opt_verbose,           # flag, multiple use allowed
120
                "override!"     => \$opt_override,          # [no]flag
116
                "override!"     => \$opt_override,          # [no]flag
121
                "merge|m!"      => \$opt_merge,             # [no]flag.
117
                "merge|m!"      => \$opt_merge,             # [no]flag.
122
                "archive=s"     => \$opt_archive,           # string
118
                "archive=s"     => \$opt_archive,           # string
123
                "quiet+"        => \$opt_quiet,             # Flag
119
                "quiet+"        => \$opt_quiet,             # Flag
124
                "generic!"      => \$opt_generic,           # [no]Flag
120
                "generic!"      => \$opt_generic,           # [no]Flag
125
                "pname=s"       => \$opt_pname,             # string
121
                "pname=s"       => \$opt_pname,             # string
126
                "pversion=s"    => \$opt_pversion,          # string
122
                "pversion=s"    => \$opt_pversion,          # string
127
                "test!"         => \$opt_test,              # [no]flag
123
                "test!"         => \$opt_test,              # [no]flag
-
 
124
                "md5!"          => \$opt_md5,               # [no]flag
128
                );
125
                );
129
 
126
 
130
 
127
 
131
    #
128
    #
132
    #   Process help and manual options
129
    #   Process help and manual options
133
    #
130
    #
134
    pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
131
    pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
135
    pod2usage(-verbose => 1)  if ($opt_help == 2 );
132
    pod2usage(-verbose => 1)  if ($opt_help == 2 );
136
    pod2usage(-verbose => 2)  if ($opt_manual || $opt_help > 2);
133
    pod2usage(-verbose => 2)  if ($opt_help > 2);
137
 
134
 
138
    #
135
    #
139
    #   Init the error and message subsystem
136
    #   Init the error and message subsystem
140
    #
137
    #
141
    ErrorConfig( 'name'    =>'CREATE_DPKG',
138
    ErrorConfig( 'name'    =>'CREATE_DPKG',
Line 147... Line 144...
147
       Verbose ("Program: $PROGNAME");
144
       Verbose ("Program: $PROGNAME");
148
       Verbose ("Version: $VERSION");
145
       Verbose ("Version: $VERSION");
149
    }
146
    }
150
 
147
 
151
    #
148
    #
-
 
149
    #   Needed EnvVars
-
 
150
    #
-
 
151
    EnvImport ('GBE_MACHTYPE');
-
 
152
 
-
 
153
    #
152
    #   Check for a "pkg" directory
154
    #   Check for a "pkg" directory
153
    #   This may be in:
155
    #   This may be in:
154
    #       1) The deploy directory (DEPLOY) build/deploy/descpkg
156
    #       1) The deploy directory (DEPLOY) build/deploy/descpkg
155
    #       2) The build directory (ANT)     build/pkg/descpkg
157
    #       2) The build directory (ANT)     build/pkg/descpkg
156
    #       3) The current directory (JATS)  pkg/xxxx/descpkg
158
    #       3) The current directory (JATS)  pkg/xxxx/descpkg
Line 431... Line 433...
431
#     If an error ocurs during the dpkg_archive creation the script
433
#     If an error ocurs during the dpkg_archive creation the script
432
#     will terminate.
434
#     will terminate.
433
#
435
#
434
#------------------------------------------------------------------------------
436
#------------------------------------------------------------------------------
435
{
437
{
436
 
438
    #
437
    # first we need to ensure we have the top level directory
439
    # first we need to ensure we have the top level directory
438
    #
440
    #
439
    if ( -d $DPKG_DIR )
441
    if ( -d $DPKG_DIR )
440
    {
442
    {
441
        Warning("Detected previous dpkg_archive [$DPKG_DIR]");
443
        Warning("Detected previous dpkg_archive [$DPKG_DIR]");
Line 445... Line 447...
445
            if ( !GetYesNo("Do you wish to continue?") )
447
            if ( !GetYesNo("Do you wish to continue?") )
446
            {
448
            {
447
                Error("Script terminated by user.");
449
                Error("Script terminated by user.");
448
            }
450
            }
449
        }
451
        }
-
 
452
 
-
 
453
        #
-
 
454
        #   Target exists
-
 
455
        #   Unless we are merging, we need to blow the entire tree away
-
 
456
        #
-
 
457
        unless ( $opt_merge )
-
 
458
        {
-
 
459
            LogFileOp("Remove Prev Pkg",$DPKG_DIR);
-
 
460
            rmtree($DPKG_DIR);
-
 
461
 
-
 
462
            #
-
 
463
            #   At this point the target directory 'should not' exist
-
 
464
            #   but it may. Some packges (like JATS) have Unix links within
-
 
465
            #   dpkg_archive filesystem. These cannot be deleted under windows
-
 
466
            #
-
 
467
            #   Not nice, but we live with it.
-
 
468
            #
-
 
469
            Warning ("Unable to delete previous instance of the package")
-
 
470
                if ( -d $DPKG_DIR );
-
 
471
        }
450
    }
472
    }
451
    Information("");
473
    Information("");
452
 
474
 
453
    #
475
    #
454
    #   Create the top level directory
476
    #   Create the top level directory
Line 459... Line 481...
459
    # lets process the files.
481
    # lets process the files.
460
    #
482
    #
461
    if ( -d $SRC_ROOT )
483
    if ( -d $SRC_ROOT )
462
    {
484
    {
463
        File::Find::find( \&pkgFind2, $SRC_ROOT );
485
        File::Find::find( \&pkgFind2, $SRC_ROOT );
-
 
486
 
-
 
487
        if ( $bad_merge_count )
-
 
488
        {
-
 
489
            my $msg = "Merged files that differ: $bad_merge_count";
-
 
490
            $opt_md5 ? Error($msg) : Warning($msg);
-
 
491
        }
464
    }
492
    }
465
    else
493
    else
466
    {
494
    {
467
        Error("Failed to find dir [$SRC_ROOT]",
495
        Error("Failed to find dir [$SRC_ROOT]",
468
              "Check JATS config.");
496
              "Check JATS config.");
Line 528... Line 556...
528
            if ( $item eq $SRC_ROOT );
556
            if ( $item eq $SRC_ROOT );
529
 
557
 
530
        #
558
        #
531
        #   Directories are handled differently
559
        #   Directories are handled differently
532
        #       - Directories are created with nice permissions
560
        #       - Directories are created with nice permissions
533
        #       - If the directory already exists then it is being
561
        #       - If the directory already exists then it is being merged.
534
        #         replaced or merged. It is not possible to merge some
-
 
535
        #         directories - they must be deleted first.
-
 
536
        #
562
        #
537
        if ( ! -d "$target" )
563
        if ( ! -d "$target" )
538
        {
564
        {
539
            LogFileOp("Creating Dir", $target);
565
            LogFileOp("Creating Dir", $target);
540
            mkpath("$target", 0, 0775);
566
            mkpath("$target", 0, 0775);
541
        }
567
        }
542
        else
-
 
543
        {
-
 
544
            if ( !$opt_merge &&
-
 
545
                 "$base" !~ m/^lib$/ &&
-
 
546
                 "$base" !~ m/^bin$/ &&
-
 
547
                 "$base" !~ m/^jar$/ )
-
 
548
            {
-
 
549
                LogFileOp("Remove Prev Dir",$target);
-
 
550
                rmtree("$target");
-
 
551
            }
-
 
552
 
-
 
553
            unless ( -d $target )
-
 
554
            {
-
 
555
                LogFileOp("Creating Dir",$target);
-
 
556
                mkpath("$target", 0, 0775);
-
 
557
            }
-
 
558
        }
-
 
559
    }
568
    }
560
    else
569
    else
561
    {
570
    {
562
        #
571
        #
563
        #   File copy
572
        #   File copy
Line 613... Line 622...
613
                LogFileOp("Touch File",$target);
622
                LogFileOp("Touch File",$target);
614
                TouchFile( $target ) && Error ( "Failed to touch: $target" );
623
                TouchFile( $target ) && Error ( "Failed to touch: $target" );
615
            }
624
            }
616
            else
625
            else
617
            {
626
            {
-
 
627
                #
-
 
628
                #   MD5 digest the files that are being merged
-
 
629
                #   Ignore version_*.h files as these are generated
-
 
630
                #   and may contain different dates and line endings
-
 
631
                #
-
 
632
                my $msg = "Merge Skip File";
-
 
633
                unless ( $target =~ m~/version[^/]*\.h$~ )
-
 
634
                {
-
 
635
                    $msg = "Merge Test File";
-
 
636
                    #
-
 
637
                    #   Compare the two files with an MD5
-
 
638
                    #
-
 
639
                    local *FILE;
-
 
640
                    open(FILE, $target) or Error ("Can't open '$target': $!");
-
 
641
                    binmode(FILE);
-
 
642
                    my $target_md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
-
 
643
                    close FILE;
-
 
644
 
-
 
645
                    open(FILE, $item) or Error ("Can't open '$item': $!");
-
 
646
                    binmode(FILE);
-
 
647
                    my $source_md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
-
 
648
                    close FILE;
-
 
649
 
-
 
650
                    unless ( $source_md5 eq $target_md5 )
-
 
651
                    {
-
 
652
                        $msg = "DIFF: Merge Test File";
-
 
653
                        $bad_merge_count ++;
-
 
654
                    }
-
 
655
                }
618
                LogFileOp("Merge Skip File",$target);
656
                LogFileOp($msg,$target);
619
            }
657
            }
620
        }
658
        }
621
    }
659
    }
622
}
660
}
623
 
661
 
Line 695... Line 733...
695
 
733
 
696
    #
734
    #
697
    #   Calculate the target directory name
735
    #   Calculate the target directory name
698
    #
736
    #
699
    my $target = $File::Find::dir;
737
    my $target = $File::Find::dir;
700
    $target = substr ( $target, 1+length ($SRC_ROOT) );
738
    $target = substr ( $target, length ($SRC_ROOT) );
-
 
739
    $target =~ s~^.~~;
701
 
740
 
702
    if ( -d $_ ) {
741
    if ( -d $_ ) {
703
        $test_dir_count++;
742
        $test_dir_count++;
704
    } else {
743
    } else {
705
        $test_file_count++;
744
        $test_file_count++;
Line 707... Line 746...
707
        {
746
        {
708
            #
747
            #
709
            #   Locate files in the package root directory that
748
            #   Locate files in the package root directory that
710
            #   are not expected to be there.
749
            #   are not expected to be there.
711
            #
750
            #
712
            next if ( $_ eq 'descpkg' );
751
            unless ((  $_ eq 'descpkg' ) || ( $_ eq 'incpkg' ))
713
            next if ( $_ eq 'incpkg' );
752
            {
714
            push @test_root_file, $_;
753
                push @test_root_file, $_;
-
 
754
            }
715
        }
755
        }
716
    }
756
    }
717
}
757
}
718
 
758
 
719
# ---------------------------------------------------------
759
# ---------------------------------------------------------
Line 775... Line 815...
775
    -help -help        - Detailed help message
815
    -help -help        - Detailed help message
776
    -man               - Full documentation
816
    -man               - Full documentation
777
    -quiet             - Suppress progress messages, then warning messages
817
    -quiet             - Suppress progress messages, then warning messages
778
    -verbose           - Display additional progress messages
818
    -verbose           - Display additional progress messages
779
    -override          - Override any previous version of the package
819
    -override          - Override any previous version of the package
780
    -merge             - merge with existing version of the package
820
    -[no]merge         - merge with existing version of the package
781
    -archive=name      - Specify archive (cache, local, main, store, sandbox, deploy)
821
    -archive=name      - Specify archive (cache, local, main, store, sandbox, deploy)
782
    -pname=name        - Ensure package is named correctly
822
    -pname=name        - Ensure package is named correctly
783
    -pversion=version  - Ensure package version is correct
823
    -pversion=version  - Ensure package version is correct
784
    -generic           - Create a built.generic file
824
    -generic           - Create a built.generic file
785
    -test              - Test package. Do not transfer.
825
    -[no]test          - Test package. Do not transfer.
-
 
826
    -[no]md5           - Use MD5 comparison of merged files(enabled)
786
    
827
    
787
 
828
 
788
=head1 OPTIONS
829
=head1 OPTIONS
789
 
830
 
790
=over 8
831
=over 8
Line 836... Line 877...
836
=item B<-test>
877
=item B<-test>
837
 
878
 
838
If this option is enabled the utility will perform initial sanity testing, but
879
If this option is enabled the utility will perform initial sanity testing, but
839
it will not perform the copy.
880
it will not perform the copy.
840
 
881
 
-
 
882
=item B<-[no]md5>
-
 
883
 
-
 
884
If package builds are being merged then a validity check is performed using
-
 
885
an MD5 digest over the current and the existing file.
-
 
886
 
-
 
887
By default, it is an error for the user file to differ from the merged file.
-
 
888
 
-
 
889
This option disabled the error. The test is still done and the results are
-
 
890
reported.
-
 
891
 
841
=over 8
892
=over 8
842
 
893
 
843
=item cache
894
=item cache
844
 
895
 
845
The location of the target archive will be taken from GBE_DPKG_CACHE.
896
The location of the target archive will be taken from GBE_DPKG_CACHE.