package TRD::Uranai;
use warnings;
use strict;
use LWP::UserAgent;
use Jcode;
=head1 NAME
TRD::Uranai - Today's Uranai Count down.
=head1 VERSION
Version 0.0.1
=cut
our $VERSION = '0.0.1';
=head1 SYNOPSIS
Quick summary of what the module does.
Perhaps a little code snippet.
use TRD::Uranai;
my $uranai = TRD::Uranai::get( 'sjis' );
TRD::Uranai::dump( $uranai );
=head1 EXPORT
A list of functions that can be exported. You can delete this section
if you don't export anything, such as for a purely object-oriented module.
=head1 FUNCTIONS
=head2 get
get today's uranai count down data.
data
'month' => '08',
'day' => '01',
'ranking' => [
{
'rank' => '01',
'image' => 'item/conste_sagittarius.gif',
'star' => 'いて座',
'text' => '大活躍',
'lucky' => [
{
'lucky' => 'カジュアルな服を着る',
},
],
},
],
=cut
#========================================================================
sub get {
my $encode = (@_) ? shift : 'sjis';
my $contents = &TRD::Uranai::getPage();
my $uranai = &TRD::Uranai::parseContents( $contents, $encode );
$uranai;
}
=head2 dump
=cut
#========================================================================
sub dump {
my $uranai = shift;
print "month=". $uranai->{'month'}. "\n";
print "day=". $uranai->{'day'}. "\n";
foreach my $ranking ( @{$uranai->{'ranking'}} ){
print "\trank=". $ranking->{'rank'}. "\n";
print "\timage=". $ranking->{'image'}. "\n";
print "\tstar=". $ranking->{'star'}. "\n";
print "\ttext=". $ranking->{'text'}. "\n";
foreach my $lucky ( @{$ranking->{'lucky'}} ){
print "\t\tlucky=". $lucky->{'lucky'}. "\n";
}
print "\n";
}
}
=head2 parseContents
=cut
#========================================================================
sub parseContents {
my $contents = shift;
my $encode = shift;
my $uranai;
if( $contents=~m#class="day">(\d+)月(\d+)日# ){
$uranai->{'month'} = $1;
$uranai->{'day'} = $2;
}
my @ranks;
push( @ranks, [$1, $2] ) while( $contents=~s/
(.*?)<\/table>//is );
foreach my $row ( @ranks ){
my $item;
my( $rank, $part ) = @{$row};
$item->{'rank'} = $rank;
if( $part=~s# valign="top">
{'image'} = $1;
my $star = $2;
$star = Jcode::convert( $star, $encode, 'euc' );
$item->{'star'} = $star;
} elsif( $part=~s# valign="top">
{'image'} = $1;
my $star = $2;
$star = Jcode::convert( $star, $encode, 'euc' );
$item->{'star'} = $star;
}
if( $part=~s# class="text">(.+?)## ){
my $text = $1;
$text = Jcode::convert( $text, $encode, 'euc' );
$item->{'text'} = $text;
}
while( $part=~s# class="lucky">(.+?)## ){
my $l = $1;
$l = Jcode::convert( $l, $encode, 'euc' );
my $lucky = {'lucky' => $l };
push( @{$item->{'lucky'}}, $lucky );
}
push( @{$uranai->{'ranking'}}, $item );
}
$uranai;
}
=head2 getPage
=cut
#========================================================================
sub getPage {
my $retval = '';
my $url = 'http://www.fujitv.co.jp/meza/uranai/index.html';
my $ua = LWP::UserAgent->new;
$ua->agent( 'Mozilla' );
my $request = HTTP::Request->new( GET=>$url );
my $res = $ua->request( $request );
if( $res->is_success ){
$retval = Jcode::convert( $res->content, 'euc', 'sjis' );
}
$retval;
}
=head1 AUTHOR
Takuya Ichikawa, C<< >>
=head1 BUGS
Please report any bugs or feature requests to C, or through
the web interface at L. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc TRD::Uranai
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L
=item * AnnoCPAN: Annotated CPAN documentation
L
=item * CPAN Ratings
L
=item * Search CPAN
L
=back
=head1 ACKNOWLEDGEMENTS
=head1 COPYRIGHT & LICENSE
Copyright 2008 Takuya Ichikawa, 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; # End of TRD::Uranai