rpmsafe: realpath fixes
[nethome.git] / bin / rpmsafereduce
1 #! /usr/bin/perl
2 # rpmsafe|sort -u|rpmsafereduce >EXCLUDE-FILELIST
3 use strict;
4 use warnings;
5 sub slashes($) {
6   my($s)=@_;
7   (my $sl=$s)=~tr{/}{}cd;
8   $sl=length $sl;
9   $sl>=1 or die $_;
10   return $sl;
11 }
12 my(%d,%f,%t);
13 my $l;
14 while (<>) {
15   chomp;
16   next if $_ eq "/";
17   die $_ if m{//};
18   m{^/} or die $_;
19   die $_ if m{/$};
20   die "sort -u: $l >= $_" if $l && $l ge $_;
21   $l=$_;
22   my $sl=slashes $_;
23   $d{$_}=$sl if -d;
24   $f{$_}=$sl if -f;
25   s{/[^/]*$}{} or die $_;
26   $t{$_}=1 if $d{$_};
27 }
28 my $time;
29 while (%t) {
30   my @t=keys(%t);
31   %t=();
32   #warn((@t+0)."\n");
33   @t=sort { ($f{$b}||$d{$b}) <=> ($f{$a}||$d{$a}) || $a cmp $b; } @t;
34   while (@t) {
35     if (defined $time&&time()!=$time) {
36       $time=time();
37       print STDERR (@t+0)."    \r";
38     }
39     my $t=shift @t;
40     next if !$d{$t}&&!$f{$t};
41     opendir DIR,$t or die "$t: $!";
42     my $ok=1;
43     local $_;
44     my @d;
45     for my $d (readdir DIR) {
46       push @d,$d;
47       next if $d eq ".";
48       next if $d eq "..";
49       next if $f{"$t/$d"};
50       next if $d{"$t/$d"};
51       $ok=0;
52       last;
53     }
54     closedir DIR or die "$t: $!";
55     next if !$ok;
56     for my $d (@d) {
57       delete $f{"$t/$d"};
58       delete $t{"$t/$d"};
59     }
60     $f{$t}=slashes $t;
61     $t=~s{/[^/]*$}{} or die $t;
62     $d{$t}=slashes $t;
63     $t{$t}=1;
64   }
65 }
66 for my $f (sort keys(%f)) {
67   print "$f\n";
68 }