Re: address@hidden: obtaining tags]

[Mark D. Baushke]

Hi Rob,

Rob Helmer asked the info-cvs mailing list:
>What's the easiest way to grab a list of tags for all files
>in a given repository? I'd like to do this for part of my
>build system.

You may find the following perl script useful for this purpose.
It is a script I hacked together quickly some time ago.

I wrote it to be able to get symbolic tags out of ALL of the files in
a repository (including obsolete 'Attic' files). I also had a need to
figure out which tags were used during a 'cvs import' as distinct from
those applied over files that had been locally modified. So, I
separated symbolic names into:
        cvs import vendor branch names
        cvs import vendor version names
        cvs branch names
        cvs version names

This script goes directly to the cvs repository rather than using the
'cvs log' command to be able to have visibility into Attic files.  It
also reads the entire ,v file instead of just the parts that contain
the symbols entries. This is a waste and so you could hack it to read
only the first few disk records until it sees all of the 'symbols.*;'
section of the RCS file.

If you do not need all the labels found in the Attic files, then a
version based on parsing the output of 'cvs log' such as you
previously mentioned being available at
http://www.focusresearch.com/gregor/ltag/ would be better to use.
I thought about hacking something like this feature into cvs, but I
did not really see the need for it as this knock-off script did the
job I needed done in the short term.

        Enjoy!
        -- Mark

               --------------- cut here ---------------
#!/usr/local/bin/perl
#
# Copyright (c) 2000, by Mark D. Baushke
#   All rights reserved.
#
# You may distribute under the terms of the GNU General Public License as
# specified in the README file that comes with the CVS source distribution.
#
# Version: 0.2 -- add parsing for remote cvs server
# Version: 0.1 -- initial version
#

use strict;
require 5.003;

use File::Find;
use Getopt::Std;
use vars qw(%symbol_branch %symbol_version %vendor_branch %vendor_import
            $opt_d $opt_h $opt_v $verbose);

select(STDERR); $| = 1;         # no buffering of stderr
select(STDOUT);

getopts('d:hv');

$verbose = 1 if ($opt_v);       # provide more verbosity

if ($opt_h) {
    print(join("\n",
               "Usage: $0 [-h] [-v] [-d cvsroot] [modules]",
               "-h         print this usage message",
               "-d cvsroot specify the cvsroot",
               "-v         verbose",
               "modules    optional list of modules to search for tags",
               ''));
    exit 0;
}

my($cvsroot) = $ENV{'CVSROOT'};
if ( -f 'CVS/Repository' ) {
    if (open(FILE, 'CVS/Root')) {
        chomp($cvsroot = <FILE>);
        close(FILE);
    }
}
$cvsroot = $opt_d if ($opt_d ne '');

my($rsh) = 'rsh';                       # default access method
$rsh = $ENV{'CVS_RSH'} if (defined($ENV{'CVS_RSH'})); # cvs override

# user to use for remote operation
my($login) = $ENV{'USER'} || getlogin || (getpwuid($<))[0];

my($user) = $login;             # default to using current user remotely
my($host) = 'localhost';        # default to using the current host
my($repository);
my(@modules) = @ARGV;           # list of modules

#
# Intuit the kind of CVSROOT we have
# host:path
# :ext:address@hidden:path
# :pserver:address@hidden:path (this form is not supported by this script)
#
if ($cvsroot =~ /:/) {
    if (scalar(($cvsroot =~ tr/:/:/)) == 1) {
        # old-style host:/path/to/directory
        ($host, $repository) = split(/:/, $cvsroot);
    } else {
        if ($cvsroot =~ /:ext:(address@hidden)address@hidden([^:])+:(.*)$/) {
            $user = $1;
            $host = $2;
            $repository = $3;
        } elsif ($cvsroot =~ /^:pserver:/) {
            print(STDERR "pserver mode not supported for $0\n");
            exit 1;
        } else {
            print(STDERR "Unable to parse $cvsroot\n");
            exit 1;
        }
    }
} else {
    $repository = $cvsroot;
}

if ($host ne 'localhost') {
    my($cmd);

    # If the repository is on a remote machine, attempt to
    # run this script remotely. This will fail if
    # /usr/local/bin/find-all-tags.perl is not installed on your
    # cvs server machine(s).
    $cmd  = "$rsh -l $user $host $0 -d $repository";
    $cmd .= join(' ', @modules) if (scalar(@modules) > 0);
    $cmd .= "</dev/null";
    print STDERR "$cmd\n" if ($verbose);
    system($cmd);
} else {
    my(@dirs);

    # If we are running on the local host, then it is time
    # to enumerate the direstories to be searched for ,v files.
    push(@modules, '.') if (scalar(@modules) == 0);

    # put the full directory pathnames together
    for my $module (@modules) {
        push(@dirs, $repository.'/'.$module);
    }
    print(STDERR "Starting find in ", join(' ', @dirs), "\n") if ($verbose);
    File::Find::find(\&wanted, @dirs); # find calls wanted for each name

    # print the results of the search.
    # for now ignore the count of files that contain these branches
    print(join("\n\t",
               "Vendor branch tags:",
               (sort keys %vendor_branch)),
          "\n",
          join("\n\t",
               "Vendor import version tags:",
               (sort keys %vendor_import)),
          "\n",
          join("\n\t",
               'Branch tags:',
               (sort keys %symbol_branch)),
          "\n",
          join("\n\t",
               "Version tags:",
               (sort keys %symbol_version)),
          "\n");
}
exit 0;

########################################################################
#
# subroutines
#
########################################################################

# read a CVS repository ,v file and extract the tag symbols
# and versions.
sub seek_tag_names {
    my($file) = @_;
    my($tag, $ver);
    my($text, $symbols);

    undef $/;
    if (open(FILE, $file)) {
        $text = <FILE>;         # slurp the entire file
        close(FILE);
    } else {
        print(STDERR "Unable to open $file: $!");
        return;
    }

    # find the subset of the file containing tag information
    if ($text =~ /^\s*symbols([^\;]*);/ms) {
        $symbols = $1;
    } else {
        return;                 # no symbols found
    }

    # canonicalize the form of the symbol list
    $symbols =~ s/\s+/\n/g;
    foreach (split(/\n/, $symbols)) {
        next if ($_ eq '');     # nothing useful here
        ($tag,$ver) = split(':'); # symbolicversion:numeric.version

        if ($ver =~ /\.0\.\d+$/) {
            # cvs magic branches have a zero for the second-to-last
            # version number
            $symbol_branch{$tag}++;
        } elsif (!(scalar($ver =~ tr/\./\./) & 1)) {
            # an even number of dots implies vendor or rcs branch
            # For CVS this will usually be version 1.1.1, but no
            # check is being made here to enforce this assumption.
            $vendor_branch{$tag}++;
        } elsif ($ver =~ /\d+\.\d+\.\d*[13579]\.\d+$/) {
            # An imported branch version will usually end up
            # on the 1.1.1 default vendor branch, but any
            # odd number as the second-to-last element is
            # not a vanilla CVS branch version, so call it
            # a vendor imported version.
            $vendor_import{$tag}++;
        } else {
            # A normal CVS version number
            $symbol_version{$tag}++;
        }
    }
}

# Process each CVS repository ,v file found
sub wanted {
    print "searching in $File::Find::name ...\n"
        if ( $verbose && -d $File::Find::name );
    seek_tag_names($File::Find::name) if (/,v$/);
}