bin/cvsutil

   1 #! /usr/bin/perl
   2 #
   3 #       $Id$
   4 #
   5 #       Recommended aliases:
   6 #               alias cvsfiles='cvsutil --files --print'
   7 #               alias cvsignores='cvsutil --ignores --print'
   8 #               alias cvsignoresall='cvsutil --ignores --workings --print'
   9 #               alias cvsignoresrm='cvsutil --ignores --rm'
  10 #               alias cvsignoresrmall='cvsutil --ignores --workings --rm'
  11 #               alias cvsignoresallrm='cvsutil --ignores --workings --rm'
  12
  13 use strict;
  14 use warnings;
  15
  16 use Getopt::Long;
  17 use Cwd qw(chdir fastgetcwd);
  18 use Errno qw(ENOENT);
  19 use Carp qw(confess cluck croak carp);
  20 BEGIN {
  21         if (!eval q{ use File::Remove qw(remove); 1; }) {{
  22                 sub main::remove(@)
  23                 {
  24                         my $r="";
  25                         if ("SCALAR" eq ref $_[0]) {
  26                                 $r="-r" if ${$_[0]};
  27                                 shift;
  28                                 }
  29                         my $cmd="rm -f $r ".join(" ",map({s/'/'\\''/g;"'$_'";} @_));
  30                         my $err=system($cmd) and confess("$cmd: $cmd");
  31                         return @_;
  32                 }
  33                 }}
  34 }
  35
  36 use constant ENTRIES  =>"CVS/Entries";
  37 use constant CVSIGNORE=>".cvsignore";
  38 use constant ROOT     =>"CVS/Root";
  39
  40 my($opt_files,$opt_ignores,$opt_workings,$opt_dirs);
  41 my($opt_rm,$opt_print);
  42 our($opt_root); # undefined=>no rooting, ""=>print roots or first phase for root checking, ne ""=>set roots
  43 my($opt_verbose,$opt_fatal);
  44 my($opt_force); # set roots without their checking
  45 my(@opt_ignore);
  46
  47 $Getopt::Long::ignorecase=0;
  48 $Getopt::Long::bundling=1;
  49 die if !GetOptions_shortfilter(
  50                 "f|files!"   ,\$opt_files,
  51                 "i|ignores!" ,\$opt_ignores,
  52                 "w|workings!",\$opt_workings,
  53                 "d|dirs!"    ,\$opt_dirs,
  54                 "r|rm!"      ,\$opt_rm,
  55                 "p|print!"   ,\$opt_print,
  56                   "root:s"   ,\$opt_root,
  57                 "v|verbose!" ,\$opt_verbose,
  58                   "fatal!"   ,\$opt_fatal,
  59                   "force!"   ,\$opt_force,
  60                 "I|ignore=s" ,\@opt_ignore,
  61                 );
  62
  63 die "--root possible only with (optional and ignored) -d|--dirs"
  64                 if defined $opt_root && ($opt_files || $opt_ignores || $opt_workings || $opt_dirs || $opt_rm || $opt_print);
  65 die "-d|--dirs forbidden with -r|--rm"
  66                 if $opt_dirs && $opt_rm;
  67 die "Nothing to do (no -r|--rm, no -p|--print)"
  68                 if !$opt_rm && !$opt_print && !defined $opt_root;
  69 die "Nothing to process (no -f|--files, no -i|--ignores, no -w|--workings, no -d|--dirs)"
  70                 if !defined $opt_root && (!$opt_files && !$opt_ignores && !$opt_workings && !$opt_dirs);
  71
  72 my @all_ignore=("CVS");
  73 for (@opt_ignore) {
  74         push @all_ignore,$_;
  75         @all_ignore=() if $_ eq "!";
  76         }
  77
  78 my($root_contents,@root_dirs);
  79
  80 @ARGV=(".") if !@ARGV;
  81 our(@dir_dirs)=@ARGV;
  82 our(@dir_files,@dir_ignores,@dir_workings,@dir_victims);
  83 our($dir_dirname)="";
  84 unless ((defined $opt_root && $opt_root ne "") && $opt_force) {
  85         local($opt_root)=$opt_root;
  86         $opt_root="" if defined $opt_root && $opt_root ne "";
  87         localdircore();
  88         }
  89
  90 actionrootfinal() if defined $opt_root && $opt_root eq "";
  91 if (defined $opt_root && $opt_root ne "") {
  92         die "Non-matching \"".ROOT."\" contents, use --force for override" if !@root_dirs && !$opt_force;
  93         localdircore();
  94         }
  95
  96 exit 0;
  97
  98 sub mayfatal
  99 {
 100 my($msg,%opts)=@_;
 101
 102         my $errstr=$!;
 103         $msg.=" in \"".fastgetcwd."\" (CVS \"$dir_dirname\")".($opts{"noerrno"} ? "" : ": $errstr");
 104         croak $msg if $opt_fatal;
 105         carp $msg;
 106 }
 107
 108 sub fordirs
 109 {
 110 my($func,@dirs)=@_;
 111
 112         my $origdir=fastgetcwd;
 113         for (@dirs) {
 114                 if (!chdir $_) {
 115                         mayfatal "Unable to process directory \"$_\"";
 116                         next;
 117                         }
 118                 &$func($_);
 119                 chdir $origdir;
 120                 }
 121 }
 122
 123 sub localdir
 124 {
 125 my($localdirname)=@_;
 126
 127         verbose("localdir(\"$localdirname\") entry");
 128
 129         local(@dir_dirs,@dir_files,@dir_ignores,@dir_workings,@dir_victims);
 130         local($dir_dirname)=$dir_dirname.$localdirname."/";
 131
 132         localreaddir() or return;
 133
 134         localdircore();
 135
 136         verbose("localdir(\"$localdirname\") exit");
 137 }
 138
 139 sub localdircore
 140 {
 141         localvictims() if !defined $opt_root;
 142         localaction();
 143
 144         fordirs \&localdir,@dir_dirs;
 145 }
 146
 147 sub filterout
 148 {
 149 my($from,@what)=@_;
 150
 151         my %hash=map { $_=>1; } @$from;
 152         for (@what) {
 153                 delete $hash{$_};
 154                 }
 155         return keys %hash;
 156 }
 157
 158 sub localreaddir
 159 {
 160         local *E;
 161         if (!open E,ENTRIES) {
 162                 mayfatal "File \"".ENTRIES."\" cannot be opened";
 163                 return 0;
 164                 }
 165         while (<E>) {
 166                 chomp;
 167                 next if /^D$/;
 168                 do { push @dir_dirs ,$1; next; } if m#^D/([^/]*)/#;
 169                 next if m#^/[^/]*/-#;   # deleted file: /filename/-1.1/dummy timestamp//
 170                 # New file is a valid entry!
 171                 # next if m#^/[^/]*/0/#;        # new file: /filename/0/dummy timestamp//
 172                 do { push @dir_files,$1; next; } if m#^/([^/]*)/# ;
 173                 mayfatal "File ".ENTRIES." contains invalid line \"$_\"",("noerrno"=>1);
 174                 }
 175         close E;
 176
 177         return 1 if defined $opt_root;
 178
 179         local *I;
 180         if (open I,CVSIGNORE) {
 181                 while (<I>) {
 182                         while (/\S+/g) {
 183                                 for (<$&>) {
 184                                         push @dir_ignores,$_ if -e $_;
 185                                         }
 186                                 }
 187                         }
 188                 close I;
 189                 @dir_ignores=filterout \@dir_ignores,@dir_dirs,@dir_files;
 190                 }
 191         else {
 192                 mayfatal "File \"".CVSIGNORE."\" cannot be opened" if !$!{ENOENT};
 193                 }
 194
 195         local *D;
 196         if (!opendir D,".") {
 197                 mayfatal "Cannot read directory \".\"";
 198                 return 0;
 199                 }
 200         @dir_workings=filterout [readdir D],@dir_dirs,@dir_files,@dir_ignores,@all_ignore,".","..";
 201         closedir D;
 202         return 1;
 203 }
 204
 205 sub localvictims
 206 {
 207         push @dir_victims,@dir_files    if $opt_files;
 208         push @dir_victims,@dir_ignores  if $opt_ignores;
 209         push @dir_victims,@dir_workings if $opt_workings;
 210         push @dir_victims,@dir_dirs     if $opt_dirs;
 211 }
 212
 213 sub localactionprint
 214 {
 215 my($filename)=@_;
 216
 217         mayfatal "File \"$filename\" does not exist",("noerrno"=>1) if !-e $filename;
 218         print "${dir_dirname}$filename\n";
 219 }
 220
 221 sub localactionrm
 222 {
 223 my($filename)=@_;
 224
 225         # &chmod follows the symlinks.
 226         -l $filename or chmod 0700,$filename or do {
 227                 mayfatal "File \"$_\" cannot be chmod(2)ed" if !$!{ENOENT};
 228                 };
 229         # '\1' for '-r':
 230         remove \1,$filename or do {
 231                 mayfatal "File \"$_\" cannot be removed" if !$!{ENOENT};
 232                 };
 233 }
 234
 235 sub localactionrootset
 236 {
 237         local *R;
 238         if (!open R,'+<',ROOT) {
 239                 mayfatal "File \"".ROOT."\" cannot be written";
 240                 return;
 241                 }
 242         print R "$opt_root\n";
 243         truncate R,tell R;
 244         close R;
 245 }
 246
 247 sub localactionrootprint
 248 {
 249         local *R;
 250         if (!open R,ROOT) {
 251                 mayfatal "File \"".ROOT."\" cannot be opened";
 252                 return;
 253                 }
 254         local $/=undef;
 255         localactionrootprintcheck(<R>);
 256         close R;
 257 }
 258
 259 sub localactionrootprintcheck
 260 {
 261 my($contents)=@_;
 262
 263         if (!defined $root_contents) {
 264                 push @root_dirs,$dir_dirname;
 265                 $root_contents=$contents;
 266                 return;
 267                 }
 268         if (@root_dirs && $root_contents eq $contents) {
 269                 push @root_dirs,$dir_dirname;
 270                 return;
 271                 }
 272         if (@root_dirs) {
 273                 print map "$_: $root_contents",@root_dirs;
 274                 @root_dirs=();
 275                 }
 276         print "$dir_dirname: $contents";
 277 }
 278
 279 sub actionrootfinal
 280 {
 281         return if !@root_dirs;
 282         print $root_contents;
 283 }
 284
 285 sub localaction
 286 {
 287         if ("" ne $dir_dirname && defined $opt_root) {
 288                 localactionrootset()   if defined $opt_root && "" ne $opt_root;
 289                 localactionrootprint() if defined $opt_root && "" eq $opt_root;
 290                 return;
 291                 }
 292         for (@dir_victims) {
 293                 localactionprint $_ if $opt_print;
 294                 localactionrm    $_ if $opt_rm;
 295                 }
 296 }
 297
 298 sub verbose
 299 {
 300 my($msg)=@_;
 301
 302         return if !$opt_verbose;
 303         print fastgetcwd.": $msg\n";
 304 }
 305
 306 sub GetOptions_shortfilter
 307 {
 308         my @r;
 309         while ($_=shift) {
 310                 if (/^(\w)\|/) {
 311                         my $ref=shift;
 312                         push @r,$1,$ref,$',$ref;
 313                         next;
 314                         }
 315                 push @r,$_;
 316                 }
 317         return GetOptions @r;
 318 }