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