path: root/config/cvsu

#!/usr/bin/perl -w
# An efficient substitute for `cvs -n update'.

use strict;
use Getopt::Long;

# Do a quick check to see what files are out of date.
# tromey Thu Mar 16 1995
#
# derived from http://www.cygnus.com/~tromey/ - jmm

# To Do:
# Add option to include leading (non-`.') directory names of mentioned files

(my $VERSION = '$Revision: 1.1 $ ') =~ tr/[0-9].//cd;
(my $program_name = $0) =~ s|.*/||;

my @months = qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my @days = qw (Sun Mon Tue Wed Thu Fri Sat);

my $debug = 0;

# If this is set, do only local files.
my $local = 0;

# If this is set, show conflicts with C
my $conflicts = 0;

# If this is set, then don't check any dates and just print the names
# of all version-controlled files (but no directories).
my $list_all_files = 0;

# Regex that matches file (as opposed to dir) entries in CVS/Entries.
# Note that we allow an empty value ('*' vs '+') for timestamp, to
# work around an odd bug in CVS.
my $file_entry_re = qr{^/([^/]+)/([^/]+)/([^/]*)};

sub usage ($)
{
  my ($exit_code) = @_;
  no strict 'refs';
  no strict 'subs';
  my $STREAM = ($exit_code == 0 ? STDOUT : STDERR);
  if ($exit_code != 0)
    {
      print $STREAM "Try `$program_name --help' for more information.\n";
    }
  else
    {
      print $STREAM <<EOF;
Usage: $program_name [OPTIONS] [DIRECTORY]...

An efficient substitute for `cvs -n update'.

In a cvs-checked-out working directory, list all cvs-controlled files
that have been modified (or even touched but not changed), cvs added, or
cvs removed.  This script is a lot faster than `cvs -n update' because
it doesn't use the repository.  So for people at remote sites, it's MUCH
faster.  Also, when you have changes to files in subdirectories, the
listing it produces is more useful since it includes the relative path
name on each line indicating an Added, Removed, or Modified file.

NOTE: since $program_name works only on the local files it may indicate
files are modified that cvs can determine where merely touched. Similarly
files with a C may have had conflicts that have since been removed.

Here are the options:

   --list-all-files   don't check any dates; just print the names of all
                        version-controlled files (but no directories)
   --local (-l)       don't process subdirectories (like cvs' -l option)
   --help             display this help and exit
   --version          output version information and exit
   --conflicts        show conflicts with C instead of the default M

EOF
    }
  exit $exit_code;
}

sub do_directory ($$);

{
  GetOptions
    (
     debug => \$debug,
     'list-all-files' => \$list_all_files,
     conflicts => \$conflicts,
     local => \$local,
     l => \$local,
     help => sub { usage 0 },
     version => sub { print "$program_name version $VERSION\n"; exit },
    ) or usage 1;

  unshift (@ARGV, ".") if !@ARGV;
  # print "$#ARGV ; $ARGV[0], $ARGV[1]\n";
  foreach (@ARGV)
    {
      do_directory ($_, 1);
    }

  exit 0;
}

sub do_directory ($$) {
    my ($thisdir, $is_command_line_arg) = @_;

    $thisdir =~ s,^\./,,;
    my $prefix = ($thisdir eq '.' ? '' : "$thisdir/");

    print "\tCALL; thisdir = $thisdir\n"
      if $debug;

    # Scan CVS/Entries.
    my %version;
    my %entries;
    my %is_dir;

    my $entries_file = "${prefix}CVS/Entries";
    if ( ! open (ENTRIES, '<', $entries_file))
      {
	my $warn = $is_command_line_arg ? '' : "Warning: ";
	warn "$program_name: ${warn}couldn't open $entries_file: $!\n";
	$is_command_line_arg
	  and exit 1;
	return;
      }

    while (<ENTRIES>) {
        # Ignore entries for directories.
	if (m,^D,)
	  {
	    next if /^D$/;
	    if (m,^D/([^/]+)/,)
	      {
		$is_dir{$1} = 1;
		next;
	      }
	    # else fall through so we get the `invalid line' error
	  }

	/$file_entry_re/
	    || die "$program_name: $entries_file: $.: invalid line\n";
	$entries{$1} = $3 || 'Empty-Timestamp';
	$version{$1} = $2;
    }
    close (ENTRIES);

    # process Entries.Log file if it exists
    # lines are prefixed by A (add) or R (remove)
    # we add or delete accordingly.
    my $entries_log_file = "${prefix}CVS/Entries.Log";
    my $type;
    if (open (ENTRIES, "< $entries_log_file")) {
	while (<ENTRIES>) {
	    if (!/^([AR]) (.*)$/) {
		warn "$program_name: $entries_log_file: $.: unrecognized line format\n";
		next;
	    }
	    ($type, $_) = ($1,$2);
	    # Ignore entries for directories.
	    if (m,^D,)
	      {
		next if /^D$/;
		if (m,^D/([^/]+)/,)
		  {
		    if ($type eq 'A') {
			$is_dir{$1} = 1;
		    } else {
			delete $is_dir{$1};
		    }
		    next;
		  }
		# else fall through so we get the `invalid line' error
	      }

	/$file_entry_re/
		|| die "$program_name: $entries_log_file: $.: invalid line\n";
	    if ($type eq 'A') {
		$entries{$1} = $3;
		$version{$1} = $2;
	    } else {
		delete $entries{$1};
		delete $version{$1};
	    }
	}
	close (ENTRIES);
    }

    foreach (sort keys %entries) {
	# Handle directories later.
	die "$program_name: bogus entry: $prefix$_\n"
	  if ($_ eq 'CVS' || $_ eq '.' || $_ eq '..');
	(print "$prefix$_\n"), next if $list_all_files;
	next if -l "$prefix$_";
	next unless $entries{$_};
	if ($version{$_} =~ /^-/)
	  {
	    # A negative revision number (e.g., `-1.9') means the file is
	    # slated for removal.
	    print "R $prefix$_\n";
	    next;
	  }
	elsif ($version{$_} eq '0')
	  {
	    # A revision number of `0' means the file is slated for addition.
	    print "A $prefix$_\n";
	    next;
	  }

	# These strings appear in the date field only for additions
	# and removals.
	die "$program_name: unexpected entry for $_: $entries{$_}\n"
	  if $entries{$_} eq 'dummy timestamp'
	    || $entries{$_} =~ /^Initial /;

	next unless -f _;

	my $mtime = (stat _) [9];
	print "\t$mtime $_\n"
	  if $debug;
	my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime ($mtime);
	my $s = ($days[$wday] . ' ' . $months[$mon] . ' '
	      . sprintf ("%2d %02d:%02d:%02d %02d", $mday, $hour, $min,
			 $sec, 1900 + $year));
	if ($entries{$_} ne $s) {
	    my $t = 'M';
	    $t = 'C'
		if ($conflicts && $entries{$_} =~ /^Result of merge\+/);
	    print "$t $prefix$_\n";
	    if ($debug) {
		print "\t$entries{$_}\n";
		print "\t$s\n";
		print "================\n";
	    }
	}
    }

    # Now do directories.
    if (!$local)
      {
	foreach (sort keys %is_dir)
	  {
	    print "\tdir = $thisdir, _ = $_\n"
	      if $debug;
	    do_directory ("$prefix$_", 0);
	  }
      }
}