Algorithm-SixDegrees

 view release on metacpan or  search on metacpan

lib/Algorithm/SixDegrees.pm  view on Meta::CPAN

	return (0,undef,undef) if !defined($count) || $count == 0;
	# mental note: this should never return an id
	# after all, you can't have two mains together in a true
	# alternating chain
	return $self->_match($side,$altsource,$mainsource,$thisside,$thatside);
}

sub _match_one {
	my ($self,$side,$source,$thisside,$thatside) = @_;
	# Assume $self is OK since this is an internal function
	return $self->_match($side,$source,$source,$thisside,$thatside);
}

sub _match {
	my ($self,$side,$fromsource,$tosource,$thisside,$thatside) = @_;
	# Assume $self is OK since this is an internal function
	return (undef,undef,'Internal error: missing code') unless reftype($self->{"_source_$side"}{$fromsource}{'sub'}) eq 'CODE';
	return (undef,undef,'Internal error: missing side (1)') unless reftype($thisside) eq 'HASH';
	return (undef,undef,'Internal error: missing side (2)') unless exists($thisside->{$fromsource});
	return (undef,undef,'Internal error: missing side (3)') unless reftype($thatside) eq 'HASH';
	return (undef,undef,'Internal error: missing side (4)') unless exists($thatside->{$tosource});

	my $newsidecount = 0;
	foreach my $id (keys %{$thisside->{$fromsource}}) {
		next if exists($self->{"_investigated"}{$fromsource}{$id});
		$self->{"_investigated"}{$fromsource}{$id} = 1;

		my $use_args = reftype($self->{"_source_$side"}{$fromsource}{'args'}) eq 'ARRAY' ? 1 : 0;

		my @ids = &{$self->{"_source_$side"}{$fromsource}{'sub'}}($id,($use_args?@{$self->{"_source_$side"}{$fromsource}{'args'}}:()));
		return (undef,undef,$ERROR) if scalar(@ids) == 1 && !defined($ids[0]);
		foreach my $thisid (@ids) {
			unless (exists($thisside->{$tosource}{$thisid})) {
				$thisside->{$tosource}{$thisid} = $id;
				$newsidecount++;
			}
			return (0,$thisid,undef) if exists($thatside->{$tosource}{$thisid});
		}
	}

	return $newsidecount;
}

=head1 SUBROUTINE RULES

Passed-in subroutines should take at least one argument, which
should be some form of unique identifier, and return a list of
unique identifiers that have a relation to the argument.

The unique identifiers must be able to be compared with C<eq>.

The identifiers should be unique in datatype; that is, in an
actor/movie relationship, "Kevin Bacon" can be both the name of an
actor and a movie.

A linked data type must return identifiers that relate across the
link; that is, for an actor/movie relationship, an actor subroutine
should return movies, and a movie subroutine should return actors.

Additional arguments can be provided; these will be stored in the
object and passed through as the second and further arguments to
the subroutine.  This may be useful, for example, if you're using
some form of results caching and need to pass a C<tie>d handle
around.

If you return explicit undef, please set C<$Algorithm::SixDegrees::ERROR>
with an error code.  Explicit undef means that an error occurred
that should terminate the search; it should be returned as a
one-element list.

=head1 AUTHOR

Peter Krawczyk, C<< <petek@cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-algorithm-sixdegrees@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.  I will be notified, and then you'll automatically
be notified of progress on your bug as I make changes.

=head1 ACKNOWLEDGEMENTS

Thank you to Slaven Rezić and Peter John Acklam for bug reports.
Apologies it took so long to see and fix them. (So much for
notifications...)

Andy Lester and Ricardo Signes wrote Module::Starter, which helped
get the framework up and running fairly quickly.

Brad Fitzpatrick of L<http://livejournal.com> for giving me access
to a LiveJournal interface to determine linking information on that
site, which enabled me to write the algorithm that has been reduced
into this module.

=head1 COPYRIGHT & LICENSE

Copyright 2005-2020 Peter Krawczyk, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Algorithm::SixDegrees



( run in 0.606 second using v1.01-cache-2.11-cpan-39bf76dae61 )