root/lang/perl/Acme-JapaneseAvActress/trunk/lib/Acme/JapaneseAvActress.pm @ 2681

package Acme::JapaneseAvActress;

use strict;
use warnings;
use URI::Fetch;
use XML::Simple;
use HTML::Entities;
use Cache::File;

our $VERSION = "0.0.1";

sub new {
    my $class = shift;
    my $opt   = ref $_[0] eq 'HASH' ? shift: {@_};
    my %self  = (
        wikipedia_url =>
"http://ja.wikipedia.org/wiki/%E7%89%B9%E5%88%A5:Export/AV%E5%A5%B3%E5%84%AA%E4%B8%80%E8%A6%A7",
        %$opt,
    );

    return bless \%self, $class;
}

sub get {
    my $self = shift;
    my $content;
    if ( $self->{default_expires} && $self->{cache_root} ) {
        my $cache = Cache::File->new(
            cache_root      => $self->{cache_root},
            default_expires => $self->{default_expires}
        );
        if ( $cache->exists( $self->{wikipedia_url} ) ) {
            $content =
              Storable::thaw( $cache->get( $self->{wikipedia_url} ) )
              ->{Content};
        }
        else {
            my $xml =
              URI::Fetch->fetch( $self->{wikipedia_url}, Cache => $cache )
              or die URI::Fetch->errstr;
            $content = $xml->content;
        }
    }
    else {
        my $xml = URI::Fetch->fetch( $self->{wikipedia_url} )
          or die URI::Fetch->errstr;
        $content = $xml->content;
    }
    my ( @actress, $initial );
    my $flag = 0;
    my @lines = split( /\n/, $content );
    foreach my $line (@lines) {
        my $actress_info = {};
        $flag = 1 if $line =~ /== あ行 ==/;
        last if $line =~ /== 関連項目 ==/;
        next unless $flag;
        if ( $line =~ /===\s([あ-ん]*?)\s===\Z/ ) {
            $initial = $1;
        }
        elsif ( $line =~ /\[\[(.*?)\]\](.*)/ ) {
            my $temp;
            $actress_info->{name} = $1;
            $temp = $2;
            if ( $temp =~
/(?:（|\()(.*?)(?:）|\)).*(?:（|\()\[\[(\d{4})年\]\](?:）|\))/
              )
            {
                $actress_info->{yomi} = $1;
                $actress_info->{year} = $2;
            }
            elsif ( $temp =~ /(?:（|\()\[\[(\d{4})年\]\](?:）|\))/ ) {
                $actress_info->{yomi} = "";
                $actress_info->{year} = $1;
            }
            elsif ( $temp =~ /(?:（|\()(.*?)(?:）|\))/ ) {
                $actress_info->{yomi} = $1;
                $actress_info->{year} = "";
            }
            if ( $actress_info->{name} =~ /(.*)\|(.*)/ ) {
                $actress_info->{name} = $2;
            }
            decode_entities( $actress_info->{name} );
            decode_entities( $actress_info->{yomi} );
            $actress_info->{initial} = $initial;
            push( @actress,
                Acme::JapaneseAvActress::Actress->new($actress_info) );
        }
    }
    $self->{actress} = \@actress;
    return \@actress;
}

sub initial {
    my ( $self, $initial ) = @_;
    my @temp;
    foreach my $actress ( @{ $self->{actress} } ) {
        push( @temp, $actress ) if $actress->initial eq $initial;
    }
    return \@temp;
}

sub year {
    my ( $self, $year ) = @_;
    my @temp;
    foreach my $actress ( @{ $self->{actress} } ) {
        push( @temp, $actress ) if $actress->year eq $year;
    }
    return \@temp;
}

sub name {
    my ( $self, $name ) = @_;
    foreach my $actress ( @{ $self->{actress} } ) {
        return $actress if $actress->name eq $name;
    }
    return;
}
sub yomi {
    my ( $self, $yomi ) = @_;
    foreach my $actress ( @{ $self->{actress} } ) {
        my $y = $actress->yomi;
        $y =~ s/ //;
        $yomi =~ s/ //;
        return $actress if $y eq $yomi;
    }
    return;
}

package Acme::JapaneseAvActress::Actress;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);

__PACKAGE__->mk_accessors(qw(name initial yomi year));


1;

__END__

=head1 NAME

Acme::JapaneseAvActress - Get Japanese AV Actress Infomation from wikipedia


=head1 VERSION

This document describes Acme::JapaneseAvActress version 0.0.1


=head1 SYNOPSIS

    use Acme::JapaneseAvActress;
    use Data::Dumper;

    my $actress = Acme::JapaneseAvActress->new(
        {
            'cache_root'      => '/tmp/avactress',
            'default_expires' => '7days',
        }
    );
    $actress->get;
    my $actlist = $actress->year("2000");
    print Dumper($actlist);

=head1 AUTHOR

Yusuke Wada  C<< <yusuke@kamawada.com> >>


=head1 LICENCE AND COPYRIGHT

Copyright (c) 2007, Yusuke Wada C<< <yusuke@kamawada.com> >>. All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.