--- /dev/null
+Revision history for Perl extension App::IMDBtop.
+
+0.001 2016-10-31T23:41+00:00
+ - Initial release
--- /dev/null
+Changes
+imdbtop
+lib/App/IMDBtop.pm
+Makefile.PL
+MANIFEST
+README
+t/00-compile.t
+t/01-network.t
--- /dev/null
+use 5.014000;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'App::IMDBtop',
+ VERSION_FROM => 'lib/App/IMDBtop.pm',
+ ABSTRACT_FROM => 'lib/App/IMDBtop.pm',
+ AUTHOR => 'Marius Gavrilescu <marius@ieval.ro>',
+ MIN_PERL_VERSION => '5.14.0',
+ LICENSE => 'perl',
+ SIGN => 1,
+ PREREQ_PM => {
+ qw/IMDB::Film 0/,
+ },
+ TEST_REQUIRES => {
+ qw/Test::RequiresInternet 0/
+ },
+ META_ADD => {
+ dynamic_config => 0,
+ resources => {
+ repository => 'https://git.ieval.ro/?p=app-imdbtop.git',
+ },
+ }
+);
--- /dev/null
+App-IMDBtop version 0.001
+=========================
+
+This script solves a simple problem: you have a list of movies you've
+watched (in the form of IMDB IDs), and you are looking for the actors
+that have starred most often in these movies
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+* IMDB::Film
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2016 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.24.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+
--- /dev/null
+#!/usr/bin/perl
+use v5.14;
+use warnings;
+
+use App::IMDBtop;
+
+App::IMDBtop->run;
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+imdbtop - list actors that are popular in your movie collection
+
+=head1 SYNOPSIS
+
+ # List all actors in the given movies, sorted by number of (given)
+ # movies they starred in
+ imdbtop < list_of_movie_ids
+
+ # As above, but only lists top 20 actors
+ imdbtop -n 20 < list_of_movie_ids
+
+ # As above, but only lists actors that appeared in at least 5 of the
+ # given movies
+ imdbtop -m 5 a_list_of_movie_ids another_list
+
+=head1 DESCRIPTION
+
+This script solves a simple problem: you have a list of movies you've
+watched (in the form of IMDB IDs), and you are looking for the actors
+that have starred most often in these movies.
+
+=head1 OPTIONS
+
+=over
+
+=item B<-n> I<count>, B<--nr> I<count>
+
+Only print the top I<count> actors.
+
+=item B<-m> I<min>, B<--min-count> I<min>
+
+Do not print actors that appear in less than I<min> of the given
+movies.
+
+=item B<-c>, B<--cache>, B<--no-cache>
+
+If B<--cache>, stores the content of retrieved pages in a cache.
+Defaults to B<--no-cache>.
+
+=item B<--cache-root> F<path>
+
+Location where cached pages are stored. Defaults to F</tmp>.
+
+=back
+
+=head1 SEE ALSO
+
+L<http://imdb.com>
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2016 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.24.0 or,
+at your option, any later version of Perl 5 you may have available.
+b
+
+=cut
--- /dev/null
+package App::IMDBtop;
+
+use 5.014000;
+use strict;
+use warnings;
+
+use Getopt::Long;
+use IMDB::Film;
+use IMDB::Persons;
+
+our $VERSION = '0.001';
+
+our $warned = 0;
+
+our (%cast_cache, %cast_count);
+our ($nr, $min_count, $cache, $cache_root);
+
+sub patched_cast {
+ my IMDB::Film $self = shift;
+ my ($forced) = shift || 0;
+
+ if($forced) {
+ 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;
+ }
+ # }
+ }
+
+ $self->{_cast} = \@cast;
+ }
+
+ return $self->{_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__
+
+=encoding utf-8
+
+=head1 NAME
+
+App::IMDBtop - list actors that are popular in your movie collection
+
+=head1 SYNOPSIS
+
+ use App::IMDBtop;
+ App::IMDBtop->run
+
+=head1 DESCRIPTION
+
+This module solves a simple problem: you have a list of movies you've
+watched (in the form of IMDB IDs), and you are looking for the actors
+that have starred most often in these movies.
+
+This module is the backend for the B<imdbtop> script.
+
+=head1 SEE ALSO
+
+L<http://imdb.com>, L<imdbtop>
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2016 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.24.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+
+=cut
--- /dev/null
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+BEGIN { use_ok('App::IMDBtop') };
--- /dev/null
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Test::RequiresInternet 'www.imdb.com' => 80;
+use Test::More tests => 2;
+use App::IMDBtop;
+
+App::IMDBtop::add_film 'tt0114814';
+
+ok ((grep { $App::IMDBtop::cast_cache{$_} =~ /Kevin Spacey/i && $App::IMDBtop::cast_count{$_} > 0 } keys %App::IMDBtop::cast_count), 'Kevin Spacey starred in The Usual Suspects (using movie id)');
+
+%App::IMDBtop::cast_count = %App::IMDBtop::cast_cache = ();
+
+App::IMDBtop::add_film 'The Usual Suspects';
+
+ok ((grep { $App::IMDBtop::cast_cache{$_} =~ /Kevin Spacey/i && $App::IMDBtop::cast_count{$_} > 0 } keys %App::IMDBtop::cast_count), 'Kevin Spacey starred in The Usual Suspects (using movie name)');
projects / app-imdbtop.git / commitdiff