Subversion Repositories DevTools

Rev

Rev 233 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 233 Rev 241
Line 5... Line 5...
5 
# Module type   : Makefile system
 5 
# Module type   : Makefile system
6 
# Compiler(s)   : n/a
 6 
# Compiler(s)   : n/a
7 
# Environment(s): JATS. This script is designed to be run under JATS
 7 
# Environment(s): JATS. This script is designed to be run under JATS
8 
#
 8 
#
9 
# Description   : Make ClearCase difference report suitable for uploading
 9 
# Description   : Make ClearCase difference report suitable for uploading
10 
#                 to Code Stricker.
 10 
#                 to Code Striker.
11 
#......................................................................#
 11 
#......................................................................#
12 
 
 12 
 
13 
require 5.6.1;
 13 
require 5.6.1;
14 
use strict;
 14 
use strict;
15 
use warnings;
 15 
use warnings;
16 
use JatsError;
 16 
use JatsError;
17 
use JatsSystem;
 17 
use JatsSystem;
18 
use Pod::Usage;                             # required for help support
 18 
use Pod::Usage;                             # required for help support
- 
 
 19 
use Cwd;
- 
 
 20 
 
19 
use Getopt::Long;
 21 
use Getopt::Long;
20 
 
 22 
 
- 
 
 23 
#-------------------------------------------------------------------------------
- 
 
 24 
#
- 
 
 25 
#  Function Prototypes
- 
 
 26 
#
- 
 
 27 
sub prevElement($);
- 
 
 28 
sub get_newFiles();
- 
 
 29 
sub get_prev_viewname();
- 
 
 30 
sub get_workingDirectory();
- 
 
 31 
 
- 
 
 32 
#-------------------------------------------------------------------------------
- 
 
 33 
#
- 
 
 34 
#  Global variables
- 
 
 35 
#
21 
my $VERSION = "1.0.0";                      # Update this
 36 
my $VERSION = "1.0.1";                      # Update this
22 
 
 37 
 
23 
 
 38 
 
24 
#
 39 
#
25 
#   Globals - Provided by the JATS environment
 40 
#   Globals - Provided by the JATS environment
26 
#
 41 
#
Line 48... Line 63...
48 
my $VOB_SEP         = $UNIX ? '/' : '\\';
 63 
my $VOB_SEP         = $UNIX ? '/' : '\\';
49 
my $view_path;
 64 
my $view_path;
50 
my @view_tags;
 65 
my @view_tags;
51 
my %files;
 66 
my %files;
52 
my %diffs;
 67 
my %diffs;
- 
 
 68 
( my $startDirectory = getcwd() ) =~ s/[\n\r]+$//;
53 
 
 69 
 
54 
#
 70 
#
55 
#   ROOT_VOBS is a list of VOBS too look in first
 71 
#   ROOT_VOBS is a list of VOBS too look in first
56 
#   If a label is not found in these vobs, then the program will
 72 
#   If a label is not found in these vobs, then the program will
57 
#   look in all vobs. This list is a hint to speed up searching
 73 
#   look in all vobs. This list is a hint to speed up searching
Line 115... Line 131...
115 
}
 131 
}
116 
 
 132 
 
117 
#
 133 
#
118 
#   Error check the user arguments
 134 
#   Error check the user arguments
119 
#
 135 
#
120 
 
 - 
 
121 
Error ("Need to provide the 'new' label")
 136 
Error ("Need to provide the 'new' label")
122 
    unless ( $opt_new_label );
 137 
    unless ( $opt_new_label );
123 
 
 138 
 
124 
Error ("Too many command line arguments" )
 139 
Error ("Too many command line arguments" )
125 
    unless ( $#ARGV < 0 );
 140 
    unless ( $#ARGV < 0 );
126 
 
 141 
 
127 
#
 142 
#
- 
 
 143 
# $workingDirectory is only used if compareWithDirectory == 1, which is
- 
 
 144 
# only true when user has specified that -new points to a directory
- 
 
 145 
#
- 
 
 146 
my ( $workingDirectory, $compareWithDirectory ) = get_workingDirectory ();
- 
 
 147 
 
- 
 
 148 
#
128 
#   Generate a default ouput put file name
 149 
#   Generate a default ouput put file name
129 
#
 150 
#
130 
unless ( $opt_outfile )
 151 
unless ( $opt_outfile )
131 
{
 152 
{
132 
    if ( $opt_old_label )
 153 
    if ( $opt_old_label )
Line 136... Line 157...
136 
    else
 157 
    else
137 
    {
 158 
    {
138 
        $opt_outfile = "${opt_new_label}-diff.txt";
 159 
        $opt_outfile = "${opt_new_label}-diff.txt";
139 
    }
 160 
    }
140 
}
 161 
}
141 
Verbose ("Outout file: $opt_outfile");
 162 
Verbose ("Output file: $opt_outfile");
142 
 
 163 
 
143 
#
 164 
#
144 
#   Determine the machine type
 165 
#   Determine the machine type
145 
#
 166 
#
146 
Verbose ("Machine Type: UNIX=$UNIX");
 167 
Verbose ("Machine Type: UNIX=$UNIX");
Line 154... Line 175...
154 
 
 175 
 
155 
#
 176 
#
156 
#   Ensure that the 'administration_view' is availalable
 177 
#   Ensure that the 'administration_view' is availalable
157 
#   Then start the view, before checking its availability
 178 
#   Then start the view, before checking its availability
158 
#
 179 
#
159 
if ( ClearCmd ( "lsview $opt_viewname" ) )
 180 
if( ClearCmd('lsview', $opt_viewname) )
160 
{
 181 
{
161 
    Error ("Required view not found: $opt_viewname",
 182 
    Error ("Required view not found: $opt_viewname",
162 
           "This is a dynamic view that should exist as it is used by the build system"
 183 
           "This is a dynamic view that should exist as it is used by the build system"
163 
          );
 184 
          );
164 
}
 185 
}
165 
 
 186 
 
- 
 
 187 
#
- 
 
 188 
# Under windows if user is comparing with a directory you need knowledge of under
- 
 
 189 
# what view the command was invoked with
- 
 
 190 
#
- 
 
 191 
#my $prev_viewname = "";
- 
 
 192 
#$prev_viewname = get_prev_viewname() if( $compareWithDirectory && ! $UNIX );
- 
 
 193 
 
166 
if ( ClearCmd ( "startview $opt_viewname" ) )
 194 
if( ClearCmd( 'startview', $opt_viewname) )
167 
{
 195 
{
168 
    Error ("Cannot start the required view: $opt_viewname");
 196 
    Error ("Cannot start the required view: $opt_viewname");
169 
}
 197 
}
170 
 
 198 
 
171 
$view_path = "$opt_drive/$opt_viewname";
 199 
$view_path = "$opt_drive/$opt_viewname";
Line 187... Line 215...
187 
    @ROOT_VOBS = ();
 215 
    @ROOT_VOBS = ();
188 
    foreach my $vob ( @opt_vobs )
 216 
    foreach my $vob ( @opt_vobs )
189 
    {
 217 
    {
190 
        $vob = '/' . $vob;
 218 
        $vob = '/' . $vob;
191 
        $vob =~ s~^$UNIX_VOB_PREFIX~~ if ($UNIX);
 219 
        $vob =~ s~^$UNIX_VOB_PREFIX~~ if ($UNIX);
192 
        $vob =~ tr~\\/~/~s;
 220 
        $vob =~ tr{\\/}{/}s;
193 
        push @ROOT_VOBS, $vob;
 221 
        push @ROOT_VOBS, $vob;
194 
    }
 222 
    }
195 
}
 223 
}
196 
else
 224 
else
197 
{
 225 
{
Line 200... Line 228...
200 
    while (<CMD>)
 228 
    while (<CMD>)
201 
    {
 229 
    {
202 
        #
 230 
        #
203 
        #   Filter output from the user
 231 
        #   Filter output from the user
204 
        #
 232 
        #
205 
        chomp;
 233 
        s~[\n\r]+$~~;
206 
        s~^$UNIX_VOB_PREFIX~~ if ($UNIX);
 234 
        s~^$UNIX_VOB_PREFIX~~ if ($UNIX);
207 
        Verbose2("lsvob: $_");
 235 
        Verbose2("lsvob: $_");
208 
        tr~\\/~/~s;
 236 
        tr{\\/}{/}s;
209 
        push @ROOT_VOBS, $_;
 237 
        push @ROOT_VOBS, $_;
210 
    }
 238 
    }
211 
    close(CMD);
 239 
    close(CMD);
212 
}
 240 
}
213 
 
 241 
 
Line 218... Line 246...
218 
my $l2_vob = LocateLabel( $opt_new_label);
 246 
my $l2_vob = LocateLabel( $opt_new_label);
219 
 
 247 
 
220 
#
 248 
#
221 
#   Locate all files for the two labels
 249 
#   Locate all files for the two labels
222 
#
 250 
#
223 
files_from_from_view( $l1_vob, ,$opt_old_label, 1 ) if $opt_old_label;;
 251 
files_from_view( $l1_vob, $opt_old_label, 1 ) if $opt_old_label;
224 
files_from_from_view( $l2_vob, ,$opt_new_label, 2 );
 252 
files_from_view( $l2_vob, $opt_new_label, 2 );
225 
 
 253 
 
226 
#DebugDumpData ("Files", \%files );
 254 
#DebugDumpData ("Files", \%files );
227 
 
 255 
 
228 
#
 256 
#
229 
#   Create a hash of files that are different
 257 
#   Create a hash of files that are different
Line 234... Line 262...
234 
{
 262 
{
235 
    #
 263 
    #
236 
    #   These files are the same
 264 
    #   These files are the same
237 
    #
 265 
    #
238 
    next if ( $files{$file}{1} && $files{$file}{2} );
 266 
    next if ( $files{$file}{1} && $files{$file}{2} );
239 
 
 267
240 
    my $tag = 1;
 268 
    my $tag = 1;
241 
    $tag = 2 if $files{$file}{2};
 269 
    $tag = 2 if $files{$file}{2};
242 
 
 270
243 
    #
 271 
    #
244 
    #   Break path into file and version
 272 
    #   Break path into file and version
245 
    #
 273 
    #
246 
    $file =~ m~(.*)(@@[^@]*$)~;
 274 
    $file =~ m~(.*)(@@[^@]*$)~;
247 
    my ($f,$b) = ($1,$2);
 275 
    my ($f,$b) = ($1,$2);
248 
    $diffs{$f}{$tag} = $file;
 276 
    $diffs{$f}{$tag} = $file;
249 
 
 - 
 
250 
#    print "$file\n";
 - 
 
251 
}
 277 
}
252 
 
 278 
 
253 
#
 279 
#
254 
#   Process files that are common, but have changed
 280 
#   Process files that are common, but have changed
255 
#
 281 
#
256 
my @no_text;
 282 
my @no_text;
257 
my $added = 0;
 283 
my $added = 0;
258 
my $deleted = 0;
 284 
my $deleted = 0;
259 
my $diffs = 0;
 285 
my $diffs = 0;
260 
my $funny = 0;
 286 
my $ifile = 0;
- 
 
 287 
 
261 
open (FO, ">", $opt_outfile) || Error ("Cannot open file: $opt_outfile");
 288 
open (FO, ">", "$startDirectory/$opt_outfile") || Error ("Cannot open file: $startDirectory/$opt_outfile");
- 
 
 289 
 
262 
foreach my $file ( sort keys %diffs )
 290 
foreach my $file ( sort keys %diffs )
263 
{
 291 
{
- 
 
 292 
    $ifile ++;
- 
 
 293 
 
- 
 
 294 
    print "Running ClearDiff on file $ifile/" . scalar(keys %diffs) . "            \r";
- 
 
 295 
 
264 
    my ($hs, $id, $type);
 296 
    my ($hs, $id, $type);
265 
    #
 297 
    #
266 
    #   Files are are common
 298 
    #   Files are are common
267 
    #
 299 
    #
268 
    if ( $diffs{$file}{1} && $diffs{$file}{2} )
 300 
    if ( $diffs{$file}{1} && $diffs{$file}{2} )
269 
    {
 301 
    {
270 
        $type = "different";
 302 
	$type = "different";
271 
        ($hs, $id) = ClearDiff("-serial_format", "-blank_ignore", $diffs{$file}{1}, $diffs{$file}{2});
 303 
	($hs, $id) = ClearDiff("-serial_format", "-blank_ignore", $diffs{$file}{1}, $diffs{$file}{2});
272 
        $diffs++ if ( $hs );
 304 
	$diffs++ if ( $hs );
273 
    }
 305 
    }
274 
    elsif ($diffs{$file}{1} )
 306 
    elsif ($diffs{$file}{1} )
275 
    {
 307 
    {
276 
        #
 308 
	#
277 
        #   File has been deleted
 309 
	#   File has been deleted
278 
        #
 310 
	#
279 
        $type = "deleted";
 311 
	$type = "deleted";
280 
        Message ("$file has been deleted");
 312 
	Verbose ("$file has been deleted");
281 
        ($hs, $id) = ClearDiff("-serial_format", $diffs{$file}{1}, element0($diffs{$file}{1}) );
 313 
	($hs, $id) = ClearDiff("-serial_format", $diffs{$file}{1}, element0($diffs{$file}{1}) );
282 
        $deleted++ if ( $hs );
 314 
	$deleted++ if ( $hs );
283 
    }
 315 
    }
284 
    else
 316 
    else
285 
    {
 317 
    {
286 
        #
 318 
	#
287 
        #   File has been added
 319 
	#   File has been added
288 
        #
 320 
	#
289 
        $type = "added";
 321 
	$type = "added";
- 
 
 322 
	if( $compareWithDirectory )
- 
 
 323 
	{
- 
 
 324 
	    my $cmd = QuoteCommand( 'cleartool', 'dump', $diffs{$file}{2} );
- 
 
 325 
 
- 
 
 326 
	    open( CMD, "$cmd 2>&1 |") or Error("can't run command: $!");
- 
 
 327 
	    <CMD>; # line 1 - blank
- 
 
 328 
	    <CMD>; # line 2 - clearcase filename and a code for it
- 
 
 329 
	    (my $basefilename = <CMD>) =~ s~[\n\r]+$~~; # line 3 is what we want
- 
 
 330 
	    while( <CMD> ){} # Get rid of broken pipe messages
- 
 
 331 
	    close( CMD );
- 
 
 332 
 
- 
 
 333 
	    $basefilename =~ s{@@.*}{}; # strip off the branch/version number
- 
 
 334 
#	    $basefilename = "${opt_drive}/${prev_viewname}${basefilename}" if( ! $UNIX );
- 
 
 335 
 
- 
 
 336 
	    ($hs, $id) = ClearDiff("-serial_format", $diffs{$file}{2}, $basefilename );
- 
 
 337 
	    $diffs++ if ( $hs );
- 
 
 338 
	}
- 
 
 339 
	else
- 
 
 340 
	{
290 
        ($hs, $id) = ClearDiff("-serial_format", element0($diffs{$file}{2}) , $diffs{$file}{2} );
 341 
	    ($hs, $id) = ClearDiff("-serial_format", element0($diffs{$file}{2}) , $diffs{$file}{2} );
291 
        $added++ if ( $hs );
 342 
	    $added++ if ( $hs );
- 
 
 343 
	}
292 
    }
 344 
    }
293 
 
 345 
 
294 
    $type = "identical"
 346 
    $type = "identical"
295 
        if ( $id  );
 347 
	if ( $id  );
296 
    $file = StripView($file);
 348 
    $file = StripView($file);
297 
    Message ("$type: $file" );
 349 
    Verbose ("$type: $file" );
- 
 
 350
- 
 
 351 
    push @no_text, $file unless ( $hs || $id );
- 
 
 352 
}
298 
 
 353 
 
- 
 
 354 
#
- 
 
 355 
# If comparing with a directory, do additional files that have been
- 
 
 356 
# added since the label
- 
 
 357 
#
- 
 
 358 
if( $compareWithDirectory )
- 
 
 359 
{
- 
 
 360 
    my @newFiles = get_newFiles();
- 
 
 361
299 
    unless ( $hs || $id )
 362 
    my ($hs, $id);
- 
 
 363 
    my $type = "added";
- 
 
 364 
 
- 
 
 365 
    Message ("Going to run cleardiff for new files") if( @newFiles );
- 
 
 366 
 
- 
 
 367 
    foreach my $newFile (@newFiles)
300 
    {
 368 
    {
301 
        push @no_text, $file;
 369 
	my $prev_element = prevElement($newFile);
- 
 
 370 
 
- 
 
 371 
	($hs, $id) = ClearDiff("-serial_format", $prev_element, $newFile );
302 
        $funny ++;
 372 
	$added++ if ( $hs );
- 
 
 373
- 
 
 374 
	$type = "identical" if ( $id  );
- 
 
 375 
	$newFile = StripView($newFile);
- 
 
 376 
	Verbose ("$type: $newFile" );
- 
 
 377
- 
 
 378 
	push @no_text, $newFile unless ( $hs || $id );
303 
    }
 379 
    }
304 
}
 380 
}
305 
close FO;
 - 
 
306 
 
 381 
 
307 
#
 382 
#
308 
#   Warn about problem files
 383 
#   Warn about problem files
309 
#
 384 
#
310 
if ( @no_text )
 385 
if ( @no_text )
Line 320... Line 395...
320 
             "Old Label:         : " . ( $opt_old_label ? $opt_old_label : '-None-') ,
 395 
             "Old Label:         : " . ( $opt_old_label ? $opt_old_label : '-None-') ,
321 
             "New Label:         : $opt_new_label",
 396 
             "New Label:         : $opt_new_label",
322 
             "Files different    : $diffs",
 397 
             "Files different    : $diffs",
323 
             "Files added        : $added",
 398 
             "Files added        : $added",
324 
             "Files deleted      : $deleted",
 399 
             "Files deleted      : $deleted",
325 
             "Files not in report: $funny",
 400 
             "Files not in report: " . scalar(@no_text),
326 
             "Output file        : $opt_outfile",
 401 
             "Output file        : $startDirectory/$opt_outfile",
327 
             );
 402 
             );
328 
 
 403 
 
329 
 
 404 
 
330 
#DebugDumpData ("Files", \%diffs);
 405 
#DebugDumpData ("Files", \%diffs);
331 
 
 406 
 
- 
 
 407 
close FO;
332 
exit (0);
 408 
exit (0);
333 
 
 409 
 
334 
#-------------------------------------------------------------------------------
 410 
#-------------------------------------------------------------------------------
- 
 
 411 
# Function        : get_workingDirectory
- 
 
 412 
#
- 
 
 413 
# Description     : Works out the working directory that should be used if the
- 
 
 414 
#                   user has specified that the 'new' label is really a directory
- 
 
 415 
#
- 
 
 416 
#
- 
 
 417 
# Inputs          :
- 
 
 418 
#
- 
 
 419 
# Returns         : $workingDirectory    - The directory to compare with
- 
 
 420 
#                   $compareWithDirectory - 1 (true) if the user has specified that
- 
 
 421 
#                                          a directory is to be compared
- 
 
 422 
#
- 
 
 423 
sub get_workingDirectory()
- 
 
 424 
{
- 
 
 425 
    return ("", 0) if( $opt_new_label !~ m/^dir=/ && $opt_new_label !~ m/^current/ );
- 
 
 426 
 
- 
 
 427 
    my $workingDirectory = "";
- 
 
 428 
 
- 
 
 429 
    $workingDirectory = $startDirectory
- 
 
 430 
	if ( $opt_new_label eq 'current' || $opt_new_label eq "dir=current" );
- 
 
 431
- 
 
 432 
    if ( $opt_new_label =~ m~^dir=(.+)~ || $opt_new_label =~ m~^current=(.+)~ )
- 
 
 433 
    {
- 
 
 434 
	my $wdir = $1;
- 
 
 435 
 
- 
 
 436 
	if( ! $UNIX && $wdir =~ m~^.:~ ) # on windows, directory has been specified as a full drive path
- 
 
 437 
	{
- 
 
 438 
	    $workingDirectory = $wdir;
- 
 
 439 
	}
- 
 
 440 
	elsif( $wdir =~ m~^/~ || ($wdir =~ m~^\\~ && ! $UNIX) ) # Full path on the current drive
- 
 
 441 
	{
- 
 
 442 
	    $workingDirectory = $wdir;
- 
 
 443 
	}
- 
 
 444 
	else # Relative path
- 
 
 445 
	{
- 
 
 446 
	    $workingDirectory = "$startDirectory/$wdir";
- 
 
 447 
	}
- 
 
 448 
    }
- 
 
 449 
 
- 
 
 450 
    Verbose ("working directory: '$workingDirectory'");
- 
 
 451 
 
- 
 
 452 
    Error("Could not find the directory '$workingDirectory'")
- 
 
 453 
	unless( -d $workingDirectory );
- 
 
 454 
 
- 
 
 455 
    chdir $workingDirectory or Error ("Could not chdir into '$workingDirectory'");
- 
 
 456 
 
- 
 
 457 
    # We go through the same algorithm in many parts as the
- 
 
 458 
    # no-minus-old algorithm, so to minimise code changes we just
- 
 
 459 
    # treat it the same with the addition of the '$compareWithDirectory' flag
- 
 
 460 
    # to execute additional code.
- 
 
 461 
    $opt_new_label = $opt_old_label;
- 
 
 462 
    $opt_old_label = "";
- 
 
 463 
 
- 
 
 464 
    return( $workingDirectory, 1);
- 
 
 465 
}
- 
 
 466 
 
- 
 
 467 
 
- 
 
 468 
#-------------------------------------------------------------------------------
- 
 
 469 
# Function        : prevElement
- 
 
 470 
#
- 
 
 471 
# Description     : Works out the element that should be compared with the
- 
 
 472 
#                   file in the working directory.
- 
 
 473 
#
- 
 
 474 
#
- 
 
 475 
# Inputs          : $newFile        - File found by cleartool ls'ing the
- 
 
 476 
#                                     working directory
- 
 
 477 
#
- 
 
 478 
# Returns         : $prevElement - the element to cleardiff on
- 
 
 479 
#
- 
 
 480 
sub prevElement($)
- 
 
 481 
{
- 
 
 482 
    my ( $newFile ) = @_;
- 
 
 483 
 
- 
 
 484 
    my $cmd = qq(cleartool find $newFile -directory -version "{lbtype($opt_new_label)}" -print);
- 
 
 485 
 
- 
 
 486 
    Verbose ("Cmd: '$cmd'");
- 
 
 487 
 
- 
 
 488 
    my $ret = "${newFile}@@/main/0";
- 
 
 489 
 
- 
 
 490 
    open( CMD, "$cmd 2>&1 |") or Error("can't run command: $!");
- 
 
 491 
    while( <CMD> )
- 
 
 492 
    {
- 
 
 493 
        s~[\n\r]+$~~;
- 
 
 494 
	next if( m/Error:/ || m/Warning:/ );
- 
 
 495 
	($ret = $_) =~ s{//}{/}g;
- 
 
 496 
	$ret =~ s{vobs/vobs/}{vobs/}g;
- 
 
 497 
	last;
- 
 
 498 
    }
- 
 
 499 
    while( <CMD> ){} # Get rid of broken pipe messages
- 
 
 500 
    close( CMD );
- 
 
 501 
 
- 
 
 502 
    return $ret;
- 
 
 503 
}
- 
 
 504 
 
- 
 
 505 
#-------------------------------------------------------------------------------
- 
 
 506 
# Function        : get_newFiles
- 
 
 507 
#
- 
 
 508 
# Description     : Calls 'cleartool ls -recurse' to get a list of clearcase
- 
 
 509 
#                   objects in the working directory that have been
- 
 
 510 
#                   checked in to clearcase only after the label was made
- 
 
 511 
#
- 
 
 512 
# Inputs          :
- 
 
 513 
#
- 
 
 514 
# Returns         : @newFiles - an array of files
- 
 
 515 
#
- 
 
 516 
sub get_newFiles()
- 
 
 517 
{
- 
 
 518 
    Message ("Determine clearcase file versions for: $workingDirectory");
- 
 
 519 
 
- 
 
 520 
    # Step 1: get list of files that are in the directory and in clearcase
- 
 
 521 
    my @candFiles = ();
- 
 
 522 
    {
- 
 
 523 
	my $cmd = QuoteCommand( 'cleartool', 'ls', '-recurse', $workingDirectory);
- 
 
 524 
	open( CMD, "$cmd 2>& 1 |") or Error("can't run command: $!");
- 
 
 525 
 
- 
 
 526 
	while( <CMD> )
- 
 
 527 
	{
- 
 
 528 
	    # Each line will be of the form (e.g.):
- 
 
 529 
	    # ./LIB/JatsMakeConfig.pm@@/main/4         Rule: core_devl_2.73.2000.cr
- 
 
 530 
 
- 
 
 531 
	    s~[\n\r]+$~~;
- 
 
 532 
	    next if( ! m/Rule:/ ); # We only want clearcase files - these will show with what rule
- 
 
 533 
	                           # they are in our view via some text like m/Rule: .*/.
- 
 
 534 
 
- 
 
 535 
	    (my $firstWord = $_) =~ s/^(\S+).*/$1/;
- 
 
 536 
	    my ( $candFile, $candFileVersion) = split(/@@/, $firstWord);
- 
 
 537 
 
- 
 
 538 
	    push @candFiles, $candFile;
- 
 
 539 
	}
- 
 
 540 
	close( CMD );
- 
 
 541 
    }
- 
 
 542 
 
- 
 
 543 
    my @newFiles = ();
- 
 
 544 
 
- 
 
 545 
    # Step 2: See whether each candidate file is in the 'old' label
- 
 
 546 
    # If not, then it is a new file that has been added since the label was created
- 
 
 547 
    my $icandFile = 0;
- 
 
 548 
    foreach my $candFile (@candFiles)
- 
 
 549 
    {
- 
 
 550 
	$icandFile ++;
- 
 
 551 
 
- 
 
 552 
	print "Running cleartool find on file $icandFile/" . scalar(@candFiles) . "           \r";
- 
 
 553 
 
- 
 
 554 
	my $isPartOfLabel = 0;
- 
 
 555 
 
- 
 
 556 
	# This command will return no output if file is not part of label, else
- 
 
 557 
	# some output if it is part of the label.  This provides an simple way of
- 
 
 558 
	# determining if the file is a new file that has been added since the label was created
- 
 
 559 
	my $cmd = qq(cleartool find $candFile -directory -version "{lbtype($opt_new_label)}" -print);
- 
 
 560 
 
- 
 
 561 
	Verbose ("Cmd: '$cmd'");
- 
 
 562 
	open( CMD, "$cmd 2>& 1 |") or Error("can't run command: $!");
- 
 
 563 
	$isPartOfLabel = 1 if( <CMD> );
- 
 
 564 
	while( <CMD> ){} # Get rid of broken pipe messages
- 
 
 565 
	close( CMD );
- 
 
 566 
 
- 
 
 567 
	push @newFiles, $candFile if( ! $isPartOfLabel );
- 
 
 568 
    }
- 
 
 569 
 
- 
 
 570 
    return @newFiles;
- 
 
 571 
}
- 
 
 572 
 
- 
 
 573 
#-------------------------------------------------------------------------------
- 
 
 574 
# Function        : get_prev_viewname
- 
 
 575 
#
- 
 
 576 
# Description     : Works out the view in use when CCdiff.pl is invoked.
- 
 
 577 
#
- 
 
 578 
# Inputs          :
- 
 
 579 
#
- 
 
 580 
# Returns         : $prev_viewname
- 
 
 581 
#
- 
 
 582 
sub get_prev_viewname()
- 
 
 583 
{
- 
 
 584 
    my $cmd = "cleartool pwv";
- 
 
 585 
 
- 
 
 586 
    open( CMD, "$cmd 2>&1 |") or Error("can't run command: $!");
- 
 
 587 
    (my $firstline = <CMD>) =~ s~[\n\r]+$~~;
- 
 
 588 
    while( <CMD> ){} # Get rid of broken pipe messages
- 
 
 589 
    close( CMD );
- 
 
 590 
 
- 
 
 591 
    if( $firstline !~ /^Working directory view: / || $firstline =~ / NONE / )
- 
 
 592 
    {
- 
 
 593 
	Error ("Cannot determine current view name",
- 
 
 594 
	       "Path may not be a clearcase view");
- 
 
 595 
    }
- 
 
 596 
 
- 
 
 597 
    (my $prev_viewname = $firstline) =~ s/^Working directory view: (\S+).*/$1/;
- 
 
 598 
 
- 
 
 599 
    Verbose ("Previous viewname: '$prev_viewname'");
- 
 
 600 
    return $prev_viewname;
- 
 
 601 
}
- 
 
 602 
 
- 
 
 603 
 
- 
 
 604 
#-------------------------------------------------------------------------------
335 
# Function        : files_from_from_view
 605 
# Function        : files_from_view
336 
#
 606 
#
337 
# Description     : Determine the list of files/versions in a given view
 607 
# Description     : Determine the list of files/versions in a given view
338 
#
 608 
#
339 
# Inputs          : $vpath          - Path to the view
 609 
# Inputs          : $vpath          - Path to the view
340 
#                   $label          - Label
 610 
#                   $label          - Label
Line 342... Line 612...
342 
#
 612 
#
343 
# Returns         : Nothing
 613 
# Returns         : Nothing
344 
#                   Populates the %files array
 614 
#                   Populates the %files array
345 
#
 615 
#
346 
 
 616 
 
347 
sub files_from_from_view
 617 
sub files_from_view
348 
{
 618 
{
349 
    my ($vpath, $label, $tag) = @_;
 619 
    my ($vpath, $label, $tag) = @_;
350 
    my $cutlen = length ($vpath );
 620 
    my $cutlen = length ($vpath );
351 
    Message("Determine file versions for: $label");
 621 
    Message ("Determine file versions for label: $label");
352 
 
 622 
 
353 
    #
 623 
    #
354 
    #   Ensure that the VOB is mounted
 624 
    #   Ensure that the VOB is mounted
355 
    #   The mount command MUST have the correct vob format
 625 
    #   The mount command MUST have the correct vob format
356 
    #
 626 
    #
357 
    my $vob = $vpath;
 627 
    my $vob = $vpath;
358 
    $vob =~ s~^/+~~;
 628 
    $vob =~ s~^/+~~;
359 
    $vob = $VOB_SEP . $vob;
 629 
    $vob = $VOB_SEP . $vob;
360 
    ClearCmd ("mount $vob" );
 630 
    ClearCmd ('mount',$vob);
361 
 
 631 
 
362 
 
 - 
 
363 
    my $cmd = "cleartool find $opt_drive/$opt_viewname/$vpath -all -follow -type f -element \"lbtype_sub($label)\" -version \"lbtype_sub($label)\" -print";
 632 
    my $cmd = qq(cleartool find "$opt_drive/$opt_viewname/$vpath" -all -follow -type f -element "lbtype_sub($label)" -version "lbtype_sub($label)" -print);
364 
    Verbose ("ClearTool: $cmd");
 633 
    Verbose ("ClearTool: $cmd");
- 
 
 634 
 
365 
    open(CMD, "$cmd 2>&1 |") || Error "Can't run command: $!";
 635 
    open(CMD, "$cmd 2>&1 |") || Error "Can't run command: $!";
366 
    while (<CMD>)
 636 
    while (<CMD>)
367 
    {
 637 
    {
368 
        print "Label$tag: $_" if $opt_verbose;
 638 
        Verbose( "Label$tag: $_");
369 
        my $file = $_;
 639 
        my $file = $_;
370 
        $file =~ s~[\r\n]+$~~;
 640 
        $file =~ s~[\n\r]+$~~;
371 
        $file =~ tr~\\/~/~s;
 641 
        $file =~ tr{\\/}{/}s;
372 
        $files{$file}{$tag} = 1;
 642 
        $files{$file}{$tag} = 1;
373 
    }
 643 
    }
374 
    close(CMD);
 644 
    close(CMD);
375 
    Verbose2 "ClearTool Exit Status: $?";
 645 
    Verbose2 ("ClearTool Exit Status: $?");
- 
 
 646 
 
- 
 
 647 
    Message ("There are " . scalar(keys %files) . " files in label $label");
376 
}
 648 
}
377 
 
 649 
 
378 
#-------------------------------------------------------------------------------
 650 
#-------------------------------------------------------------------------------
379 
# Function        : ClearDiff
 651 
# Function        : ClearDiff
380 
#
 652 
#
Line 388... Line 660...
388 
#
 660 
#
389 
sub ClearDiff
 661 
sub ClearDiff
390 
{
 662 
{
391 
    my $header_seen = 0;
 663 
    my $header_seen = 0;
392 
    my $identical = 0;
 664 
    my $identical = 0;
393 
    my $cmd = "cleardiff " . QuoteCommand (@_);
 665 
    my $cmd = QuoteCommand("cleardiff", @_);
- 
 
 666 
 
- 
 
 667 
    Verbose ("ClearDiff: $cmd");
394 
 
 668 
 
395 
    Verbose ("ClearDiff: $cmd");
 - 
 
396 
    open(CMD, "$cmd 2>&1 |") || Error "can't run command: $!";
 669 
    open(CMD, "$cmd 2>&1 |") || Error "can't run command: $!";
- 
 
 670 
 
397 
    while (<CMD>)
 671 
    while (<CMD>)
398 
    {
 672 
    {
399 
        $header_seen = 1
 673 
        $header_seen = 1
400 
            if ( m~^[*]{32}~ );
 674 
            if ( m~^[*]{32}~ );
401 
        unless ( $header_seen )
 675 
        unless ( $header_seen )
402 
        {
 676 
        {
403 
            if ( m~^Files are identical~ )
 677 
	    $identical = 1 if ( m~^Files are identical~ );
404 
            {
 - 
 
405 
                $identical = 1;
 - 
 
406 
                next;
 - 
 
407 
            }
 - 
 
408 
            next;
 678 
            next;
409 
        }
 679 
        }
410 
 
 680 
 
411 
        #
 681 
        #
412 
        #   Filter output from the user
 682 
        #   Filter output from the user
Line 421... Line 691...
421 
    #   An extra line doesn't affect CS parsing, but without it any file
 691 
    #   An extra line doesn't affect CS parsing, but without it any file
422 
    #   without a trailing \n will kill the header parsing
 692 
    #   without a trailing \n will kill the header parsing
423 
    #
 693 
    #
424 
    print FO "\n" if($header_seen);
 694 
    print FO "\n" if($header_seen);
425
695
426 
    Verbose "ClearDiff Exit Status: $?";
 696 
    Verbose ("ClearDiff Exit Status: $?");
427 
 
 697 
 
428 
    return $header_seen, $identical;
 698 
    return $header_seen, $identical;
429 
}
 699 
}
430 
 
 700 
 
431 
#-------------------------------------------------------------------------------
 701 
#-------------------------------------------------------------------------------
Line 439... Line 709...
439 
# Returns         : Exit code
 709 
# Returns         : Exit code
440 
#                   Also the global @error_list
 710 
#                   Also the global @error_list
441 
#
 711 
#
442 
sub ClearCmd
 712 
sub ClearCmd
443 
{
 713 
{
444 
    my( $cmd ) = @_;
 714 
    my $cmd = QuoteCommand( @_ );
- 
 
 715
445 
    Verbose "cleartool $cmd";
 716 
    Verbose ("cleartool $cmd");
446 
 
 717 
 
447 
        @error_list = ();
 718 
    @error_list = ();
448 
        open(CMD, "cleartool $cmd  2>&1 |")    || Error "can't run command: $!";
 719 
    open(CMD, "cleartool $cmd  2>&1 |")    || Error "can't run command: $!";
449 
        while (<CMD>)
 720 
    while (<CMD>)
450 
        {
 721 
    {
451 
            chomp;
 722 
	s~[\n\r]+$~~;
452 
            Verbose2 ($_);
 723 
	Verbose2 ($_);
453 
            push @error_list, $_ if ( m~Error:~ );
 724 
	push @error_list, $_ if ( m~Error:~ );
454 
        }
 725 
    }
455 
        close(CMD);
 726 
    close(CMD);
456 
 
 727 
 
457 
    Verbose2 "Exit Status: $?";
 728 
    Verbose2 ("Exit Status: $?");
458 
    return $? / 256;
 729 
    return ($?) / 256;
459 
}
 730 
}
460 
 
 731 
 
461 
#-------------------------------------------------------------------------------
 732 
#-------------------------------------------------------------------------------
462 
# Function        : LocateLabel
 733 
# Function        : LocateLabel
463 
#
 734 
#
464 
# Description     : Determine the VOBs that conatins the specified label
 735 
# Description     : Determine the VOBs that contains the specified label
465 
#
 736 
#
466 
# Inputs          : $label  - Label to locate
 737 
# Inputs          : $label  - Label to locate
467 
#
 738 
#
468 
# Returns         : First VOB that conatins the label
 739 
# Returns         : First VOB that contains the label
469 
#
 740 
#
470 
sub LocateLabel
 741 
sub LocateLabel
471 
{
 742 
{
472 
    my ($label) = @_;
 743 
    my ($label) = @_;
473 
 
 744 
 
474 
    Message ("Locate label in VOB: $label" );
 745 
    Message ("Locate label in VOB: $label" );
475 
    Verbose("Ensure Label is found in a VOB");
 746 
    Verbose ("Ensure Label is found in a VOB");
476 
    my $found = 0;
 747 
    my $found = 0;
477 
    foreach my $vob ( @ROOT_VOBS )
 748 
    foreach my $vob ( @ROOT_VOBS )
478 
    {
 749 
    {
479 
        $vob = $UNIX_VOB_PREFIX . $vob if ( $UNIX );
 750 
        $vob = $UNIX_VOB_PREFIX . $vob if ( $UNIX && $vob !~ m~^${UNIX_VOB_PREFIX}~ );
480 
        (my $vob_name = $vob) =~ s~/~$VOB_SEP~g;
 751 
        (my $vob_name = $vob) =~ s~/~$VOB_SEP~g;
481 
 
 752 
 
482 
        Verbose2 ("Examine label $label in vob: $vob" );
 753 
        Verbose2 ("Examine label $label in vob: $vob" );
483 
 
 754 
 
484 
        my $cmd = "cleartool lstype \"lbtype:$label\@$vob_name\"";
 755 
        my $cmd = "cleartool lstype \"lbtype:$label\@$vob_name\"";
Line 486... Line 757...
486 
        while (<CMD>)
 757 
        while (<CMD>)
487 
        {
 758 
        {
488 
            #
 759 
            #
489 
            #   Filter output from the user
 760 
            #   Filter output from the user
490 
            #
 761 
            #
491 
            chomp;
 762 
	    s~[\n\r]+$~~;
492 
            Verbose2("lstype: $_");
 763 
            Verbose2 ("lstype: $_");
493 
            next if ( m~Error~ );
 764 
            next if ( m~Error~ );
494 
            next unless ( m~label type~ );
 765 
            next unless ( m~label type~ );
495 
            $found = $vob;
 766 
            $found = $vob;
496 
            last;
 767 
            last;
497 
        }
 768 
        }
- 
 
 769 
	while( <CMD> ){} # Get rid of broken pipe messages
498 
        close(CMD);
 770 
        close(CMD);
499 
        last if ( $found );
 771 
        last if ( $found );
500 
    }
 772 
    }
501 
 
 773 
 
502 
    Error ("Label $label not found in @ROOT_VOBS")
 774 
    Error ("Label $label not found in @ROOT_VOBS")
Line 521... Line 793...
521 
# Returns         : as described
 793 
# Returns         : as described
522 
#
 794 
#
523 
sub element0
 795 
sub element0
524 
{
 796 
{
525 
    my ($element) = @_;
 797 
    my ($element) = @_;
526 
    $element =~ s~/\d+$~/0~;
 798 
    $element =~ s{/\d+$}{/0};
527 
    return $element;
 799 
    return $element;
528 
}
 800 
}
529 
 
 801 
 
530 
#-------------------------------------------------------------------------------
 802 
#-------------------------------------------------------------------------------
531 
# Function        : StripView
 803 
# Function        : StripView
Line 570... Line 842...
570 
 Options:
 842 
 Options:
571 
    -help              - brief help message
 843 
    -help              - brief help message
572 
    -help -help        - Detailed help message
 844 
    -help -help        - Detailed help message
573 
    -man               - Full documentation
 845 
    -man               - Full documentation
574 
    -old=label         - Old label (optional)
 846 
    -old=label         - Old label (optional)
575 
    -new=label         - New label (mandatory)
 847 
    -new=label         - New label (or dir=path) (mandatory)
576 
    -output=file       - Output filename
 848 
    -output=file       - Output filename
577 
    -vob=name          - Vob for labels
 849 
    -vob=name          - Vob for labels
578 
    -drive=path        - Alternate vob location
 850 
    -drive=path        - Alternate vob location
579 
 
 851 
 
580 
=head1 OPTIONS
 852 
=head1 OPTIONS
Line 601... Line 873...
601 
=item B<-new=label>
 873 
=item B<-new=label>
602 
 
 874 
 
603 
This option specifies the new, or current, label for the difference report. This
 875 
This option specifies the new, or current, label for the difference report. This
604 
label is mandatory for the difference report.
 876 
label is mandatory for the difference report.
605 
 
 877 
 
- 
 
 878 
The label may be of the form dir=path to force the utility to use a
- 
 
 879 
local view or path.  You may also use '-new=current', or -new=current=path,
- 
 
 880 
as in jats CCbc2.
- 
 
 881 
 
606 
The old and new labels may be provided on the command line, or via named
 882 
The old and new labels may be provided on the command line, or via named
607 
options, but not both.
 883 
options, but not both.
608 
 
 884 
 
609 
=item B<-vob=name>
 885 
=item B<-vob=name>
610 
 
 886