anndata

   1 #!/usr/bin/perl -w
   2
   3 use LWP::UserAgent;
   4 use Getopt::Long;
   5
   6 sub get
   7 {
   8     my($uri, $ua, $res);
   9     ($uri) = @_;
  10
  11     $ua = LWP::UserAgent->new;
  12     $ua->agent("ANNData/0.1");
  13
  14     $res = $ua->request(HTTP::Request->new("GET", "$uri"));
  15
  16     die "could not fetch $uri\n" unless $res->is_success;
  17     return $res->content;
  18 }
  19
  20 sub getlist
  21 {
  22     my($name, $il, $html, @ret);
  23     ($name) = @_;
  24
  25     $il = uc(($name =~ /^(.)/)[0]);
  26     $il = "9" if (!($il =~ /[A-Z]/));
  27     $html = get "http://www.animenewsnetwork.com/encyclopedia/anime.php?list=$il";
  28
  29     # The only way to recognize entries that seems sure is to look
  30     # after the "HOVERLINE" class.
  31
  32     push @ret, $1 while $html =~ /<A\s.*CLASS=HOVERLINE\s.*>.*<FONT.*>([^<>]*$name[^<>]*)<\/FONT/ig;
  33
  34     return(@ret);
  35 }
  36
  37 sub getid
  38 {
  39     my($name, $il, $html, $url);
  40     ($name) = @_;
  41
  42     $il = uc(($name =~ /^(.)/)[0]);
  43     $il = "9" if (!($il =~ /[A-Z]/));
  44     $html = get "http://www.animenewsnetwork.com/encyclopedia/anime.php?list=$il";
  45
  46     # The only way to recognize entries that seems sure is to look
  47     # after the "HOVERLINE" class.
  48
  49     (($url) = ($html =~ /<A\s.*CLASS=HOVERLINE\s.*HREF=\"([^\"]+)\".*$name/i)) || return;
  50
  51     return((($url =~ /\?id=(\d+)$/)[0]));
  52 }
  53
  54 sub getnamefromid
  55 {
  56     my($id, $html);
  57     ($id) = @_;
  58
  59     $html = get "http://www.animenewsnetwork.com/encyclopedia/anime.php?id=$id";
  60
  61     return(($html =~ /\<TITLE\>Anime News Network - ([^<]*)<\/TITLE>/)[0]);
  62 }
  63
  64 GetOptions(\%options, ("l"));
  65
  66 if($options{"l"}) {
  67     @list = getlist $ARGV[0];
  68     foreach $name (@list) {
  69         print "$name\n";
  70     }
  71     exit 0;
  72 }
  73
  74 unless($test = getid $ARGV[0]) {
  75     printf STDERR "could not find $ARGV[0]\n";
  76     exit 1;
  77 }
  78
  79 print getnamefromid($test) . "\n";
  80