package WWW::Hashdb;
use warnings;
use strict;
use Moose;
use Params::Validate;
use WWW::Mechanize;
use Web::Scraper;
=head1 NAME
WWW::Hashdb - search by http://hashdb.com/.
=head1 VERSION
Version 0.01
=cut
our $VERSION = '0.01';
=head1 SYNOPSIS
use WWW::Hashdb;
use XXX;
my $hashdb = WWW::Hashdb->new( limit => 10 );
my @items = $hashdb->search("BURST CITY");
XXX @items;
=head1 EXPORT
none.
=head1 FUNCTIONS
=head2 limit
=cut
has 'limit' => ( is => 'rw', isa => 'Int', default => 10 );
=head2 search
=cut
sub search {
my ($self, $word) = validate_pos(@_, 1, 1);
# http://hashdb.com/search.php?q=SYMPHONY+X&p=1&s=u
# q = query, words
# p = page
# s = ???
my @items;
{
my @pages = do {
my $first = URI->new("http://hashdb.com/search.php");
$first->query_form( { q => $word, p => 1 } );
$first;
};
#warn $uri->as_string;
my $item = scraper {
process "p.searchList";
process 'input', ignore => '@value';
};
my $lists = scraper {
# 次へ(N)
process 'a[accesskey="N"]',
"next" => '@href';
process 'form[name="download"]>p',
"items[]" => $item;
#result 'items';
};
while (my $uri = shift @pages) {
my $items_ref = $lists->scrape( $uri );
push @items, @{$items_ref->{items} || []};
last if $self->limit > 0 and @items >= $self->limit;
push @pages, $items_ref->{next};
}
}
for my $item (@items) {
my @parts = split(/,/, $item->{ignore});
# 先頭のフィールド「名前」には「,」がデリミタとしてではなく表れる場合がある。
until (@parts == 8) {
$parts[0] = join(',', @parts[0 .. 1]);
splice(@parts, 1, 1);
}
# (アニメ)[ラストエグザイル LASTEXILE] (OP) Cloud Age Symphony.mp3,kzELjn4dD0,0,0,6d3d7136e9a7753108aa44e4a20526b7,0,1,0
$item->{name} = $parts[0];
$item->{trip} = $parts[1];
$item->{hash} = $parts[4];
$item->{fetch} = $item->{hash} ? join(",", "", "", 0, 0, $item->{hash}, 0) : undef;
}
return @items;
}
=head1 AUTHOR
Tomohiro Hosaka, C<< >>
=head1 COPYRIGHT & LICENSE
Copyright 2008 Tomohiro Hosaka, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1;