view release on metacpan or  search on metacpan

samples/movie.pl  view on Meta::CPAN

#!/usr/bin/perl -Tw

=head1 NAME

movie.pl - A sample script to link actors through movies

=head1 DESCRIPTION

This sample script takes a database full of actors and movies,
and creates the necessary framework for C<Algorithm::SixDegrees>
to link the actors through the movies.

The data source (and thus the script) expects the last name first.
In other words, you can play "Six Degrees of Bacon, Kevin" with this.

=head1 FINDING ACTORS

If an actor is not found, the script searches the data source, using
the input as the starting string.  If it finds only one match, it
uses that instead.  For example, in my data source, Johnny Carson
is actually represented as 'Carson, Johnny (I)'.  But since he's the
only one (there's no 'Carson, Johnny (II)'), the script will use that
instead.  On the other hand, 'Smith, Will' gives the following note:

  No match for 'Smith, Will'.  Did you mean:
        'Smith, Will (I)' (career: 1992-2005)
        'Smith, Willetta' (career: 1953-1954)
        'Smith, William 'Smitty'' (career: 1990)
	... (omittance for brevity) ...
        'Smith, Willis S.' (career: 1920)

Also, the script is not smart enough to figure out similar people.
That is, in my data source, Charlie Chaplin is actually listed as
'Chaplin, Charles'; this sample will not know the two are the same.

=cut

use warnings;
use strict;
use vars qw/$dbh $actorsth $moviesth $dbhit $th/;
use Algorithm::SixDegrees;

eval "use DBI"; die "Can't run sample: DBI not installed:\n$@" if $@;
eval "use Time::HiRes"; $th = $@ ? 0 : 1;

print 'Enter a source actor (L,F): ';
my $actor1 = <STDIN>;
$actor1 =~ s/^\s*(.*?)\s*$/$1/ || die 'regex did not match';
print 'Enter a destination actor: ';
my $actor2 = <STDIN>;
$actor2 =~ s/^\s*(.*?)\s*$/$1/ || die 'regex did not match';

die 'Need two actors' unless $actor1 && $actor2;

&db_connect;

$actor1 = &suggest_actor($actor1);
$actor2 = &suggest_actor($actor2);

$dbhit = 0;
my $sd = Algorithm::SixDegrees->new;
$sd->data_source( movies => \&movie_actors );
$sd->data_source( actors => \&actor_movies );
$dbhit = 0; # reset the database hit counter, used in the two subs
my $start = &time;
my @chain = $sd->make_link('actors',$actor1,$actor2);
my $end = &time;

if(scalar(@chain)) {
	print join (' -> ',@chain), "\n";