prtorphan



    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 }