diff options
Diffstat (limited to 'build-aux/cvsu')
-rwxr-xr-x | build-aux/cvsu | 512 |
1 files changed, 0 insertions, 512 deletions
diff --git a/build-aux/cvsu b/build-aux/cvsu deleted file mode 100755 index 741f6b238..000000000 --- a/build-aux/cvsu +++ /dev/null @@ -1,512 +0,0 @@ -#! /usr/bin/perl -w - -# cvsu - do a quick check to see what files are out of date. -# -# Copyright (C) 2000-2005 Pavel Roskin <proski@gnu.org> -# Initially written by Tom Tromey <tromey@cygnus.com> -# Completely rewritten by Pavel Roskin <proski@gnu.org> -# -# This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/>. - - -require 5.004; -use Getopt::Long; -use File::Basename; -use Time::Local; -use strict; - -use vars qw($list_types %messages %options @batch_list $batch_cmd - $no_recurse $explain_type $find_mode $short_print - $no_cvsignore $nolinks $file $single_filename $curr_dir - @common_ignores $ignore_rx %entries %subdirs %removed); - -use constant SUBDIR_FOUND => 1; -use constant SUBDIR_CVS => 2; - -# This list comes from the CVS manual. -use constant STANDARD_IGNORES => - ('RCS', 'SCCS', 'CVS', 'CVS.adm', 'RCSLOG', 'cvslog.*', 'tags', - 'TAGS', '.make.state', '.nse_depinfo', '*~', '#*', '.#*', ',*', - "_\$*", "*\$", '*.old', '*.bak', '*.BAK', '*.orig', '*.rej', - '.del-*', '*.a', '*.olb', '*.o', '*.obj', '*.so', '*.exe', - '*.Z', '*.elc', '*.ln', 'core'); - -# 3-letter month names in POSIX locale, for fast date decoding -my %months = ( - "Jan" => 0, - "Feb" => 1, - "Mar" => 2, - "Apr" => 3, - "May" => 4, - "Jun" => 5, - "Jul" => 6, - "Aug" => 7, - "Sep" => 8, - "Oct" => 9, - "Nov" => 10, - "Dec" => 11 -); - -# print usage information and exit -sub usage () -{ - print "Usage:\n" . - " cvsu [OPTIONS] [FILE] ...\n" . - "Options:\n" . - " --local Disable recursion\n" . - " --explain Verbosely print status of files\n" . - " --find Emulate find - filenames only\n" . - " --short Don't print paths\n" . - " --ignore Don't read .cvsignore\n" . - " --messages List known file types and long messages\n" . - " --nolinks Disable recognizing hard and soft links\n" . - " --types=[^]LIST Print only file types [not] from LIST\n" . - " --batch=COMMAND Execute this command on files\n" . - " --help Print this usage information\n" . - " --version Print version number\n" . - "Abbreviations and short options are supported\n"; - exit 0; -} - -# print version information and exit -sub version () -{ - print "cvsu - CVS offline examiner, version 0.2.3\n"; - exit 0; -} - -# If types begin with '^', make inversion -sub adjust_types () -{ - if ($list_types =~ m{^\^(.*)$}) { - $list_types = ""; - foreach (keys %messages) { - $list_types .= $_ - if (index ($1, $_) < 0); - } - } -} - -# list known messages and exit -sub list_messages () -{ - my $default_mark; - print "Recognizable file types are:\n"; - foreach (sort keys %messages) { - if (index($list_types, $_) >= 0) { - $default_mark = "*"; - } else { - $default_mark = " "; - } - print " $default_mark $_ $messages{$_}\n"; - } - print "* indicates file types listed by default\n"; - exit 0; -} - -# Initialize @common_ignores -# Also read $HOME/.cvsignore and append it to @common_ignores -sub init_ignores () -{ - my $HOME = $ENV{"HOME"}; - - push @common_ignores, STANDARD_IGNORES; - - unless (defined($HOME)) { - return; - } - - my $home_cvsignore = "${HOME}/.cvsignore"; - - if (-f "$home_cvsignore") { - - unless (open (CVSIGNORE, "< $home_cvsignore")) { - error ("couldn't open $home_cvsignore: $!"); - } - - while (<CVSIGNORE>) { - push (@common_ignores, split); - } - - close (CVSIGNORE); - } - - my $CVSIGNOREENV = $ENV{"CVSIGNORE"}; - - unless (defined($CVSIGNOREENV)) { - return; - } - - my @ignores_var = split (/ /, $CVSIGNOREENV); - push (@common_ignores, @ignores_var); - -} - -# Print message and exit (like "die", but without raising an exception). -# Newline is added at the end. -sub error ($) -{ - print STDERR "cvsu: ERROR: " . shift(@_) . "\n"; - exit 1; -} - -# execute commands from @exec_list with $exec_cmd -sub do_batch () -{ - my @cmd_list = split (' ', $batch_cmd); - system (@cmd_list, @batch_list); -} - -# print files status -# Parameter 1: status in one-letter representation -sub file_status ($) -{ - my $type = shift (@_); - my $item; - my $pathfile; - - return - if $ignore_rx ne '' && $type =~ /[?SLD]/ && $file =~ /$ignore_rx/; - - return - if (index($list_types, $type) < 0); - - $pathfile = $curr_dir . $file; - - if (defined($batch_cmd)) { - push (@batch_list, $pathfile); - # 1000 items in the command line might be too much for HP-UX - if ($#batch_list > 1000) { - do_batch(); - undef @batch_list; - } - } - - if ($short_print) { - $item = $file; - } else { - $item = $pathfile; - } - - if ($find_mode) { - print "$item\n"; - } else { - $type = $messages{$type} - if ($explain_type); - print "$type $item\n"; - } -} - -# load entries from CVS/Entries and CVS/Entries.Log -# Parameter 1: file name for CVS/Entries -# Return: list of entries in the format used in CVS/Entries -sub load_entries ($); -sub load_entries ($) -{ - my $entries_file = shift (@_); - my $entries_log_file = "$entries_file.Log"; - my %ent = (); - - unless (open (ENTRIES, "< $entries_file")) { - error ("couldn't open $entries_file: $!"); - } - while (<ENTRIES>) { - chomp; - $ent{$_} = 1; - } - close (ENTRIES); - - if (open (ENTRIES, "< $entries_log_file")) { - while (<ENTRIES>) { - chomp; - if ( m{^A (.+)} ) { - $ent{$1} = 1; - } elsif ( m{^R (.+)} ) { - delete $ent{$1}; - } else { - # Note: "cvs commit" helps even when you are offline - error ("$entries_log_file:$.: unrecognizable line, " . - "try \"cvs commit\""); - } - } - close (ENTRIES); - } - - return keys %ent; -} - -# process one directory -# Parameter 1: directory name -sub process_arg ($); -sub process_arg ($) -{ - my $arg = shift (@_); - my %found_files = (); - - # $file, $curr_dir, and $ignore_rx must be seen in file_status - local $file = ""; - local $ignore_rx = ""; - local $single_filename = 0; - - if ( $arg eq "" or -d $arg ) { - $curr_dir = $arg; - my $real_curr_dir = $curr_dir eq "" ? "." : $curr_dir; - - error ("$real_curr_dir is not a directory") - unless ( -d $real_curr_dir ); - - # Scan present files. - file_status ("."); - opendir (DIR, $real_curr_dir) || - error ("couldn't open directory $real_curr_dir: $!"); - foreach (readdir (DIR)) { - $found_files {$_} = 1; - } - closedir (DIR); - } else { - $single_filename = basename $arg; - $curr_dir = dirname $arg; - $found_files{$single_filename} = 1 if lstat $arg; - } - - $curr_dir .= "/" - unless ( $curr_dir eq "" || $curr_dir =~ m{/$} ); - - # Scan CVS/Entries. - my %entries = (); - my %subdirs = (); - my %removed = (); - - foreach ( load_entries ("${curr_dir}CVS/Entries") ) { - if ( m{^D/([^/]+)/} ) { - $subdirs{$1} = SUBDIR_FOUND if !$single_filename; - } elsif ( m{^/([^/]+)/([^/])[^/]*/([^/]*)/} ) { - if ( !$single_filename or $single_filename eq $1 ) { - $entries{$1} = $3; - $removed{$1} = 1 - if $2 eq '-'; - } - } elsif ( m{^D$} ) { - next; - } else { - error ("${curr_dir}CVS/Entries: unrecognizable line"); - } - } - - if ( $single_filename && !$entries{$single_filename} && - !$found_files{$single_filename} ) { - error ("nothing known about $arg"); - } - - # Scan .cvsignore if any - unless ($no_cvsignore) { - my (@ignore_list) = (); - - if (-f "${curr_dir}.cvsignore") { - open (CVSIGNORE, "< ${curr_dir}.cvsignore") - || error ("couldn't open ${curr_dir}.cvsignore: $!"); - while (<CVSIGNORE>) { - push (@ignore_list, split); - } - close (CVSIGNORE); - } - - my ($iter); - foreach $iter (@ignore_list, @common_ignores) { - if ($iter eq '!') { - $ignore_rx = '' - } else { - if ($ignore_rx eq '') { - $ignore_rx = '^('; - } else { - $ignore_rx .= '|'; - } - $ignore_rx .= glob_to_rx ($iter); - } - } - $ignore_rx .= ')$' - if $ignore_rx ne ''; - } - - # File is missing - foreach $file (sort keys %entries) { - unless ($found_files{$file}) { - if ($removed{$file}) { - file_status("R"); - } else { - file_status("U"); - } - } - } - - foreach $file (sort keys %found_files) { - next if ($file eq '.' || $file eq '..'); - lstat ($curr_dir . $file) || - error ("lstat() failed on $curr_dir . $file"); - if (! $nolinks && -l _) { - file_status ("L"); - } elsif (-d _) { - if ($file eq 'CVS') { - file_status ("C"); - } elsif ($subdirs{$file}) { - $subdirs{$file} = SUBDIR_CVS; - } else { - file_status ("D"); # Unknown directory - } - } elsif (! (-f _) && ! (-l _)) { - file_status ("S"); # This must be something very special - } elsif (! $nolinks && (stat _) [3] > 1 ) { - file_status ("H"); # Hard link - } elsif (! $entries{$file}) { - file_status ("?"); - } elsif ($entries{$file} =~ /^Initial |^dummy /) { - file_status ("A"); - } elsif ($entries{$file} =~ /^Result of merge/) { - file_status ("G"); - } elsif ($entries{$file} !~ - /^(...) (...) (..) (..):(..):(..) (....)$/) { - error ("Invalid timestamp for $curr_dir$file: $entries{$file}"); - } else { - my $cvtime = timegm($6, $5, $4, $3, $months{$2}, $7 - 1900); - my $mtime = (stat _) [9]; - if ($cvtime == $mtime) { - file_status ("F"); - } elsif ($cvtime < $mtime) { - file_status ("M"); - } else { - file_status ("O"); - } - } - } - - # Now do directories. - unless ($no_recurse) { - my $save_curr_dir = $curr_dir; - foreach $file (sort keys %subdirs) { - if ($subdirs{$file} == SUBDIR_FOUND) { - $curr_dir = $save_curr_dir; - file_status ("X"); - } elsif ($subdirs{$file} == SUBDIR_CVS) { - process_arg ($save_curr_dir . $file) - } - } - } -} - -# Turn a glob into a regexp without recognizing square brackets. -sub glob_to_rx_simple ($) -{ - my ($expr) = @_; - # Quote all non-word characters, convert ? to . and * to .* - $expr =~ s/(\W)/\\$1/g; - $expr =~ s/\\\*/.*/g; - $expr =~ s/\\\?/./g; - return $expr; -} - -# Turn a glob into a regexp -sub glob_to_rx ($) -{ - my $result = ''; - my ($expr) = @_; - # Find parts in square brackets and copy them literally - # Text outside brackets is processed by glob_to_rx_simple() - while ($expr ne '') { - if ($expr =~ /^(.*?)(\[.*?\])(.*)/) { - $expr = $3; - $result .= glob_to_rx_simple ($1) . $2; - } else { - $result .= glob_to_rx_simple ($expr); - last; - } - } - return $result; -} - -sub Main () -{ - # types of files to be listed - $list_types = "^.FCL"; - - # long status messages - %messages = ( - "?" => "Unlisted file", - "." => "Known directory", - "F" => "Up-to-date file", - "C" => "CVS admin directory", - "M" => "Modified file", - "S" => "Special file", - "D" => "Unlisted directory", - "L" => "Symbolic link", - "H" => "Hard link", - "U" => "Lost file", - "X" => "Lost directory", - "A" => "Newly added", - "O" => "Older copy", - "G" => "Result of merge", - "R" => "Removed file" - ); - - undef @batch_list; # List of files for batch processing - undef $batch_cmd; # Command to be executed on files - $no_recurse = 0; # If this is set, do only local files - $explain_type = 0; # Verbosely print status of files - $find_mode = 0; # Don't print status at all - $short_print = 0; # Print only filenames without path - $no_cvsignore = 0; # Ignore .cvsignore - $nolinks = 0; # Do not test for soft- or hard-links - my $want_msg = 0; # List possible filetypes and exit - my $want_help = 0; # Print help and exit - my $want_ver = 0; # Print version and exit - - my %options = ( - "types=s" => \$list_types, - "batch=s" => \$batch_cmd, - "local" => \$no_recurse, - "explain" => \$explain_type, - "find" => \$find_mode, - "short" => \$short_print, - "ignore" => \$no_cvsignore, - "messages" => \$want_msg, - "nolinks" => \$nolinks, - "help" => \$want_help, - "version" => \$want_ver - ); - - GetOptions(%options); - - adjust_types(); - - list_messages() if $want_msg; - usage() if $want_help; - version() if $want_ver; - - unless ($no_cvsignore) { - init_ignores(); - } - - if ($#ARGV < 0) { - @ARGV = (""); - } - - foreach (@ARGV) { - process_arg ($_); - } - - if ($#batch_list >= 0) { - do_batch(); - } -} - -Main(); |