build-aux/cvsu

   1 #! /usr/bin/perl -w
   2
   3 # cvsu - do a quick check to see what files are out of date.
   4 #
   5 # Copyright (C) 2000-2005  Pavel Roskin <proski@gnu.org>
   6 # Initially written by Tom Tromey <tromey@cygnus.com>
   7 # Completely rewritten by Pavel Roskin <proski@gnu.org>
   8 #
   9 # This program is free software; you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 2, or (at your option)
  12 # any later version.
  13 #
  14 # This program is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program; if not, write to the Free Software
  21 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  22 # 02111-1307, USA.
  23
  24
  25 require 5.004;
  26 use Getopt::Long;
  27 use File::Basename;
  28 use Time::Local;
  29 use strict;
  30
  31 use vars qw($list_types %messages %options @batch_list $batch_cmd
  32             $no_recurse $explain_type $find_mode $short_print
  33             $no_cvsignore $nolinks $file $single_filename $curr_dir
  34             @common_ignores $ignore_rx %entries %subdirs %removed);
  35
  36 use constant SUBDIR_FOUND => 1;
  37 use constant SUBDIR_CVS   => 2;
  38
  39 # This list comes from the CVS manual.
  40 use constant STANDARD_IGNORES =>
  41         ('RCS', 'SCCS', 'CVS', 'CVS.adm', 'RCSLOG', 'cvslog.*', 'tags',
  42          'TAGS', '.make.state', '.nse_depinfo', '*~', '#*', '.#*', ',*',
  43          "_\$*", "*\$", '*.old', '*.bak', '*.BAK', '*.orig', '*.rej',
  44          '.del-*', '*.a', '*.olb', '*.o', '*.obj', '*.so', '*.exe',
  45          '*.Z', '*.elc', '*.ln', 'core');
  46
  47 # 3-letter month names in POSIX locale, for fast date decoding
  48 my %months = (
  49     "Jan" => 0,
  50     "Feb" => 1,
  51     "Mar" => 2,
  52     "Apr" => 3,
  53     "May" => 4,
  54     "Jun" => 5,
  55     "Jul" => 6,
  56     "Aug" => 7,
  57     "Sep" => 8,
  58     "Oct" => 9,
  59     "Nov" => 10,
  60     "Dec" => 11
  61 );
  62
  63 # print usage information and exit
  64 sub usage ()
  65 {
  66     print "Usage:\n" .
  67         "  cvsu [OPTIONS] [FILE] ...\n" .
  68         "Options:\n" .
  69         "  --local              Disable recursion\n" .
  70         "  --explain            Verbosely print status of files\n" .
  71         "  --find               Emulate find - filenames only\n" .
  72         "  --short              Don't print paths\n" .
  73         "  --ignore             Don't read .cvsignore\n" .
  74         "  --messages           List known file types and long messages\n" .
  75         "  --nolinks            Disable recognizing hard and soft links\n" .
  76         "  --types=[^]LIST      Print only file types [not] from LIST\n" .
  77         "  --batch=COMMAND      Execute this command on files\n" .
  78         "  --help               Print this usage information\n" .
  79         "  --version            Print version number\n" .
  80         "Abbreviations and short options are supported\n";
  81     exit 0;
  82 }
  83
  84 # print version information and exit
  85 sub version ()
  86 {
  87     print "cvsu - CVS offline examiner, version 0.2.3\n";
  88     exit 0;
  89 }
  90
  91 # If types begin with '^', make inversion
  92 sub adjust_types ()
  93 {
  94     if ($list_types =~ m{^\^(.*)$}) {
  95         $list_types = "";
  96         foreach (keys %messages) {
  97             $list_types .= $_
  98                 if (index ($1, $_) < 0);
  99         }
 100     }
 101 }
 102
 103 # list known messages and exit
 104 sub list_messages ()
 105 {
 106     my $default_mark;
 107     print "Recognizable file types are:\n";
 108     foreach (sort keys %messages) {
 109         if (index($list_types, $_) >= 0) {
 110             $default_mark = "*";
 111         } else {
 112             $default_mark = " ";
 113         }
 114         print "  $default_mark $_ $messages{$_}\n";
 115     }
 116     print "* indicates file types listed by default\n";
 117     exit 0;
 118 }
 119
 120 # Initialize @common_ignores
 121 # Also read $HOME/.cvsignore and append it to @common_ignores
 122 sub init_ignores ()
 123 {
 124     my $HOME = $ENV{"HOME"};
 125
 126     push @common_ignores, STANDARD_IGNORES;
 127
 128     unless (defined($HOME)) {
 129         return;
 130     }
 131
 132     my $home_cvsignore = "${HOME}/.cvsignore";
 133
 134     if (-f "$home_cvsignore") {
 135
 136         unless (open (CVSIGNORE, "< $home_cvsignore")) {
 137             error ("couldn't open $home_cvsignore: $!");
 138         }
 139
 140         while (<CVSIGNORE>) {
 141             push (@common_ignores, split);
 142         }
 143
 144         close (CVSIGNORE);
 145     }
 146
 147     my $CVSIGNOREENV = $ENV{"CVSIGNORE"};
 148
 149     unless (defined($CVSIGNOREENV)) {
 150         return;
 151     }
 152
 153     my @ignores_var = split (/ /, $CVSIGNOREENV);
 154     push (@common_ignores, @ignores_var);
 155
 156 }
 157
 158 # Print message and exit (like "die", but without raising an exception).
 159 # Newline is added at the end.
 160 sub error ($)
 161 {
 162         print STDERR "cvsu: ERROR: " . shift(@_) . "\n";
 163         exit 1;
 164 }
 165
 166 # execute commands from @exec_list with $exec_cmd
 167 sub do_batch ()
 168 {
 169         my @cmd_list = split (' ', $batch_cmd);
 170         system (@cmd_list,  @batch_list);
 171 }
 172
 173 # print files status
 174 # Parameter 1: status in one-letter representation
 175 sub file_status ($)
 176 {
 177     my $type = shift (@_);
 178     my $item;
 179     my $pathfile;
 180
 181     return
 182         if $ignore_rx ne '' && $type =~ /[?SLD]/ && $file =~ /$ignore_rx/;
 183
 184     return
 185         if (index($list_types, $type) < 0);
 186
 187     $pathfile = $curr_dir . $file;
 188
 189     if (defined($batch_cmd)) {
 190         push (@batch_list, $pathfile);
 191         # 1000 items in the command line might be too much for HP-UX
 192         if ($#batch_list > 1000) {
 193             do_batch();
 194             undef @batch_list;
 195         }
 196     }
 197
 198     if ($short_print) {
 199         $item = $file;
 200     } else {
 201         $item = $pathfile;
 202     }
 203
 204     if ($find_mode) {
 205         print "$item\n";
 206     } else {
 207         $type = $messages{$type}
 208             if ($explain_type);
 209         print "$type $item\n";
 210     }
 211 }
 212
 213 # load entries from CVS/Entries and CVS/Entries.Log
 214 # Parameter 1: file name for CVS/Entries
 215 # Return: list of entries in the format used in CVS/Entries
 216 sub load_entries ($);
 217 sub load_entries ($)
 218 {
 219     my $entries_file = shift (@_);
 220     my $entries_log_file = "$entries_file.Log";
 221     my %ent = ();
 222
 223     unless (open (ENTRIES, "< $entries_file")) {
 224         error ("couldn't open $entries_file: $!");
 225     }
 226     while (<ENTRIES>) {
 227         chomp;
 228         $ent{$_} = 1;
 229     }
 230     close (ENTRIES);
 231
 232     if (open (ENTRIES, "< $entries_log_file")) {
 233         while (<ENTRIES>) {
 234             chomp;
 235             if ( m{^A (.+)} ) {
 236                 $ent{$1} = 1;
 237             } elsif ( m{^R (.+)} ) {
 238                 delete $ent{$1};
 239             } else {
 240                 # Note: "cvs commit" helps even when you are offline
 241                 error ("$entries_log_file:$.: unrecognizable line, " .
 242                         "try \"cvs commit\"");
 243             }
 244         }
 245         close (ENTRIES);
 246     }
 247
 248     return keys %ent;
 249 }
 250
 251 # process one directory
 252 # Parameter 1: directory name
 253 sub process_arg ($);
 254 sub process_arg ($)
 255 {
 256     my $arg = shift (@_);
 257     my %found_files = ();
 258
 259     # $file, $curr_dir, and $ignore_rx must be seen in file_status
 260     local $file = "";
 261     local $ignore_rx = "";
 262     local $single_filename = 0;
 263
 264     if ( $arg eq "" or -d $arg ) {
 265         $curr_dir = $arg;
 266         my $real_curr_dir = $curr_dir eq "" ? "." : $curr_dir;
 267
 268         error ("$real_curr_dir is not a directory")
 269             unless ( -d $real_curr_dir );
 270
 271         # Scan present files.
 272         file_status (".");
 273         opendir (DIR, $real_curr_dir) ||
 274             error ("couldn't open directory $real_curr_dir: $!");
 275         foreach (readdir (DIR)) {
 276             $found_files {$_} = 1;
 277         }
 278         closedir (DIR);
 279     } else {
 280         $single_filename = basename $arg;
 281         $curr_dir = dirname $arg;
 282         $found_files{$single_filename} = 1 if lstat $arg;
 283     }
 284
 285     $curr_dir .= "/"
 286         unless ( $curr_dir eq "" || $curr_dir =~ m{/$} );
 287
 288     # Scan CVS/Entries.
 289     my %entries = ();
 290     my %subdirs = ();
 291     my %removed = ();
 292
 293     foreach ( load_entries ("${curr_dir}CVS/Entries") ) {
 294         if ( m{^D/([^/]+)/} ) {
 295             $subdirs{$1} = SUBDIR_FOUND if !$single_filename;
 296         } elsif ( m{^/([^/]+)/([^/])[^/]*/([^/]*)/} ) {
 297             if ( !$single_filename or $single_filename eq $1 ) {
 298                 $entries{$1} = $3;
 299                 $removed{$1} = 1
 300                     if $2 eq '-';
 301             }
 302         } elsif ( m{^D$} ) {
 303             next;
 304         } else {
 305             error ("${curr_dir}CVS/Entries: unrecognizable line");
 306         }
 307     }
 308
 309     if ( $single_filename && !$entries{$single_filename} &&
 310          !$found_files{$single_filename} ) {
 311         error ("nothing known about $arg");
 312     }
 313
 314     # Scan .cvsignore if any
 315     unless ($no_cvsignore) {
 316         my (@ignore_list) = ();
 317
 318         if (-f "${curr_dir}.cvsignore") {
 319             open (CVSIGNORE, "< ${curr_dir}.cvsignore")
 320                 || error ("couldn't open ${curr_dir}.cvsignore: $!");
 321             while (<CVSIGNORE>) {
 322                 push (@ignore_list, split);
 323             }
 324             close (CVSIGNORE);
 325         }
 326
 327         my ($iter);
 328         foreach $iter (@ignore_list, @common_ignores) {
 329             if ($iter eq '!') {
 330                 $ignore_rx = ''
 331             } else {
 332                 if ($ignore_rx eq '') {
 333                     $ignore_rx = '^(';
 334                 } else {
 335                     $ignore_rx .= '|';
 336                 }
 337                 $ignore_rx .= glob_to_rx ($iter);
 338             }
 339         }
 340         $ignore_rx .= ')$'
 341             if $ignore_rx ne '';
 342     }
 343
 344     # File is missing
 345     foreach $file (sort keys %entries) {
 346         unless ($found_files{$file}) {
 347             if ($removed{$file}) {
 348                 file_status("R");
 349             } else {
 350                 file_status("U");
 351             }
 352         }
 353     }
 354
 355     foreach $file (sort keys %found_files) {
 356         next if ($file eq '.' || $file eq '..');
 357         lstat ($curr_dir . $file) ||
 358             error ("lstat() failed on $curr_dir . $file");
 359         if (! $nolinks && -l _) {
 360             file_status ("L");
 361         } elsif (-d _) {
 362             if ($file eq 'CVS') {
 363                 file_status ("C");
 364             } elsif ($subdirs{$file}) {
 365                 $subdirs{$file} = SUBDIR_CVS;
 366             } else {
 367                 file_status ("D"); # Unknown directory
 368             }
 369         } elsif (! (-f _) && ! (-l _)) {
 370             file_status ("S"); # This must be something very special
 371         } elsif (! $nolinks && (stat _) [3] > 1 ) {
 372             file_status ("H"); # Hard link
 373         } elsif (! $entries{$file}) {
 374             file_status ("?");
 375         } elsif ($entries{$file} =~ /^Initial |^dummy /) {
 376             file_status ("A");
 377         } elsif ($entries{$file} =~ /^Result of merge/) {
 378             file_status ("G");
 379         } elsif ($entries{$file} !~
 380                 /^(...) (...) (..) (..):(..):(..) (....)$/) {
 381             error ("Invalid timestamp for $curr_dir$file: $entries{$file}");
 382         } else {
 383             my $cvtime = timegm($6, $5, $4, $3, $months{$2}, $7 - 1900);
 384             my $mtime = (stat _) [9];
 385             if ($cvtime == $mtime) {
 386                 file_status ("F");
 387             } elsif ($cvtime < $mtime) {
 388                 file_status ("M");
 389             } else {
 390                 file_status ("O");
 391             }
 392         }
 393     }
 394
 395     # Now do directories.
 396     unless ($no_recurse) {
 397         my $save_curr_dir = $curr_dir;
 398         foreach $file (sort keys %subdirs) {
 399             if ($subdirs{$file} == SUBDIR_FOUND) {
 400                 $curr_dir = $save_curr_dir;
 401                 file_status ("X");
 402             } elsif ($subdirs{$file} == SUBDIR_CVS) {
 403                 process_arg ($save_curr_dir . $file)
 404             }
 405         }
 406     }
 407 }
 408
 409 # Turn a glob into a regexp without recognizing square brackets.
 410 sub glob_to_rx_simple ($)
 411 {
 412     my ($expr) = @_;
 413     # Quote all non-word characters, convert ? to . and * to .*
 414     $expr =~ s/(\W)/\\$1/g;
 415     $expr =~ s/\\\*/.*/g;
 416     $expr =~ s/\\\?/./g;
 417     return $expr;
 418 }
 419
 420 # Turn a glob into a regexp
 421 sub glob_to_rx ($)
 422 {
 423     my $result = '';
 424     my ($expr) = @_;
 425     # Find parts in square brackets and copy them literally
 426     # Text outside brackets is processed by glob_to_rx_simple()
 427     while ($expr ne '') {
 428         if ($expr =~ /^(.*?)(\[.*?\])(.*)/) {
 429             $expr = $3;
 430             $result .= glob_to_rx_simple ($1) . $2;
 431         } else {
 432             $result .= glob_to_rx_simple ($expr);
 433             last;
 434         }
 435     }
 436     return $result;
 437 }
 438
 439 sub Main ()
 440 {
 441     # types of files to be listed
 442     $list_types = "^.FCL";
 443
 444     # long status messages
 445     %messages = (
 446         "?" => "Unlisted file",
 447         "." => "Known directory",
 448         "F" => "Up-to-date file",
 449         "C" => "CVS admin directory",
 450         "M" => "Modified file",
 451         "S" => "Special file",
 452         "D" => "Unlisted directory",
 453         "L" => "Symbolic link",
 454         "H" => "Hard link",
 455         "U" => "Lost file",
 456         "X" => "Lost directory",
 457         "A" => "Newly added",
 458         "O" => "Older copy",
 459         "G" => "Result of merge",
 460         "R" => "Removed file"
 461     );
 462
 463     undef @batch_list;          # List of files for batch processing
 464     undef $batch_cmd;           # Command to be executed on files
 465     $no_recurse = 0;            # If this is set, do only local files
 466     $explain_type = 0;          # Verbosely print status of files
 467     $find_mode = 0;             # Don't print status at all
 468     $short_print = 0;           # Print only filenames without path
 469     $no_cvsignore = 0;          # Ignore .cvsignore
 470     $nolinks = 0;               # Do not test for soft- or hard-links
 471     my $want_msg = 0;           # List possible filetypes and exit
 472     my $want_help = 0;          # Print help and exit
 473     my $want_ver = 0;           # Print version and exit
 474
 475     my %options = (
 476         "types=s"  => \$list_types,
 477         "batch=s"  => \$batch_cmd,
 478         "local"    => \$no_recurse,
 479         "explain"  => \$explain_type,
 480         "find"     => \$find_mode,
 481         "short"    => \$short_print,
 482         "ignore"   => \$no_cvsignore,
 483         "messages" => \$want_msg,
 484         "nolinks"  => \$nolinks,
 485         "help"     => \$want_help,
 486         "version"  => \$want_ver
 487     );
 488
 489     GetOptions(%options);
 490
 491     adjust_types();
 492
 493     list_messages() if $want_msg;
 494     usage() if $want_help;
 495     version() if $want_ver;
 496
 497     unless ($no_cvsignore) {
 498         init_ignores();
 499     }
 500
 501     if ($#ARGV < 0) {
 502         @ARGV = ("");
 503     }
 504
 505     foreach (@ARGV) {
 506         process_arg ($_);
 507     }
 508
 509     if ($#batch_list >= 0) {
 510             do_batch();
 511     }
 512 }
 513
 514 Main();