Subversion Repositories DevTools

Rev

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

Rev 255 Rev 309
Line 35... Line 35...
35 
#   Options
 35 
#   Options
36 
#
 36 
#
37 
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
 37 
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
38 
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
 38 
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
39 
my $opt_help = 0;
 39 
my $opt_help = 0;
40 
my $opt_manual = 0;
 - 
 
41 
my $opt_label;
 40 
my $opt_label;
42 
my $opt_replace;
 41 
my $opt_replace;
43 
my $opt_create;
 42 
my $opt_create;
44 
my $opt_lock;
 43 
my $opt_lock;
45 
my $opt_unlock;
 44 
my $opt_unlock;
Line 88... Line 87...
88 
# Description     :
 87 
# Description     :
89 
#
 88 
#
90 
# Inputs          :
 89 
# Inputs          :
91 
#
 90 
#
92 
my $result = GetOptions (
 91 
my $result = GetOptions (
93 
                "help+"         => \$opt_help,              # flag, multiple use allowed
 92 
                "help:+"        => \$opt_help,
94 
                "manual"        => \$opt_manual,            # flag
 93 
                "manual:3"      => \$opt_help,
95 
                "verbose+"      => \$opt_verbose,           # flag, multiple use allowed
 94 
                "verbose:+"     => \$opt_verbose,
96 
                "label"         => \$opt_label,             # Flag
 95 
                "label"         => \$opt_label,             # Flag
97 
                "replace"       => \$opt_replace,           # Flag
 96 
                "replace"       => \$opt_replace,           # Flag
98 
                "create"        => \$opt_create,            # Flag
 97 
                "create"        => \$opt_create,            # Flag
99 
                "lock"          => \$opt_lock,              # Flag
 98 
                "lock"          => \$opt_lock,              # Flag
100 
                "unlock"        => \$opt_unlock,            # Flag
 99 
                "unlock"        => \$opt_unlock,            # Flag
Line 127... Line 126...
127 
 
 126 
 
128 
#
 127 
#
129 
#   Process help and manual options
 128 
#   Process help and manual options
130 
#
 129 
#
131 
pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 || ! $result);
 130 
pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 || ! $result);
132 
pod2usage(-verbose => 1) if ($opt_help == 2 );
 131 
pod2usage(-verbose => 1) if ( $opt_help == 2 );
133 
pod2usage(-verbose => 2) if ($opt_manual || ($opt_help > 2));
 132 
pod2usage(-verbose => 2) if ( $opt_help > 2 );
134 
pod2usage(-verbose => 0, -message => "Version: $VERSION") if ( $#ARGV < 0 );
 133 
pod2usage(-verbose => 0, -message => "Version: $VERSION") if ( $#ARGV < 0 );
135 
 
 134 
 
136 
#
 135 
#
137 
#   Configure the error reporting process now that we have the user options
 136 
#   Configure the error reporting process now that we have the user options
138 
#
 137 
#
Line 284... Line 283...
284 
#   Process command
 283 
#   Process command
285 
#       Label files and directories
 284 
#       Label files and directories
286 
 
 285 
 
287 
if ( $opt_label || ( $opt_auto && ! $opt_clone ) )
 286 
if ( $opt_label || ( $opt_auto && ! $opt_clone ) )
288 
{
 287 
{
289 
    Verbose ("Label files and directories");
 - 
 
290 
    my $element0_count = 0;
 - 
 
291 
    my $label_error = 0;
 288 
    my $label_error;
292 
    my @label_these;
 - 
 
293 
    my @check_these;
 - 
 
294 
    my @parent_list;
 - 
 
295 
    my $checked_out_count_dir = 0;
 - 
 
296 
    my $checked_out_count = 0;
 - 
 
297 
    my $missing_file_count = 0;
 - 
 
298 
    my $is_symlink;
 - 
 
299 
    my @cmd_opt;
 289 
    my @cmd_opt;
- 
 
 290 
    my %info;
300 
    push @cmd_opt, "-replace" if ( $opt_replace );
 291 
    push @cmd_opt, "-replace" if ( $opt_replace );
301 
 
 292 
 
302 
    #
 293 
    #
- 
 
 294 
    #   Locate and label directories first
- 
 
 295 
    #   Label dirs before we locate files as it simplifies the process
- 
 
 296 
    #   of avoiding the current directory
- 
 
 297 
    #
- 
 
 298 
    determine_dirs_to_label(\%info);
- 
 
 299 
    DebugDumpData("Directory Data", \%info ) if (IsVerbose (2));
- 
 
 300 
    #
- 
 
 301 
    #   Label the directories
- 
 
 302 
    #
- 
 
 303 
    if ( @{$info{'dir_list'}}  )
- 
 
 304 
    {
- 
 
 305 
        print "Root : $info{'VobRoot'}\n";
- 
 
 306 
        foreach  ( @{$info{'dir_list'}} )
- 
 
 307 
        {
- 
 
 308 
            my $name = $_;
- 
 
 309 
            $name =~ s~^$info{'VobRoot'}/~~;
- 
 
 310 
            print "Label: $name\n";
- 
 
 311 
        }
- 
 
 312 
 
- 
 
 313 
        ClearCmd ("mklabel", @cmd_opt, $label, @{$info{'dir_list'}} ) unless $opt_test;
- 
 
 314 
        $label_error = 1
- 
 
 315 
            if ( display_error_list() );
- 
 
 316 
    }
- 
 
 317 
 
- 
 
 318 
    #
- 
 
 319 
    #   Locate and label files
- 
 
 320 
    #
- 
 
 321 
    determine_files_to_label( \%info );
- 
 
 322 
    DebugDumpData("File Data", \%info ) if (IsVerbose (2));
- 
 
 323 
 
- 
 
 324 
    #
- 
 
 325 
    #   Label required files
- 
 
 326 
    #   Only do a few at a time so as to limit the command line length
- 
 
 327 
    #
- 
 
 328 
    if ( @{$info{'label_list'}} )
- 
 
 329 
    {
- 
 
 330 
        print "Label: $_\n" foreach @{$info{'label_list'}};
- 
 
 331 
 
- 
 
 332 
        #
- 
 
 333 
        #   Process the labels in groups
- 
 
 334 
        #   The command line does have a finite length
- 
 
 335 
        #
- 
 
 336 
        my $base = 0;
- 
 
 337 
        my $num = $#{$info{'label_list'}};
- 
 
 338 
 
- 
 
 339 
        while ( $base <= $num )
- 
 
 340 
        {
- 
 
 341 
            my $end = $base + 10;
- 
 
 342 
            $end = $num if ( $end > $num );
- 
 
 343 
 
- 
 
 344 
            print ".";
- 
 
 345 
            ClearCmd ("mklabel", @cmd_opt, $label, @{$info{'label_list'}}[$base .. $end] ) unless ( $opt_test );
- 
 
 346 
            $label_error = 1
- 
 
 347 
                if ( display_error_list() );
- 
 
 348 
            $base = $end + 1;
- 
 
 349 
        }
- 
 
 350 
        print "\n";
- 
 
 351 
    }
- 
 
 352 
 
- 
 
 353 
    #
- 
 
 354 
    #   Generate warnings based on collected data
- 
 
 355 
    #
- 
 
 356 
    sub show_warning
- 
 
 357 
    {
- 
 
 358 
        my ($text, $element, $allowed) = @_;
- 
 
 359 
        $allowed = 0 unless ( $allowed );
- 
 
 360 
        my $count = scalar(@{$info{$element}});
- 
 
 361 
        print $text, ': ', $count, "\n"
- 
 
 362 
            if ( $count > $allowed );
- 
 
 363 
    }
- 
 
 364 
 
- 
 
 365 
    print "Exclude: $_\n" foreach @{$info{'exclude_list'}};
- 
 
 366 
    print "Exclude(/main/0): $_\n" foreach @{$info{'element0_list'}};
- 
 
 367 
    print "Missing File: $_\n" foreach @{$info{'missing_files'}};
- 
 
 368 
 
- 
 
 369 
    print        ("Labels applied:", scalar(@{$info{'label_list'}}) + scalar(@{$info{'dir_list'}}), "\n" );
- 
 
 370 
    show_warning ("WARNING: Labels applied to checked out parent directories", 'checked_out_pdirs' );
- 
 
 371 
    show_warning ("WARNING: Labels applied to checked out files", 'checked_out_files' );
- 
 
 372 
    show_warning ("WARNING: Labels applied to checked out dirs", 'checked_out_dirs' );
- 
 
 373 
    show_warning ("WARNING: Labels NOT applied to missing files", 'missing_files' );
- 
 
 374 
    show_warning ("WARNING: Labels NOT applied to element-0 of files", 'element0_list' );
- 
 
 375 
    print        ("WARNING: Path to the VOB root contains a symbolic link. Labeling incomplete") if ( $info{'is_symlink'} );
- 
 
 376 
    show_warning ("WARNING: Multiple build.pl files labeled", 'build_files', 1 );
- 
 
 377 
 
- 
 
 378 
    Error ("Program Terminated") if ( $label_error );
- 
 
 379 
 
- 
 
 380 
    #
- 
 
 381 
    #   Double check the label process
- 
 
 382 
    #   We are seeing issues with ClearCase where a file, or dir, is not being
- 
 
 383 
    #   labeled. The following is a quick check. See if there is any thing to
- 
 
 384 
    #   label again
- 
 
 385 
    #
- 
 
 386 
    %info = ();
- 
 
 387 
    determine_dirs_to_label ( \%info );
- 
 
 388 
    determine_files_to_label( \%info );
- 
 
 389 
    if ( @{$info{'dir_list'}}  || @{$info{'label_list'}} )
- 
 
 390 
    {
- 
 
 391 
        DebugDumpData("DoubleCheck Data", \%info );
- 
 
 392 
        Error ('ClearCase label problem detected',
- 
 
 393 
               'Please report to david.purdie@vix-erg.com',
- 
 
 394 
               'Directories and Files not labled as requested:',
- 
 
 395 
               @{$info{'dir_list'}},
- 
 
 396 
               @{$info{'label_list'}}
- 
 
 397 
               );
- 
 
 398 
    }
- 
 
 399 
 
- 
 
 400 
 
- 
 
 401 
    $opr_done = 1;
- 
 
 402 
}
- 
 
 403 
 
- 
 
 404 
#-------------------------------------------------------------------------------
- 
 
 405 
#   Process command
- 
 
 406 
#       Clone
- 
 
 407 
if ( $opt_clone )
- 
 
 408 
{
- 
 
 409 
    Verbose ("Clone Label");
- 
 
 410 
    my @cmd_opt;
- 
 
 411 
    push @cmd_opt, "-all" if ($opt_all);
- 
 
 412 
 
- 
 
 413 
    my @cmd2_opt;
- 
 
 414 
    push @cmd2_opt, "-replace" if ( $opt_replace );
- 
 
 415 
 
- 
 
 416 
    my $count = 0;
- 
 
 417 
    my $checked_out_count = 0;
- 
 
 418 
 
- 
 
 419 
    my $cmd = QuoteCommand ("cleartool", "find", ".", @cmd_opt, "-version", "lbtype($opt_clone)", "-print");
- 
 
 420 
    Verbose2($cmd);
- 
 
 421 
 
- 
 
 422 
    open(CLONECMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
- 
 
 423 
    while (<CLONECMD>)
- 
 
 424 
    {
- 
 
 425 
        chomp;
- 
 
 426 
        print($_ . "\n");
- 
 
 427 
        $count++;
- 
 
 428 
        $checked_out_count++ if ( m/CHECKEDOUT$/ );
- 
 
 429 
 
- 
 
 430 
        ClearCmd ("mklabel", @cmd2_opt, $label, $_ ) unless ( $opt_test );
- 
 
 431 
        last if ( @error_list )
- 
 
 432 
    }
- 
 
 433 
    close(CLONECMD);
- 
 
 434 
 
- 
 
 435 
    Error ("Program Terminated") if ( @error_list );
- 
 
 436 
    print "Labels applied: $count\n";
- 
 
 437 
    print "WARNING: Labels applied to checked out files: $checked_out_count\n" if ( $checked_out_count );
- 
 
 438 
    $opr_done = 1;
- 
 
 439 
}
- 
 
 440 
 
- 
 
 441 
 
- 
 
 442 
#-------------------------------------------------------------------------------
- 
 
 443 
#   Process command
- 
 
 444 
#       Show labeled files and directories
- 
 
 445 
#       Remove labels
- 
 
 446 
 
- 
 
 447 
if ( $opt_show || $opt_remove )
- 
 
 448 
{
- 
 
 449 
    Verbose ("Show Label");
- 
 
 450 
    my @cmd_opt;
- 
 
 451 
    push @cmd_opt, "-all" if ($opt_all);
- 
 
 452 
 
- 
 
 453 
    my $cmd = QuoteCommand("cleartool", "find", ".", @cmd_opt, "-version", "lbtype($label)", "-print");
- 
 
 454 
    Verbose2($cmd);
- 
 
 455 
 
- 
 
 456 
    open(SHOWCMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
- 
 
 457 
    while (<SHOWCMD>)
- 
 
 458 
    {
- 
 
 459 
        #
- 
 
 460 
        #   Filter output from the user
- 
 
 461 
        #
- 
 
 462 
        chomp;
- 
 
 463 
        print($_ . "\n");
- 
 
 464 
 
- 
 
 465 
        if ( $opt_remove )
- 
 
 466 
        {
- 
 
 467 
            ClearCmd ( "rmlabel", $label, $_ ) unless $opt_test;
- 
 
 468 
        }
- 
 
 469 
 
- 
 
 470 
    }
- 
 
 471 
    close(SHOWCMD);
- 
 
 472 
    $opr_done = 1;
- 
 
 473 
}
- 
 
 474 
 
- 
 
 475 
#-------------------------------------------------------------------------------
- 
 
 476 
#   Process command
- 
 
 477 
#       Delete a label
- 
 
 478 
if ( $opt_delete )
- 
 
 479 
{
- 
 
 480 
    Verbose ("Delete label");
- 
 
 481 
    ClearCmd ("rmtype", "-force", "-rmall", "lbtype:$label$vob_desc" ) unless $opt_test;
- 
 
 482 
    Error ("Program Terminated") if ( @error_list );
- 
 
 483 
    $opr_done = 1;
- 
 
 484 
}
- 
 
 485 
 
- 
 
 486 
#-------------------------------------------------------------------------------
- 
 
 487 
#   Process command
- 
 
 488 
#       Lock a label - if not already locked
- 
 
 489 
if ( $opt_lock )
- 
 
 490 
{
- 
 
 491 
    Verbose ("Lock label");
- 
 
 492 
    ClearCmd ("describe", "-fmt", "%[locked]p", "lbtype:$label$vob_desc" );
- 
 
 493 
    if ( $last_result =~ m~unlocked~ )
- 
 
 494 
    {
- 
 
 495 
        ClearCmd ("lock", "lbtype:$label$vob_desc" ) unless $opt_test;
- 
 
 496 
        Error ("Program Terminated") if ( @error_list );
- 
 
 497 
    }
- 
 
 498 
    $opr_done = 1;
- 
 
 499 
}
- 
 
 500 
 
- 
 
 501 
#-------------------------------------------------------------------------------
- 
 
 502 
#   Process command
- 
 
 503 
#       Display Label information
- 
 
 504 
if ( $opt_info )
- 
 
 505 
{
- 
 
 506 
    Verbose ("describe label");
- 
 
 507 
    system (QuoteCommand("cleartool", "describe", "-long", "lbtype:$label$vob_desc" )) unless $opt_test;
- 
 
 508 
    Error ("Program Terminated") if ( @error_list );
- 
 
 509 
    $opr_done = 1;
- 
 
 510 
}
- 
 
 511 
 
- 
 
 512 
 
- 
 
 513 
Error ("No valid operations specified. Try -h") unless ( $opr_done );
- 
 
 514 
if ( $opt_test )
- 
 
 515 
{
- 
 
 516 
    print ("End program [Test Mode]\n");
- 
 
 517 
}
- 
 
 518 
else
- 
 
 519 
{
- 
 
 520 
    print ("End program\n");
- 
 
 521 
}
- 
 
 522 
 
- 
 
 523 
exit 0;
- 
 
 524 
 
- 
 
 525 
#-------------------------------------------------------------------------------
- 
 
 526 
# Function        : determine_dirs_to_label
- 
 
 527 
#
- 
 
 528 
# Description     : Determine diretories up to the VOB root that need to be
- 
 
 529 
#                   labeled.
- 
 
 530 
#
- 
 
 531 
# Inputs          : $data           - Ref to hash to collect info
- 
 
 532 
#
- 
 
 533 
# Returns         : Nothing
- 
 
 534 
#                   Values populated into $data hash
- 
 
 535 
#
- 
 
 536 
sub determine_dirs_to_label
- 
 
 537 
{
- 
 
 538 
    my ($data) = @_;
- 
 
 539 
    Verbose ("Locate directories to label");
- 
 
 540 
 
- 
 
 541 
    #
- 
 
 542 
    #   Init data - so that we can see what to expect
- 
 
 543 
    #
- 
 
 544 
    $data->{'dir_list'} = [];
- 
 
 545 
    $data->{'checked_out_pdirs'} = [];
- 
 
 546 
    $data->{'is_symlink'} = 0;
- 
 
 547 
    $data->{'VobRoot'} = '';
- 
 
 548 
 
- 
 
 549 
    #
303 
    #   Figure out what to do
 550 
    #   Figure out what to do
304 
    #       Label dirs upwards if requested, or we are not doing files or dirs
 551 
    #       Label dirs upwards if requested, or we are not doing files or dirs
305 
    #       Label the current directory unless asked to do files/dirs or up-only
 552 
    #       Label the current directory unless asked to do files/dirs or up-only
306 
    #
 553 
    #
307 
    my $do_files = scalar @opt_files;
 554 
    my $do_files = scalar @opt_files;
308 
    my $do_dirs = scalar @opt_dirs;
 555 
    my $do_dirs  = scalar @opt_dirs;
309 
    my $do_up = $opt_up || ( ! $do_files && ! $do_dirs );
 556 
    my $do_up = $opt_up || ( ! $do_files && ! $do_dirs );
310 
    push @opt_dirs, '.' unless ($opt_up || $do_files || $do_dirs);
 557 
    push @opt_dirs, '.' unless ($opt_up || $do_files || $do_dirs);
311 
 
 558 
 
312 
 
 - 
 
313 
    #
 559 
    #
314 
    #   Build up a list of parent directories up to the root of the VOB
 560 
    #   Build up a list of parent directories up to the root of the VOB
315 
    #   that do not have the desired label
 561 
    #   that do not have the desired label
316 
    #
 562 
    #
317 
    if ( $do_up )
 563 
    if ( $do_up )
Line 327... Line 573...
327 
            my $start_labels;
 573 
            my $start_labels;
328 
            my $link;
 574 
            my $link;
329 
            my $is_checkedout;
 575 
            my $is_checkedout;
330 
 
 576 
 
331 
            Verbose($cmd);
 577 
            Verbose($cmd);
- 
 
 578 
            my $cmd_handle;
332 
            open(CMD, "$cmd 2>&1 |") || Error( "Can't run command: $!");
 579 
            open($cmd_handle, "$cmd 2>&1 |") || Error( "Can't run command: $!");
333 
            while (<CMD>)
 580 
            while (<$cmd_handle>)
334 
            {
 581 
            {
335 
                #
 582 
                #
336 
                #   Filter output from the user
 583 
                #   Filter output from the user
337 
                #
 584 
                #
338 
                chomp;
 585 
                chomp;
339 
                Verbose2($_);
 586 
                Verbose2($_);
340 
                push @error_list, $_ if ( m~Error:~ );
 587 
                push @error_list, $_    if ( m~Error:~ );
341 
                $link = $1 if ( m~^symbolic link.* -> (.*)~ );
 588 
                $link = $1              if ( m~^symbolic link.* -> (.*)~ );
342 
                $is_versioned = 1 if ( m~^directory version ~ );
 589 
                $is_versioned = 1       if ( m~^directory version ~ );
343 
                $start_labels = 1 if ( m~^\s+Labels:$~ );
 590 
                $start_labels = 1       if ( m~^\s+Labels:$~ );
344 
                $is_checkedout = 1 if ( m~[\\/]CHECKEDOUT"~ );
 591 
                $is_checkedout = 1      if ( m~[\\/]CHECKEDOUT"~ );
345 
                next unless ( $start_labels );
 592 
                next unless ( $start_labels );
346 
                $has_label = 1 if ( m~^\s+$label$~ );
 593 
                $has_label = 1          if ( m~^\s+$label$~ );
347 
            }
 594 
            }
348 
            close(CMD);
 595 
            close($cmd_handle);
- 
 
 596 
            $data->{'VobRoot'} = $path;
349 
 
 597 
 
350 
            #
 598 
            #
351 
            #   Symbolic link located
 599 
            #   Symbolic link located
352 
            #   Resolve the link and continue
 600 
            #   Resolve the link and continue
353 
            #   The link cannot be labeled. If we can label the resolved link then
 601 
            #   The link cannot be labeled. If we can label the resolved link then
354 
            #   all is good, otherwise we have a a problem
 602 
            #   all is good, otherwise we have a a problem
355 
            #
 603 
            #
356 
            if ( $link )
 604 
            if ( $link )
357 
            {
 605 
            {
358 
                $is_symlink = 1;
 606 
                $data->{'is_symlink'} = 1;
359 
                $path =~ s~[/][^/]*$~~;
 607 
                $path =~ s~[/][^/]*$~~;
360 
                $path = $path . '/' . $link;
 608 
                $path = $path . '/' . $link;
361 
                $path =~ s~/[^/]+/\.\./~/~;
 609 
                $path =~ s~/[^/]+/\.\./~/~;
362 
                Verbose("Symbolic link: $link, Path: $path" );
 610 
                Verbose("Symbolic link: $link, Path: $path" );
363 
                next;
 611 
                next;
Line 365... Line 613...
365 
 
 613 
 
366 
            #
 614 
            #
367 
            #   Parent directory checked out. Options:
 615 
            #   Parent directory checked out. Options:
368 
            #       0: Don't Label checkedout elements
 616 
            #       0: Don't Label checkedout elements
369 
            #       1: Do Label only checkout elements
 617 
            #       1: Do Label only checkout elements
370 
            #       2: Label both
 618 
            #       2: Label both (default)
371 
            #
 619 
            #
372 
            if ( $is_checkedout )
 620 
            if ( $is_checkedout )
373 
            {
 621 
            {
374 
                next find if ( $opt_checkout == 0 );
 622 
                $has_label = 2 if ( $opt_checkout == 0 );
375 
                $checked_out_count_dir++;
 623 
                push @{$data->{'checked_out_pdirs'}}, $_;
376 
            }
 624 
            }
377 
            else
 625 
            else
378 
            {
 626 
            {
379 
                next find if ( $opt_checkout == 1 );
 627 
                $has_label = 2 if ( $opt_checkout == 1 );
380 
            }
 628 
            }
381 
 
 629 
 
382 
            last unless ( $is_versioned );
 630 
            last unless ( $is_versioned );
383 
            push @parent_list, $path unless ( $has_label );
 631 
            unshift @{$data->{'dir_list'}}, $path unless ( $has_label );
384 
 
 632 
 
385 
            #
 633 
            #
386 
            #   Versioned directory seen
 634 
            #   Versioned directory seen
387 
            #   If the previous one loop was a symlink, then we have labeled
 635 
            #   If the previous one loop was a symlink, then we have labeled
388 
            #   the link correctly
 636 
            #   the link correctly
389 
            #
 637 
            #
390 
            $is_symlink = 0;
 638 
            $data->{'is_symlink'} = 0;
391 
 
 639 
 
392 
            #
 640 
            #
393 
            #   Calculate the path of the parent directory
 641 
            #   Calculate the path of the parent directory
394 
            #   Stop when we get to the top ( ie z: is not good )
 642 
            #   Stop when we get to the top ( ie z: is not good )
395 
            #
 643 
            #
396 
            last unless ($path =~ s~[/][^/]*$~~);
 644 
            last unless ( $path =~ s~[/][^/]*$~~);
397 
            last unless ( $path =~ m~/~ );
 645 
            last unless ( $path =~ m~/~ );
398 
        }
 646 
        }
399 
        Verbose ("parent directories to label: @parent_list");
 - 
 
400 
 
 - 
 
401 
        #
 - 
 
402 
        #   Label all the parent directories
 - 
 
403 
        #
 - 
 
404 
        if ( @parent_list )
 - 
 
405 
        {
 - 
 
406 
            foreach ( @parent_list )
 - 
 
407 
            {
 - 
 
408 
                print "Label: $_\n";
 - 
 
409 
            }
 - 
 
410
- 
 
411 
            ClearCmd ("mklabel", @cmd_opt, $label, @parent_list ) unless $opt_test;
 - 
 
412 
            if ( @error_list )
 - 
 
413 
            {
 - 
 
414 
                display_error_list();
 - 
 
415 
                @error_list = ();
 - 
 
416 
                $label_error = 1;
 - 
 
417 
            }
 - 
 
418 
        }
 - 
 
419 
    }
 647 
    }
- 
 
 648 
}
420 
 
 649 
 
421 
    if ( @opt_files )
 - 
 
422 
    {
 - 
 
423 
        my $file_error;
 650 
#-------------------------------------------------------------------------------
424 
        #
 - 
 
425 
        #   Process the user specified list of files
 651 
# Function        : determine_files_to_label
426 
        #
 652 
#
427 
        Verbose ("Examine specified files");
 653 
# Description     : Determine a list of files that need to be
428 
        foreach my $file ( @opt_files )
 654 
#                   labeled.
429 
        {
 655 
#
430 
            ClearCmd ("describe", "-short", $file );
 656 
# Inputs          : $data           - Ref to hash to collect info
431 
            if ( @error_list )
 - 
 
432 
            {
 657 
#
433 
                display_error_list();
 658 
# Returns         : Nothing
434 
                @error_list = ();
 659 
#                   Values populated into $data hash
- 
 
 660 
#
435 
                $file_error++;
 661 
sub determine_files_to_label
- 
 
 662 
{
436 
                next;
 663 
    my ($data) = @_;
437 
            }
 - 
 
438 
            push @check_these, $last_result;
 664 
    Verbose ("Locate files to label");
439 
        }
 - 
 
440 
        Error ("Program Terminated") if ( $file_error );
 - 
 
441
- 
 
442 
    }
 - 
 
443 
 
 665 
 
444 
    foreach my $dir ( @opt_dirs )
 - 
 
445 
    {
 666 
    #
- 
 
 667 
    #   Init data - so that we can see what to expect
446 
        #
 668 
    #
- 
 
 669 
    $data->{'label_list'} = [];
447 
        #   Label everything in and below the current directory
 670 
    $data->{'checked_out_files'} = [];
448 
        #   Be smart and only attempt to label stuff that does not have a label
 671 
    $data->{'checked_out_dirs'} = [];
- 
 
 672 
    $data->{'missing_files'} = [];
- 
 
 673 
    $data->{'element0_list'} = [];
- 
 
 674 
    $data->{'exclude_list'} = [];
449 
        #
 675 
    $data->{'build_files'} = [];
450 
 
 676 
 
- 
 
 677 
    #
- 
 
 678 
    #   Figure out what to do
- 
 
 679 
    #       Label dirs upwards if requested, or we are not doing files or dirs
- 
 
 680 
    #       Label the current directory unless asked to do files/dirs or up-only
- 
 
 681 
    #
- 
 
 682 
    my $do_files = scalar @opt_files;
- 
 
 683 
    my $do_dirs  = scalar @opt_dirs;
- 
 
 684 
    my $do_up = $opt_up || ( ! $do_files && ! $do_dirs );
- 
 
 685 
    push @opt_dirs, '.' unless ($opt_up || $do_files || $do_dirs);
- 
 
 686 
 
- 
 
 687 
    my @check_these;
- 
 
 688 
 
- 
 
 689 
    #
- 
 
 690 
    #   Examine all specified files and directories
- 
 
 691 
    #       Detect nasty files
- 
 
 692 
    #       Don't label elements that have already been labled
- 
 
 693 
    #
- 
 
 694 
    #   Use the cleartool find command as it will allow us to determine
- 
 
 695 
    #   if the element has already been labled.
- 
 
 696 
    #
- 
 
 697 
    #   Note: cleartool find works on files and directories
- 
 
 698 
    #
- 
 
 699 
    foreach my $dir (@opt_files, @opt_dirs )
- 
 
 700 
    {
451 
        #
 701 
        #
452 
        #   Remove possible trailing / from user specified directory as
 702 
        #   Remove possible trailing / from user specified directory as
453 
        #   clearcase doesn't handle these too well.
 703 
        #   clearcase doesn't handle these too well.
454 
        #
 704 
        #
455 
        $dir =~ tr~\\/~/~s;
 705 
        $dir =~ tr~\\/~/~s;
Line 459... Line 709...
459 
        Verbose ("Examine subdirectory: $dir");
 709 
        Verbose ("Examine subdirectory: $dir");
460 
        my $find_arg = $opt_recurse ? '' : '-nrecurse';
 710 
        my $find_arg = $opt_recurse ? '' : '-nrecurse';
461 
        my $cmd = QuoteCommand ("cleartool", "find", "$dir", "-cview", $find_arg, "-version", "{!lbtype($label)}", "-print");
 711 
        my $cmd = QuoteCommand ("cleartool", "find", "$dir", "-cview", $find_arg, "-version", "{!lbtype($label)}", "-print");
462 
        Verbose2($cmd);
 712 
        Verbose2($cmd);
463 
 
 713 
 
- 
 
 714 
        my $cmd_handle;
464 
        open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
 715 
        open($cmd_handle, "$cmd 2>&1 |") || Error( "can't run command: $!");
465 
        while (<CMD>)
 716 
        while (<$cmd_handle>)
466 
        {
 717 
        {
467 
            #
 718 
            #
468 
            #   Filter output from the user
 719 
            #   Filter output from the user
469 
            #
 720 
            #
470 
            chomp;
 721 
            chomp;
Line 476... Line 727...
476 
                #   This may be cause by generated directory that has been checked in
 727 
                #   This may be cause by generated directory that has been checked in
477 
                #   If the directory gets re-generated then the Find gets confused.
 728 
                #   If the directory gets re-generated then the Find gets confused.
478 
                #
 729 
                #
479 
                if ( $autobuild && m~Not a vob object:~ )
 730 
                if ( $autobuild && m~Not a vob object:~ )
480 
                {
 731 
                {
481 
                    Warning( "AutoBuildTool surpessed: $_" );
 732 
                    Warning( "AutoBuildTool supressed: $_" );
482 
                    next;
 733 
                    next;
483 
                }
 734 
                }
484 
                push @error_list, $_;
 735 
                push @error_list, $_;
485 
                next;
 736 
                next;
486 
            }
 737 
            }
487 
            push @check_these, $_;
 738 
            push @check_these, $_;
488 
        }
 739 
        }
489 
        close(CMD);
 740 
        close($cmd_handle);
490 
        Error ("Program Terminated") if ( @error_list );
 741 
        Error ("Program Terminated") if ( @error_list );
491 
    }
 742 
    }
492 
 
 743 
 
493 
    #
 744 
    #
494 
    #   Have a list of files to examine to see if we really want to label them
 745 
    #   Have a list of files to examine to see if we really want to label them
Line 503... Line 754...
503 
        #
 754 
        #
504 
        next find
 755 
        next find
505 
            if ( ! $opt_recurse  && -d $file );
 756 
            if ( ! $opt_recurse  && -d $file );
506 
 
 757 
 
507 
        tr~\\/~/~s;
 758 
        tr~\\/~/~s;
- 
 
 759 
        s~^\./~~;
508 
 
 760 
 
509 
        #
 761 
        #
510 
        #   Exclude files and directories that are the /main/0 element
 762 
        #   Exclude files and directories that are the /main/0 element
511 
        #   These may be in a view due to branching rules
 763 
        #   These may be in a view due to branching rules
512 
        #   The contents will be empty. Labeling them will create uglyness
 764 
        #   The contents will be empty. Labeling them will create uglyness
513 
        #   it simplifies life if we don't label them
 765 
        #   it simplifies life if we don't label them
514 
        #
 766 
        #
515 
        if ( m~/main/0$~ )
 767 
        if ( m~/main/0$~ )
516 
        {
 768 
        {
517 
            $element0_count++;
 769 
            push @{$data->{'element0_list'}}, $_;
518 
            print "Exclude(/main/0): $_\n";
 - 
 
519 
            next find;
 770 
            next find;
520 
        }
 771 
        }
521 
 
 772 
 
522 
        #
 773 
        #
523 
        #   Has it been excluded
 774 
        #   Has it been excluded
524 
        #
 775 
        #
525 
        foreach my $name ( @opt_exclude )
 776 
        foreach my $name ( @opt_exclude )
526 
        {
 777 
        {
527 
            if ( m~/$name[/@]~ )
 778 
            if ( m~/$name[/@]~ )
528 
            {
 779 
            {
529 
                print "Exclude: $_\n";
 780 
                push @{$data->{'exclude_list'}}, $_;
530 
                next find;
 781 
                next find;
531 
            }
 782 
            }
532 
        }
 783 
        }
533 
 
 784 
 
534 
        #
 785 
        #
Line 536... Line 787...
536 
        #   In a static sandbox CC retains memory of files that have been
 787 
        #   In a static sandbox CC retains memory of files that have been
537 
        #   deleted. This may be intentional it may be an error
 788 
        #   deleted. This may be intentional it may be an error
538 
        #
 789 
        #
539 
        if ( ! -e $file && ! $opt_all )
 790 
        if ( ! -e $file && ! $opt_all )
540 
        {
 791 
        {
541 
            print ("WARNING: File missing from view. Not labeled: $file \n");
 - 
 
542 
            $missing_file_count++;
 792 
            push @{$data->{'missing_files'}}, $file;
543 
            next find;
 793 
            next find;
544 
        }
 794 
        }
545 
 
 795 
 
546 
        #
 796 
        #
547 
        #   Count build.pl files
 797 
        #   Count build.pl files
- 
 
 798 
        #   Not really useful for Ant Builds
548 
        #
 799 
        #
549 
        if ( m~/build.pl@~i )
 800 
        if ( m~/build.pl@~i )
550 
        {
 801 
        {
551 
            $build_count++;
 802 
            push @{$data->{'build_files'}}, $_
552 
        }
 803 
        }
553 
 
 804 
 
554 
        #
 805 
        #
555 
        #   Handle Checked out files
 806 
        #   Handle Checked out files
556 
        #
 807 
        #
557 
        if ( m/CHECKEDOUT$/ )
 808 
        if ( m/CHECKEDOUT$/ )
558 
        {
 809 
        {
559 
            next find if ( $opt_checkout == 0 );
 810 
            next find if ( $opt_checkout == 0 );
560 
            $checked_out_count++;
 - 
 
561 
        }
 - 
 
562 
        else
 - 
 
563 
        {
 - 
 
564 
            next find if ( $opt_checkout == 1 );
 - 
 
565 
        }
 - 
 
566 
 
 - 
 
567 
        push @label_these, $_ ;
 - 
 
568 
 
 - 
 
569 
    }
 - 
 
570 
 
 - 
 
571 
    if ( @label_these )
 - 
 
572 
    {
 - 
 
573 
        foreach ( @label_these)
 - 
 
574 
        {
 - 
 
575 
            print "Label: $_\n";
 - 
 
576 
        }
 - 
 
577 
 
 - 
 
578 
        #
 - 
 
579 
        #   Process the labels in groups
 - 
 
580 
        #   The command line does have a finite length
 - 
 
581 
        #
 - 
 
582 
        my $base = 0;
 - 
 
583 
        my $num = $#label_these;
 - 
 
584 
 
 - 
 
585 
        while ( $base <= $num )
 - 
 
586 
        {
 - 
 
587 
            my $end = $base + 10;
 - 
 
588 
            $end = $num if ( $end > $num );
 - 
 
589 
 
 - 
 
590 
            print ".";
 - 
 
591 
            ClearCmd ("mklabel", @cmd_opt, $label, @label_these[$base .. $end] ) unless ( $opt_test );
 - 
 
592 
            if ( @error_list )
 811 
            if ( -d $file  )
593 
            {
 812 
            {
594 
                display_error_list();
 813 
                push @{$data->{'checked_out_dirs'}}, $_;
- 
 
 814 
            }
595 
                $label_error = 1;
 815 
            else
- 
 
 816 
            {
596 
                @error_list = ();
 817 
                push @{$data->{'checked_out_files'}}, $_;
597 
            }
 818 
            }
598 
 
 - 
 
599 
            $base = $end + 1;
 - 
 
600 
        }
 819 
        }
601 
        print "\n";
 - 
 
602 
    }
 - 
 
603 
 
 - 
 
604 
    print "Labels applied: ". (scalar(@label_these) + scalar(@parent_list))  ."\n";
 - 
 
605 
    print "WARNING: Labels applied to checked out parent directories: $checked_out_count_dir\n" if ( $checked_out_count_dir );
 - 
 
606 
    print "WARNING: Labels applied to checked out files: $checked_out_count\n" if ( $checked_out_count );
 - 
 
607 
    print "WARNING: Labels NOT applied to missing files: $missing_file_count\n" if ( $missing_file_count );
 - 
 
608 
    print "WARNING: Labels NOT applied to element-0 of files: $element0_count\n" if ( $element0_count );
 - 
 
609 
    print "WARNING: Path to the VOB root contains a symbolic link. Labeling incomplete.\n" if ( $is_symlink );
 - 
 
610 
    print "WARNING: Multiple build.pl files labeled: $build_count.\n" if ( $build_count > 1 );
 - 
 
611 
 
 - 
 
612 
    Error ("Program Terminated") if ( $label_error );
 - 
 
613 
 
 - 
 
614 
    $opr_done = 1;
 - 
 
615 
}
 - 
 
616 
 
 - 
 
617 
#-------------------------------------------------------------------------------
 - 
 
618 
#   Process command
 - 
 
619 
#       Clone
 820 
        else
620 
if ( $opt_clone )
 - 
 
621 
{
 - 
 
622 
    Verbose ("Clone Label");
 - 
 
623 
    my @cmd_opt;
 - 
 
624 
    push @cmd_opt, "-all" if ($opt_all);
 - 
 
625 
 
 - 
 
626 
    my @cmd2_opt;
 - 
 
627 
    push @cmd2_opt, "-replace" if ( $opt_replace );
 - 
 
628 
 
 - 
 
629 
    my $count = 0;
 - 
 
630 
    my $checked_out_count = 0;
 - 
 
631 
 
 - 
 
632 
    my $cmd = QuoteCommand ("cleartool", "find", ".", @cmd_opt, "-version", "lbtype($opt_clone)", "-print");
 - 
 
633 
    Verbose2($cmd);
 - 
 
634 
 
 - 
 
635 
    open(CLONECMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
 - 
 
636 
    while (<CLONECMD>)
 - 
 
637 
    {
 - 
 
638 
        chomp;
 - 
 
639 
        print($_ . "\n");
 - 
 
640 
        $count++;
 - 
 
641 
        $checked_out_count++ if ( m/CHECKEDOUT$/ );
 - 
 
642 
 
 - 
 
643 
        ClearCmd ("mklabel", @cmd2_opt, $label, $_ ) unless ( $opt_test );
 - 
 
644 
        last if ( @error_list )
 - 
 
645 
    }
 - 
 
646 
    close(CLONECMD);
 - 
 
647 
 
 - 
 
648 
    Error ("Program Terminated") if ( @error_list );
 - 
 
649 
    print "Labels applied: $count\n";
 - 
 
650 
    print "WARNING: Labels applied to checked out files: $checked_out_count\n" if ( $checked_out_count );
 - 
 
651 
    $opr_done = 1;
 - 
 
652 
}
 - 
 
653 
 
 - 
 
654 
 
 - 
 
655 
#-------------------------------------------------------------------------------
 - 
 
656 
#   Process command
 - 
 
657 
#       Show labeled files and directories
 - 
 
658 
#       Remove labels
 - 
 
659 
 
 - 
 
660 
if ( $opt_show || $opt_remove )
 - 
 
661 
{
 - 
 
662 
    Verbose ("Show Label");
 - 
 
663 
    my @cmd_opt;
 - 
 
664 
    push @cmd_opt, "-all" if ($opt_all);
 - 
 
665 
 
 - 
 
666 
    my $cmd = QuoteCommand("cleartool", "find", ".", @cmd_opt, "-version", "lbtype($label)", "-print");
 - 
 
667 
    Verbose2($cmd);
 - 
 
668 
 
 - 
 
669 
    open(SHOWCMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
 - 
 
670 
    while (<SHOWCMD>)
 - 
 
671 
    {
 - 
 
672 
        #
 - 
 
673 
        #   Filter output from the user
 - 
 
674 
        #
 - 
 
675 
        chomp;
 - 
 
676 
        print($_ . "\n");
 - 
 
677 
 
 - 
 
678 
        if ( $opt_remove )
 - 
 
679 
        {
 821 
        {
680 
            ClearCmd ( "rmlabel", $label, $_ ) unless $opt_test;
 822 
            next find if ( $opt_checkout == 1 );
681 
        }
 823 
        }
682 
 
 824 
 
- 
 
 825 
        push @{$data->{'label_list'}}, $_ ;
683 
    }
 826 
    }
684 
    close(SHOWCMD);
 - 
 
685 
    $opr_done = 1;
 - 
 
686 
}
 - 
 
687 
 
 - 
 
688 
#-------------------------------------------------------------------------------
 - 
 
689 
#   Process command
 - 
 
690 
#       Delete a label
 - 
 
691 
if ( $opt_delete )
 - 
 
692 
{
 - 
 
693 
    Verbose ("Delete label");
 - 
 
694 
    ClearCmd ("rmtype", "-force", "-rmall", "lbtype:$label$vob_desc" ) unless $opt_test;
 - 
 
695 
    Error ("Program Terminated") if ( @error_list );
 - 
 
696 
    $opr_done = 1;
 - 
 
697 
}
 - 
 
698 
 
 - 
 
699 
#-------------------------------------------------------------------------------
 - 
 
700 
#   Process command
 - 
 
701 
#       Lock a label - if not already locked
 - 
 
702 
if ( $opt_lock )
 - 
 
703 
{
 - 
 
704 
    Verbose ("Lock label");
 - 
 
705 
    ClearCmd ("describe", "-fmt", "%[locked]p", "lbtype:$label$vob_desc" );
 - 
 
706 
    if ( $last_result =~ m~unlocked~ )
 - 
 
707 
    {
 - 
 
708 
        ClearCmd ("lock", "lbtype:$label$vob_desc" ) unless $opt_test;
 - 
 
709 
        Error ("Program Terminated") if ( @error_list );
 - 
 
710 
    }
 - 
 
711 
    $opr_done = 1;
 - 
 
712 
}
 827 
}
713 
 
 828 
 
714 
#-------------------------------------------------------------------------------
 829 
#-------------------------------------------------------------------------------
715 
#   Process command
 - 
 
716 
#       Display Label information
 - 
 
717 
if ( $opt_info )
 - 
 
718 
{
 - 
 
719 
    Verbose ("describe label");
 - 
 
720 
    system (QuoteCommand("cleartool", "describe", "-long", "lbtype:$label$vob_desc" )) unless $opt_test;
 - 
 
721 
    Error ("Program Terminated") if ( @error_list );
 - 
 
722 
    $opr_done = 1;
 - 
 
723 
}
 - 
 
724 
 
 - 
 
725 
 
 - 
 
726 
Error ("No valid operations specified. Try -h") unless ( $opr_done );
 - 
 
727 
if ( $opt_test )
 - 
 
728 
{
 - 
 
729 
    print ("End program [Test Mode]\n");
 - 
 
730 
}
 - 
 
731 
else
 - 
 
732 
{
 - 
 
733 
    print ("End program\n");
 - 
 
734 
}
 - 
 
735 
 
 - 
 
736 
exit 0;
 - 
 
737 
 
 - 
 
738 
 
 - 
 
739 
#-------------------------------------------------------------------------------
 - 
 
740 
# Function        : display_error_list
 830 
# Function        : display_error_list
741 
#
 831 
#
742 
# Description     : Display the error list
 832 
# Description     : Display the error list
743 
#                   This function is registered as an Error callback function
 833 
#                   This function is registered as an Error callback function
744 
#                   it will be called on error exit
 834 
#                   it will be called on error exit
745 
#
 835 
#
- 
 
 836 
#                   Will clear error list when called, so that it can be used
- 
 
 837 
#                   in non-exit situations.
- 
 
 838 
#
746 
# Inputs          :
 839 
# Inputs          :
747 
#
 840 
#
748 
# Returns         :
 841 
# Returns         : true            - Errors in list
- 
 
 842 
#                   false           - No error in list
749 
#
 843 
#
750 
sub display_error_list
 844 
sub display_error_list
751 
{
 845 
{
752 
    foreach ( @error_list )
 846 
    return 0 unless ( @error_list );
753 
    {
 847 
    print "$_\n" foreach ( @error_list );
754 
        print "$_\n";
 848 
    @error_list = ();
755 
    }
 849 
    return 1;
756 
}
 850 
}
757 
 
 851 
 
758 
#-------------------------------------------------------------------------------
 852 
#-------------------------------------------------------------------------------
759 
# Function        : ClearCmd
 853 
# Function        : ClearCmd
760 
#
 854 
#
Line 773... Line 867...
773 
{
 867 
{
774 
    my $cmd = QuoteCommand (@_);
 868 
    my $cmd = QuoteCommand (@_);
775 
    Verbose2 "cleartool $cmd";
 869 
    Verbose2 "cleartool $cmd";
776 
 
 870 
 
777 
        @error_list = ();
 871 
        @error_list = ();
- 
 
 872 
        my $cmd_handle;
778 
        open(CMD, "cleartool $cmd  2>&1 |")    || Error "can't run command: $!";
 873 
        open($cmd_handle, "cleartool $cmd  2>&1 |")    || Error "can't run command: $!";
779 
        while (<CMD>)
 874 
        while (<$cmd_handle>)
780 
        {
 875 
        {
781 
            chomp;
 876 
            chomp;
782 
            $last_result = $_;
 877 
            $last_result = $_;
783 
            Verbose ( "cleartool resp:" . $_);
 878 
            Verbose ( "cleartool resp:" . $_);
784 
            push @error_list, $_ if ( m~Error:~ );
 879 
            push @error_list, $_ if ( m~Error:~ );
785 
        }
 880 
        }
786 
        close(CMD);
 881 
        close($cmd_handle);
787 
 
 882 
 
788 
    Verbose2 "Exit Status: $?";
 883 
    Verbose2 "Exit Status: $?";
789 
    return $? / 256;
 884 
    return $? / 256;
790 
}
 885 
}
791 
 
 886