bin/cvsutil

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