package TV::ProgrammesSchedules::STAR;

use strict; use warnings;

use Carp;
use Readonly;
use Data::Dumper;
use LWP::UserAgent;
use Time::localtime;
use HTTP::Request::Common;

=head1 NAME

TV::ProgrammesSchedules::STAR - Interface to STAR TV Programmes Schedules.

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';
our $DEBUG   = 0;

Readonly my $BASE_URL => 'http://www.indya.com/uk/tvguide/tvguide.asp';
Readonly my $CHANNELS => 
{
    gold => 'STAR Gold',
    news => 'STAR News',
    one  => 'STAR One',
    plus => 'STAR Plus',
};

=head1 SYNOPSIS

STAR is a  leading  media and entertainment  company in Asia. STAR broadcasts over 60 television 
services in 13 languages to  more than 300 million viewers across 53 Asian countries. STAR TV is 
the UK's leading provider for South Asian entertainment.  STAR's bouquet of channels  in  the UK 
includes:

    --------------------------------------------------------------------------------------------
    | Name      |  Description                                                                 |
    --------------------------------------------------------------------------------------------
    | STAR Plus | UK's Most Watched Hindi Pay General Entertainment Channel.                   |
    |           |                                                                              |
    | STAR One  | UK's lighter general entertainment channel reflecting contemporary India.    |
    |           |                                                                              |
    | STAR Gold | The Widest Reaching Bollywood Movie Channel in the UK.                       |
    |           |                                                                              |
    | STAR News | Europe's First 24 Hours Hindi News Channel.                                  |
    |           |                                                                              |    
    --------------------------------------------------------------------------------------------

=head2 CONSTRUCTOR

The constructor optionally expects a reference to an anonymous hash as input parameter. Possible 
keys to the anonymous hash are (yyyy, mm, dd). The yyyy, mm and dd are optional.If missing picks 
up the current year, month and day.

    use strict; use warnings;
    use TV::ProgrammesSchedules::STAR;
    
    my $star_today = TV::ProgrammesSchedules::STAR->new();
    my $star_on_2011_04_12 = TV::ProgrammesSchedules::STAR->new({ yyyy => 2011, mm => 4 dd => 12 });

=cut

sub new
{
    my $class = shift;
    my $param = shift;
    
    croak("ERROR: Input param has to be a ref to HASH.\n")
        if (defined($param) && (ref($param) ne 'HASH'));
    croak("ERROR: Invalid number of keys found in the input hash.\n")
        if (defined($param) && (scalar(keys %{$param}) != 3));

    $param->{_browser} = LWP::UserAgent->new();
    unless (defined($param) && defined($param->{yyyy}) && defined($param->{mm}) && defined($param->{dd}))
    {
        my $today = localtime; 
        $param->{yyyy} = $today->year+1900;
        $param->{mm}   = $today->mon+1;
        $param->{dd}   = $today->mday;
    }
    
    _validate_date($param->{yyyy}, $param->{mm}, $param->{dd});
    bless $param, $class;
    return $param;
}

=head1 METHODS

=head2 get_listings()

Return the programmes listings for the given channel. Data would be in the form of reference to 
a list containing anonymous hash with keys time and title for each of the programmes.  Possible
values are listed below:

    --------------------------------
    | Channel    | Values          | 
    --------------------------------
    | STAR Plue  | plus            |  
    |            |                 |
    | STAR One   | one             | 
    |            |                 |  
    | STAR Gold  | gold            | 
    |            |                 |
    | STAR News  | news            |
    --------------------------------    

    use strict; use warnings;
    use TV::ProgrammesSchedules::STAR;
    
    my $star = TV::ProgrammesSchedules::STAR->new();
    my $listings = $star->get_listings('news');

=cut

sub get_listings
{
    my $self    = shift;
    my $channel = shift;
    
    _validate_channel($channel);
    my ($browser, $ddDate);
    $browser = $self->{_browser};
    $ddDate  = sprintf("%02d_%02d_%04d", $self->{dd}, $self->{mm}, $self->{yyyy});
    if (exists($self->{$ddDate}->{$channel}))
    {
        print {*STDOUT} "Listing already cached previously...\n" if $DEBUG;
        return $self->{$ddDate}->{$channel};
    }    
    
    my ($query, $response);
    $query    = [ ddChannelName => $CHANNELS->{$channel}, 
                  ddDate        => $ddDate
                ];
    print Dumper($query) if $DEBUG;
    $response = $browser->request(POST $BASE_URL, $query);
    croak("ERROR: Couldn't connect to [$BASE_URL].\n") 
        unless $response->is_success;
    print {*STDOUT} "Fetch programmes listing for channel [$channel] date [$ddDate] using url [$BASE_URL]..\n"
        if $DEBUG;
        
    my ($contents, $listings, $program, $count);
    $contents = $response->content;
    foreach (split(/\n/,$contents))
    {
        chomp;
        s/^\s+//g;
        s/\s+$//g;
        next if /^$/;
        my ($row, $line, $time, $title);
        if (/\<tr class\=black (.*)/)
        {
            $row = $1;
            $row =~ s/(.*?)\<\/td\>\<\/tr\>(.*)/$2/;
            while ($row =~ s/\<tr class(.*?)\<\/tr\>//)
            {
                $line = $1;
                
                $line =~ /(\d\d\:\d\d)/;
                $time = $1;
                
                $line =~ /\&nbsp\;(.*?)\<\/div\>/;
                $title = $1;
                
                $title =~ s/[^[:print:]+]//g;
                $title =~ s/^\s+|\s+$//g;
                
                push @$listings, { time => $time, title => $title };
            }
            $self->{listings} = $listings;
            return $listings;
        }
    }
    $self->{$listings} = $listings;
    return $listings;
}

sub _validate_channel
{
    my $channel = shift;
    
    croak("ERROR: Channel undefined.\n")
        unless defined $channel;
        
    croak("ERROR: Invalid channel [$channel].\n")
        unless exists($CHANNELS->{lc($channel)});
}

sub _validate_date
{
    my $yyyy = shift;
    my $mm   = shift;
    my $dd   = shift;

    croak("ERROR: Invalid year [$yyyy].\n")
        unless (defined($yyyy) && ($yyyy =~ /^\d{4}$/) && ($yyyy > 0));
    croak("ERROR: Invalid month [$mm].\n")
        unless (defined($mm) && ($mm =~ /^\d{1,2}$/) && $mm >= 1 && $mm <= 12);
    croak("ERROR: Invalid day [$dd].\n")
        unless (defined($dd) && ($dd =~ /^\d{1,2}$/) && $dd >= 1 && $dd <= 31);
}

=head1 AUTHOR

Mohammad S Anwar, C<< <mohammad.anwar at yahoo.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-tv-programmesschedules-star at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=TV-ProgrammesSchedules-STAR>.  
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 TV::ProgrammesSchedules::STAR

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=TV-ProgrammesSchedules-STAR>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/TV-ProgrammesSchedules-STAR>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/TV-ProgrammesSchedules-STAR>

=item * Search CPAN

L<http://search.cpan.org/dist/TV-ProgrammesSchedules-STAR/>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2011 Mohammad S Anwar.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=head1 DISCLAIMER

This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=cut

1; # End of TV::ProgrammesSchedules::STAR