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.