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