IMDB::BaseClass - a base class for IMDB::Film and IMDB::Persons.

  use base qw(IMDB::BaseClass);

package IMDB::BaseClass;

use strict;
use warnings;

use HTML::TokeParser;
use LWP::Simple qw($ua get);
use Cache::FileCache;
use Text::Unidecode qw(unidecode);
use HTML::Entities;
use Carp;

use Data::Dumper;

use constant MAIN_TAG	=> 'h4';
use constant ID_LENGTH	=> 6;

use vars qw($VERSION %FIELDS $AUTOLOAD %STATUS_DESCR);

BEGIN {
	$VERSION = '0.49';

	%STATUS_DESCR = (
		0 => 'Empty',
		1 => 'Filed',
		2 => 'Fresh',
		3 => 'Cached',
	);	
}

use constant FORCED 		=> 1;
use constant CLASS_NAME 	=> 'IMDB::BaseClass';

use constant FROM_FILE		=> 1;
use constant FROM_INTERNET	=> 2;
use constant FROM_CACHE		=> 3;

use fields qw(	content
				parser
				matched
				proxy
				error
				cache
				host
				query
				search
				cacheObj
				cache_exp
				cache_root
				clear_cache
				debug
				status
				file
				timeout
				user_agent
				decode_html
				_code
	);

sub new {
	my $caller = shift;
	my $class = ref($caller) || $caller;
	my $self = fields::new($class);
	$self->_init(@_);
	return $self;
}

sub _init {
	my CLASS_NAME $self = shift;
	my %args = @_;

	no warnings 'deprecated';

	for my $prop ( keys %{ $self->fields } ) {		
		unless($prop =~ /^_/) {
			$self->{$prop} = defined $args{$prop} ? $args{$prop} : $self->_get_default_value($prop);	
		}	
	}
	
	if($self->_cache()) {
		$self->_cacheObj( new Cache::FileCache( { 	default_expires_in 	=> $self->_cache_exp, 
													cache_root 			=> $self->_cache_root } ) );

		$self->_cacheObj->clear() if $self->_clear_cache;											
	}												
	
	if($self->_proxy) { $ua->proxy(['http', 'ftp'], $self->_proxy()) }
	else { $ua->env_proxy() }

	$ua->timeout($self->timeout);
	$ua->agent($self->user_agent);

	$self->_content( $args{crit} );
	$self->_parser();
}

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

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

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

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

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

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

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

sub _clear_cache {
	my CLASS_NAME $self = shift;
	if($_) { $self->{clear_cache} = shift }
	return $self->{clear_cache};
}

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

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

sub _cache_root {
	my CLASS_NAME $self = shift;
	$self->{cache_root} = shift if @_;

	$self->_show_message("CACHE ROOT is " . $self->{cache_root}, 'DEBUG');
	
	return $self->{cache_root};
}

sub _show_message {
	my CLASS_NAME $self = shift;
	my $msg = shift || 'Unknown error';
	my $type = shift || 'ERROR';

	return if $type =~ /^debug$/i && !$self->_debug();
	
	if($type =~ /(debug|info|warn)/i) { carp "[$type] $msg" } 
	else { croak "[$type] $msg" }
}

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

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

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

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

sub _content {
	my CLASS_NAME $self = shift;
	if(@_) {
		my $crit = shift || '';
		my $page;
	
		$self->code($crit) if $crit =~ /^\d{6,8}$/;
		$page = $self->_cacheObj()->get($crit) if $self->_cache();
		
		$self->_show_message("CRIT: $crit", 'DEBUG');
		
		unless($page) {			
			if( -f $crit ) {
				$self->_show_message("Parse IMDB HTML file ...", 'DEBUG');
				
				local $/;
				undef $/;
				open FILE, $crit or die "Cannot open off-line IMDB file: $!!";
				$page = <FILE>;
				close FILE;
				$self->status(FROM_FILE);
			} else {
				$self->_show_message("Retrieving page from internet ...", 'DEBUG');
					
				my $url = 'http://'.$self->_host().'/'.
						( $crit =~ /^\d+$/ && length($crit) >= ID_LENGTH ? $self->_query() : $self->_search() ).$crit;				
				
				$page = $self->_get_page_from_internet($url);
				$self->status(FROM_INTERNET);
			}
			
			$self->_cacheObj()->set($crit, $page, $self->_cache_exp()) if $self->_cache();
		} else {
			$self->_show_message("Retrieving page from cache ...", 'DEBUG');
			$self->status(FROM_CACHE);
		}
		
		$self->{content} = \$page;
	}

	$self->{content};
}

sub _get_page_from_internet {
	my CLASS_NAME $self = shift;
	my $url = shift;
	
	$self->_show_message("URL is [$url]...", 'DEBUG');

	my $page = get($url);

	unless($page) {
		$self->error("Cannot retieve an url: [$url]!");				
		$self->_show_message("Cannot retrieve url [$url]", 'CRITICAL');				
	}
	
	return $page;
}

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

	if($forced) {
		my $content = defined $page ? $page : $self->_content();

		my $parser = new HTML::TokeParser($content) or croak "[CRITICAL] Cannot create HTML parser: $!!";
		$self->{parser} = $parser;
	}
	
	return $self->{parser};
}

sub _get_simple_prop {
	my CLASS_NAME $self = shift;
	my $target = shift || '';
	
	my $parser = $self->_parser(FORCED);

	while(my $tag = $parser->get_tag(MAIN_TAG)) {
		my $text = $parser->get_text;

		$self->_show_message("[$tag->[0]] $text --> $target", 'DEBUG');
		last if $text =~ /$target/i;
	}

	my $end_tag = '/a';
	$end_tag = '/div' if $target eq 'trivia';
	$end_tag = 'span' if $target eq 'Production Co';
	$end_tag = '/div' if $target eq 'aspect ratio';
	
	my $res = $parser->get_trimmed_text($end_tag);	

	$res =~ s/\s+(see )?more$//i;

	$self->_show_message("RES: $res", 'DEBUG');
	
	$res = $self->_decode_special_symbols($res);

	return $res;
}

sub _search_results {
	my CLASS_NAME $self = shift;
	my $pattern = shift || croak 'Please, specify search pattern!';
	my $end_tag = shift || '/li';
	my $year	= shift;
	
	my(@matched, @guess_res, %matched_hash);
	my $parser = $self->_parser();
	
	my $count = 0;
	while( my $tag = $parser->get_tag('a') ) {
		my $href = $tag->[1]{href};
		my $title = $parser->get_trimmed_text('a', $end_tag);
		
		$self->_show_message("TITLE: " . $title, 'DEBUG');
		next if $title =~ /\[IMG\]/i or $href =~ /pro.imdb.com/;
		
		# Remove garbage from the first title
		$title =~ s/(\n|\r)//g;
		$title =~ s/\s*\.media_strip_thumbs.*//m;

		if(my($id) = $href =~ /$pattern/) {
			$matched_hash{$id} = {title => $title, 'pos' => $count++};
			@guess_res = ($id, $title) if $year && $title =~ /$year/ && !@guess_res;
		}	
	}

	@matched = map { {title => $matched_hash{$_}->{title}, id => $_} }  
				sort { $matched_hash{$a}->{'pos'} <=> $matched_hash{$b}->{'pos'} } keys %matched_hash;
	
	$self->matched(\@matched);

	$self->_show_message("matched: " . Dumper(\@matched), 'DEBUG');
	$self->_show_message("guess: " . Dumper(\@guess_res), 'DEBUG');

	my($title, $id);
	if(@guess_res) {
		($id, $title) = @guess_res;
	} else {
		$title = $matched[0]->{title};
		$id = $matched[0]->{id};
	}

	$self->_content($id);
	$self->_parser(FORCED);

	return $title;
}

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

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

sub status_descr {
	my CLASS_NAME $self = shift;
	return $STATUS_DESCR{$self->{status}} || $self->{status};	
}

sub retrieve_code {
	my CLASS_NAME $self = shift;
	my $parser = shift;
	my $pattern = shift;
	my($id, $tag);			
	
	while($tag = $parser->get_tag('link')) {
		if($tag->[1]{href} && $tag->[1]{href} =~ m!$pattern!) {
			$self->code($1);
			last;
		}	
	}	
}

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

sub _decode_special_symbols {
	my($self, $text) = @_;
	if($self->_decode_html) {
		$text = unidecode(decode_entities($text));
	}	
	return $text;
}

sub AUTOLOAD {
 	my $self = shift;
	my($class, $method) = $AUTOLOAD =~ /(.*)::(.*)/;
	my($pack, $file, $line) = caller;

	carp "Method [$method] not found in the class [$class]!\n Called from $pack	at line $line";
}

sub DESTROY {
	my $self = shift;
}

1;

__END__