File Coverage

blib/lib/TRD/Uranai.pm
Criterion Covered Total %
statement 12 77 15.5
branch 0 12 0.0
condition n/a
subroutine 4 8 50.0
pod 4 4 100.0
total 20 101 19.8


# ){
line stmt bran cond sub pod time code
1             package TRD::Uranai;
2              
3 1     1   36847 use warnings;
  1         2  
  1         32  
4 1     1   5 use strict;
  1         2  
  1         32  
5 1     1   3653 use LWP::UserAgent;
  1         151055  
  1         40  
6 1     1   1268 use Jcode;
  1         73326  
  1         1224  
7              
8             =head1 NAME
9              
10             TRD::Uranai - Today's Uranai Count down.
11              
12             =head1 VERSION
13              
14             Version 0.0.2
15              
16             =cut
17              
18             our $VERSION = '0.0.2';
19              
20              
21             =head1 SYNOPSIS
22              
23             Quick summary of what the module does.
24              
25             Perhaps a little code snippet.
26              
27             use TRD::Uranai;
28              
29             my $uranai = TRD::Uranai::get( 'sjis' );
30             TRD::Uranai::dump( $uranai );
31              
32             =head1 EXPORT
33              
34             A list of functions that can be exported. You can delete this section
35             if you don't export anything, such as for a purely object-oriented module.
36              
37             =head1 FUNCTIONS
38              
39             =head2 get
40              
41             get today's uranai count down data.
42              
43             data
44             'count' => 12,
45             'month' => '08',
46             'day' => '01',
47             'ranking' => [
48             {
49             'rank' => '01',
50             'image' => 'item/conste_sagittarius.gif',
51             'star' => 'いて座',
52             'text' => '大活躍',
53             'lucky' => [
54             {
55             'lucky' => 'カジュアルな服を着る',
56             },
57             ],
58             },
59             ],
60              
61             =cut
62             #========================================================================
63             sub get {
64 0 0   0 1   my $encode = (@_) ? shift : 'sjis';
65 0           my $contents = &TRD::Uranai::getPage();
66 0           my $uranai = &TRD::Uranai::parseContents( $contents, $encode );
67              
68 0           $uranai;
69             }
70              
71             =head2 dump
72              
73             =cut
74             #========================================================================
75             sub dump {
76 0     0 1   my $uranai = shift;
77              
78 0           print "count=". $uranai->{'count'}. "\n";
79 0           print "month=". $uranai->{'month'}. "\n";
80 0           print "day=". $uranai->{'day'}. "\n";
81 0           foreach my $ranking ( @{$uranai->{'ranking'}} ){
  0            
82 0           print "\trank=". $ranking->{'rank'}. "\n";
83 0           print "\timage=". $ranking->{'image'}. "\n";
84 0           print "\tstar=". $ranking->{'star'}. "\n";
85 0           print "\ttext=". $ranking->{'text'}. "\n";
86 0           foreach my $lucky ( @{$ranking->{'lucky'}} ){
  0            
87 0           print "\t\tlucky=". $lucky->{'lucky'}. "\n";
88             }
89 0           print "\n";
90             }
91             }
92              
93             =head2 parseContents
94              
95             =cut
96             #========================================================================
97             sub parseContents {
98 0     0 1   my $contents = shift;
99 0           my $encode = shift;
100 0           my $uranai;
101 0           my $cnt = 0;
102              
103 0 0         if( $contents=~m#class="day">(\d+)月(\d+)日
104 0           $uranai->{'month'} = $1;
105 0           $uranai->{'day'} = $2;
106             }
107 0           my @ranks;
108 0           push( @ranks, [$1, $2] ) while( $contents=~s/(.*?)<\/table>//is ); ## ){ ## ){
109              
110 0           foreach my $row ( @ranks ){
111 0           my $item;
112 0           my( $rank, $part ) = @{$row};
  0            
113 0           $item->{'rank'} = $rank;
114 0 0         if( $part=~s# valign="top">(.+?)
    0          
115 0           $item->{'image'} = $1;
116 0           my $star = $2;
117 0           $star = Jcode::convert( $star, $encode, 'euc' );
118 0           $item->{'star'} = $star;
119             } elsif( $part=~s# valign="top">(.+?)
120 0           $item->{'image'} = $1;
121 0           my $star = $2;
122 0           $star = Jcode::convert( $star, $encode, 'euc' );
123 0           $item->{'star'} = $star;
124             }
125 0 0         if( $part=~s# class="text">(.+?)
126 0           my $text = $1;
127 0           $text = Jcode::convert( $text, $encode, 'euc' );
128 0           $item->{'text'} = $text;
129             }
130 0           while( $part=~s# class="lucky">(.+?)
131 0           my $l = $1;
132 0           $l = Jcode::convert( $l, $encode, 'euc' );
133 0           my $lucky = {'lucky' => $l };
134 0           push( @{$item->{'lucky'}}, $lucky );
  0            
135             }
136              
137 0           push( @{$uranai->{'ranking'}}, $item );
  0            
138              
139 0           $cnt += 1;
140             }
141              
142 0           $uranai->{'count'} = $cnt;
143              
144 0           $uranai;
145             }
146              
147             =head2 getPage
148              
149             =cut
150             #========================================================================
151             sub getPage {
152 0     0 1   my $retval = '';
153 0           my $url = 'http://www.fujitv.co.jp/meza/uranai/index.html';
154 0           my $ua = LWP::UserAgent->new;
155 0           $ua->agent( 'Mozilla' );
156 0           my $request = HTTP::Request->new( GET=>$url );
157 0           my $res = $ua->request( $request );
158 0 0         if( $res->is_success ){
159 0           $retval = Jcode::convert( $res->content, 'euc', 'sjis' );
160             }
161              
162 0           $retval;
163             }
164              
165             =head1 AUTHOR
166              
167             Takuya Ichikawa, C<< >>
168              
169             =head1 BUGS
170              
171             Please report any bugs or feature requests to C, or through
172             the web interface at L. I will be notified, and then you'll
173             automatically be notified of progress on your bug as I make changes.
174              
175              
176              
177              
178             =head1 SUPPORT
179              
180             You can find documentation for this module with the perldoc command.
181              
182             perldoc TRD::Uranai
183              
184              
185             You can also look for information at:
186              
187             =over 4
188              
189             =item * RT: CPAN's request tracker
190              
191             L
192              
193             =item * AnnoCPAN: Annotated CPAN documentation
194              
195             L
196              
197             =item * CPAN Ratings
198              
199             L
200              
201             =item * Search CPAN
202              
203             L
204              
205             =back
206              
207              
208             =head1 ACKNOWLEDGEMENTS
209              
210              
211             =head1 COPYRIGHT & LICENSE
212              
213             Copyright 2008 Takuya Ichikawa, all rights reserved.
214              
215             This program is free software; you can redistribute it and/or modify it
216             under the same terms as Perl itself.
217              
218              
219             =cut
220              
221             1; # End of TRD::Uranai