package WWW::NioTV;
use Moose;
use version; our $VERSION = qv('0.04');
use WWW::Mechanize;
use HTML::TableExtract;
use HTML::SimpleLinkExtor;
use List::MoreUtils qw(any);
#use Smart::Comments;
#use Data::TreeDumper;
has 'content' => ( is => 'rw', isa => 'Str' );
has 'schedule' => ( is => 'rw', isa => 'HashRef' );
has 'mech' => ( is => 'rw', isa => 'Ref' );
my $url = 'http://www.niotv.com/i_index.php?cont=now';
my $url_prefix = 'http://www.niotv.com/';
my @ch_id = (46..50, 52, 53);
#my @ch_id = (46..50, 52, 53, 55..57, 141);
=head1 NAME
WWW::NioTV - retrieve TV information from http://www.niotv.com/
=head1 VERSION
Version 0.04
=cut
=head1 SYNOPSIS
use WWW::NioTV;
my $tv = WWW::NioTV->new;
$tv->now;
$tv->next;
=head1 FUNCTIONS
=head2 new
create a WWW::NioTV object
=cut
sub new {
my ($class, %args) = @_;
my $self = bless \%args, $class;
$self->_init;
return $self;
}
sub _init {
my $self = shift;
# content
my $mech = WWW::Mechanize->new;
$mech->get($url);
$self->content($mech->content);
$self->mech($mech);
# parse
my $te = HTML::TableExtract->new;
$te->parse($self->content);
my @tables = $te->tables;
my @rows = $tables[5]->rows; # 5 => movies
shift @rows;
my %schedule;
foreach my $row (@rows) {
my $channel = $row->[0];
my $now_name = $row->[2];
my $next_name = $row->[4];
$now_name =~ s/(^\s+|\s+$)//;
$next_name =~ s/(^\s+|\s+$)//;
$schedule{$channel} = {
now => $now_name,
next => $next_name,
};
}
$self->schedule(\%schedule);
return;
}
sub _find_link {
my $self = shift;
my $name = shift;
my $extor = HTML::SimpleLinkExtor->new;
$extor->parse($self->content);
foreach my $link ($extor->links) {
next unless any { $link =~ /ch_id=$_$/ } @ch_id;
### $link
### $name
return "$url_prefix$link" if $link =~ /epg_name=$name/;
}
### _find_link return
return;
}
=head2 now
retrieve "now on" tv information
=cut
sub now {
my $self = shift;
my %result = $self->_parse('now');
return wantarray ? %result : \%result;
}
=head2 next
retrieve "next on" tv information
=cut
sub next {
my $self = shift;
my %result = $self->_parse('next');
return wantarray ? %result : \%result;
}
sub _parse {
my $self = shift;
my $type = shift; # now || next
my $mech = $self->mech;
my %result;
foreach my $channel (keys %{$self->schedule}) {
### $channel
my $name = (split /\s+/, $self->schedule->{$channel}->{$type})[0];
### _find_link
my $url = $self->_find_link($name);
### _parse_unit
my %data = $self->_parse_unit($url);
$result{$channel} = \%data;
}
return %result;
}
sub _parse_unit {
my $self = shift;
my $url = shift;
my $mech = $self->mech;
### get
$mech->get($url);
### parse start
my $te = HTML::TableExtract->new;
$te->parse($mech->content);
### parse end
my @tables = $te->tables;
my $name = $tables[1]->rows->[0]->[0];
my $type = $tables[1]->rows->[1]->[1];
my $time = $tables[1]->rows->[2]->[0];
my ($english_name) = $name =~ /\(([^)]+)/;
$time =~ s/(^\s+|\s+$)//g;
$time =~ s/(?<=\))[^0-9]+/ /g;
my %data = (
name => $name,
type => $type,
time => $time,
english_name => $english_name,
);
return %data;
}
=head1 AUTHOR
Alec Chen, C<< <alec at cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-www-niotv at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WWW-NioTV>. 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 WWW::NioTV
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-NioTV>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/WWW-NioTV>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/WWW-NioTV>
=item * Search CPAN
L<http://search.cpan.org/dist/WWW-NioTV>
=back
=head1 COPYRIGHT & LICENSE
Copyright 2008 Alec Chen, 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 WWW::NioTV