Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

Class for getting film information from IMDB.

by nite_man (Deacon)
on Jul 28, 2004 at 13:35 UTC ( [id://378029]=sourcecode: print w/replies, xml ) Need Help??
Category: Web Stuff
Author/Contact Info Michael Stepanov (misha@tunderworx.com)
Description: IMDB::Film is OO Perl interface to the films information in the IMDB. I've tried to implement possibility to inherit, override and expande its functionality (Hope I did it). For example, you need retrieve number of votes with user rating. So, you can use IMDB::Film as base class and override method rating. All critical remarks, suggestions and etc will be appreciated. Hope that module will be useful for someone.

Updated: Fixed bug with retrieving film information by its title.

=head1 NAME

IMDB::Film - OO Perl interface to the movies database IMDB.

=head1 VERSION

IMDB::Film 0.01

=head1 SYNOPSIS

    use IMDB;

    my $imdbObj = new IMDB::Film(crit => 227445);

    or

    my $imdbObj = new IMDB::Film(crit => 'Troy');

    print "Title: ".$imdbObj->title()."\n";
    print "Year: ".$imdbObj->year()."\n";
    print "Plot Symmary: ".$imdbObj->plot()."\n";

=head1 DESCRIPTION

=head2 Overview

IMDB::Film is an object-oriented interface to the IMDB.
You can use that module to retrieve information about film:
title, year, plot etc. 

=cut
package IMDB::Film;

use strict;
use warnings;

use HTML::TokeParser;
use LWP::UserAgent;
use Cache::FileCache;
use Carp;

use fields qw(    _title
                _year
                _summary
                _casts
                _directors
                _writers
                _cover
                _code
                _language
                _country
                _rating
                _genres
                _tagline
                _plot
                _certifications
                _duration
                content
                parser
                matched
                proxy
                error
                cache
                host
                query
                search
                cacheObj
                cache_exp
                debug
    );
    
use vars qw( $VERSION %FIELDS %FILM_CERT );

use constant CLASS_NAME => 'IMDB::Film';
use constant FORCED        => 1;
use constant USE_CACHE    => 1;
use constant DEBUG_MOD    => 1;

BEGIN {
        $VERSION = '0.03';
                        
        # Convert age gradation to the digits        
        %FILM_CERT = ( G => 'All', R => 16, 'NC-17' => 16, PG => 13, '
+PG-13' => 13 );                    
}

{
    my $_objcount = 0;

    sub get_objcount { $_objcount }
    sub _incr_objcount { ++$_objcount }
    sub _decr_objcount { --$_objcount }
    
    my %_defaults = ( 
        proxy        => $ENV{http_proxy},
        cache        => 0,
        debug        => 1,
        error        => [],
        cache_exp    => '1 h',
        host        => 'www.imdb.com',
        query        => 'title/tt',
        search         => 'Find?select=All&for=',        
    );

    sub _get_default_attrs { keys %_defaults }        
    sub _get_default_value {
        my($self, $attr) = @_;
        $_defaults{$attr};
    }
}

=head2 Constructor and initialization

=over 4

=item new()

Object's constructor. You should pass as parameter movie title or IMDB
+ code.

    my $imdb = new IMDB::Film(crit => <some code>);

or    

    my $imdb = new IMDB::Film(crit => <some title>);

Also, you can specify following optional parameters:
    
    - proxy - define proxy server name and port;
    - debug    - switch on debug mode (on by default);
    - cache - cache or not of content retrieved pages.

=cut
sub new {
    my $caller = shift;
    my $class = ref($caller) || $caller;

    $class->_incr_objcount();

    no strict "refs";
    my $self = bless [\%{"${caller}::FIELDS"}], $class;

    $self->_init(@_);
    return $self;
}

=item _init()

Initialize object.

=cut
sub _init {
    my CLASS_NAME $self = shift;
    my %args = @_;
    
    for my $prop ( $self->_get_default_attrs ) {        
        $self->{$prop} = defined $args{$prop}     ? $args{$prop} : 
                                                $self->_get_default_va
+lue($prop);    
    }

    $self->_cacheObj( new Cache::FileCache( { default_expires_in => $s
+elf->_cache_exp() } ) );
    
    croak "Film IMDB ID or Title should be defined!" 
                                            if !defined $args{crit} &&
+ $args{crit} eq '';                                    
    
    $self->_content( $args{crit} );
    $self->_parser(FORCED);
    $self->title(FORCED);

    for my $prop (grep { /^_/ && !/^_title$/ } sort keys %FIELDS) {
        ($prop) = $prop =~ /^_(.*)/;
        $self->$prop(FORCED);
    }    
}

=back

=head2 Object Private Methods

=over 4

=item _proxy()

Store address of proxy server. You can pass a proxy name as parameter 
+into
object constructor:

    my $imdb = new IMDB::Film(code => 111111, proxy => 'my.proxy.host:
+8080');

or you can define environment variable 'http_host'. For exanple, for L
+inux
you shoud do a following:

    export http_proxy=my.proxy.host:8080
    
=cut
sub _proxy {
    my CLASS_NAME $self = shift;
    if(@_) { $self->{proxy} = shift }
    return $self->{proxy};
}

=item _cache()

Store cache flag. Indicate use file cache to store content page or not
+:
    
    my $imdb = new IMDB::Film(code => 111111, cache => 1);

=cut
sub _cache {
    my CLASS_NAME $self = shift;
    if(@_) { $self->{cache} = shift }
    return $self->{cache}
}

=item _cacheObj()

In case of using cache, we create new Cache::File object and store it 
+in object's
propery. For more details about Cache::File please see Cache::Cache do
+cumentation.

=cut
sub _cacheObj {
    my CLASS_NAME $self = shift;
    if(@_) { $self->{cacheObj} = shift }
    return $self->{cacheObj}
}

=item _cache_exp()

In case of using cache, we can define value time of cache expire.

    my $imdb = new IMDB::Film(code => 111111, cache_exp => '1 h');

For more details please see Cache::Cache documentation.

=cut
sub _cache_exp {
    my CLASS_NAME $self = shift;
    if(@_) { $self->{cache_exp} = shift }
    return $self->{cache_exp}
}

=item _host()

Store IMDB host name. You can pass this value in object constructor:
        
    my $imdb = new IMDB::Film(code => 111111, host => 'us.imdb.com');

By default, it uses 'www.imdb.com'.

=cut
sub _host {
    my CLASS_NAME $self = shift;
    if(@_) { $self->{host} = shift }
    return $self->{host}
}

=item _query()

Store query string to retrieve film by its ID. You can define
different value for that:

    my $imdb = new IMDB::Film(code => 111111, query => 'some significa
+nt string');

Default value is 'title/tt'.

=cut
sub _query {
    my CLASS_NAME $self = shift;
    if(@_) { $self->{query} = shift }
    return $self->{query}
}

=item _search()

Store search string to find film by its title. You can define
different value for that:

    my $imdb = new IMDB::Film(code => 111111, seach => 'some significa
+nt string');

Default value is 'Find?select=Titles&for='.

=cut    
sub _search {
    my CLASS_NAME $self = shift;
    if(@_) { $self->{search} = shift }
    return $self->{search}
}

=item _debug()

Indicate to use DEBUG mode to display some debug messages:
    
    my $imdb = new IMDB::Film(code => 111111, debug => 1);

By default debug mode is switched off.    

=cut
sub _debug {
    my CLASS_NAME $self = shift;
    if(@_) { $self->{debug} = shift }
    return $self->{debug}
}

=item _content()

Connect to the IMDB, retrieve page according to crit: by film
IMDB ID or its title and store content of that page in the object
property. 
In case using cache, first check if page was already stored in the
cache then retrieve page from the cache else store content of the 
page in the cache.

=cut
sub _content {
    my CLASS_NAME $self = shift;
    if(@_) {
        my $crit = shift;
        my ($page);
    
        $page = $self->_cacheObj()->get($crit) if $self->_cache();

        $self->{_code} = $crit if $crit =~ /^\d+$/;

        unless (defined $page) {
            
            print "[DEBUG] Retrieving page from internet ...\n" if $se
+lf->_debug();
            
            my $ua = new LWP::UserAgent();
            $ua->proxy(['http', 'ftp'], 'http://'.$self->_proxy()) if 
+defined $self->_proxy();

            my $url = 'http://'.$self->_host().'/'.
                        ( $crit =~ /^\d+$/ ? $self->_query() : $self->
+_search() ).$crit;

            print "[DEBUG] URL is $url ...\n" if $self->_debug();

            my $req = new HTTP::Request(GET => $url);
            my $res = $ua->request($req);

            unless($res->is_success) {
                carp "Cannot retrieve page: ".$res->status_line();
                $self->error($res->status_line());
                return;
            }
            
            $page = $res->content();
            $self->_cacheObj()->set($crit, $page, $self->_cache_exp())
+ if $self->_cache();
        } else {
            print "[DEBUG] Retrieving page from cache ...\n" if $self-
+>_debug();
        }
        
        $self->{content} = \$page;
    }
    
    return $self->{content};
}

=item _parser()

Setup HTML::TokeParser and store. To have possibility to inherite that
+ class
we should every time initialize parser using stored content of page.
For more information please see HTML::TokeParser documentation.

=cut
sub _parser {    
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;

    if($forced) {
        my $content = $self->_content();

        my $parser = new HTML::TokeParser($content) or croak "Cannot c
+reate HTML parser: $!!";
        $self->{parser} = $parser;
    }
    
    return $self->{parser};
}

=item _search_film()

Implemets functionality to search film by name.

=cut
sub _search_film {
    my CLASS_NAME $self = shift;
    my (@matched);
    
    my $parser = $self->_parser();

    while(my $tag = $parser->get_tag('a')) {
        my $href = $tag->[1]{href};
        if (my ($id) = $href =~ /\/title\/tt(\d+)/) {
            push @matched, {id => $id, title => $parser->get_text};
        }    
    }

    $self->matched(\@matched);
    $self->_content($matched[0]->{id});
    $self->_parser(FORCED);

    return $matched[0]->{title};
}

=back

=head2 Object Public Methods

=over 4

=item code()

Get IMDB film code.

    my $code = $film->code();

=cut
sub code {
    my CLASS_NAME $self = shift;

    return $self->{_code};
}

=item title()

Retrieve film title from film page. If was got search page instead
of film page this method calls method _search_film to get list
matched films and continue to process first one:

    my $title = $film->title();

=cut
sub title {    
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;
    if($forced) {
        my ($parser) = $self->_parser(FORCED);
    
        $parser->get_tag('title');
        my $title = $parser->get_text();
        if($title =~ /IMDb name and title search/i) {
            print "[DEBUG] Go to search page ..." if $self->_debug();
            $title = $self->_search_film();                
        } 
        
        (my ($ftitle, $year)) = $title =~ /(.*?)\s+\((\d{4}).*?\)/;
        $self->{_title} = $ftitle;
        $self->{_year} = $year;
    }    
    
    return $self->{_title};
}

=item year()

Get film year:
    
    my $year = $film->year();

=cut
sub year {
    my CLASS_NAME $self = shift;
    return $self->{_year};
}

=item cover()

Retrieve url of film cover:

    my $cover = $film->cover();

=cut
sub cover {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;

    if($forced) {
        my ($parser) = $self->_parser(FORCED);
        my ($cover);

        while(my $img_tag = $parser->get_tag('img')) {
            $img_tag->[1]{alt} ||= '';    
            if($img_tag->[1]{alt} =~ /cover/i) {
                $cover = $img_tag->[1]{src};
                last;
            }

            last if $img_tag->[1]{alt} =~ /^no poster/i;
        }

        $self->{_cover} = $cover;
    }    

    return $self->{_cover};
}    

=item directors()

Retrieve film directors list each element of which is hash reference -
{ id => <ID>, name => <Name> }:

    my @directors = @{ $film->directors() };
    
=cut
sub directors {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;

    if($forced) {
        my ($parser) = $self->_parser(FORCED);
        my (@directors, $tag);
    
        while($tag = $parser->get_tag('b')) {
            last if $parser->get_text =~ /^directed/i;
        }

        while ($tag = $parser->get_tag() ) {
            my $text = $parser->get_text();
            last if $text =~ /writing/i;
            
            if($tag->[0] eq 'a') {
                my ($id) = $tag->[1]{href} =~ /(\d+)/;    
                push @directors, {id => $id, name => $text};
            }            
        }
        
        $self->{_directors} = \@directors;        
    }    

    return $self->{_directors};
}

=item writers()

Retrieve film writers list each element of which is hash reference -
{ id => <ID>, name => <Name> }:

    my @writers = @{ $film->writers() };

=cut
sub writers {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;

    if($forced) {
        my ($parser) = $self->_parser(FORCED);
        my (@writers, $tag);
        
        while($tag = $parser->get_tag('b')) {
            last if $parser->get_text =~ /^writing/i;
        }
            
        while($tag = $parser->get_tag()) {
            my $text = $parser->get_text();
            last if $tag->[0] eq '/table';
            
            if($tag->[0] eq 'a') {
                if(my ($id) = $tag->[1]{href} =~ /nm(\d+)/) {
                    push @writers, {id => $id, name => $text};
                }    
            }        
        }
        
        $self->{_writers} = \@writers;
    }    

    return $self->{_writers};
}

=item genres()

Retrieve film genres list:

    my @genres = @{ $film->genres() };

=cut
sub genres {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;

    if($forced) {
        my ($parser) = $self->_parser(FORCED);
        my (@genres);
        
        while(my $tag = $parser->get_tag('b')) {
            last if $parser->get_text =~ /^genre/i;
        }

        while(my $tag = $parser->get_tag('a')) {
            my $genre = $parser->get_text;    
            last unless $tag->[1]{href} =~ /genres/i;
            last if $genre =~ /more/i;
            push @genres, $genre;
        }    

        $self->{_genres} = \@genres;
    }    

    return $self->{_genres};
}

=item tagline()

Retrieve film tagline:
    
    my $tagline = $film->tagline();

=cut
sub tagline {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;

    if($forced) {
        my ($parser) = $self->_parser(FORCED);        

        while(my $tag = $parser->get_tag('b')) {
            last if($parser->get_text =~ /tagline/i);
        }    
                
        $self->{_tagline} = $parser->get_trimmed_text('b', 'a');
    }    

    return $self->{_tagline};
}

=item plot()

Retrieve film plot summary:

    my $plot = $film->plot();

=cut
sub plot {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;

    my ($text);

    if($forced) {
        my $parser = $self->_parser(FORCED);

        while(my $tag = $parser->get_tag('b')) {
            last if $parser->get_text =~ /^plot/i;
        }

        $self->{_plot} = $parser->get_trimmed_text('b', 'a');
    }    

    return $self->{_plot};
}

=item rating()

Retrieve film user rating:
    
    my $rate = $film->rating();

=cut
sub rating {
    my CLASS_NAME $self = shift;
    my ($forced) = shift || 0;

    if($forced) {
        my $parser = $self->_parser(FORCED);
    
        while(my $tag = $parser->get_tag('b')) {
            last if $parser->get_text =~ /rating/i;
        }

        my $tag = $parser->get_tag('b');    
        ($self->{_rating}) = $parser->get_trimmed_text('b', 'a') =~ m!
+(\d+\.?\d+)\/!;
    }

    return $self->{_rating};
}

=item casts()

Retrieve film casts list each element of which is hash reference -
{ id => <ID>, name => <Name> }:

    my @casts = @{ $film->casts() };

=cut
sub casts {
    my CLASS_NAME $self = shift;
    my ($forced) = shift || 0;

    if($forced) {
        my (@casts, $tag, $cast);
        my $parser = $self->_parser(FORCED);
    
        while($tag = $parser->get_tag('b')) {
            last if $parser->get_text() =~ /^cast overview/i;
        }

        while($tag = $parser->get_tag('a')) {
            if(defined $tag->[1]{href} && $tag->[1]{href} =~ m!/name/n
+m(\d+?)/!) {
                $cast = $parser->get_text;
                push @casts, {id => $1, name => $cast};
            }    
            
            last if $cast =~ /more/i;
        }    
        
        $self->{_casts} = \@casts;
    }

    return $self->{_casts};
}

=item duration()

Retrieve film duration in minutes:

    my $duration = $film->duration();

=cut
sub duration {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;
    
    if($forced) {

        my $parser = $self->_parser(FORCED);
        while(my $tag = $parser->get_tag('b')) {
            my $text = $parser->get_text();
            last if $text =~ /runtime:/i;
        }    
        
        $self->{_duration} = $parser->get_trimmed_text('b', 'br');
    }

    return $self->{_duration};
}

=item country()

Retrieve film produced countries list:

    my @countries = $film->country();

=cut
sub country {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;
    
    if($forced) {
        my $parser = $self->_parser(FORCED);
        while (my $tag = $parser->get_tag('b')) {
            last if $parser->get_text =~ /country/i;
        }    

        my (@countries);
        while(my $tag = $parser->get_tag()) {
            
            if( $tag->[0] eq 'a' && $tag->[1]{href} =~ /countries/i ) 
+{
                push @countries, $parser->get_text();
            } 
            
            last if $tag->[0] eq 'br';
        }

        $self->{_country} = \@countries; 
    }
    
    return $self->{_country}
}

=item language()

Retrieve film languages list:

    my @languages = $film->language();

=cut
sub language {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;
    
    if($forced) {
        my (@languages, $tag);
        my $parser = $self->_parser(FORCED);
        while ($tag = $parser->get_tag('b')) {
            last if $parser->get_text =~ /language/i;
        }    

        while($tag = $parser->get_tag()) {
            
            if( $tag->[0] eq 'a' && $tag->[1]{href} =~ /languages/i ) 
+{
                push @languages, $parser->get_text();
            } 
            
            last if $tag->[0] eq 'br';
        }

        $self->{_language} = \@languages; 
    }
    
    return $self->{_language};

}

=item summary()

Retrieve film user summary:

    my $descr = $film->summary();
    
=cut
sub summary {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;
        
    if($forced) {
        my ($tag, $text);
        my ($parser) = $self->_parser(FORCED);

        while($tag = $parser->get_tag('b')) {
            $text = $parser->get_text();
            last if $text =~ /^summary/i;
        }    

        $text = $parser->get_text('b', 'a');
        $self->{_summary} = $text;
    }    
    
    return $self->{_summary};
}

=item certifications()

Retrieve list of film certifications each element of which is hash ref
+erence -
{ country => certificate }:

    my @cert = $film->certifications();

=cut
sub certifications {
    my CLASS_NAME $self = shift;
    my $forced = shift || 0;
    my (%cert_list, $tag);

    if($forced) {
        my $parser = $self->_parser(FORCED);
        while($tag = $parser->get_tag('b')) {
            last if $parser->get_text =~ /certification/i;
        }

        while($tag = $parser->get_tag()) {
            
            if($tag->[0] eq 'a' && $tag->[1]{href} =~ /certificates/i)
+ {
                my ($country, $range) = split /\:/, $parser->get_text;
                $cert_list{$country} = $range;
            }

            last if $tag->[0] eq '/td';
        }

        $self->{_certifications} = \%cert_list;
    }

    return $self->{_certifications};
}

=item matched()

Retrieve list of matched films each element of which is hash reference
+ - 
{ id => <Film ID>, title => <Film Title>:

    my @matched = @{ $film->matched() };

=cut
sub matched {
    my CLASS_NAME $self = shift;
    if(@_) { $self->{matched} = shift }
    return $self->{matched};
}


=item error()

Return string which contains error messages separated by \n:

    my $errors = $film->error();

=cut
sub error {
    my CLASS_NAME $self = shift;
    if(@_) { push @{ $self->{error} }, shift() }
    return join("\n", @{ $self->{error} });
}


=back

=cut

sub DESTROY {
    my CLASS_NAME $self = shift;
    $self->_decr_objcount();
}

1;

__END__

=head2 Class Variables

=over 4

=item %FIELDS

Contains list all object's properties. See description of pragma C<fie
+lds>.

=item @FILM_CERT

Matches USA film certification notation and age.

=back

=head1 EXPORTS

Nothing

=head1 BUGS

Please, send me any found bugs by email: misha@thunderworx.com. 

=head1 SEE ALSO

HTML::TokeParser, IMDB::Movie, perlobj

=head1 AUTHOR

Michael Stepanov (misha@thunderworx.com)

=head1 COPYRIGHT

Copyright (c) 2004, Michael Stepanov. All Rights Reserved.
This module is free software. It may be used, redistributed and/or 
modified under the same terms as Perl itself.

=cut
Replies are listed 'Best First'.
Re: Class for getting film information from IMDB.
by ctilmes (Vicar) on Jul 28, 2004 at 16:31 UTC
    Looks cool. The only thing I don't like is the name. If you're going to snag a top level name, just make it plain old "IMDB" -- the "Film" is pretty redundant. (Unless you envision other IMDB modules that aren't associated with "Film").

    My preference would be to find a better top level 'home' for it, but I'm not sure which one would be good...

      Thanks, guys. I'm glade to hear that somebody is interested of my work!

      I've named my module IMDB::Film because it's releated with IMDB and there is a module IMDB::Movie. So, no need to create new name space for that.

      But, any way, thanks for your suggestions!

      ---
      Schiller

      It's only my opinion and it doesn't have pretensions of absoluteness!

        So why did you decide to reinvent IMDB::Movie? The only extra feature I see is plot, which would've made an excellent addition to IMDB::Movie.

        --

        MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
        I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
        ** The third rule of perl club is a statement of fact: pod is sexy.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://378029]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (6)
As of 2024-03-29 14:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found