9 use Cwd qw(chdir fastgetcwd);
12 use constant ENTRIES =>"CVS/Entries";
13 use constant CVSIGNORE=>".cvsignore";
14 use constant ROOT =>"CVS/Root";
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
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,
31 "p|print!" ,\$opt_print,
33 "v|verbose!" ,\$opt_verbose,
34 "fatal!" ,\$opt_fatal,
35 "force!" ,\$opt_force,
36 "I|ignore=s" ,\@opt_ignore,
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);
48 my @all_ignore=("CVS");
51 @all_ignore=() if $_ eq "!";
54 my($root_contents,@root_dirs);
56 @ARGV=(".") if !@ARGV;
58 our(@dir_files,@dir_ignores,@dir_workings,@dir_victims);
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 "";
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;
79 $msg.=" in \"".fastgetcwd."\" (CVS \"$dir_dirname\")".($opts{"noerrno"} ? "" : ": $errstr");
80 die $msg if $opt_fatal;
88 my $origdir=fastgetcwd;
91 mayfatal "Unable to process directory \"$_\"";
101 my($localdirname)=@_;
103 verbose("localdir(\"$localdirname\") entry");
105 local(@dir_dirs,@dir_files,@dir_ignores,@dir_workings,@dir_victims);
106 local($dir_dirname)=$dir_dirname.$localdirname."/";
108 localreaddir() or return;
112 verbose("localdir(\"$localdirname\") exit");
117 localvictims() if !defined $opt_root;
120 fordirs \&localdir,@dir_dirs;
126 if (!open E,ENTRIES) {
127 mayfatal "File \"".ENTRIES."\" cannot be opened";
132 do { push @dir_dirs ,$1; next; } if m#^D/([^/]*)/#;
133 do { push @dir_files,$1; next; } if m#^/([^/]*)/# ;
135 mayfatal "File ".ENTRIES." contains invalid line \"$_\"",("noerrno"=>1);
139 return 1 if defined $opt_root;
142 if (open I,CVSIGNORE) {
146 push @dir_ignores,$_ if -e $_;
153 mayfatal "File \"".CVSIGNORE."\" cannot be opened" if !$!{ENOENT};
157 if (!opendir D,".") {
158 mayfatal "Cannot read directory \".\"";
161 @dir_workings=readdir D;
163 my %delworkings=map { $_=>1; } @dir_workings;
164 for (@dir_dirs,@dir_files,@dir_ignores,@all_ignore,".","..") {
165 delete $delworkings{$_};
167 @dir_workings=keys %delworkings;
173 push @dir_victims,@dir_files if $opt_files;
174 push @dir_victims,@dir_ignores if $opt_ignores;
175 push @dir_victims,@dir_workings if $opt_workings;
176 push @dir_victims,@dir_dirs if $opt_dirs;
183 mayfatal "File \"$filename\" does not exist",("noerrno"=>1) if !-e $filename;
184 print "${dir_dirname}$filename\n";
191 if (!unlink $filename) {
192 mayfatal "File \"$_\" cannot be removed" if !$!{ENOENT};
196 sub localactionrootset
199 if (!open R,'+<',ROOT) {
200 mayfatal "File \"".ROOT."\" cannot be written";
203 print R "$opt_root\n";
208 sub localactionrootprint
212 mayfatal "File \"".ROOT."\" cannot be opened";
216 localactionrootprintcheck(<R>);
220 sub localactionrootprintcheck
224 if (!defined $root_contents) {
225 push @root_dirs,$dir_dirname;
226 $root_contents=$contents;
229 if (@root_dirs && $root_contents eq $contents) {
230 push @root_dirs,$dir_dirname;
234 print map "$_: $root_contents",@root_dirs;
237 print "$dir_dirname: $contents";
242 return if !@root_dirs;
243 print $root_contents;
248 if ("" ne $dir_dirname && defined $opt_root) {
249 localactionrootset() if defined $opt_root && "" ne $opt_root;
250 localactionrootprint() if defined $opt_root && "" eq $opt_root;
254 localactionprint $_ if $opt_print;
255 localactionrm $_ if $opt_rm;
263 return if !$opt_verbose;
264 print fastgetcwd.": $msg\n";
267 sub GetOptions_shortfilter
273 push @r,$1,$ref,$',$ref;
278 return GetOptions @r;