File Coverage

blib/lib/Locale/ID/GuessGender/FromFirstName/v1_rules.pm
Criterion Covered Total %
statement 6 40 15.0
branch 0 18 0.0
condition 0 3 0.0
subroutine 2 3 66.6
pod 1 1 100.0
total 9 65 13.8


line stmt bran cond sub pod time code
1             package Locale::ID::GuessGender::FromFirstName::v1_rules;
2              
3 3     3   41 use strict;
  3         5  
  3         101  
4 3     3   15 use warnings;
  3         5  
  3         1461  
5              
6             our $VERSION = '0.05'; # VERSION
7              
8             # XXX extract from common list instead of wild guessing
9             my @rules = (
10             [qr/.o$/, M => 0.98],
11             [qr/.i$/, F => 0.60],
12             [qr/.ini$/, F => 0.90],
13             [qr/.d$/, M => 0.85],
14             [qr/.wan$/, M => 0.99],
15             [qr/.wati$/, F => 0.99],
16             [qr/.us$/, M => 0.7],
17             );
18              
19             sub guess_gender {
20 0     0 1   my $opts;
21 0 0 0       if (@_ && ref($_[0]) eq 'HASH') {
22 0           $opts = shift;
23             } else {
24 0           $opts = {};
25             }
26 0 0         die "Please specify at least 1 name" unless @_;
27              
28 0           my @res;
29 0           for my $name (@_) {
30 0 0         do { push @res, undef; next } unless defined($name);
  0            
  0            
31 0           my $res = { success => 0 };
32              
33 0           my $num_match = 0;
34 0           my $m = 1;
35 0           my $f = 1;
36 0           my $min_ratio = 0.75;
37 0           for my $rule (@rules) {
38 0 0         $name =~ $rule->[0] or next;
39 0           $num_match++;
40 0 0         if ($rule->[1] eq 'M') {
41 0           $m *= $rule->[2];
42 0           $f *= (1-$rule->[2]);
43             } else {
44 0           $f *= $rule->[2];
45 0           $m *= (1-$rule->[2]);
46             }
47             }
48 0 0         if ($num_match) {
49 0           $res->{success} = 1;
50 0           $res->{num_rules} = $num_match;
51 0           $res->{min_gender_ratio} = $min_ratio;
52 0 0         my $r = $m > $f ? $m/($m+$f) : $f/($m+$f);
53 0 0         $res->{result} = $r < $min_ratio ? "both" : ($m > $f ? "M" : "F");
    0          
54 0           $res->{gender_ratio} = $r;
55 0           $res->{guess_confidence} = $r;
56             } else {
57 0           $res->{error} = "No heuristic rules matched";
58             }
59 0           push @res, $res;
60             }
61 0           @res;
62             }
63              
64             1;
65             # ABSTRACT: v1_rules
66              
67             __END__