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();