File Coverage

blib/lib/Locale/ID/GuessGender/FromFirstName.pm

Criterion	Covered	Total	%
statement	60	61	98.3
branch	7	14	50.0
condition	10	25	40.0
subroutine	9	9	100.0
pod	1	1	100.0
total	87	110	79.0

package Locale::ID::GuessGender::FromFirstName;

our $DATE = '2016-03-11'; # DATE
our $VERSION = '0.06'; # VERSION

use 5.010001;
use strict;
use warnings;
use experimental 'smartmatch';

my @known_algos = qw/common v1_rules google/;

use Locale::ID::GuessGender::FromFirstName::common;
use Locale::ID::GuessGender::FromFirstName::v1_rules;
use Locale::ID::GuessGender::FromFirstName::google;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(guess_gender);

sub guess_gender {
    my $opts;
    if (@_ && ref($_[0]) eq 'HASH') {
        $opts = shift;
    } else {
        $opts = {};
    }
    die "Please specify at least 1 name" unless @_;

    # preprocess names
    my @names;
    for (@_) {
        my $name = lc $_;
        $name =~ s/[^a-z]//g;
        die "Invalid first name `$_`" unless $name;
        push @names, $name;
    }

    $opts->{try_all} //= 0;
    $opts->{algos} //= [qw/common v1_rules/];
    $opts->{min_guess_confidence} //= 0.51;
    $opts->{algo_opts} //= {};

    my @res = map {
        {
            name => $names[$_],
            result => undef,
            algo => undef,
            algo_res => [],
        }
    } 0..$#names;
    my $i = 0;
    no strict 'refs';
    for my $algo (@{ $opts->{algos} }) {
        die "Unknown algoritm `$algo`, use one of: ".
            join(", ", @known_algos) unless $algo ~~ @known_algos;
        $i++;
        my $func = "Locale::ID::GuessGender::FromFirstName::".
            $algo . "::guess_gender";
        my $algo_opts = $opts->{algo_opts}{$algo} // {};
        my @algo_res = $func->($algo_opts,
                               map { ($opts->{try_all} || !$res[$_]{result}) ?
                                   $names[$_] : undef } 0..$#_);
        for (0..$#algo_res) {
            next unless $algo_res[$_];
            $algo_res[$_]{algo} = $algo;
            $algo_res[$_]{order} = $i;
            push @{ $res[$_]{algo_res} }, $algo_res[$_];
            if ($algo_res[$_]{success} &&
                $algo_res[$_]{guess_confidence} >= $opts->{min_guess_confidence} &&
                (!$res[$_]{result} || $res[$_]{guess_confidence} < $algo_res[$_]{guess_confidence})) {
                $res[$_]{result} = $algo_res[$_]{result};
                $res[$_]{gender_ratio} = $algo_res[$_]{gender_ratio};
                $res[$_]{guess_confidence} = $algo_res[$_]{guess_confidence};
                $res[$_]{algo} = $algo;
            }
        }
    }

    @res;
}

1;
# ABSTRACT: Guess gender of an Indonesian first name

__END__