From 76ed8698d0ef29dee241ce00906c4f67647b4753 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Tue, 1 Nov 2016 01:41:26 +0200 Subject: [PATCH] Initial commit --- Changes | 4 ++ MANIFEST | 8 +++ Makefile.PL | 24 ++++++++ README | 31 +++++++++++ imdbtop | 77 +++++++++++++++++++++++++ lib/App/IMDBtop.pm | 136 +++++++++++++++++++++++++++++++++++++++++++++ t/00-compile.t | 6 ++ t/01-network.t | 17 ++++++ 8 files changed, 303 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100755 imdbtop create mode 100644 lib/App/IMDBtop.pm create mode 100644 t/00-compile.t create mode 100644 t/01-network.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..0406f91 --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Perl extension App::IMDBtop. + +0.001 2016-10-31T23:41+00:00 + - Initial release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..53bc563 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,8 @@ +Changes +imdbtop +lib/App/IMDBtop.pm +Makefile.PL +MANIFEST +README +t/00-compile.t +t/01-network.t diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..7deaa0c --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,24 @@ +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 ', + 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', + }, + } +); diff --git a/README b/README new file mode 100644 index 0000000..8f665d5 --- /dev/null +++ b/README @@ -0,0 +1,31 @@ +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. + + diff --git a/imdbtop b/imdbtop new file mode 100755 index 0000000..acfd73e --- /dev/null +++ b/imdbtop @@ -0,0 +1,77 @@ +#!/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, B<--nr> I + +Only print the top I actors. + +=item B<-m> I, B<--min-count> I + +Do not print actors that appear in less than I 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 + +Location where cached pages are stored. Defaults to F. + +=back + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Marius Gavrilescu, Emarius@ieval.roE + +=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 diff --git a/lib/App/IMDBtop.pm b/lib/App/IMDBtop.pm new file mode 100644 index 0000000..0eda7b2 --- /dev/null +++ b/lib/App/IMDBtop.pm @@ -0,0 +1,136 @@ +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 script. + +=head1 SEE ALSO + +L, L + +=head1 AUTHOR + +Marius Gavrilescu, Emarius@ieval.roE + +=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 diff --git a/t/00-compile.t b/t/00-compile.t new file mode 100644 index 0000000..5044a6e --- /dev/null +++ b/t/00-compile.t @@ -0,0 +1,6 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Test::More tests => 1; +BEGIN { use_ok('App::IMDBtop') }; diff --git a/t/01-network.t b/t/01-network.t new file mode 100644 index 0000000..a4f4444 --- /dev/null +++ b/t/01-network.t @@ -0,0 +1,17 @@ +#!/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)'); -- 2.39.2