/usr/local/CPAN/Class-Accessor-Ref/API.pm

• package API
  • find_color_by_hints
  • max_list
• EOF

# example of a library that expects in-out variables in calls.
package API;
use strict;

use vars qw(%colors %rev_colors);

%colors = (
	Black  => [ qw(night cave) ],
	Red    => [ qw(blood ferrari sexy strawberry) ],
	Blue   => [ qw(ocean sky) ],
	Orange => [ qw(sunset cpan orange) ],
	Green  => [ qw(envy forest grape) ],
	Brown  => [ qw(coconut) ],
);

foreach my $color (keys %colors) {
	foreach my $hint (@{ $colors{$color} }) {
		warn "conflicting hints for color!" if exists $rev_colors{$hint};
		$rev_colors{$hint} = $color;
	}
}

# find the color of something based on hints about what it looks like.
# return true if an educated guess was found, false otherwise.
# The color is set into the first argument (which is expected to hold
# a reference to an exiting scalar).

sub find_color_by_hints {
	my($r_color, @hints) = @_;
	my %guesses;
	HINT: foreach my $hint (@hints) {
		my $guess = $rev_colors{$hint} or next HINT;
		$guesses{$guess}++;
	}
	# find highest scoring color (or random best guess if several found)
	my %rev_guesses = reverse %guesses;
	my $best = max_list([keys %rev_guesses]) or return;
	$$r_color = $rev_guesses{$best};
	return 1;
}

sub max_list {
	my $listref = shift;
	my $greatest = 0;
	do { $greatest = $_ if $_ > $greatest } for @$listref;
	return $greatest;
}

1;