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