The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package WWW::AtMovies;

use warnings;
use strict;
use Moose;
use WWW::Mechanize;
use HTML::TokeParser::Simple;
#use Smart::Comments;

has 'title'         => ( is => 'rw', isa => 'Str' );
has 'chinese_title' => ( is => 'rw', isa => 'Str' );
has 'url'           => ( is => 'rw', isa => 'Str' );
has 'crit'          => ( is => 'rw', isa => 'Str' );
has 'imdb_code'     => ( is => 'rw', isa => 'Num' );
has 'status'        => ( is => 'rw', isa => 'Num' );

=head1 NAME

WWW::AtMovies - retrieves movie information from www.atmovies.com.tw

=head1 VERSION

Version 0.03

=cut

our $VERSION = '0.03';


=head1 SYNOPSIS

    use WWW::AtMovies;

    my $foo = WWW::AtMovies->new( crit => 'Troy' );
    if ($foo->status) {
	print $foo->title, "\n";
	print $foo->chinese_title, "\n";
	print $foo->imdb_code, "\n";
	print $foo->url, "\n";
    }

=head1 FUNCTIONS

=head2 new 

Create a new WWW::AtMovies object.

=cut

sub new {
    my ($class, %args) = @_;
    my $self = bless \%args, $class;
    $self->_init;
    return $self;
}

sub _init {
    my $self = shift;
    my $search_term = $self->crit;

    my $mech = WWW::Mechanize->new;
    $mech->get('http://search.atmovies.com.tw/search/search.cfm');

    my $form = $mech->current_form;
    $form->value('search_term', $search_term);
    $mech->submit;

    ### search result
    my $result_link = $mech->find_link( url_regex => qr/redirect/ );
    if (!$result_link) {
	$self->status(0);
	return;
    }
    $mech->get($result_link->url_abs);
    $self->url($mech->uri->as_string);

    ### movie page
    my $imdb_url = $mech->find_link( url_regex => qr/imdb/ )->url_abs;
    my ($imdb_code) = $imdb_url =~ /(\d+)/;
    $self->imdb_code($imdb_code);

    my $parser = HTML::TokeParser::Simple->new( string => $mech->content );
    while ( my $span = $parser->get_tag('span') ) {
	my $class = $span->get_attr('class');
	next unless defined $class;
	if ($class eq 'at21b') {
	    $self->chinese_title( $parser->get_trimmed_text('/span') );
	}
	elsif ($class eq 'at12b_gray') {
	    $self->title( $parser->get_trimmed_text('/span') );
	}
    }

    $self->status(1);
    return;
}

=head1 AUTHOR

Alec Chen, C<< <alec at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-www-atmovies at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WWW-AtMovies>.  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::AtMovies


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-AtMovies>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/WWW-AtMovies>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/WWW-AtMovies>

=item * Search CPAN

L<http://search.cpan.org/dist/WWW-AtMovies/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT & LICENSE

Copyright 2009 Alec Chen.

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.


=cut

1; # End of WWW::AtMovies