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

 my @opt_files;
 my @opt_dirs;
 my $opt_comment;
 my $opt_vob;
 my $opt_user;
+my $opt_admin_vob;
 my $label;
 my $user_cwd;
 my @error_list;
 my $last_result;
                 "files=s"       => \@opt_files,             # Multiple strings
                 "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
                 );
+                #
                 #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
 if ( $opt_create || ( $opt_auto && ! $label_exists    ) )
+{
     Verbose ("Create label");
     Error ("Label already exists") if ( $label_exists );
-    my $opts = '-nc';
+    my @opts;
-    $opts = '-c "' . $opt_comment . '"' if ( $opt_comment );
+    push @opts, $opt_comment ? ( '-c', '"' . $opt_comment . '"' ) : '-nc';
+    push @opts, '-global' if ( $opt_admin_vob );
-    ClearCmd ("mklbtype", $opts, "$label$vob_desc" ) unless $opt_test;
+    ClearCmd ("mklbtype", @opts, "$label$vob_desc" ) unless $opt_test;
     Error ("Program Terminated") if ( @error_list );
     $opr_done = 1;
+}
 #-------------------------------------------------------------------------------
+    #
     $data->{'dir_list'} = [];
     $data->{'checked_out_pdirs'} = [];
     $data->{'is_symlink'} = 0;
     $data->{'VobRoot'} = '';
+    $data->{'DirsSeen'} = {};
+    #
     #   Figure out what to do
     #       Label dirs upwards if requested, or we are not doing files or dirs
     #       Label the current directory unless asked to do files/dirs or up-only
+    #
     my $do_files = scalar @opt_files;
     my $do_dirs  = scalar @opt_dirs;
     my $do_up = $opt_up || ( ! $do_files && ! $do_dirs );
-    push @opt_dirs, '.' unless ($opt_up || $do_files || $do_dirs);
+    #
     #   Build up a list of parent directories up to the root of the VOB
     #   that do not have the desired label
+    #
     if ( $do_up )
+    {
         Verbose ("Examine parent directories");
+        examine_directory (getcwd(), $data, 1);
+        #
+        #   If the user has provided a list of directories or files then we should label
+        #   the directory components too
+        #
-        my $path = getcwd();
+        my @dirs_from_files;
-        while ( 1 )
+        foreach my $file ( @opt_files )
+        {
-            my $cmd = QuoteCommand ("cleartool", "describe", $path);
-            my $has_label;
-            my $is_versioned;
+            my $dir = $file;
-            my $start_labels;
+            $dir =~ tr~\\/~/~s;
-            my $link;
-            my $is_checkedout;
-            Verbose($cmd);
-            my $cmd_handle;
-            open($cmd_handle, "$cmd 2>&1 |") || Error( "Can't run command: $!");
-            while (<$cmd_handle>)
-            {
-                #
-                #   Filter output from the user
+            $dir =~ s~/[^/]+$~~ unless ( -d $dir);
-                #
-                chomp;
-                Verbose2($_);
+            push @dirs_from_files, $dir;
-                push @error_list, $_    if ( m~Error:~ );
-                $link = $1              if ( m~^symbolic link.* -> (.*)~ );
-                $is_versioned = 1       if ( m~^directory version ~ );
-                $start_labels = 1       if ( m~^\s+Labels:$~ );
-                $is_checkedout = 1      if ( m~[\\/]CHECKEDOUT"~ );
-                next unless ( $start_labels );
-                $has_label = 1          if ( m~^\s+$label$~ );
-            }
+        }
-            close($cmd_handle);
-            $data->{'VobRoot'} = $path;
-            #
-            #   Symbolic link located
-            #   Resolve the link and continue
-            #   The link cannot be labeled. If we can label the resolved link then
-            #   all is good, otherwise we have a a problem
+        foreach my $dir ( @opt_dirs , @dirs_from_files)
-            #
+        {
-            if ( $link )
+            examine_directory ($dir, $data);
-            {
+        }
-                $data->{'is_symlink'} = 1;
-                $path =~ s~[/][^/]*$~~;
-                $path = $path . '/' . $link;
-                $path =~ s~/[^/]+/\.\./~/~;
-                Verbose("Symbolic link: $link, Path: $path" );
-                next;
-            }
+    }
+}
+#-------------------------------------------------------------------------------
-            #
+# Function        : examine_directory
+#
-            #   Parent directory checked out. Options:
+# Description     : Examine one directory entry
+#
-            #       0: Don't Label checkedout elements
+# Inputs          : $path           - Path to examine
-            #       1: Do Label only checkout elements
+#                   $data           - Ref to hash to collect info
-            #       2: Label both (default)
+#                   $find_root      - Finding root
+#
-            #
+# Returns         :
+#
-            if ( $is_checkedout )
+sub examine_directory
-            {
+{
-                $has_label = 2 if ( $opt_checkout == 0 );
-                push @{$data->{'checked_out_pdirs'}}, $_;
+    my ($path, $data, $find_root) = @_;
-            }
-            else
+    my $is_symlink;
-            {
-                $has_label = 2 if ( $opt_checkout == 1 );
-            }
+    $path =~ tr~\\/~/~s;
+    while ( 1 )
+    {
-            last unless ( $is_versioned );
+        return if ( defined $data->{'DirsSeen'}{$path} );
-            unshift @{$data->{'dir_list'}}, $path unless ( $has_label );
+        $data->{'DirsSeen'}{$path} = 1;
+        my $cmd = QuoteCommand ("cleartool", "describe", $path);
-            #
+        my $has_label;
-            #   Versioned directory seen
+        my $is_versioned;
-            #   If the previous one loop was a symlink, then we have labeled
-            #   the link correctly
+        my $start_labels;
-            #
+        my $link;
-            $data->{'is_symlink'} = 0;
+        my $is_checkedout;
+        Verbose($cmd);
+        my $cmd_handle;
+        open($cmd_handle, "$cmd 2>&1 |") || Error( "Can't run command: $!");
+        while (<$cmd_handle>)
+        {
+            #
-            #   Calculate the path of the parent directory
+            #   Filter output from the user
-            #   Stop when we get to the top ( ie z: is not good )
+            #
+            chomp;
+            Verbose2($_);
+            push @error_list, $_    if ( m~Error:~ );
+            $link = $1              if ( m~^symbolic link.* -> (.*)~ );
+            $is_versioned = 1       if ( m~^directory version ~ );
+            $start_labels = 1       if ( m~^\s+Labels:$~ );
+            $is_checkedout = 1      if ( m~[\\/]CHECKEDOUT"~ );
+            next unless ( $start_labels );
+            $has_label = 1          if ( m~^\s+$label$~ );
+        }
+        close($cmd_handle);
+        $data->{'VobRoot'} = $path if ( $find_root );
+        #
+        #   Symbolic link located
+        #   Resolve the link and continue
+        #   The link cannot be labeled. If we can label the resolved link then
+        #   all is good, otherwise we have a a problem
+        #
+        if ( $link )
+        {
+            $is_symlink = 1;
-            last unless ( $path =~ s~[/][^/]*$~~);
+            $path =~ s~[/][^/]*$~~;
-            last unless ( $path =~ m~/~ );
+            $path = $path . '/' . $link;
+            $path =~ s~/[^/]+/\.\./~/~;
+            Verbose("Symbolic link: $link, Path: $path" );
+            next;
+        }
+        #
+        #   Parent directory checked out. Options:
+        #       0: Don't Label checkedout elements
+        #       1: Do Label only checkout elements
+        #       2: Label both (default)
+        #
+        if ( $is_checkedout )
+        {
+            $has_label = 2 if ( $opt_checkout == 0 );
+            push @{$data->{'checked_out_pdirs'}}, $_;
+        }
+        else
+        {
+            $has_label = 2 if ( $opt_checkout == 1 );
+        }
+        last unless ( $is_versioned );
+        unshift @{$data->{'dir_list'}}, $path unless ( $has_label );
+        #
+        #   Versioned directory seen
+        #   If the previous one loop was a symlink, then we have labeled
+        #   the link correctly
+        #
+        $is_symlink = 0;
+        #
+        #   Calculate the path of the parent directory
+        #   Stop when we get to the top ( ie z: is not good )
+        #
+        last unless ( $path =~ s~[/][^/]*$~~);
+        last unless ( length $path);
+        last if ( $path =~ m~:$~ );
+    }
+    #
+    #   Accumulate bad symlinks
+    #
+    $data->{'is_symlink'}++
+        if ( $is_symlink );
+}
 #-------------------------------------------------------------------------------
 # Function        : determine_files_to_label
+#
 # Description     : Determine a list of files that need to be
 #                   labeled.
     #       Label dirs upwards if requested, or we are not doing files or dirs
     #       Label the current directory unless asked to do files/dirs or up-only
+    #
     my $do_files = scalar @opt_files;
     my $do_dirs  = scalar @opt_dirs;
-    my $do_up = $opt_up || ( ! $do_files && ! $do_dirs );
     push @opt_dirs, '.' unless ($opt_up || $do_files || $do_dirs);
     my @check_these;
+    #
     #   Use the cleartool find command as it will allow us to determine
     #   if the element has already been labled.
+    #
     #   Note: cleartool find works on files and directories
+    #
+    my $doing_files = 0;
-    foreach my $dir (@opt_files, @opt_dirs )
+    foreach my $dir (@opt_dirs ,undef, @opt_files )
+    {
+        if ( ! defined $dir )
+        {
+            $doing_files = 1;
+            next;
+        }
+        #
+        #   If this element is from the files option and its not a file
+        #   this skip it - the path will have been processed
+        #
+        next if ($doing_files  && -d $dir );
+        #
         #   Remove possible trailing / from user specified directory as
         #   clearcase doesn't handle these too well.
+        #
         $dir =~ tr~\\/~/~s;
         $dir =~ s~/+$~~;
         $dir = '/' unless ( $dir );
         Verbose ("Examine subdirectory: $dir");
-        my $find_arg = $opt_recurse ? '' : '-nrecurse';
+        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;
         open($cmd_handle, "$cmd 2>&1 |") || Error( "can't run command: $!");
     -[no]mine          - Set label owner to user.
     -info              - Provide label information
     -smartlock         - Unlock and Relock label, if it was locked
  Modifiers
+    -admin             - Modifies label creation to create global label
     -all               - Process all the VOB. Use with -show and -remove.
     -replace           - Replace existing labels. Use with -label
     -exclude=n1,n2     - Exclude files and directories from the -label process.
     -files=f1,f2,...   - Label only the named files.
     -dirs=d1,d2,...    - Label only the named dirs.
 Wildcards are not supported.
 Directories will not be recursed, but may be labeled.
+The component paths of the named path will also be labeled, when the B<-up> is
+used.
 =item B<-dirs=name>
 Label only the specified directories. The names may be comma separated, or the
 option may be specified multiple times.
 and the entire file tree will not be scanned. Only the specified directories
 will be labeled.
 Wildcards are not supported.
+The component paths of the named path will also be labeled, when the B<-up> is
+used.
 =item B<-label>
 This option will label all the files in, and below, the current directory and
 all the parent directories.
 operation is performed automatically when a -rename operation occurs. The
 "no" option allows this behaviour to be modified.
 =item B<-up>
-This option will prevent the utility for labeling files and directories below
+This option will prevent the utility from labeling files and directories below
 the current directory. Only directories above the current directory will be
 labeled.
 This option may be specifically used with -dirs and -files to label the named
 directories and files as well as the directoires up, from the current directory.
 This option is used by commands that do not acutally place labels on files to
 manipulate when the user's current directry is not within a view. This allows lables to be created,
 locked and unlocked without having a view present.
+=item B<-admin>
+This option modifies the label creation process to create a global label. This
+may be used in an admin vob.
 =back
 =head1 DESCRIPTION
 This program provides a number of useful ClearCase labeling operations. These

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/jats_label.pl @ 321 – Rev 315 → 319