File Coverage

blib/lib/App/IMDBtop.pm

Criterion	Covered	Total	%
statement	49	58	84.4
branch	10	22	45.4
condition	5	15	33.3
subroutine	8	10	80.0
pod	0	4	0.0
total	72	109	66.0

package App::IMDBtop;

use 5.014000;
use strict;
use warnings;

use Getopt::Long;
use IMDB::Film;
use IMDB::Persons;

our $VERSION = '0.001001';

our $warned = 0;

our (%cast_cache, %cast_count);
our ($nr, $min_count, $cache, $cache_root);

sub patched_cast {
	my IMDB::Film $self = shift;

	my (@cast, $tag, $person, $id, $role);
	my $parser = $self->_parser(1);

	while($tag = $parser->get_tag('table')) {
		last if $tag->[1]->{class} && $tag->[1]->{class} =~ /^cast_list$/i;
	}
	while($tag = $parser->get_tag()) {
		last if $tag->[0] eq 'a' && $tag->[1]{href} && $tag->[1]{href} =~ /fullcredits/i;
	#	if($tag->[0] eq 'td' && $tag->[1]{class} && $tag->[1]{class} eq 'name') {
			$tag = $parser->get_tag('a');
			if($tag->[1]{href} && $tag->[1]{href} =~ m#name/nm(\d+?)/#) {
				$person = $parser->get_text;
				$id = $1;
				my $text = $parser->get_trimmed_text('/tr');
				($role) = $text =~ /\.\.\. (.*)$/;
				push @cast, {id => $id, name => $person, role => $role} if $person;
			}
	#	}
	}

	\@cast
}

sub add_film {
	my ($crit) = @_;
	chomp $crit;
	my @args = (crit => $crit);
	push @args, cache => $cache if defined $cache;
	push @args, cache_root => $cache_root if defined $cache_root;
	my $film = IMDB::Film->new(@args);
	my @cast = @{ $film->cast() };
	unless (@cast) {
		warn "Installed IMDB::Film is broken, using patched cast() method\n" unless $warned;
		$warned = 1;
		@cast = @{ patched_cast $film };
	}
	for my $cast (@cast) {
		my ($id, $name) = ($cast->{id}, $cast->{name});
		$cast_cache{$id} = $name;
		$cast_count{$id}++
	}
}

sub print_results {
	my $cnt = 0;
	for (
		sort {
			$cast_count{$b} <=> $cast_count{$a}
			  or $cast_cache{$a} cmp $cast_cache{$b}
		  }
		  grep {
			  !$min_count || $cast_count{$_} > $min_count
		  } keys %cast_count) {
		last if $nr && $cnt++ >= $nr;
		say $cast_count{$_} . ' ' . $cast_cache{$_}
	}
}

sub run {
	GetOptions (
		'n|nr=i'        => \$nr,
		'm|min-count=i' => \$min_count,
		'c|cache!'      => \$cache,
		'cache-root=s'  => \$cache_root,
	);

	add_film $_ while <>;
	print_results
}

1;
__END__