1 | #!/usr/bin/env perl |
---|
2 | |
---|
3 | use strict; |
---|
4 | use warnings; |
---|
5 | |
---|
6 | sub regfiles { |
---|
7 | |
---|
8 | my ($top,$regfile) = @_; |
---|
9 | |
---|
10 | my $fast = 1; |
---|
11 | |
---|
12 | my @regs; |
---|
13 | |
---|
14 | if ($fast) { |
---|
15 | push(@regs,"$top/local/var/macports/registry/$regfile"); |
---|
16 | } |
---|
17 | |
---|
18 | # in case this bug ever comes up again and $regfile moves |
---|
19 | else { |
---|
20 | @regs = `find /opt -name '$regfile'`; |
---|
21 | return undef unless @regs; |
---|
22 | chomp @regs; |
---|
23 | } |
---|
24 | |
---|
25 | |
---|
26 | return \@regs; |
---|
27 | |
---|
28 | } |
---|
29 | |
---|
30 | my $sqlite3 = '/opt/local/bin/sqlite3'; |
---|
31 | die "Please do a 'port install sqlite3' and try again\n" if (! -x $sqlite3); |
---|
32 | |
---|
33 | my $top = '/opt'; |
---|
34 | my $regfile = 'registry.db'; |
---|
35 | my $regs = regfiles($top,$regfile); |
---|
36 | die "Unable to locate $regfile in $top\n" if (! $regs); |
---|
37 | |
---|
38 | my $cmd; |
---|
39 | |
---|
40 | foreach my $dbfile (@$regs) { |
---|
41 | |
---|
42 | $cmd = "$sqlite3 $dbfile 'SELECT * FROM dependencies WHERE id NOT IN (SELECT DISTINCT id FROM ports);'"; |
---|
43 | print $cmd, "\n"; |
---|
44 | my @tofix = `$cmd`; |
---|
45 | |
---|
46 | if (! @tofix) { |
---|
47 | warn "Registry file $regfile format is correct...\n"; |
---|
48 | } |
---|
49 | else { |
---|
50 | |
---|
51 | chomp @tofix; |
---|
52 | |
---|
53 | my $ids = {}; |
---|
54 | foreach my $entry (@tofix) { |
---|
55 | my @parts = split /\|/, $entry; |
---|
56 | my $id = shift @parts; |
---|
57 | $ids->{$id} = 1; |
---|
58 | } |
---|
59 | |
---|
60 | foreach my $id (sort keys %$ids) { |
---|
61 | |
---|
62 | $cmd = "$sqlite3 $dbfile 'DELETE FROM files WHERE id = $id'"; |
---|
63 | print $cmd, "\n"; |
---|
64 | system($cmd); |
---|
65 | |
---|
66 | $cmd = "$sqlite3 $dbfile 'DELETE FROM dependencies WHERE id = $id'"; |
---|
67 | print $cmd, "\n"; |
---|
68 | system($cmd); |
---|
69 | |
---|
70 | } |
---|
71 | |
---|
72 | } |
---|
73 | |
---|
74 | } |
---|
75 | |
---|
76 | my @inactive = `port list inactive`; |
---|
77 | if (@inactive) { |
---|
78 | $cmd = 'port uninstall inactive'; |
---|
79 | print $cmd, "\n"; |
---|
80 | system($cmd); |
---|
81 | } |
---|