bin/cvsutil

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