root/lang/perl/WWW-CDTV/trunk/lib/WWW/CDTV.pm @ 34409

Revision 34409, 2.5 kB (checked in by yusukebe, 5 years ago)

Checking in changes prior to tagging of version 0.04. Changelog diff is:

Index: Changes
===================================================================
--- Changes (リビジョン 34406)
+++ Changes (作業コピー)
@@ -1,5 +1,7 @@

Revision history for WWW-CDTV


+0.04 2009/07/13
+ fixed for new html

0.03 Sat Oct 11 15:47:00 2008

support new pages of the CDTV

0.02 Fri May 8 00:15:00 2008

Line 
1package WWW::CDTV;
2
3use warnings;
4use strict;
5use Carp;
6use LWP::UserAgent;
7use Encode;
8use HTML::Entities;
9use DateTime;
10use WWW::CDTV::Track;
11
12our $VERSION = "0.04";
13
14sub new {
15    my ( $class, $opt ) = @_;
16    my $self =
17      bless { url => $opt->{url}
18          || "http://www.tbs.co.jp/cdtv/cddb/thisweek.html", }, $class;
19    $self->init();
20    $self;
21}
22
23sub init {
24    my $self     = shift;
25    my $ua       = LWP::UserAgent->new();
26    my $response = $ua->get( $self->{url} );
27    Carp::croak $response->status_line unless $response->is_success;
28    my $content = $response->content;
29    $content = decode( "iso-2022-jp", $content );
30
31    $self->{week} = $1
32      if ( $content =~ m!<span class="date">(\d{4}/\d{2}/\d{2})</span>! );
33    my @match = $content =~ m!<tr class="(?:tbg1|tbg2)">(.*?)</tr>!gs;
34
35    my $entry_regex = <<"EOF";
36.*<th scope="row">(.*?)</th>.*<span class="ico_(.*?)">.*<td><a href="../songdb/song.*\.html">(.*?)</a></td>.*<td><a href="../artistdb/.*?">(.*?)</a></td>
37EOF
38    my @tracks;
39    my %move_table = ( 'new' => 'new', 'up' => 'up', 'down' => 'down', );
40    foreach my $entry_html (@match) {
41        $entry_html =~ m/$entry_regex/gs;
42        my $entry = {
43            no     => $1,
44            title  => decode_entities($3),
45            artist => decode_entities($4),
46        };
47        $entry->{move} = $move_table{$2};
48        $tracks[ $entry->{no} ] = WWW::CDTV::Track->new($entry);
49    }
50    $self->{tracks} = \@tracks;
51}
52
53sub track {
54    my ( $self, $no ) = @_;
55    $no = $no || 1;
56    my @tracks = @{ $self->{tracks} };
57    return $tracks[$no];
58}
59
60sub week {
61    my $self = shift;
62    return $self->{week};
63}
64
65sub datetime {
66    my $self = shift;
67    my $str  = $self->week;
68    $str =~ m!(\d{4})/(\d{2})/(\d{2})!;
69    my $dt = DateTime->new(
70        year      => $1,
71        month     => $2,
72        day       => $3,
73        time_zone => 'Asia/Tokyo',
74    );
75    return $dt;
76}
77
781;
79
80__END__
81
82=head1 NAME
83
84WWW::CDTV - Get a weekly music ranking from CDTV ( Japanese TV Program )
85
86=head1 SYNOPSIS
87
88    use WWW::CDTV;
89    my $cdtv  = WWW::CDTV->new;
90    my $track = $cdtv->track(1);
91    print sprintf( "No.%d is %s by %s ", $track->no, $track->title,
92        $track->artist );
93 
94=head1 DESCRIPTION
95
96=head1 SEE ALSO
97
98http://www.tbs.co.jp/cdtv/
99
100=head1 AUTHOR
101
102Yusuke Wada  C<< <yusuke@kamawada.com> >>
103
104=head1 LICENCE AND COPYRIGHT
105
106Copyright (c) 2008, Yusuke Wada C<< <yusuke@kamawada.com> >>. All rights reserved.
107
108This module is free software; you can redistribute it and/or
109modify it under the same terms as Perl itself. See L<perlartistic>.
110
Note: See TracBrowser for help on using the browser.