YourAVHost をスクレイピング

私は ero ではないですが erogeek さんを尊敬しています。
表には出さないけど絶対みんなやってるよね。改良の余地ありありです。

#!/usr/bin/perl
use strict;
use warnings;

use URI;
use URI::Escape 'uri_unescape';
use HTTP::Request;
use LWP::UserAgent;
use Web::Scraper;

my $ua = LWP::UserAgent->new(keep_alive => 1);
$Web::Scraper::UserAgent = $ua;

my $avs = scraper {
  process '//div[@class="entry"]', 'avs[]' => scraper {
    process '//h2/a', name => 'text';
    process '//div/div/div/a[img]', 'flvs[]' => [
      '@href', sub { sleep 1; print $_->as_string, "\n"; $_->as_string }, \&yfh2flv ];
  }
}->scrape(URI->new('http://pulpsite.net/youravhost/'))->{avs};

foreach (@{$avs}) {
  mkdir $_->{name}
    unless -d $_->{name};
  foreach my $flv (@{$_->{flvs}}) {
    my ($file) = $flv =~ m!([^/]+\.flv)!;
    my $path = $_->{name} . '/' . $file;
    next
      if -f $path;
    print $file, "\n";
    $ua->request(HTTP::Request->new(GET => $flv), $path);
    sleep 1;
  }
};

sub yfh2flv {
  my $yfh = shift;
  scraper {
    process '//object/param[@name="movie"]', flv => sub {
      $_->attr('value') =~ /video=([^&]+)/;
      my $resp = $ua->get(uri_unescape($1));
      $resp->is_success
        or die;
      $resp->content =~ /video_id=([^&]+)/;
      uri_unescape($1);
    }
  }->scrape(URI->new($yfh))->{flv};
}

[h@lily eg]$ ls -R
.:
yah.pl      きららかおり  一色志乃  桜月舞      瀬戸由衣  早乙女優  竹内あい  瞳めい    姫咲しゅり  友崎亜希
かすみ果穂  鮎川なお      橘ますみ  山咲あかり  倉持茜    大沢佑香  桃井りか  美波さら  片瀬まこ    恋野恋

./かすみ果穂:
146fc5e53c4dad621171bdb0da71904e.flv  8afe76be86f40b6e318948eb2c8a219c.flv  ddc733538d0cba6a967765b6bbd9d94e.flv
4ae92a846c38c1760ecabe5e783e13fc.flv  a1e4a223039f15b9bdc90ec1cc1703ff.flv  ddfeededcbead61bb783248f4f60441a.flv
4e476eb1febce5d1134e03f233f78ab6.flv  b101d3ee971cf6ecab9f9b5b9aa17cd2.flv  e753f67f4d48f492648c376197aa9dcc.flv
66e56420ac6f938e0c7da9321d367265.flv  b614aa03ca610f8a5a7abf2c6e223667.flv  eb80d43ae86b0db37960d16f1bd39f4a.flv
（略）

2007/12/28 追記
これ使えばよかたー。
http://yusukebe.com/tech/archives/20071227/013225.html