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         truncate R,tell R;
 203         close R;
 204 }
 205
 206 sub localactionrootprint
 207 {
 208         local *R;
 209         if (!open R,ROOT) {
 210                 mayfatal "File \"".ROOT."\" cannot be opened";
 211                 return;
 212                 }
 213         local $/=undef;
 214         localactionrootprintcheck(<R>);
 215         close R;
 216 }
 217
 218 sub localactionrootprintcheck
 219 {
 220 my($contents)=@_;
 221
 222         if (!defined $root_contents) {
 223                 push @root_dirs,$dir_dirname;
 224                 $root_contents=$contents;
 225                 return;
 226                 }
 227         if (@root_dirs && $root_contents eq $contents) {
 228                 push @root_dirs,$dir_dirname;
 229                 return;
 230                 }
 231         if (@root_dirs) {
 232                 print map "$_: $root_contents",@root_dirs;
 233                 @root_dirs=();
 234                 }
 235         print "$dir_dirname: $contents";
 236 }
 237
 238 sub actionrootfinal
 239 {
 240         return if !@root_dirs;
 241         print $root_contents;
 242 }
 243
 244 sub localaction
 245 {
 246         if ("" ne $dir_dirname && defined $opt_root) {
 247                 localactionrootset()   if defined $opt_root && "" ne $opt_root;
 248                 localactionrootprint() if defined $opt_root && "" eq $opt_root;
 249                 return;
 250                 }
 251         for (@dir_victims) {
 252                 localactionprint $_ if $opt_print;
 253                 localactionrm    $_ if $opt_rm;
 254                 }
 255 }
 256
 257 sub verbose
 258 {
 259 my($msg)=@_;
 260
 261         return if !$opt_verbose;
 262         print fastgetcwd.": $msg\n";
 263 }
 264
 265 sub GetOptions_shortfilter
 266 {
 267         my @r;
 268         while ($_=shift) {
 269                 if (/^(\w)\|/) {
 270                         my $ref=shift;
 271                         push @r,$1,$ref,$',$ref;
 272                         next;
 273                         }
 274                 push @r,$_;
 275                 }
 276         return GetOptions @r;
 277 }