WebSVN – DevTools – Diff – /core_devl/trunk/TOOLS/jats_label.pl

 my @opt_dirs;
 my $opt_comment;
 my $opt_vob;
 my $opt_user;
 my $opt_admin_vob;
+my $opt_entire_view;
 my $label;
 my $user_cwd;
 my @error_list;
+my @last_results;
 my $last_result;
 my $opr_done;
 my $label_exists = 0;
 my $label_is_locked = 0;
 my $build_count = 0;
 my $vob_desc ='';
+my $vob_base;
+#
 #   Globals
+#
 my $USER = $ENV{'USER'};
                 "dirs=s"        => \@opt_dirs,              # Multiple strings
                 "comment=s"     => \$opt_comment,           # String
                 "vob=s"         => \$opt_vob,               # String
                 "user=s"        => \$opt_user,              # String
                 "admin"         => \$opt_admin_vob,         # String
+                "entireview"    => \$opt_entire_view,       # Flag
                 );
+                #
                 #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
 #   Validate user options
 #   Use either -spec or one command line argument
+#
 Error ("No labels provided") if ( $#ARGV < 0);
 Error ("Too many labels provided") if ( $#ARGV > 0);
-Error ("Conflicting options") if ( $opt_clone && $opt_label );
+Error ("Conflicting options: -clone and -label") if ( $opt_clone && $opt_label );
+Error ("Conflicting options: -entireview and -label" ) if ( $opt_entire_view && $opt_label );
+Error ("Conflicting options: -entireview and -exclude" ) if ( $opt_entire_view && @opt_exclude );
+Error ("Conflicting options: -entireview and -files" ) if ( $opt_entire_view && @opt_files );
+Error ("Conflicting options: -entireview and -dir" ) if ( $opt_entire_view && @opt_dirs );
+Error ("Conflicting options: -entireview and -norecurse" ) if ( $opt_entire_view && !$opt_recurse );
 $label = $ARGV[0];
+#
 #   Allow the exclude list to contain comma seperated names
+#
 #   There is a potential problem/race condition if doing a rename
 #   within a static view of a label that is a part of the views config spec
+#
 #   Work around: If performing a rename, then ensure that we have the VOB name
+#
-if ( $opt_rename && ! $opt_vob )
+if ( ($opt_rename || $opt_entire_view ) && ! $opt_vob )
+{
     Verbose ("Determine VOB name");
     ClearCmd ('describe', '-short', 'vob:.' );
     Error ("Cannot determine vob from current directory") if ( @error_list || ! $last_result );
+    $vob_base = $last_result;
-    $vob_desc = '@' . $last_result;
+    $vob_desc = '@' . $vob_base;
+    $vob_desc =~ s~/~$VOB_SEP~g;
-    Verbose ("VOB name: $vob_desc");
+    Verbose ("VOB name: $vob_base");
+}
 elsif ( $opt_vob )
+{
     Error ("-vob option cannot be used with this command")
-        if ( $opt_clone || $opt_label || $opt_show || $opt_remove  );
+        if ( $opt_clone || $opt_label || $opt_show || $opt_remove );
     $vob_desc = $UNIX_VOB_PREFIX if ( $UNIX );
     $vob_desc = '@/' . $vob_desc . '/' . $opt_vob;
     $vob_desc =~ s~//~/~g;
     $vob_desc =~ s~/~$VOB_SEP~g;
 #   Check to see if the label exists
 #   Determine if its locked at the same time
+#
 Verbose ("Check label");
 ClearCmd ("describe", "-fmt", "%[locked]p", "lbtype:$label$vob_desc" );
+$label_exists = 1 unless( $opt_test
-$label_exists = 1 unless( $opt_test || grep ( /Label type not found/, @error_list ));
+                          || grep ( /Label type not found/, @error_list )
+                          || grep ( /Unable to determine VOB/, @error_list )
+                            );
 if ( $label_exists && $last_result )
+{
     $label_is_locked = ($last_result =~ m~unlocked~)? 0:1;
+}
 Verbose ("Check label: Exist:$label_exists, Locked:$label_is_locked");
 #-------------------------------------------------------------------------------
 #   Process command
 #       Create a label
+#
 if ( $opt_create || ( $opt_auto && ! $label_exists ) )
+{
     Verbose ("Create label");
     Error ("Label already exists") if ( $label_exists );
     my @opts;
     push @opts, '-global' if ( $opt_admin_vob );
     ClearCmd ("mklbtype", @opts, "$label$vob_desc" ) unless $opt_test;
     Error ("Program Terminated") if ( @error_list );
     $opr_done = 1;
+    $label_exists = 1;
+}
 #-------------------------------------------------------------------------------
 #   Process command
 #       Unlock a label - if it was locked
 #-------------------------------------------------------------------------------
 #   Process command
 #       Label files and directories
-if ( $opt_label || ( $opt_auto && ! $opt_clone ) )
+if ( $opt_label || ( $opt_auto && ! $opt_clone && ! $opt_entire_view ))
+{
     my $label_error;
     my @cmd_opt;
     my %info;
     push @cmd_opt, "-replace" if ( $opt_replace );
     show_warning ("WARNING: Labels NOT applied to element-0 of files", 'element0_list' );
     print        ("WARNING: Path to the VOB root contains a symbolic link. Labeling incomplete") if ( $info{'is_symlink'} );
     show_warning ("WARNING: Multiple build.pl files labeled", 'build_files', 1 );
     Error ("Program Terminated") if ( $label_error );
+    $opr_done = 1;
+}
+#-------------------------------------------------------------------------------
+#   Process command
+#       Label entire view.
+#       Intended for 'buildtool' use as its not as flexible, bit it is faster
+#
+if ( $opt_entire_view )
+{
+    #
+    #   The -recurse option doesn't do a good job of reporting
+    #   errors if the label does not exist. Ensure thatit exists
+    #
+    Error ("Label does not exist: $label")
+        unless ( $label_exists );
+    #
+    #   Calculate the root of the vob
+    #
+    my $here =  getcwd();
+    Verbose ("Current dir: $here");
+    $here =~ m~^(.*$vob_base)~;
+    my $base_dir = $1;
+    Verbose ("Path of base: $base_dir");
+    Error ("Calculating Vob Root: $base_dir" ) unless ( -d  $base_dir );
+    Message ("Labeling ENTIRE view", $base_dir);
+    #
+    #   Use -recurse option to label the entire view
+    #
+    my @cmd_opt = ('-recurse', '-follow');
+    push @cmd_opt, '-replace' if ( $opt_replace );
+    ClearCmd ("mklabel", @cmd_opt, $label, $base_dir  ) unless ( $opt_test );
+    #
+    #   Can't use the return value or the error list as the command will
+    #   report errors for many different conditions
+    #
+    #   Look at the tail of @last_results
+    #   The last line is the most informative.
+    #       Check that its in the right form. ie: ' nnn failed'
+    #
+    Error ("Cannot parse comamnd result for recursive label", $last_result )
+        unless ( $last_result =~ m~(\d+)\s+failed~ );
+    my $fail_count = $1;
+    if ( $fail_count )
+    {
+        #
+        #   Pretty up the error list
+        #
+        #
+        @error_list = grep ( !/No such file or directory.$/, @error_list );
+        @error_list = grep ( !/^Created label/, @error_list );
+        Error ("Labeling entire view: $fail_count Errors" );
+    }
+    Message ("Labeling entire view", @last_results[-5 .. -1 ]);
+    #
-    #   Double check the label process
+    #   Since we don't have 100% confidence in this 'new' labeling
-    #   We are seeing issues with ClearCase where a file, or dir, is not being
+    #   process, within the auto build environment we will double
+    #   check the process.
+    #
-    #   labeled. The following is a quick check. See if there is any thing to
+    #   Note: This test can be removed at some time in the future
-    #   label again
+    #         When we have more faith in the process
+    #
     unless ( $opt_test )
+    {
-        %info = ();
+        my %info = ();
+        @opt_files = ();
+        @opt_dirs = $base_dir;
+        undef $opt_up;
+        $opt_recurse = 1;
-        determine_dirs_to_label ( \%info );
+        Message ("Double checking labeling");
         determine_files_to_label( \%info );
-        if ( @{$info{'dir_list'}}  || @{$info{'label_list'}} )
+        if ( @{$info{'label_list'}} )
+        {
             DebugDumpData("DoubleCheck Data", \%info );
             Error ('ClearCase label problem detected',
                    'Please report to david.purdie@vix-erg.com',
-                   'Directories and Files not labled as requested:',
+                   'Directories and Files not recursively labled as requested'
-                   @{$info{'dir_list'}},
-                   @{$info{'label_list'}}
                    );
+        }
+    }
     $opr_done = 1;
         my $find_arg = $opt_recurse && !$doing_files ? '' : '-nrecurse';
         my $cmd = QuoteCommand ("cleartool", "find", "$dir", "-cview", $find_arg, "-version", "{!lbtype($label)}", "-print");
         Verbose2($cmd);
         my $cmd_handle;
+        @error_list = ();
+        @last_results = ();
+        $last_result = undef;
         open($cmd_handle, "$cmd 2>&1 |") || Error( "can't run command: $!");
         while (<$cmd_handle>)
+        {
+            #
             #   Filter output from the user
+{
     my $cmd = QuoteCommand (@_);
     Verbose2 "cleartool $cmd";
         @error_list = ();
+        @last_results = ();
+        $last_result = undef;
         my $cmd_handle;
         open($cmd_handle, "cleartool $cmd  2>&1 |")    || Error "can't run command: $!";
         while (<$cmd_handle>)
+        {
             chomp;
             $last_result = $_;
+            $last_result =~ tr~\\/~/~s;
+            push @last_results, $last_result;
             Verbose ( "cleartool resp:" . $_);
             push @error_list, $_ if ( m~Error:~ );
+        }
         close($cmd_handle);
     -man               - Full documentation
     -auto              - Auto create and label
     -clone=xxx         - Apply new label to objects with label xxx
     -create            - Create a label
     -label             - Labels a directory tree
+    -entireview        - Labels entire view
     -lock              - Lock the label
     -remove            - Remove label from elements
     -delete            - Delete label label from elements and vob
     -rename=xxx        - Rename a label
     -show              - Show elements with the label
 The -replace option may be used to force labels to be moved.
 The -norecurse option may be used to prevent recursion into all subdirectories,
 and the labeling of any directories.
+=item B<-entireview>
+This option will label all the files and directories in the current view. It may be
+invoked at any point within the view.
+This option is intended to be used by the 'autobuild' process. It is not as
+flexible as the B<-label> option, nor can it be used in conjunction with
+may other options.
+The -replace option may be used to force labels to be moved.
+The option will determine the root of the vob and label all components in the
+current view, following vib-symbolic links in the process.
 =item B<-lock>
 This option will lock the specified label. This operation will be done after any
 other operations have been performed.  If the label is already locked then
 this operation will not attempt to lock the label.

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/jats_label.pl @ 335 – Rev 329 → 331