File Coverage

blib/lib/WWW/JASRAC.pm

Criterion	Covered	Total	%
statement	43	119	36.1
branch	0	44	0.0
condition	0	28	0.0
subroutine	15	17	88.2
pod	2	2	100.0
total	60	210	28.5

# $Id: JASRAC.pm 1 2006-03-14 18:30:19Z daisuke $
#
# Copyright (c) 2006 Daisuke Maki
# All rights reserved.

package WWW::JASRAC;
use strict;
use Encode qw(encode decode);
use HTML::TreeBuilder;
use LWP::UserAgent;
use WWW::JASRAC::Result;
our $VERSION;

BEGIN {
    $VERSION = '0.01'
}

use constant O_NAIGAI   => 'naigai';
use constant O_DOMESTIC => 'naikoku';
use constant O_INTL     => 'gaikoku';
use constant O_ZENPOU   => 'zenpou';
use constant O_BUBUN    => 'bubun';
use constant O_KOHO     => 'koho';
use constant O_KANZEN   => 'kanzen';
use constant DEFAULT_OE => 'euc-jp';
use constant DEFAULT_IE => 'euc-jp';

sub new
{
    my $class = shift;
    my %args  = @_;
    my $self  = bless {
        ie => $args{ie} || DEFAULT_OE,
        oe => $args{oe} || DEFAULT_IE,
        ua => LWP::UserAgent->new,
        uri => $args{uri} || 'http://www2.jasrac.or.jp/cgi-bin/db2www/jwid040.d2w/report',
    }, $class;

    return $self;
}


sub search
{
    my $self = shift;
    my %args = @_;

    my $ie = $args{ie} || $self->{ie};
    my $oe = $args{oe} || $self->{oe};

    my $ua   = $self->{ua};
    my %form = (
        Naigai => 'naigai',
        Kensu  => 110,
        # ºîÉÊ̾
        L_SakJ => undef,
        K_SakJ => undef, # Á°Êý¡¿Éôʬ¡¿¸åÊý¡¿´°Á´°ìÃ×
        L_SakK => undef,
        K_SakK => undef, # Á°Êý¡¿Éôʬ¡¿¸åÊý¡¿´°Á´°ìÃ×
        # ¸¢Íø¼Ô̾
        L_KenJ => undef,
        K_KenJ => undef,
        L_KenK => undef,
        K_KenK => undef,
        # ¥¢¡¼¥Æ¥£¥¹¥È̾
        L_KasJ => undef,
        K_KasJ => undef,
        L_KasK => undef,
        K_KasK => undef,
        # ºîÉÊ¥³¡¼¥É
        L_SakC => undef,
        K_SakC => undef,
    );

    if ($args{code}) {
        my $f = ref($args{code}) eq 'HASH' ?
            $args{code} : { text => $args{code} };
        $form{L_SakC} = $f->{text};
        $form{K_SakC} = $f->{option} || O_KANZEN;
    }

    if ($args{title}) {
        my $f = ref($args{title}) eq 'HASH' ?
            $args{title} : { text => $args{title} };
        $form{L_SakJ} = $f->{text};
        $form{K_SakJ} = $f->{option} || O_KANZEN;
    }

    if ($args{title_yomi}) {
        my $f = ref($args{title_yomi}) eq 'HASH' ?
            $args{title_yomi} : { text => $args{title_yomi} };
        $form{L_SakK} = $f->{text};
        $form{K_SakK} = $f->{option} || O_KANZEN;
    }

    if ($args{rights_holder}) {
        my $f = ref($args{rights_holder}) eq 'HASH' ?
            $args{rights_holder} : { text => $args{rights_holder} };
        $form{L_KenJ} = $f->{text};
        $form{K_KenJ} = $f->{option} || O_KANZEN;
    }

    if ($args{rights_holder_yomi}) {
        my $f = ref($args{rights_holder_yomi}) eq 'HASH' ?
            $args{rights_holder_yomi} : { text => $args{rights_holder_yomi} };
        $form{L_KenK} = $f->{text};
        $form{K_KenK} = $f->{option} || O_KANZEN;
    }

    if ($args{artist}) {
        my $f = ref($args{artist}) eq 'HASH' ?
            $args{artist} : { text => $args{artist} };
        $form{L_KasJ} = $f->{text};
        $form{K_KasJ} = $f->{option} || O_KANZEN;
    }

    if ($args{artist_yomi}) {
        my $f = ref($args{artist_yomi}) eq 'HASH' ?
            $args{artist_yomi} : { text => $args{artist_yomi} };
        $form{L_KasK} = $f->{text};
        $form{K_KasK} = $f->{option} || O_KANZEN;
    }

    foreach my $key (keys %form) {
        unless ($form{$key}) {
            delete $form{$key} ;
            next ;
        }
        $form{$key} = encode('sjis', decode($ie, $form{$key}));
    }

    my $response = $ua->post($self->{uri}, \%form);
    my $content  = $response->content;
    my $original_encoding;
    if ($response->header('Content-Type') =~ /charset=([\w-]+)/) {
        $original_encoding = $1;
    }
    $original_encoding ||= 'sjis';

    $content = encode($oe, decode($original_encoding, $content));

    if ($content =~ /³ºÅö¤¹¤ë¥Ç¡¼¥¿¤Ï¸ºß¤·¤Þ¤»¤ó¤Ç¤·¤¿/) {
        return undef;
    }

    my @ret;
    my $tree = HTML::TreeBuilder->new_from_content($content);
    foreach my $row ($tree->look_down(_tag => 'tr')) {
        my @list = $row->content_list;
        next unless ref $list[0];
        next unless $list[0]->as_text =~ /^([\d-]+)<\d+>$/;

        my $title = ($list[1]->look_down(_tag => 'a'));
        push @ret, WWW::JASRAC::Result->new(
            code => $1,
            link => $title->attr('href'),
            text => encode($self->{oe}, decode('euc-jp', $title->as_text)),
            rights => [
                grep { length($_) && !/^\s+$/ }
                map { s/¡¡/ /g; s/\s$//; s/^\s+//; s/\s+/ /g;
                    encode($self->{oe}, decode('euc-jp', $_)) }
                grep { !ref($_) }
                $list[2]->content_list ],
            artists => [
                grep { length($_) && !/^\s+$/ }
                map { s/¡¡/ /g; s/\s$//; s/^\s+//; s/\s+/ /g;
                    encode($self->{oe}, decode('euc-jp', $_)) }
                grep { !ref($_) }
                $list[3]->content_list ],
        );
    }
    $tree->delete;

    return wantarray ? @ret : \@ret;
}

1;

__END__