bin/unauthorized.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Getopt::Long;
   7 use HTML::TreeBuilder::XPath;
   8 use LWP::UserAgent;
   9 use YAML::Syck;
  10
  11 our %OPT;
  12 GetOptions(\%OPT, "cred=s");
  13
  14 my($searchurl) = @ARGV;
  15
  16 sub Usage () {
  17   "Usage: $0 searchurl
  18
  19 e.g. http://search.cpan.org/~rgarcia/perl-5.9.5/
  20 ";
  21 }
  22
  23 die Usage unless $searchurl;
  24
  25 sub trim {
  26   my($x) = @_;
  27   $x =~ s/^\s+//;
  28   $x =~ s/\s+\z//;
  29   $x;
  30 }
  31
  32 sub find_owner {
  33   my($mod) = @_;
  34   open my $fh, "/home/ftp/pub/PAUSE/modules/06perms.txt" or die;
  35   local $/ = "\n";
  36   while (<$fh>) {
  37     next unless /^\s*$/;
  38     last;
  39   }
  40   while (<$fh>) {
  41     s/\s*\z//;
  42     my($lmod,$luser,$perms) = split /,/, $_;
  43     next unless $lmod eq $mod;
  44     next if $perms eq "c";
  45     return $luser;
  46   }
  47 }
  48
  49 my $ua = LWP::UserAgent->new;
  50 my $resp = $ua->get($searchurl);
  51 die $resp->as_string unless $resp->is_success;
  52 my $tree = HTML::TreeBuilder::XPath->new_from_content($resp->content);
  53 my @h2 = $tree->findnodes("//h2");
  54 $|=1;
  55 for my $h2 (@h2) {
  56   next unless $h2->findvalue(".") =~ /Modules/;
  57   my($table) = $h2->findnodes("../table");
  58   my @rows = $table->findnodes(".//tr");
  59   for my $row (@rows) {
  60     my($td3) = $row->findnodes("./td[3]");
  61     next unless $td3->findvalue(".") =~ /UNAUTHORIZED/;
  62     my($td1) = $row->findnodes("./td[1]");
  63     my $td1_string = $td1->findvalue(".");
  64     my $module = trim $td1_string;
  65     my $owner = find_owner($module);
  66     printf "%-45s %-12s\n", $module, $owner;
  67   }
  68 }