Subversion Repositories DevTools

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
263 dpurdie 1
########################################################################
2
# Copyright (C) 2008 ERG Limited, All rights reserved
227 dpurdie 3
#
263 dpurdie 4
# Module name   : create_dpkg.pl
5
# Module type   : JATS Utility
6
# Compiler(s)   : Perl
7
# Environment(s): JATS
227 dpurdie 8
#
263 dpurdie 9
# Description   : This script is used to create a dpkg_archive.
227 dpurdie 10
#
263 dpurdie 11
# Usage         : See POD
227 dpurdie 12
#
263 dpurdie 13
#......................................................................#
227 dpurdie 14
 
263 dpurdie 15
require 5.008_002;
227 dpurdie 16
 
17
# Include Standard Perl Functions
18
#
19
use strict;
263 dpurdie 20
use warnings;
227 dpurdie 21
use Cwd;
22
use Getopt::Long;
23
use File::Basename;
24
use File::Find;
25
use File::Path;
26
use File::Copy;
27
use Pod::Usage;
263 dpurdie 28
use Digest::MD5;
227 dpurdie 29
 
30
use JatsError;
263 dpurdie 31
use JatsEnv;
227 dpurdie 32
use DescPkg;
33
use FileUtils;
34
 
35
# define Global variables
36
#
263 dpurdie 37
my $VERSION = "2.4.1";
227 dpurdie 38
my $PROGNAME = "create_dpkg.pl";
39
 
40
 
263 dpurdie 41
our $GBE_MACHTYPE;
227 dpurdie 42
my $DPKG_NAME     = "";
43
my $DESC_NAME     = "";
44
my $DPKG_VERSION  = "";
45
my $DESCPKG_FILE  = "";
46
my $DESCPKG_TYPE  = "";
47
my $CWD_DIR       = cwd;
48
my $SRC_ROOT;
49
my $DPKG_DIR;
50
my $DPKG_ROOT;
261 dpurdie 51
my $e_repository = "";
263 dpurdie 52
my $bad_merge_count = 0;
227 dpurdie 53
 
54
#
55
#   Option variables
56
#
57
my $opt_help = 0;
58
my $opt_manual = 0;
59
my $opt_verbose = 0;
60
my $opt_quiet = 0;
61
my $opt_override = 0;
62
my $opt_merge = 0;
63
my $opt_archive;
64
my $opt_generic;
65
my $opt_pname;
66
my $opt_pversion;
67
my $opt_test;
263 dpurdie 68
my $opt_md5 = 1;
227 dpurdie 69
 
70
 
71
#
72
#   Structure to translate -archive=xxx option to archive variable
73
#   These are the various dpkg_archives known to JATS
74
#
75
my %Archive2Var =( 'main'       =>  'GBE_DPKG',
76
                   'store'      =>  'GBE_DPKG_STORE',
77
                   'cache'      =>  'GBE_DPKG_CACHE',
78
                   'local'      =>  'GBE_DPKG_LOCAL',
79
                   'sandbox'    =>  'GBE_DPKG_SBOX',
80
                   'deploy'     =>  'GBE_DPLY',
81
                   );
82
 
83
#------------------------------------------------------------------------------
84
#------------------------------------------------------------------------------
85
# Subroutines
86
#------------------------------------------------------------------------------
87
#------------------------------------------------------------------------------
88
 
89
#------------------------------------------------------------------------------
90
sub LogFileOp
91
#
92
# Description:
93
#       This sub-routine is used to generate a consistent informational log
94
#------------------------------------------------------------------------------
95
{
96
    my ($opr, $file) = @_;
97
    $file =~ s/$DPKG_ROOT/DPKG/;
98
 
99
    Information (sprintf( "%-15s [%s]", $opr, $file));
100
}
101
 
102
#------------------------------------------------------------------------------
103
sub Init
104
#
105
# Description:
106
#     This function is used to process any command line arguements
107
#     and print the start banner.
108
#
109
#------------------------------------------------------------------------------
110
{
111
    # Process any command line arguements...
112
    my $result = GetOptions (
263 dpurdie 113
                "help:+"        => \$opt_help,              # flag, multiple use allowed
114
                "manual:3"      => \$opt_help,              # flag
115
                "verbose:+"     => \$opt_verbose,           # flag, multiple use allowed
227 dpurdie 116
                "override!"     => \$opt_override,          # [no]flag
117
                "merge|m!"      => \$opt_merge,             # [no]flag.
118
                "archive=s"     => \$opt_archive,           # string
119
                "quiet+"        => \$opt_quiet,             # Flag
120
                "generic!"      => \$opt_generic,           # [no]Flag
121
                "pname=s"       => \$opt_pname,             # string
122
                "pversion=s"    => \$opt_pversion,          # string
123
                "test!"         => \$opt_test,              # [no]flag
263 dpurdie 124
                "md5!"          => \$opt_md5,               # [no]flag
227 dpurdie 125
                );
126
 
127
 
128
    #
129
    #   Process help and manual options
130
    #
131
    pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
132
    pod2usage(-verbose => 1)  if ($opt_help == 2 );
263 dpurdie 133
    pod2usage(-verbose => 2)  if ($opt_help > 2);
227 dpurdie 134
 
135
    #
136
    #   Init the error and message subsystem
137
    #
138
    ErrorConfig( 'name'    =>'CREATE_DPKG',
139
                 'verbose' => $opt_verbose,
140
                 'quiet'   => $opt_quiet );
141
 
142
    if ($opt_verbose)
143
    {
144
       Verbose ("Program: $PROGNAME");
145
       Verbose ("Version: $VERSION");
146
    }
147
 
148
    #
263 dpurdie 149
    #   Needed EnvVars
150
    #
151
    EnvImport ('GBE_MACHTYPE');
152
 
153
    #
227 dpurdie 154
    #   Check for a "pkg" directory
155
    #   This may be in:
156
    #       1) The deploy directory (DEPLOY) build/deploy/descpkg
157
    #       2) The build directory (ANT)     build/pkg/descpkg
158
    #       3) The current directory (JATS)  pkg/xxxx/descpkg
159
    #
160
    my $PKG_BASE = "$CWD_DIR/build/deploy";
161
    Verbose2 ("Looking for descpkg: $PKG_BASE");
162
    if ( -f "$PKG_BASE/descpkg" )
163
    {
164
        #
165
        #   This is a deployment package.
166
        #   Force the use of the GBE_DPLY
167
        #
168
        $opt_archive = 'deploy' unless ( $opt_archive );
169
    }
170
    else
171
    {
172
        $PKG_BASE = "$CWD_DIR/build/pkg";
173
        Verbose ("Looking for descpkg: $PKG_BASE");
174
        if ( ! -f  "$PKG_BASE/descpkg" )
175
        {
176
            $PKG_BASE = "$CWD_DIR/pkg";
177
            Verbose ("Looking for descpkg: $PKG_BASE");
178
            Error("Failed to find a package to transfer. Looked in:",
179
                  "./build/deploy",
180
                  "./build/pkg",
181
                  "./pkg"
182
                  )
183
                unless( -d $PKG_BASE );
184
        }
185
    }
186
    Verbose("Package directory: $PKG_BASE");
187
 
188
    #
189
    #   Determine the target archive
190
    #   The default archive is GBE_DPKG, but this may be changed
191
    #
192
    $opt_archive = 'main' unless ( $opt_archive );
193
    my $archive_tag = $Archive2Var{$opt_archive};
194
    Error("Unknown archive specified: $opt_archive")
195
        unless ( $archive_tag );
196
 
197
    $DPKG_ROOT = $ENV{$archive_tag} || '';
198
    Verbose ("Archive Variable: $archive_tag" );
199
    Verbose2 ("Archive Path: $DPKG_ROOT" );
200
 
201
    Error("Repository location not specified: $archive_tag")
202
        unless $DPKG_ROOT;
203
 
204
    Error("Failed to find Repository: $DPKG_ROOT")
205
        unless ( -d $DPKG_ROOT );
206
 
207
    $e_repository = ("      *Non Standard archive")
208
        unless ( $opt_archive eq 'main' );
209
 
210
 
211
    #
212
    #   If the environment variable GBE_DPKG_SBOX is defined then the package
213
    #   is being built within a development sandbox. In such a sandbox the
214
    #   version numbers of the packages are ignored. Publishing a package
215
    #   fromm such an environment is certainly not reproducible - so don't allow
216
    #   it to happen
217
    #
218
    unless ( $opt_archive eq 'local' || $opt_archive eq 'sandbox'   )
219
    {
220
        if ( $ENV{GBE_DPKG_SBOX} )
221
        {
222
            Error ("Cannot publish a package that has been generated",
223
                   "within a Sandbox as the version of dependent packages",
224
                   "is not guaranteed.");
225
        }
226
    }
227
 
228
 
229
    #   Locate the package
230
    #   Packages are located by looking for a file called descpkg within the
231
    #   main package directory.
232
    #
233
    #   This installation process only handles one such file
234
    #
235
    File::Find::find( \&pkgFind, $PKG_BASE);
236
 
237
 
238
    # Get the dpkg_archive version number we are  going to create.
239
    #
240
    Error("Descpkg file not found in package directory: $PKG_BASE")
241
        unless ( -f "$DESCPKG_FILE" );
242
 
243
    #
244
    #   Read in the package description and validate essential fields
245
    #
246
    GetDpkgArchiveVersion($DESCPKG_FILE);
247
    unless ( "$DPKG_VERSION" )
248
    {
249
        Error ("Incorrect descpkg content detected.",
250
               "Check JATS build.pl config.");
251
    }
252
 
253
    #
254
    #   Need to support two forms of pkg subdirectory
255
    #       1) packages are in a named subdir within 'pkg'
256
    #       2) package is within 'pkg' or 'deploy'
257
    #
258
    if ( $DPKG_NAME eq 'pkg' || $DPKG_NAME eq 'deploy' )
259
    {
260
        $DPKG_NAME = $DESC_NAME;
261
        unless ( $DESC_NAME )
262
        {
263
            Error ("Cannot determine package name",
264
                   "The packages 'descpkg' file is bad or missing");
265
        }
266
    }
267
    elsif ( $DESC_NAME ne $DPKG_NAME )
268
    {
269
        Error ("Package name MUST match package description",
270
               "Check build.pl and package.pl",
271
               "Package name: $DPKG_NAME",
272
               "Description : $DESC_NAME" );
273
    }
274
 
275
    #
276
    # lets just check to see if we have a version number before
277
    # we proceed.
278
    #
279
    unless ( $DPKG_VERSION )
280
    {
281
        Error("Cannot determine dpkg_archive version number.",
282
              "Check JATS build config.");
283
    }
284
 
285
    #
286
    #   Sanity test package name and version, if provided
287
    #
288
    if ( $opt_pname )
289
    {
290
        ReportError ("Package Name does not match expected name",
291
                     "Expected: '$opt_pname'",
292
                     "Descpkg : '$DPKG_NAME'") unless ( $DPKG_NAME eq $opt_pname );
293
    }
294
    if ( $opt_pversion )
295
    {
296
        ReportError ("Package Version does not match expected version",
297
                     "Expected: '$opt_pversion'",
298
                     "Descpkg : '$DPKG_VERSION'") unless ( $DPKG_VERSION eq $opt_pversion );
299
    }
300
    ErrorDoExit();
301
 
302
    #
303
    #   Set up the target directory path and name
304
    #   It will be created later
305
    #
306
    $DPKG_DIR = "$DPKG_ROOT/$DPKG_NAME/$DPKG_VERSION";
307
 
308
    #
309
    #   Information for the user
310
    #
311
    Information ("---------------------------------------------------------------");
312
    Information ("Dpkg archive creation tool...");
313
    Information ("Version: $VERSION");
314
    Information ("");
315
    Information ("Information:");
316
    Information ("Working dir   = [$CWD_DIR]");
317
    Information ("Package Root  = [$SRC_ROOT]");
318
    Information ("Repository    = [$DPKG_ROOT]$e_repository");
319
    Information ("Target dir    = [$DPKG_DIR]");
320
    Information1("DPKG_NAME     = [$DPKG_NAME]");
321
    Information1("DPKG_VERSION  = [$DPKG_VERSION]");
322
    Information1("GBE_MACHTYPE  = [$GBE_MACHTYPE]");
323
    Information ("")                                if ( $opt_merge || $opt_override );
324
    Information ("Opt:Override  = Enabled")         if ( $opt_override );
325
    Information ("Opt:Merge     = Enabled")         if ( $opt_merge );
326
    Information ("Opt:TestMode  = Enabled. No Package Transferred") if ( $opt_test );
327
    Information ("---------------------------------------------------------------");
328
 
329
    # done.
330
    return 1;
331
}
332
 
333
#------------------------------------------------------------------------------
334
sub pkgFind
335
#
336
# Description:
235 dpurdie 337
#     This subroutine is used to locate the FIRST descpkg file in
227 dpurdie 338
#     the local pkg dir.
339
#
340
#------------------------------------------------------------------------------
341
{
342
    my($item)= "$File::Find::name";
343
    my($file)= File::Basename::basename($item);
344
 
345
    # we get the absolute path from the find, but we only require
346
    # a relative path from the starting dir.
347
    # so our start dir.
348
 
349
    # we need to determine which file we are dealing with
235 dpurdie 350
    if ( ! -d $item && $file =~ /^descpkg$/ )
227 dpurdie 351
    {
235 dpurdie 352
        #
353
        #   Only grab the first one
354
        #
355
        if ( $DESCPKG_FILE )
356
        {
357
            Warning ("Package contains multiple descpkg files");
358
            return;
359
        }
360
 
227 dpurdie 361
        $DESCPKG_FILE = $item;
362
        my($dir)= File::Basename::dirname($item);
363
        $DPKG_NAME = File::Basename::basename($dir);
364
        $SRC_ROOT = $dir;
365
    }
366
}
367
 
368
 
369
#------------------------------------------------------------------------------
370
sub GetDpkgArchiveVersion
371
#
372
# Description:
373
#     This subroutine is used to determine the version of the dpkg_archive.
374
#     We assume that the version number is in the descpkg file.
375
#
376
#     Need to allow for two forms of descpkg. Some one decided that a Java
377
#     Manifest would be a good descpkg file - a long time after the rest of the
378
#     world had been using an existing file format.
379
#
380
#     Lines are tagged
381
#
382
#     Once the version number is determined we set the
383
#     global DPKG_VERSION variable.
384
#
385
#------------------------------------------------------------------------------
386
{
387
    my ($path) = @_;
388
    my $line;
389
    my $type;
390
 
391
    #
392
    #   Use a common routine to parse the package descriptor
393
    #   There are several forms that may need to be processed
394
    #
395
    my $pkg_data = ReadDescpkg( $path );
396
    Error("Failed to open file [$path].") unless $pkg_data;
397
 
398
    $DESC_NAME    = $pkg_data->{'NAME'};
399
    $DPKG_VERSION = $pkg_data->{'VERSION_FULL'};
400
}
401
 
402
#-------------------------------------------------------------------------------
403
# Function        : TransferDescpkg
404
#
405
# Description     : Copy and process the descpkg file to the target
406
#
407
# Inputs          :
408
#
409
# Returns         :
410
#
411
sub TransferDescpkg
412
{
413
    my $result = CopyDescpkg( @_ );
414
    Error("Transfer descpkg: $result") if ( $result );
415
}
416
 
417
#------------------------------------------------------------------------------
418
sub CreateDpkgArchive
419
#
420
# Description:
421
#     This subroutine is used to create the dpkg_archive in the $DPKG_ROOT
422
#     location 
423
#
424
#     We use the global DPKG_DIR, DPKG_NAME, and DPKG_VERSION
425
#     to create the required directory structure.
426
#
427
#     If the dpkg_archive is new (ie not a new version) it is assumed the user
428
#     has access to create the top level dir for the new dpkg_archive.
429
#
430
#     The new dpkg_archive is created with the permission of the user 
431
#     executing this script.
432
#
433
#     If an error ocurs during the dpkg_archive creation the script
434
#     will terminate.
435
#
436
#------------------------------------------------------------------------------
437
{
263 dpurdie 438
    #
227 dpurdie 439
    # first we need to ensure we have the top level directory
440
    #
441
    if ( -d $DPKG_DIR )
442
    {
443
        Warning("Detected previous dpkg_archive [$DPKG_DIR]");
444
        unless ( $opt_override )
445
        {
446
            Error ("Package already exists") if ( $opt_quiet );
447
            if ( !GetYesNo("Do you wish to continue?") )
448
            {
449
                Error("Script terminated by user.");
450
            }
451
        }
263 dpurdie 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
        }
227 dpurdie 472
    }
473
    Information("");
474
 
475
    #
476
    #   Create the top level directory
477
    #
478
    mkpath($DPKG_DIR, 0, 0775);
479
 
480
 
481
    # lets process the files.
482
    #
483
    if ( -d $SRC_ROOT )
484
    {
485
        File::Find::find( \&pkgFind2, $SRC_ROOT );
263 dpurdie 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
        }
227 dpurdie 492
    }
493
    else
494
    {
495
        Error("Failed to find dir [$SRC_ROOT]",
496
              "Check JATS config.");
497
    }
498
 
499
    #
500
    #   Transfer of data is complete
501
    #       Mark the archive with the build type to indicate which parts of
502
    #       a multi-machine build have been performed
503
    #
504
    #
505
    my $touchfile = $opt_generic ? "$DPKG_DIR/built.generic" : "$DPKG_DIR/built.$GBE_MACHTYPE";
506
    LogFileOp("Mark File",$touchfile);
507
    TouchFile ( $touchfile) && Error("Failed to create file [$touchfile].");
508
 
509
    #
510
    #   If there is a .lnk file in the archive then remove it now that the
511
    #   archive has been transferred. The .lnk files are created in 'local'
512
    #   archives in order to simplify multi-package builds
513
    #
514
    my $link_file = "$DPKG_ROOT/$DPKG_NAME/$DPKG_VERSION.lnk";
515
    if ( -f $link_file )
516
    {
517
        LogFileOp("Removing Link",$link_file);
518
        unlink $link_file;
519
    }
520
 
521
    return 1;
522
}
523
 
524
 
525
#------------------------------------------------------------------------------
526
sub pkgFind2
527
#
528
# Description:
529
#   This subroutine is used to locate all associated pkg files in
530
#   the local pkg dir.
531
#
532
#   This routine is called for each file and directory within the package
533
#   Some files and directories are treated in a special manner
534
#       - Top level directory is ignored
535
#
536
#
537
#
538
#------------------------------------------------------------------------------
539
{
540
    my $item = $File::Find::name;
541
    my $base = File::Basename::basename($item);
542
 
543
    #
544
    #   Calculate the target directory name
545
    #
546
    my $target = $item;
241 dpurdie 547
    $target = $DPKG_DIR . substr ( $item, length ($SRC_ROOT) );
227 dpurdie 548
 
549
    if ( -d $item )
550
    {
551
        #
552
        #   Ignore the top level directory
553
        #   It has already been created
554
        #
555
        return
556
            if ( $item eq $SRC_ROOT );
557
 
558
        #
559
        #   Directories are handled differently
560
        #       - Directories are created with nice permissions
263 dpurdie 561
        #       - If the directory already exists then it is being merged.
227 dpurdie 562
        #
563
        if ( ! -d "$target" )
564
        {
565
            LogFileOp("Creating Dir", $target);
566
            mkpath("$target", 0, 0775);
567
        }
568
    }
569
    else
570
    {
571
        #
572
        #   File copy
573
        #   If merging then do not overwrite an existing file
574
        #
575
        unless ( $opt_merge && -f $target )
576
        {
577
            if ( $item =~ m~/descpkg$~ )
578
            {
579
                LogFileOp("Rewrite File",$target);
580
                TransferDescpkg( "$item", $target );
581
                CORE::chmod oct("0775"), $target;
582
            }
583
            else
584
            {
585
                #
586
                #   Copy file to destination
587
                #   If the file is a link, then duplicate the link contents
588
                #   Use: Unix libraries are created as two files:
589
                #        lib.xxxx.so -> libxxxx.so.vv.vv.vv
590
                #
591
                if ( -l $item )
592
                {
593
                    LogFileOp("Copying Link", $target);
594
                    my $link = readlink $item;
595
                    Verbose( "Link: $item, $link");
596
                    symlink ($link, $target );
597
                    unless ( $link && -l $target )
598
                    {
599
                        Error("Failed to copy link [$item] to [$target]: $!");
600
                    }
601
                }
602
                elsif (File::Copy::copy($item, $target))
603
                {
604
                    LogFileOp("Copying File",$target);
605
                    CORE::chmod oct("0775"), $target;
606
                }
607
                else
608
                {
609
                    Error("Failed to copy file [$item] to [$target]: $!");
610
                }
611
            }
612
        }
613
        else
614
        {
615
            #
616
            #   Merging packages
617
            #   Ensure that the descpkg file is "touched" so that caches
618
            #   that use this file as a timestamp can be updated
619
            #
620
            if ( $item =~ m~/descpkg$~ )
621
            {
622
                LogFileOp("Touch File",$target);
623
                TouchFile( $target ) && Error ( "Failed to touch: $target" );
624
            }
625
            else
626
            {
263 dpurdie 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
                #
267 dpurdie 632
                #   Don't put the files into 'binmode'
633
                #   Need to handle some level of Unix/DOS file endings
634
                #
635
                #
263 dpurdie 636
                my $msg = "Merge Skip File";
637
                unless ( $target =~ m~/version[^/]*\.h$~ )
638
                {
639
                    $msg = "Merge Test File";
640
                    #
641
                    #   Compare the two files with an MD5
642
                    #
643
                    local *FILE;
644
                    open(FILE, $target) or Error ("Can't open '$target': $!");
267 dpurdie 645
                    binmode FILE, ':crlf';
263 dpurdie 646
                    my $target_md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
647
                    close FILE;
648
 
649
                    open(FILE, $item) or Error ("Can't open '$item': $!");
267 dpurdie 650
                    binmode FILE, ':crlf';
263 dpurdie 651
                    my $source_md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
652
                    close FILE;
653
 
654
                    unless ( $source_md5 eq $target_md5 )
655
                    {
656
                        $msg = "DIFF: Merge Test File";
657
                        $bad_merge_count ++;
658
                    }
659
                }
660
                LogFileOp($msg,$target);
227 dpurdie 661
            }
662
        }
663
    }
664
}
665
 
666
 
667
# -------------------------------------------------------------------------
668
sub GetYesNo
669
#
670
# -------------------------------------------------------------------------
671
{
672
    my ($question) = @_;
673
    my ($u_tmp) = "";
674
    Question ("$question, (default: y) [y,n]: ");
675
 
676
    while ( <STDIN> )
677
    {
678
        $u_tmp = $_;
679
        chomp($u_tmp);
680
 
681
        return 1
682
            if ( "$u_tmp" eq "" );
683
 
684
        if( $u_tmp =~ /[yn]{1}/i )
685
        {
686
            return ( "$u_tmp" eq "y" );
687
        }
688
        else
689
        {
690
            Question("Please re-enter response? (default: y) [y,n]: ");
691
        }
692
    }
693
}
694
 
695
#-------------------------------------------------------------------------------
696
# Function        : TestDpkgArchive
697
#
698
# Description     : Test the structure of the source achive
699
#                   Ensure that it has some files
700
#                   Warn if files are present in the root directory
701
#
702
# Inputs          : None
703
#
704
# Returns         : Warnings
705
#
706
my $test_dir_count = 0;
707
my $test_file_count = 0;
708
my @test_root_file = ();
709
sub TestDpkgArchive
710
{
711
    Error("Failed to find dir [$SRC_ROOT]",
712
          "Check JATS config.") unless ( -d $SRC_ROOT );
713
 
714
 
715
    #
716
    #   Scan the package counting files and folders
717
    #
718
    $test_dir_count = 0;
719
    $test_file_count = 0;
720
    @test_root_file = ();
721
    File::Find::find( \&pkgFind3, $SRC_ROOT );
722
 
723
    Information ("Package contains:",
724
                 "Files: $test_file_count",
725
                 "Dirs: $test_dir_count",
726
                 );
727
    #
728
    #   There shouldn't be any files in the root directory
729
    #   other than the descpkg and incpkg.
730
    #
731
    Warning ("Unexpected files in package root:", @test_root_file)
732
        if ( @test_root_file  );
733
}
734
 
735
sub pkgFind3
736
{
737
 
738
    #
739
    #   Calculate the target directory name
740
    #
741
    my $target = $File::Find::dir;
263 dpurdie 742
    $target = substr ( $target, length ($SRC_ROOT) );
743
    $target =~ s~^.~~;
227 dpurdie 744
 
745
    if ( -d $_ ) {
746
        $test_dir_count++;
747
    } else {
748
        $test_file_count++;
749
        unless ( $target )
750
        {
241 dpurdie 751
            #
752
            #   Locate files in the package root directory that
753
            #   are not expected to be there.
754
            #
263 dpurdie 755
            unless ((  $_ eq 'descpkg' ) || ( $_ eq 'incpkg' ))
756
            {
757
                push @test_root_file, $_;
758
            }
227 dpurdie 759
        }
760
    }
761
}
762
 
763
# ---------------------------------------------------------
764
# ---------------------------------------------------------
765
# Main
766
# ---------------------------------------------------------
767
# ---------------------------------------------------------
768
 
769
 
770
# Initialise our world
771
#
772
Init();
773
 
774
 
775
# Check with the user they want to proceed
776
#
777
unless ( $opt_test )
778
{
779
    Information("Creating dpkg_archive package:", $DPKG_DIR);
780
    unless( $opt_override || $opt_quiet )
781
    {
782
        if ( !GetYesNo( "Do you wish to continue?" ) )
783
        {
784
            Error ("Script terminated by user.");
785
        }
786
    }
787
 
788
    # Create the archive and copy the files
789
    #
790
    CreateDpkgArchive();
791
}
792
else
793
{
794
    TestDpkgArchive();
795
}
796
 
797
# Done
798
#
799
Information ("Done.");
800
exit 0;
801
 
802
 
803
#-------------------------------------------------------------------------------
804
#   Documentation
805
#
806
 
807
=pod
808
 
809
=head1 NAME
810
 
811
create_dpkg - Create a dpkg_archive entry
812
 
813
=head1 SYNOPSIS
814
 
815
 jats create_dpkg [options]
816
 
817
 Options:
818
    -help              - Brief help message
819
    -help -help        - Detailed help message
820
    -man               - Full documentation
821
    -quiet             - Suppress progress messages, then warning messages
822
    -verbose           - Display additional progress messages
823
    -override          - Override any previous version of the package
263 dpurdie 824
    -[no]merge         - merge with existing version of the package
227 dpurdie 825
    -archive=name      - Specify archive (cache, local, main, store, sandbox, deploy)
826
    -pname=name        - Ensure package is named correctly
827
    -pversion=version  - Ensure package version is correct
828
    -generic           - Create a built.generic file
263 dpurdie 829
    -[no]test          - Test package. Do not transfer.
830
    -[no]md5           - Use MD5 comparison of merged files(enabled)
227 dpurdie 831
 
832
 
833
=head1 OPTIONS
834
 
835
=over 8
836
 
837
=item B<-help>
838
 
839
Print a brief help message and exits.
840
 
841
=item B<-help -help>
842
 
843
Print a detailed help message with an explanation for each option.
844
 
845
=item B<-man>
846
 
847
Prints the manual page and exits.
848
 
849
=item B<-quiet>
850
 
851
This option will suppress almost all of the progress messages, except for a single
852
copy message. It is intended to be used when the program is called from another
853
script.
854
 
855
=item B<-override>
856
 
857
If this option is enabled then any previous version of the target package will
858
be deleted, without any user intervention.
859
 
860
=item B<-merge>
861
 
862
If this option is enabled then the package will be merged with any existing
863
package, without any user intervention. This option is used by the auto build
864
tool to assemble multi-machine packages in dpkg_archive.
865
 
866
=item B<-archive=name>
867
 
868
This option specifies the destination archive to be used. The following names
869
are supported:
870
 
871
=item B<-pname=name>
872
 
873
If this option is provided, the utility will ensure that the package is named
874
correctly.
875
 
876
=item B<-pversion=version>
877
 
878
If this option is provided, the utility will ensure that the package version is
879
that expected.
880
 
881
=item B<-test>
882
 
883
If this option is enabled the utility will perform initial sanity testing, but
884
it will not perform the copy.
885
 
263 dpurdie 886
=item B<-[no]md5>
887
 
888
If package builds are being merged then a validity check is performed using
889
an MD5 digest over the current and the existing file.
890
 
891
By default, it is an error for the user file to differ from the merged file.
892
 
893
This option disabled the error. The test is still done and the results are
894
reported.
895
 
227 dpurdie 896
=over 8
897
 
898
=item cache
899
 
900
The location of the target archive will be taken from GBE_DPKG_CACHE.
901
 
902
=item local
903
 
904
The location of the target archive will be taken from GBE_DPKG_LOCAL.
905
 
906
=item main (default)
907
 
908
The location of the target archive will be taken from GBE_DPKG. This is the
909
default target archive.
910
 
911
=item store
912
 
913
The location of the target archive will be taken from GBE_DPKG_STORE.
914
 
915
=item sandbox
916
 
917
The location of the target archive will be taken from GBE_DPKG_SBOX.
918
 
919
=item deploy
920
 
921
The location of the target archive will be taken from GBE_DPLY. This is the
922
default target archive is a deployment package is detected.
923
 
924
=back
925
 
926
=item B<-generic>
927
 
928
This option will create a built.generic file, instead of one based on the machine
929
that actually built the package. This is used by the AutoBuilder toolchain.
930
 
931
=back
932
 
933
=head1 DESCRIPTION
934
 
935
This utility program is used to transfer a package that has been built into
936
dpkg_archive. The package is then available for general consumption.
937
 
938
=head2 PACKAGE LOCATION
939
 
940
The utility will locate a package by examining the following directores for
941
the package description file(descpkg).
942
 
943
=over 8
944
 
945
=item ./build/deploy
946
 
947
This format is generated by the deployment builds. The default target archive
948
will be taken from the environment variable GBE_DPLY.
949
 
950
=item ./pkg
951
 
952
This format is generated by JATS builds.
953
 
954
=item ./build/pkg
955
 
956
This format is generated by ANT builds.
957
 
958
=back
959
 
960
The program should be run in the same directory as the build control files as
961
the package subdirectory will be created in that directory.
962
 
963
=head1 EXAMPLE
964
 
965
=head2 jats create_dpkg
966
 
967
This will locate a generated package and install it into the dpkg_archive repository.
968
 
969
=cut
970