]>
iEval git - app-imdbtop.git/blob - lib/App/IMDBtop.pm
340c6125cb44e952818bd4f7e97f5992ec359a81
11 our $VERSION = '0.001';
15 our (%cast_cache, %cast_count);
16 our ($nr, $min_count, $cache, $cache_root);
19 my IMDB
::Film
$self = shift;
21 my (@cast, $tag, $person, $id, $role);
22 my $parser = $self->_parser(1);
24 while($tag = $parser->get_tag('table')) {
25 last if $tag->[1]->{class} && $tag->[1]->{class} =~ /^cast_list$/i;
27 while($tag = $parser->get_tag()) {
28 last if $tag->[0] eq 'a' && $tag->[1]{href
} && $tag->[1]{href
} =~ /fullcredits/i;
29 # if($tag->[0] eq 'td' && $tag->[1]{class} && $tag->[1]{class} eq 'name') {
30 $tag = $parser->get_tag('a');
31 if($tag->[1]{href
} && $tag->[1]{href
} =~ m
#name/nm(\d+?)/#) {
32 $person = $parser->get_text;
34 my $text = $parser->get_trimmed_text('/tr');
35 ($role) = $text =~ /\.\.\. (.*)$/;
36 push @cast, {id
=> $id, name
=> $person, role
=> $role} if $person;
47 my @args = (crit
=> $crit);
48 push @args, cache
=> $cache if defined $cache;
49 push @args, cache_root
=> $cache_root if defined $cache_root;
50 my $film = IMDB
::Film
->new(@args);
51 my @cast = @
{ $film->cast() };
53 warn "Installed IMDB::Film is broken, using patched cast() method\n" unless $warned;
55 @cast = @
{ patched_cast
$film };
57 for my $cast (@cast) {
58 my ($id, $name) = ($cast->{id
}, $cast->{name
});
59 $cast_cache{$id} = $name;
68 $cast_count{$b} <=> $cast_count{$a}
69 or $cast_cache{$a} cmp $cast_cache{$b}
72 !$min_count || $cast_count{$_} > $min_count
74 last if $nr && $cnt++ >= $nr;
75 say $cast_count{$_} . ' ' . $cast_cache{$_}
82 'm|min-count=i' => \
$min_count,
83 'c|cache!' => \
$cache,
84 'cache-root=s' => \
$cache_root,
98 App::IMDBtop - list actors that are popular in your movie collection
107 This module solves a simple problem: you have a list of movies you've
108 watched (in the form of IMDB IDs), and you are looking for the actors
109 that have starred most often in these movies.
111 This module is the backend for the B<imdbtop> script.
115 L<http://imdb.com>, L<imdbtop>
119 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
121 =head1 COPYRIGHT AND LICENSE
123 Copyright (C) 2016 by Marius Gavrilescu
125 This library is free software; you can redistribute it and/or modify
126 it under the same terms as Perl itself, either Perl version 5.24.0 or,
127 at your option, any later version of Perl 5 you may have available.
This page took 0.050232 seconds and 4 git commands to generate.