Subversion Repositories DevTools

Rev

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

Rev Author Line No. Line
227 dpurdie 1
########################################################################
2
# Copyright (C) 1998-2007 ERG Limited, All rights reserved
3
#
4
# Module name   : CCdiff.pl
5
# Module type   : Makefile system
6
# Compiler(s)   : n/a
7
# Environment(s): JATS. This script is designed to be run under JATS
8
#
9
# Description   : Make ClearCase difference report suitable for uploading
241 dpurdie 10
#                 to Code Striker.
227 dpurdie 11
#......................................................................#
12
 
255 dpurdie 13
require 5.006_001;
227 dpurdie 14
use strict;
15
use warnings;
16
use JatsError;
17
use JatsSystem;
18
use Pod::Usage;                             # required for help support
19
use Getopt::Long;
247 dpurdie 20
use FileUtils;
227 dpurdie 21
 
241 dpurdie 22
#-------------------------------------------------------------------------------
23
#
24
#  Function Prototypes
25
#
247 dpurdie 26
sub populateFilesArray($$$\%);
27
sub files_from_view($$$$\%);
28
sub generateOutputFilename(\$);
29
sub getTags();
30
sub parseTag(\$\$\$);
31
sub getClearToolFindOutput($$);
32
sub element0($);
33
sub getIds($@);
34
sub massage_path($\$$\$);
227 dpurdie 35
 
241 dpurdie 36
#-------------------------------------------------------------------------------
37
#
38
#  Global variables
39
#
227 dpurdie 40
 
247 dpurdie 41
#
42
# Update this:
43
#
251 dpurdie 44
my $VERSION = "1.1.0";
241 dpurdie 45
 
227 dpurdie 46
#
247 dpurdie 47
#  Globals that can be set immediately
227 dpurdie 48
#
247 dpurdie 49
my $ats = "@@";
50
my $UNIX = $ENV{'GBE_UNIX'};
51
my $UNIX_VOB_PREFIX = '/vobs';
52
my $VOB_SEP = $UNIX ? '/' : '\\';
227 dpurdie 53
 
54
#
55
#   Options
56
#
57
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
58
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
59
my $opt_help = 0;
60
my $opt_manual = 0;
61
my $opt_drive = $UNIX ? '/view' : 'o:';
62
my $opt_viewname = 'administration_view';
63
my $opt_outfile;
64
my @opt_vobs;
247 dpurdie 65
my $opt_new;
66
my $opt_old;
67
my $opt_massage = 1;
227 dpurdie 68
 
69
#
247 dpurdie 70
#  Globals that are set within the script
227 dpurdie 71
#
72
my @error_list;                             # ClearCmd detected errors
73
my $view_path;
74
my @view_tags;
75
my %files;
247 dpurdie 76
my %clearCaseInfos;
227 dpurdie 77
 
247 dpurdie 78
my $oldLabel;
79
my $newLabel;
80
my $oldDirectory;
81
my $newDirectory;
82
 
227 dpurdie 83
#
84
#   ROOT_VOBS is a list of VOBS too look in first
85
#   If a label is not found in these vobs, then the program will
86
#   look in all vobs. This list is a hint to speed up searching
87
#
88
my @ROOT_VOBS = qw( /LMOS /DPG_SWBase /DPG_SWCode /ProjectCD /MASS_Dev_Bus
89
                    /MASS_Dev_Infra /MOS /MASS_Dataman /MASS_Dev /MASS_Dev_Dataman
90
                    /COTS /GMPTE2005 /GMPTE2005_obe /MPR /MOS );
91
 
92
#-------------------------------------------------------------------------------
93
#
247 dpurdie 94
#  Mainline entry point
227 dpurdie 95
#
247 dpurdie 96
InitFileUtils();
227 dpurdie 97
 
98
#
99
#   Parse the user options
100
#
101
my $result = GetOptions (
247 dpurdie 102
    "help+"         => \$opt_help,              # flag, multiple use allowed
103
    "manual"        => sub{ $opt_help = 3},     # flag, multiple use allowed
104
    "verbose+"      => \$opt_verbose,           # flag, multiple use allowed
105
    "output=s"      => \$opt_outfile,           # String
106
    "new=s"         => \$opt_new,               # String
107
    "old=s"         => \$opt_old,               # String
108
    "drive=s"       => \$opt_drive,             # String
109
    "vob=s"         => \@opt_vobs,              # String
110
    "massage!"      => \$opt_massage,           # [no]flag
111
    );
227 dpurdie 112
 
247 dpurdie 113
#
114
#   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
115
#
227 dpurdie 116
 
117
#
118
#   Process help and manual options
119
#
120
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result );
121
pod2usage(-verbose => 1)  if ($opt_help == 2);
122
pod2usage(-verbose => 2)  if ($opt_help > 2);
123
 
124
#
125
#   Configure the error reporting process now that we have the user options
126
#
127
ErrorConfig( 'name'    => 'CCDIFF',
128
             'verbose' => $opt_verbose );
129
 
130
#
247 dpurdie 131
#   Work out '$oldLabel', '$newLabel', '$oldDirectory', '$newDirectory' tags
227 dpurdie 132
#
247 dpurdie 133
getTags();
227 dpurdie 134
 
135
Error ("Too many command line arguments" )
136
    unless ( $#ARGV < 0 );
137
 
247 dpurdie 138
generateOutputFilename($opt_outfile);
241 dpurdie 139
 
140
#
227 dpurdie 141
#   Determine the machine type
142
#
143
Verbose ("Machine Type: UNIX=$UNIX");
144
 
145
#
146
#   Ensure that the 'cleartool' program can be located
147
#
148
Verbose ("Locate clearcase utility in users path");
149
Error ("Cannot locate the 'cleartool' utility in the users PATH")
150
    unless ( LocateProgInPath('cleartool', '--All') );
151
 
152
#
247 dpurdie 153
#   Ensure that the 'administration_view' is available
227 dpurdie 154
#   Then start the view, before checking its availability
155
#
241 dpurdie 156
if( ClearCmd('lsview', $opt_viewname) )
227 dpurdie 157
{
158
    Error ("Required view not found: $opt_viewname",
247 dpurdie 159
           "This is a dynamic view that should exist as it is used by the build system");
227 dpurdie 160
}
161
 
241 dpurdie 162
if( ClearCmd( 'startview', $opt_viewname) )
227 dpurdie 163
{
164
    Error ("Cannot start the required view: $opt_viewname");
165
}
166
 
167
$view_path = "$opt_drive/$opt_viewname";
168
$view_path .= $UNIX_VOB_PREFIX if ( $UNIX );
247 dpurdie 169
Error ("Cannot locate the required dynamic view: $view_path",
170
       "The view exits and has been started. It cannot be found")
171
    if ( ! -d $view_path  );
227 dpurdie 172
 
173
#
247 dpurdie 174
#   Determine the list of VOBs to scan for a label
175
#   This may be user specified or all the known vobs
227 dpurdie 176
#
177
if ( @opt_vobs )
178
{
247 dpurdie 179
    #
180
    #   User has provided a list of vobs to search
181
    #   Use this list
182
    #
227 dpurdie 183
    @ROOT_VOBS = ();
184
    foreach my $vob ( @opt_vobs )
185
    {
186
        $vob = '/' . $vob;
187
        $vob =~ s~^$UNIX_VOB_PREFIX~~ if ($UNIX);
241 dpurdie 188
        $vob =~ tr{\\/}{/}s;
227 dpurdie 189
        push @ROOT_VOBS, $vob;
190
    }
191
}
192
else
193
{
247 dpurdie 194
    #
195
    #   Extend the list of ROOT_VOBS with all the known vobs
196
    #   The initial ROOT_VOBS are treated as a "hint" to assist searching
197
    #
227 dpurdie 198
    my $cmd = "cleartool lsvob -short";
199
    open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
200
    while (<CMD>)
201
    {
202
        #
203
        #   Filter output from the user
204
        #
241 dpurdie 205
        s~[\n\r]+$~~;
227 dpurdie 206
        s~^$UNIX_VOB_PREFIX~~ if ($UNIX);
207
        Verbose2("lsvob: $_");
241 dpurdie 208
        tr{\\/}{/}s;
227 dpurdie 209
        push @ROOT_VOBS, $_;
210
    }
211
    close(CMD);
212
}
213
 
214
#
215
#   Ensure the two labels are present - determine the VOB root
216
#
247 dpurdie 217
my $oldLabelVob = $oldLabel ? LocateLabel( $oldLabel ) : "";
218
my $newLabelVob = $newLabel ? LocateLabel( $newLabel ) : "";
227 dpurdie 219
 
220
#
247 dpurdie 221
#   Massage the directory path
222
#   If the user has provided a directory, then we will compare the
223
#   entire contents of the directory against the label
227 dpurdie 224
#
247 dpurdie 225
massage_path( $oldLabelVob, $oldDirectory, $newLabelVob, $newDirectory  )
226
    if ( $opt_massage );
227 dpurdie 227
 
228
#
247 dpurdie 229
#   Locate all files for the two areas
227 dpurdie 230
#
231
{
247 dpurdie 232
    my %initialFilePaths;
233
 
251 dpurdie 234
    files_from_view( $oldLabelVob, $oldLabel, 1, $oldDirectory, %initialFilePaths ) if ($opt_old);
247 dpurdie 235
    files_from_view( $newLabelVob, $newLabel, 2, $newDirectory, %initialFilePaths );
236
    #DebugDumpData ("initialFilePaths", \%initialFilePaths );
237
 
238
    populateFilesArray( $oldLabel, 1, $oldDirectory, %initialFilePaths);
239
    populateFilesArray( $newLabel, 2, $newDirectory, %initialFilePaths);
240
    #DebugDumpData ("Files", \%files );
227 dpurdie 241
}
242
 
243
#
247 dpurdie 244
#   Have a structure that contains files for both the old and new labels
245
#   Scan the list locating files that are different
227 dpurdie 246
#
247
my @no_text;
248
my $added = 0;
249
my $deleted = 0;
247 dpurdie 250
my $ndiffs = 0;
241 dpurdie 251
my $ifile = 0;
252
 
247 dpurdie 253
Verbose ("Opening file in current directory", $opt_outfile, Getcwd() );
254
open (FO, ">$opt_outfile") || Error ("Cannot open file: $opt_outfile", "Reason: $!");
241 dpurdie 255
 
247 dpurdie 256
foreach my $id ( sort keys %files )
227 dpurdie 257
{
241 dpurdie 258
    $ifile ++;
259
 
247 dpurdie 260
    Verbose("Computing differences for file $ifile/" . scalar(keys %files));
241 dpurdie 261
 
247 dpurdie 262
    my ($hs, $aid);
263
 
264
    if ( $files{$id}{1} && $files{$id}{2} ) #  File exists in both areas:
227 dpurdie 265
    {
247 dpurdie 266
        #
267
        #   Test for files existing in both tags and being identical
268
        #
269
        next if( $files{$id}{1} eq $files{$id}{2} );
270
 
271
        #
272
        #   Files are in both areas, but are different
273
        #   Perform diff. There may be cases where they are really the same text
274
        #   or the only change is in white space.
275
        #
276
        ($hs, $aid) = ClearDiff("-serial_format", "-blank_ignore", $files{$id}{1}, $files{$id}{2});
277
        $ndiffs++ if ( $hs );
227 dpurdie 278
    }
247 dpurdie 279
    elsif( $files{$id}{1} ) # File doesn't exist in 'new' area:
227 dpurdie 280
    {
247 dpurdie 281
        ($hs, $aid) = ClearDiff("-serial_format", $files{$id}{1}, element0($files{$id}{1}) );
282
        $deleted++ if ( $hs );
227 dpurdie 283
    }
247 dpurdie 284
    elsif( $files{$id}{2} ) # File doesn't exist in 'old' area:
227 dpurdie 285
    {
247 dpurdie 286
        ($hs, $aid) = ClearDiff("-serial_format", element0($files{$id}{2}), $files{$id}{2} );
287
        $added++ if ( $hs );
227 dpurdie 288
    }
247 dpurdie 289
    else # bug!
290
    {
291
        Error("Internal BUG in main line!  Please report!",
292
              "id='$id' ifile=$ifile neither has a 1 nor a 2 tag");
293
    }
227 dpurdie 294
 
247 dpurdie 295
    push @no_text, $files{$id}{1} if ( $files{$id}{1} && ! $hs && ! $aid );
296
    push @no_text, $files{$id}{2} if ( $files{$id}{2} && ! $hs && ! $aid );
241 dpurdie 297
}
227 dpurdie 298
 
247 dpurdie 299
close FO;
241 dpurdie 300
 
227 dpurdie 301
#
302
#   Warn about problem files
303
#
304
if ( @no_text )
305
{
306
    Warning ("The following files did not generate any difference report, although",
307
             "they are different. They may be binary files:", @no_text);
308
}
309
 
310
#
311
#   Summary information
312
#
313
Information ("Summary Information",
251 dpurdie 314
             "Old:               : " . ($oldLabel ? $oldLabel : $oldDirectory || 'None' ),
315
             "New:               : " . ($newLabel ? $newLabel : $newDirectory),
247 dpurdie 316
             "Files different    : $ndiffs",
227 dpurdie 317
             "Files added        : $added",
318
             "Files deleted      : $deleted",
241 dpurdie 319
             "Files not in report: " . scalar(@no_text),
247 dpurdie 320
             "Output file        : $opt_outfile"
227 dpurdie 321
             );
322
 
247 dpurdie 323
exit (0);
227 dpurdie 324
 
325
 
326
#-------------------------------------------------------------------------------
247 dpurdie 327
# Function        : generateOutputFilename
227 dpurdie 328
#
247 dpurdie 329
# Description     : Works out what the output diff filename should be
241 dpurdie 330
#
247 dpurdie 331
# Inputs          : $oldLabel, $newLabel
241 dpurdie 332
#
247 dpurdie 333
# Input/Output    : reference to $opt_outfile
241 dpurdie 334
#
247 dpurdie 335
# Returns         : 
241 dpurdie 336
#
247 dpurdie 337
sub generateOutputFilename(\$)
241 dpurdie 338
{
247 dpurdie 339
    my $refOpt_outfile = shift;
241 dpurdie 340
 
247 dpurdie 341
    unless( $$refOpt_outfile )
241 dpurdie 342
    {
247 dpurdie 343
        $$refOpt_outfile = "${oldLabel}-${newLabel}-diff.txt" if(  $oldLabel &&  $newLabel );
344
        $$refOpt_outfile = "${oldLabel}-diff.txt"             if(  $oldLabel && !$newLabel );
345
        $$refOpt_outfile = "${newLabel}-diff.txt"             if( !$oldLabel &&  $newLabel );
346
        $$refOpt_outfile = "directoryDifferences-diff.txt"    if( !$oldLabel && !$newLabel );
241 dpurdie 347
 
247 dpurdie 348
        #
349
        #   If the label has ugly characaters in it then we won't be able to create
350
        #   a nice file name. Sanitise the filename
351
        #
352
        $$refOpt_outfile =~ s{[\\/:]+}{_}g;
353
        $$refOpt_outfile =~ s{_+}{_}g;
241 dpurdie 354
    }
355
 
247 dpurdie 356
    #
357
    # Do an early check that output file can be written to
358
    #
359
    open( Z, ">$$refOpt_outfile") or Error("Could not open '$$refOpt_outfile' for writing");
360
    close( Z );
361
    unlink $$refOpt_outfile;
362
}
241 dpurdie 363
 
364
 
247 dpurdie 365
#-------------------------------------------------------------------------------
366
# Function        : getTags
367
#
368
# Description     : Works out whether using labels or directories, and fills in
369
#                   $oldLabel or $oldDirectory
370
#                   $newLabel or $newDirectory
371
#                   Function works with $opt_new, $opt_old, @ARGV
372
#
373
# Inputs          : 
374
#
375
# Returns         : 
376
#
377
sub getTags()
378
{
379
    # If we have two options and no labels, then assign them
380
    if ( ! $opt_new && ! $opt_old )
381
    {
382
        Error ("Must provide two labels on command line unless they are provided " .
383
               "via -old and -new options") if ( $#ARGV < 1 );
241 dpurdie 384
 
247 dpurdie 385
        $opt_old = shift @ARGV;
386
        $opt_new = shift @ARGV;
387
    }
241 dpurdie 388
 
247 dpurdie 389
    Error ("Need to provide the 'new' label/directory") unless ( $opt_new );
390
 
251 dpurdie 391
    parseTag($opt_old, $oldLabel, $oldDirectory) if ( $opt_old );
247 dpurdie 392
    parseTag($opt_new, $newLabel, $newDirectory);
393
 
394
    Error("Cannot compare two directories") if( $oldDirectory && $newDirectory );
241 dpurdie 395
}
396
 
397
 
398
#-------------------------------------------------------------------------------
247 dpurdie 399
# Function        : parseTags
241 dpurdie 400
#
247 dpurdie 401
# Description     : Worker function for getTags() - parses a "-new"/"-old" option
241 dpurdie 402
#
251 dpurdie 403
# Inputs          : $retOpt         - reference to the command line argument
404
#                   $refLabel       - reference to the label variable that may be initialised
405
#                   $refDirectory   - reference to the directory variable that may be initialised
241 dpurdie 406
#
247 dpurdie 407
# Returns         : 
241 dpurdie 408
#
247 dpurdie 409
sub parseTag(\$\$\$)
410
{
411
    my ($refOpt,$refLabel,$refDirectory) = @_;
412
 
413
    if( $$refOpt =~ m/^dir=(.*)/ )
414
    {
415
        $$refLabel = "";
416
        $$refDirectory = ($1 eq "current") ? "." : $1;
417
        $$refDirectory =~ tr{\\/}{/}s;
418
        $$refDirectory =~ s~/$~~;
419
    }
420
    elsif( $$refOpt =~ m/^current/ )
421
    {
422
        $$refLabel = "";
423
        $$refDirectory = ".";
424
    }
425
    else
426
    {
427
        $$refLabel = $$refOpt;
428
        $$refDirectory = "";
429
 
430
        #
431
        #   Sanity check
432
        #   Labels shouldn't have directory seperator characters in them
433
        #   The user may have mis-used the command
434
        #
435
        if ( $$refOpt =~ m~[/\\]~  )
436
        {
437
            Warning("Label has slashes in it. Looks like a directory",
438
            "Did you mean 'dir=$$refOpt'?",
439
            "Continuing anyway...");
440
        }
441
    }
442
}
443
 
444
#-------------------------------------------------------------------------------
445
# Function        : populateFilesArray
241 dpurdie 446
#
247 dpurdie 447
# Description     : Populates the global '%files' hash array.  It does this
448
#                   by taking as input a hash array that is the output of cleartool
449
#                   find/ls, and, for files that did not come up identical for both
450
#                   old and new labels, calling cleartool dump to get the info
451
#                   to put into the '%files' hash.
452
#
453
# Inputs          : $label          - Label (not set if $directory defined)
454
#                   $tag            - File tag (1 for 'old' or 2 for 'new')
455
#                   $directory      - Directory name (not set if $label defined)
456
#                   $refInitialFilePaths - reference to the hash array that stores the
457
#                                          output of previous calls to cleartool find/ls.
458
#
459
# Returns         : Nothing
460
#                   Populates the %files array
461
#
462
sub populateFilesArray($$$\%)
241 dpurdie 463
{
247 dpurdie 464
    my ($label, $tag, $directory, $refInitialFilePaths) = @_;
241 dpurdie 465
 
247 dpurdie 466
    #######################
467
    # Step 1: Get an array of filenames
468
    my @initialFilePaths;
241 dpurdie 469
 
247 dpurdie 470
    foreach my $initialFilePath (sort keys %$refInitialFilePaths)
471
    {
472
        # If a file exists in both labels and has the same initial file path
473
        # we just assume that the ids are identical and that 
474
        # cleartool dump does not need to be called
475
        # This saves execution time.
476
        # Instead - we just use the file path as the id
477
        #
478
        if( $$refInitialFilePaths{$initialFilePath}{1} && 
479
            $$refInitialFilePaths{$initialFilePath}{2} )
480
        {
481
            $files{$initialFilePath}{$tag} = $initialFilePath;
482
            next;
483
        }
241 dpurdie 484
 
247 dpurdie 485
        push @initialFilePaths, $initialFilePath 
486
            if( $$refInitialFilePaths{$initialFilePath}{$tag} );
487
    }
241 dpurdie 488
 
247 dpurdie 489
    #
251 dpurdie 490
    #   If this is a part of a 'directory' comparison, then we need to
491
    #   convert the filename into vob extended pathnames - as seen within the
492
    #   administration_view. This is slow, so we don't do it if its a part
493
    #   of a label-label comparison.
247 dpurdie 494
    #
251 dpurdie 495
    if ( $directory )
496
    {
497
        #
498
        #   Convert the list of files into a list of vob extended pathnames
499
        #   Done as a block for speed
500
        #
501
#DebugDumpData ("Initial Paths", @initialFilePaths);
502
        @initialFilePaths = getIds( $tag, @initialFilePaths );
503
#DebugDumpData ("Final Paths", @initialFilePaths);
504
    }
247 dpurdie 505
 
506
    #
251 dpurdie 507
    #   Populate the $files hash with information
508
    #   key1 - name, without version
509
    #   key2 - tag
510
    #   value - Vob extended path name
247 dpurdie 511
    #
251 dpurdie 512
    foreach my $pn ( @initialFilePaths )
241 dpurdie 513
    {
251 dpurdie 514
        my $key = $pn;
515
        $key =~ s~@@[^@]*$~~;
516
        Error ("Internal. Expected path with embedded @@", "Got: $pn") unless $key;
517
        $files{$key}{$tag} = $pn;
241 dpurdie 518
    }
251 dpurdie 519
#DebugDumpData ("FILES", \%files);
241 dpurdie 520
}
521
 
247 dpurdie 522
 
241 dpurdie 523
#-------------------------------------------------------------------------------
247 dpurdie 524
# Function        : files_from_view
241 dpurdie 525
#
247 dpurdie 526
# Description     : Fills in the hash array 'initialFilePaths' with filename paths
527
#                   If a label, uses cleartool find
528
#                   If a directory, then cleartool ls is used
241 dpurdie 529
#
247 dpurdie 530
# Inputs          : $vpath          - Path to the view
531
#                   $label          - Label (not set if $directory defined)
532
#                   $tag            - File tag (1 for 'old' or 2 for 'new')
533
#                   $directory      - Directory name (not set if $label defined)
534
#                   $refInitialFilePaths - reference to hash array of filename paths
241 dpurdie 535
#
247 dpurdie 536
# Returns         : Nothing
241 dpurdie 537
#
247 dpurdie 538
sub files_from_view($$$$\%)
241 dpurdie 539
{
247 dpurdie 540
    my ($vpath, $label, $tag, $directory, $refInitialFilePaths) = @_;
241 dpurdie 541
 
247 dpurdie 542
    if( $label )
241 dpurdie 543
    {
247 dpurdie 544
        #
545
        #   Ensure that the VOB is mounted
546
        #   The mount command MUST have the correct vob format
547
        #
548
        my $vob_name = $vpath;
549
        $vob_name =~ s~^/+~~;
550
        ClearCmd ('mount', $VOB_SEP . $vob_name);
241 dpurdie 551
 
247 dpurdie 552
        my @initialFilePaths = getClearToolFindOutput( $vpath, $label );
241 dpurdie 553
 
247 dpurdie 554
        foreach my $initialFilePath (@initialFilePaths)
555
        {
556
            $$refInitialFilePaths{$initialFilePath}{$tag} = 1;
557
        }
251 dpurdie 558
    }
247 dpurdie 559
    else
560
    {
561
        my $nfilesStartedWith = scalar(keys %$refInitialFilePaths);
562
        my @checkedout;
241 dpurdie 563
 
247 dpurdie 564
        #
565
        #   Locate files in the specified directory
566
        #   Use an absolute directory to simplify location of files
567
        #   Will cause output of the 'ls' to have absolute paths, which is good
568
        #
569
        $directory = FullPath( $directory );
570
        my $cmd = QuoteCommand( 'cleartool', 'ls', '-recurse', $directory);
241 dpurdie 571
 
247 dpurdie 572
        Message("Cleartool: searching for clearcase elements in '$directory'");
241 dpurdie 573
 
247 dpurdie 574
        open( CMD, "$cmd 2>& 1 |") or Error("can't run command: $!");
575
        while( <CMD> )
576
        {
577
            # Each line will be of the form (e.g.):
578
            # ./LIB/JatsMakeConfig.pm@@/main/4         Rule: core_devl_2.73.2000.cr
241 dpurdie 579
 
247 dpurdie 580
            s~[\n\r]+$~~;
241 dpurdie 581
 
247 dpurdie 582
            #
583
            #   Only want the files known to ClearCase
584
            #   These will have a 'Rule:'
585
            #
586
            #   If the user has checkedout files, then all of this will
587
            #   not work
588
            #
589
            if ( m{(.+?)\s+Rule:(.+)} )
590
            {
591
                my $files = $1;
592
                my $rule = $2;
241 dpurdie 593
 
247 dpurdie 594
                $files =~ tr{\\/}{/}s;  # Replace \ and / with /
595
                (my $actualFilePath = $files) =~ s~${ats}.*~~;
241 dpurdie 596
 
251 dpurdie 597
                #
598
                #   These are not good
599
                #   Remember  the names and generate an error later
600
                #
601
                push @checkedout, $actualFilePath if ( $rule =~ m/CHECKEDOUT/ );
241 dpurdie 602
 
247 dpurdie 603
                #
604
                #   Don't want to know about directories
605
                #
606
                next if( -d $actualFilePath );
241 dpurdie 607
 
247 dpurdie 608
                #
251 dpurdie 609
                #   lost+found can be a problem too
610
                #   These report: [not loaded, no version selected]
611
                #
612
                next if ( $files =~ m{/lost\+found\@\@} );
613
 
614
                #
247 dpurdie 615
                #   Save files name, with embedded version
616
                #
617
                $$refInitialFilePaths{$files}{$tag} = 1;
618
            }
619
        }
620
        close( CMD );
621
 
622
        Message ("There are " . (scalar(keys %$refInitialFilePaths) - $nfilesStartedWith) . 
623
             " files in directory $directory");
624
 
625
        #
626
        #   Files that are checked otu are bad news. They cannot be reproduced
627
        #   on demand. Generate an error
628
        #
629
        if ( @checkedout )
630
        {
631
            Error ("Processed directory contains checked out files",
632
                   "Not supported by this tool. Files are:", @checkedout );
633
        }
241 dpurdie 634
    }
635
}
636
 
247 dpurdie 637
 
241 dpurdie 638
#-------------------------------------------------------------------------------
247 dpurdie 639
# Function        : getClearToolFindOutput
241 dpurdie 640
#
247 dpurdie 641
# Description     : Runs cleartool find on a label
642
#                   Runs in the adbinistration view so that the paths that
643
#                   are provided are vob extended.
241 dpurdie 644
#
247 dpurdie 645
# Inputs          : $vpath, $label
241 dpurdie 646
#
247 dpurdie 647
# Returns         : An array of the output lines of cleartool find
241 dpurdie 648
#
247 dpurdie 649
sub getClearToolFindOutput($$)
241 dpurdie 650
{
247 dpurdie 651
    my ($vpath,$label) = @_;
652
 
653
    my $cmd = qq(cleartool find "$opt_drive/$opt_viewname/$vpath" -all -follow -type f -element "lbtype_sub($label)" -version "lbtype_sub($label)" -print);
241 dpurdie 654
 
247 dpurdie 655
    Message ("Cleartool: searching for files with label '$label'");
241 dpurdie 656
 
247 dpurdie 657
    my @outputLines;
658
 
659
    # A typical line of output:
660
    #/view/administration_view/vobs/MASS_Dev_Infra/core_devl@@/main/mass_dev/1/BIN.win32/main/mass_dev/1/printenv.exe@@/main/mass_dev/1
661
 
662
    open(CMD, "$cmd 2>&1 |") || Error "Can't run command: $!";
663
    while (<CMD>)
241 dpurdie 664
    {
247 dpurdie 665
        s~\s+$~~;           # Remove white space including newline/returns
666
        tr{\\/}{/}s;        # Replace \ and / with /
667
        next if( -d $_ );   # -d tests if file is a directory
668
        Verbose2 ("ctf: $_");
669
        push @outputLines, $_;
241 dpurdie 670
    }
247 dpurdie 671
    close(CMD);
241 dpurdie 672
 
251 dpurdie 673
    Message("There are " . scalar(@outputLines) . " files in $opt_drive/$opt_viewname$vpath");
247 dpurdie 674
 
675
    return @outputLines;
241 dpurdie 676
}
677
 
678
 
679
#-------------------------------------------------------------------------------
247 dpurdie 680
# Function        : getIds
241 dpurdie 681
#
247 dpurdie 682
# Description     : Calls cleartool dump to retrieve the unique identifer
683
#                   for each of a list of files.
227 dpurdie 684
#
247 dpurdie 685
# Inputs          : $tag
686
#                   @initialFilePaths - a list of filenames with @@'s in them.
227 dpurdie 687
#
247 dpurdie 688
# Returns         : An array of unique identifier strings.  This array has the same
689
#                   size as the input @initialFilePaths - each element is the unique
690
#                   identifier for the corresponding element of that array.
227 dpurdie 691
#
247 dpurdie 692
sub getIds($@)
227 dpurdie 693
{
247 dpurdie 694
    my ($tag,@initialFilePaths) = @_;
695
    my @ids;
696
    my $nfilesPerCallToDump = 20;
227 dpurdie 697
 
698
    #
247 dpurdie 699
    #   Change to the directory that contains the admin view
700
    #   This will ensure that the 2nd line of the dump comamnd contains
701
    #   the vob extended pathname within that view. This will be used
702
    #   to simplify the pairing of files
227 dpurdie 703
    #
251 dpurdie 704
    Verbose2 ("getIds: chdir: $view_path");
247 dpurdie 705
    chdir ($view_path) || Error ("Did not chdir to $view_path" );
706
 
707
    while( @initialFilePaths )
708
    {
709
        #
710
        #   Limit the number of files to be processed in one call to the
711
        #   clearcase dump. Iff too many, then the command line will be long.
712
        #   If short ( ie 1 ), then the call overhead is very high
713
        #
714
        my @filesToDump = splice( @initialFilePaths, 0, $nfilesPerCallToDump);
227 dpurdie 715
 
247 dpurdie 716
        #
251 dpurdie 717
        #   The dump command provides two really useful peice of  information
718
        #       1) Line1: The input file name
719
        #       2) Line2: The vob extended pathname of the files as
247 dpurdie 720
        #                 seen in the current view, together with some junk
721
        #
251 dpurdie 722
        #   The line is of the form
723
        #           path_to_vob@@vob_extended_pathname
247 dpurdie 724
        #
251 dpurdie 725
        #   Unfortunately CodeStriker needs something of the form
726
        #           path_to_vob@@mangled_pathname
727
        #   Where the mangled pathname contains 2 @@ sequences
728
        #       1) After the path_to_vob (good)
729
        #       2) One after the name of the file (bad)
730
        #   Code striker uses this to make a prety display
247 dpurdie 731
        #
251 dpurdie 732
        #   Luckily The input has the location of the 2nd @@
733
        #   Create a mangled reference by merging the input line
734
        #   and line-1
735
        #
227 dpurdie 736
 
247 dpurdie 737
        my $cmd2 = QuoteCommand( "cleartool", "dump", @filesToDump);
738
        my @newids;
739
        my $line = 0;
251 dpurdie 740
        my $user_path;
247 dpurdie 741
 
742
        Verbose2("Cleartool: getting unique identifiers for " . scalar(@filesToDump) . " files");
743
 
744
        open(CCI, "$cmd2 2>&1 |") || Error "Can't run command: $!";
745
        while( <CCI> )
746
        {
251 dpurdie 747
 
247 dpurdie 748
            s~[\n\r]+$~~;
251 dpurdie 749
            Verbose3 ("ctd: Data: $_");
247 dpurdie 750
 
751
            #
752
            #   Blank entry signals new package
753
            #
754
            unless ( $_ )
755
            {
756
                $line = 0;
757
                next;
758
            }
759
            $line++;
760
 
761
            #
762
            #   Line-1:
763
            #   Path to package as seen from current view
251 dpurdie 764
            #   Extract and save the user file name
247 dpurdie 765
            #
249 dpurdie 766
            if ( $line == 1 )
247 dpurdie 767
            {
768
                s{\\}{/}g;
769
                s{\s+\(.+\)$}{};
251 dpurdie 770
                $user_path = $_;
247 dpurdie 771
                next;
772
            }
773
 
774
            #
251 dpurdie 775
            #   Line-2
776
            #   Vob Extended Pathname
777
            #   Mangle with user pathname
247 dpurdie 778
            #
251 dpurdie 779
            if ( $line == 2 )
247 dpurdie 780
            {
251 dpurdie 781
                s{\\}{/}g;
782
                $user_path =~ m{\@\@([^@]+)$};
783
                my $suffix = $1;
784
                my $suffix_len = length $suffix;
785
 
786
                my $mpn = substr ($_, 0, - $suffix_len ) . '@@' . $suffix;
787
                push @newids, $mpn;
788
 
789
                Verbose2 ("ctd: Line2: $_");
790
                Verbose2 ("ctd: VEPN : $_");
791
                Verbose2 ("ctd: OUT  : $mpn");
247 dpurdie 792
            }
251 dpurdie 793
 
247 dpurdie 794
        }
795
        close(CCI);
796
 
797
        Error("Internal error in getIds(): Only retrieved " . scalar(@newids) . 
251 dpurdie 798
              " IDs from a cleartool dump command for " . scalar(@filesToDump) . " files",
799
              @filesToDump)
247 dpurdie 800
            if( scalar(@newids) != scalar(@filesToDump) );
801
 
802
        push @ids, @newids;
227 dpurdie 803
    }
241 dpurdie 804
 
247 dpurdie 805
    chdir ($FileUtils::CwdFull) || Error ("Did not chdir to $FileUtils::CwdFull") ;
806
    return @ids;
227 dpurdie 807
}
808
 
247 dpurdie 809
 
227 dpurdie 810
#-------------------------------------------------------------------------------
811
# Function        : ClearDiff
812
#
813
# Description     : Issue a cleartool command
814
#                   Filter out many of the stupid messages
815
#
816
# Inputs          : Options and Command line
817
#
247 dpurdie 818
# Returns         : header_seen         - Bool. Header has been seen
819
#                   identical           - Bool. Files are really the same
227 dpurdie 820
#
821
sub ClearDiff
822
{
823
    my $header_seen = 0;
824
    my $identical = 0;
241 dpurdie 825
    my $cmd = QuoteCommand("cleardiff", @_);
227 dpurdie 826
 
247 dpurdie 827
    Verbose("ClearDiff cmd: $cmd");
227 dpurdie 828
    open(CMD, "$cmd 2>&1 |") || Error "can't run command: $!";
241 dpurdie 829
 
227 dpurdie 830
    while (<CMD>)
831
    {
247 dpurdie 832
        Verbose2("ClearDiff: $_");
227 dpurdie 833
        $header_seen = 1
834
            if ( m~^[*]{32}~ );
835
        unless ( $header_seen )
836
        {
247 dpurdie 837
            $identical = 1 if ( m~^Files are identical~ );
227 dpurdie 838
            next;
839
        }
840
 
841
        #
842
        #   Filter output from the user
843
        #
844
        s~(file [12]: )$view_path/~$1/~i;
845
        print FO $_;
846
    }
847
    close(CMD);
848
 
849
    #
850
    #   Ensure the section ends with a complete line
851
    #   An extra line doesn't affect CS parsing, but without it any file
852
    #   without a trailing \n will kill the header parsing
853
    #
854
    print FO "\n" if($header_seen);
855
 
856
    return $header_seen, $identical;
857
}
858
 
247 dpurdie 859
 
227 dpurdie 860
#-------------------------------------------------------------------------------
861
# Function        : ClearCmd
862
#
863
# Description     : Execute a cleartool command
864
#                   Capture error messages only
865
#
866
# Inputs          : Command to execute
867
#
868
# Returns         : Exit code
869
#                   Also the global @error_list
870
#
871
sub ClearCmd
872
{
241 dpurdie 873
    my $cmd = QuoteCommand( @_ );
874
 
875
    @error_list = ();    
876
    open(CMD, "cleartool $cmd  2>&1 |")    || Error "can't run command: $!";
877
    while (<CMD>)
878
    {
247 dpurdie 879
        s~[\n\r]+$~~;
880
        Verbose2 ($_);
881
        push @error_list, $_ if ( m~Error:~ );
241 dpurdie 882
    }
883
    close(CMD);
227 dpurdie 884
 
247 dpurdie 885
    Verbose2 ("ClearCmd: Exit Status: $?");
886
 
241 dpurdie 887
    return ($?) / 256;
227 dpurdie 888
}
889
 
247 dpurdie 890
 
227 dpurdie 891
#-------------------------------------------------------------------------------
892
# Function        : LocateLabel
893
#
241 dpurdie 894
# Description     : Determine the VOBs that contains the specified label
227 dpurdie 895
#
896
# Inputs          : $label  - Label to locate
897
#
241 dpurdie 898
# Returns         : First VOB that contains the label
227 dpurdie 899
#
900
sub LocateLabel
901
{
902
    my ($label) = @_;
903
 
904
    Message ("Locate label in VOB: $label" );
247 dpurdie 905
 
227 dpurdie 906
    my $found = 0;
907
    foreach my $vob ( @ROOT_VOBS )
908
    {
241 dpurdie 909
        $vob = $UNIX_VOB_PREFIX . $vob if ( $UNIX && $vob !~ m~^${UNIX_VOB_PREFIX}~ );
227 dpurdie 910
        (my $vob_name = $vob) =~ s~/~$VOB_SEP~g;
911
 
247 dpurdie 912
        Verbose ("Examine label $label in vob: $vob" );
227 dpurdie 913
 
914
        my $cmd = "cleartool lstype \"lbtype:$label\@$vob_name\"";
247 dpurdie 915
 
227 dpurdie 916
        open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
917
        while (<CMD>)
918
        {
919
            #
920
            #   Filter output from the user
921
            #
247 dpurdie 922
            s~[\n\r]+$~~;
241 dpurdie 923
            Verbose2 ("lstype: $_");
227 dpurdie 924
            next if ( m~Error~ );
925
            next unless ( m~label type~ );
926
            $found = $vob;
247 dpurdie 927
 
227 dpurdie 928
            last;
929
        }
247 dpurdie 930
        while( <CMD> ){} # Get rid of broken pipe messages
227 dpurdie 931
        close(CMD);
932
        last if ( $found );
933
    }
934
 
935
    Error ("Label $label not found in @ROOT_VOBS")
936
        unless ( $found );
937
 
938
    Verbose ("Label $label found in $found");
939
    return $found;
940
}
941
 
942
 
943
#-------------------------------------------------------------------------------
944
# Function        : element0
945
#
946
# Description     : Given a branch version, this function will return the
947
#                   zero-th element on the branch
948
#
949
#                   ie: /DPG_SWBase/file@@some_branch/12
950
#                   ->  /DPG_SWBase/file@@some_branch/0
951
#
952
# Inputs          : $element
953
#
954
# Returns         : as described
955
#
247 dpurdie 956
sub element0($)
227 dpurdie 957
{
958
    my ($element) = @_;
247 dpurdie 959
    $element =~ s~/\d+$~/0~;
227 dpurdie 960
    return $element;
961
}
962
 
247 dpurdie 963
 
227 dpurdie 964
#-------------------------------------------------------------------------------
247 dpurdie 965
# Function        : massage_path
227 dpurdie 966
#
247 dpurdie 967
# Description     : Massage the user directory, if specified, such that
968
#                   it describes the root of the vob.
227 dpurdie 969
#
247 dpurdie 970
# Inputs          : $oldLabelVob
971
#                   $oldDirectory
972
#                 : $newLabelVob
973
#                   $newDirectory
227 dpurdie 974
#
247 dpurdie 975
# Returns         : Modifies $newDirectory or $oldDirectory
227 dpurdie 976
#
247 dpurdie 977
#
978
sub massage_path($\$$\$)
227 dpurdie 979
{
247 dpurdie 980
    my ($oldLabelVob, $oldDirectory, $newLabelVob, $newDirectory ) = @_;
227 dpurdie 981
 
982
    #
247 dpurdie 983
    #   If the user is comparing two labels, then there is nothing to do
227 dpurdie 984
    #
247 dpurdie 985
    return unless ( $$newDirectory || $$oldDirectory );
986
 
987
    #
988
    #   Figure out which ones to use
989
    #
990
    my $vob = $$newDirectory ? $oldLabelVob : $newLabelVob;
991
    my $directory = $$newDirectory ? $newDirectory : $oldDirectory;
992
 
993
    #
994
    #   Walk up the directory until we find the vob root
995
    #   The vob has a leading /
996
    #
997
    my $dir = $$directory;
261 dpurdie 998
    my $absdir = AbsPath($dir);
999
    while ( $absdir )
227 dpurdie 1000
    {
261 dpurdie 1001
        if ( $absdir =~ m{(.*)\Q$vob\E$} )
247 dpurdie 1002
        {
261 dpurdie 1003
            Verbose ("Massaged path to: $absdir");
247 dpurdie 1004
            return;
1005
        }
261 dpurdie 1006
        last unless ($absdir =~ s{/[^/]+$}{});
227 dpurdie 1007
    }
247 dpurdie 1008
    Error ("Could not find vob root in user directory",
1009
           "Vob Root: $vob",
1010
           "Path : $dir");
227 dpurdie 1011
 
1012
}
1013
 
1014
#-------------------------------------------------------------------------------
1015
#   Documentation
1016
#
1017
 
1018
=pod
1019
 
361 dpurdie 1020
=for htmltoc    GENERAL::ClearCase::
1021
 
227 dpurdie 1022
=head1 NAME
1023
 
1024
CCdiff - ClearCase Difference Report
1025
 
1026
=head1 SYNOPSIS
1027
 
247 dpurdie 1028
jats CCdiff [options] [old-label new-label]
227 dpurdie 1029
 
247 dpurdie 1030
Options:
227 dpurdie 1031
 
247 dpurdie 1032
  -help              - brief help message
1033
  -help -help        - Detailed help message
1034
  -man               - Full documentation
1035
  -old=label         - Old label (or dir=path)
1036
  -new=label         - New label (or dir=path)
1037
  -output=file       - Output filename
1038
  -vob=name          - Vob for labels
1039
  -drive=path        - Alternate vob location
1040
  -[no]massage       - Massage the user path [default]
1041
 
227 dpurdie 1042
=head1 OPTIONS
1043
 
1044
=over 8
1045
 
1046
=item B<-help>
1047
 
1048
Print a brief help message and exits.
1049
 
1050
=item B<-help -help>
1051
 
1052
Print a detailed help message with an explanation for each option.
1053
 
1054
=item B<-man>
1055
 
1056
Prints the manual page and exits.
1057
 
1058
=item B<-old=label>
1059
 
1060
This option specifies the old, or base, label for the difference report. This
251 dpurdie 1061
option is optional for the difference report. If not provided then a one-sided
1062
difference report will be generated. This is of use for new packages.
227 dpurdie 1063
 
247 dpurdie 1064
The old and new labels may be provided on the command line, or via named
1065
options, but not both.
1066
 
1067
The label may be of the form dir=path to force the utility to use a local
1068
view or path, within a cleacsae view.
1069
 
227 dpurdie 1070
=item B<-new=label>
1071
 
1072
This option specifies the new, or current, label for the difference report. This
1073
label is mandatory for the difference report.
1074
 
1075
The old and new labels may be provided on the command line, or via named
1076
options, but not both.
1077
 
247 dpurdie 1078
The label may be of the form dir=path to force the utility to use a local
1079
clearcase view. The utility understands:
1080
 
1081
=over 8
1082
 
361 dpurdie 1083
=item *
247 dpurdie 1084
 
361 dpurdie 1085
-new=dir=some_path  and dir=some_path
247 dpurdie 1086
 
361 dpurdie 1087
=item *
247 dpurdie 1088
 
361 dpurdie 1089
-new=dir=current and dir=current
1090
 
1091
=item *
1092
 
1093
-new=current and current
1094
 
247 dpurdie 1095
=back
1096
 
1097
The utiliity cannot compare two directories. It can only compare a directory
1098
against a labeled version. It will adjust the user-provided path to backtrack
1099
to the root of the view. The comparision is not limited to the specified
1100
sub-tree; it will always be the complete view.
1101
 
1102
All files within the view directory must be checked in. The utility will not
1103
process the directory if any files or directories are checkedout. The utility
1104
will ignore files that are not version controlled.
1105
 
227 dpurdie 1106
=item B<-vob=name>
1107
 
1108
This option limits the label search to the specified VOB. This option may be
1109
needed if the labels are to be found in multiple VOBs.
1110
 
1111
This option may be used multiple times. All specified vobs will be searched and
1112
the first one containing the label will be used.
1113
 
1114
=item B<-output=file>
1115
 
1116
This option specifies the output filename. The program will generate an output
1117
file based on the two source labels.
1118
 
1119
=item B<-drive=path>
1120
 
1121
This option allows the user to provide an alternate location for the
1122
administration vob used by the program. The default location is:
1123
 
247 dpurdie 1124
=item B<-[no]massage>
1125
 
1126
If the user has provided a directory path, then it will be massaged such that
1127
the comparison will include the entire VOB.
1128
 
1129
The default operation is to massage the path. This can be suppressed if required.
1130
 
227 dpurdie 1131
=over 8
1132
 
361 dpurdie 1133
=item *
227 dpurdie 1134
 
361 dpurdie 1135
Windows o:
227 dpurdie 1136
 
361 dpurdie 1137
=item *
1138
 
1139
Unix /view
1140
 
227 dpurdie 1141
=back
1142
 
247 dpurdie 1143
=back
1144
 
227 dpurdie 1145
=head1 DESCRIPTION
1146
 
1147
This program is the primary tool for creating 'diff' reports to be uploaded to
1148
Code Striker.
1149
 
1150
The program will determine the files that are different between the two specified
1151
labels. It will determine full pathnames for the files and create a difference
1152
report that is suitable for Code Striker.
1153
 
1154
The program uses a global administration view for the purposes of determining
1155
file versions. The path names that are generated are full vob-extended pathnames.
1156
These may be very long and may not be directly usable under windows.
1157
 
1158
=cut
1159