blob: 62e0224cfce1c9ddefb962f6b39e00ef9747ecb6 (
plain)
1 #!/usr/bin/perl
2 #
3 # $Id: prtorphan,v 1.5 2004/12/08 10:57:59 sip Exp $
4 #
5 # (c) 2003 by Martin Opel <mo@obbl-net.de>
6 #
7
8 use strict;
9
10 my %options = %{getoptions(@ARGV)};
11
12 if ( $options{"-d"} ) {
13 #
14 # Directory mode to find orphaned files in a directory subtree
15 # -d <directory>
16 #
17 my $dir = $options{"-d"};
18 unless ( -d $dir ) { exiterr("directory does not exist: $dir\n"); }
19 my %files = %{getinstalledfiles()};
20 open(FILES, "find $dir -type f |")
21 or exiterr("could not execute find");
22 while (<FILES>) {
23 chomp;
24 s/^\///;
25 if ( $files{$_} != 1 ) {
26 print "/$_\n";
27 }
28 }
29 close(FILES);
30 }
31 else {
32 #
33 # Standard mode to find orhpaned ports
34 #
35 my %validports = %{getvalidports()};
36 open(PKGS, "pkginfo -i |")
37 or exiterr("could not execute 'pkginfo -i'");
38 while (<PKGS>) {
39 my ($port, $version) = split ' ';
40 print "$port\n" unless $validports{$port};
41 }
42 close(PKGS);
43 }
44
45 exit 0;
46
47 ######################## subroutines ########################
48 sub getinstalledfiles {
49 my %files = ();
50 open(PKGDB, "/var/lib/pkg/db")
51 or exiterr("could not open package database");
52 my $port = <PKGDB>;
53 my $version = <PKGDB>;
54 while (<PKGDB>) {
55 chomp;
56 if ( /^$/ ) {
57 $port = <PKGDB>;
58 $version = <PKGDB>;
59 }
60 else {
61 $files{$_} = 1;
62 }
63 }
64 close(PKGDB);
65 return \%files;
66 }
67
68 sub getoptions {
69 my @args = reverse @_;
70 my %options = ();
71
72 while (my $argument = pop @args) {
73 if ( $argument eq "-d" ) {
74 $options{"-d"} = pop @args;
75 }
76 else {
77 exiterr("unknown option: $argument");
78 }
79 }
80 return \%options;
81 }
82
83 sub getvalidports {
84 my %validports = ();
85 my @dirlist = @{getportdirs()};
86
87 while ( my $dir = pop @dirlist ) {
88 opendir(DIR, $dir)
89 or exiterr("could not read dir $dir");
90 if ( -f "$dir/Pkgfile" ) {
91 $dir =~ s/.+\///;
92 $validports{$dir} = 1;
93 next;
94 }
95 my $entry = "";
96 while ($entry = readdir(DIR)) {
97 next if ( $entry =~ /^\./ or ! -d "$dir/$entry" );
98 if ( -f "$dir/$entry/Pkgfile" ) {
99 $validports{$entry} = 1;
100 }
101 }
102 closedir(DIR);
103 }
104 return \%validports;
105 }
106
107 sub getportdirs {
108 my @ports = ();
109 my $conf = "/etc/prt-get.conf";
110
111 open(PORTS, $conf)
112 or exiterr("could not open $conf");
113 while (<PORTS>) {
114 chomp;
115 if ( /^prtdir\s+/ ) {
116 my $port = $_;
117 $port =~ s/^prtdir\s+//;
118 $port =~ s/#(.*)$//;
119 $port =~ s/\s+$//;
120 if ( $port =~ /:/ ) {
121 $port =~ s/\s+//g;
122 my @a = split(/:/, $port);
123 my @b = split(/,/, @a[1]);
124 while ( my $c = pop @b ) {
125 push @ports, $a[0] . "/" . $c;
126 }
127 } else {
128 push @ports, $port;
129 }
130 }
131 }
132 close(PORTS);
133 return \@ports;
134 }
135
136 sub exiterr {
137 my ($msg) = @_;
138
139 print "======> ERROR: $msg\n";
140 exit 1;
141 }
|