line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Locale::ID::GuessGender::FromFirstName::google; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
9
|
use strict; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
63
|
|
4
|
3
|
|
|
3
|
|
9
|
use warnings; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
51
|
|
5
|
3
|
|
|
3
|
|
1206
|
use REST::Google::Search; |
|
3
|
|
|
|
|
138528
|
|
|
3
|
|
|
|
|
1179
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.06'; # VERSION |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub guess_gender { |
10
|
0
|
|
|
0
|
1
|
|
my $opts; |
11
|
0
|
0
|
0
|
|
|
|
if (@_ && ref($_[0]) eq 'HASH') { |
12
|
0
|
|
|
|
|
|
$opts = shift; |
13
|
|
|
|
|
|
|
} else { |
14
|
0
|
|
|
|
|
|
$opts = {}; |
15
|
|
|
|
|
|
|
} |
16
|
0
|
0
|
|
|
|
|
die "Please specify at least 1 name" unless @_; |
17
|
|
|
|
|
|
|
|
18
|
0
|
|
|
|
|
|
REST::Google::Search->http_referer( |
19
|
|
|
|
|
|
|
"http://search.cpan.org/dist/Locale-ID-GenderGuess-FromFirstName/"); |
20
|
|
|
|
|
|
|
|
21
|
0
|
|
|
|
|
|
my @res; |
22
|
0
|
|
|
|
|
|
for my $name (@_) { |
23
|
0
|
0
|
|
|
|
|
do { push @res, undef; next } unless defined($name); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
24
|
0
|
|
|
|
|
|
my $res = { success => 0 }; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
{ |
27
|
0
|
|
|
|
|
|
my $r; |
|
0
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
|
for my $c ([num_results_bapak => qq["bapak $name"]], |
29
|
|
|
|
|
|
|
[num_results_ibu => qq["ibu $name"]]) { |
30
|
0
|
|
|
|
|
|
$r = REST::Google::Search->new(q=>$c->[1]); |
31
|
0
|
0
|
|
|
|
|
if (!$r) { |
32
|
0
|
|
|
|
|
|
$res->{error} = "REST::Google::Search returns". |
33
|
|
|
|
|
|
|
" nothing (q=$c->[1])"; |
34
|
0
|
|
|
|
|
|
last; |
35
|
|
|
|
|
|
|
} |
36
|
0
|
0
|
|
|
|
|
if ($r->{responseStatus} != 200) { |
37
|
0
|
|
|
|
|
|
$res->{error} = "REST::Google::Search returns". |
38
|
|
|
|
|
|
|
" HTTP error $r->{responseStatus} (q=$c->[1])"; |
39
|
0
|
|
|
|
|
|
last; |
40
|
|
|
|
|
|
|
} |
41
|
0
|
0
|
|
|
|
|
if (!$r->{responseData}) { |
42
|
0
|
|
|
|
|
|
$res->{error} = "REST::Google::Search does not". |
43
|
|
|
|
|
|
|
" return responseData (q=$c->[1])"; |
44
|
0
|
|
|
|
|
|
last; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
$res->{$c->[0]} = $r->{responseData}{cursor}-> |
47
|
0
|
|
0
|
|
|
|
{estimatedResultCount} // 0; |
48
|
|
|
|
|
|
|
} |
49
|
0
|
0
|
|
|
|
|
last if $res->{error}; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
0
|
0
|
|
|
|
|
if (!$res->{error}) { |
53
|
0
|
|
|
|
|
|
$res->{success} = 1; |
54
|
0
|
|
|
|
|
|
my ($b, $i) = ($res->{num_results_bapak}, $res->{num_results_ibu}); |
55
|
0
|
|
|
|
|
|
my $tot = $b+$i; |
56
|
0
|
0
|
0
|
|
|
|
my $ratio = (!$b && !$i) ? 0 : |
|
|
0
|
|
|
|
|
|
57
|
|
|
|
|
|
|
($b > $i ? $b/($b+$i) : $i/($b+$i)); |
58
|
0
|
0
|
|
|
|
|
my $min_ratio = $tot < 10 ? 2/(1+2) : |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
59
|
|
|
|
|
|
|
($tot < 100 ? 2/(1+2) : $tot < 1000 ? 2/(1+2) : 2/(1+2)); |
60
|
0
|
|
|
|
|
|
$res->{min_gender_ratio} = $min_ratio; |
61
|
0
|
|
|
|
|
|
$res->{gender_ratio} = $ratio; |
62
|
0
|
0
|
|
|
|
|
if (!$tot) { |
63
|
0
|
|
|
|
|
|
$res->{result} = undef; |
64
|
0
|
|
|
|
|
|
$res->{guess_confidence} = 0; |
65
|
|
|
|
|
|
|
} else { |
66
|
|
|
|
|
|
|
$res->{result} = |
67
|
0
|
0
|
|
|
|
|
$ratio < $min_ratio ? "both" : ($b > $i ? "M" : "F"); |
|
|
0
|
|
|
|
|
|
68
|
0
|
0
|
|
|
|
|
$res->{guess_confidence} = $tot < 10 ? 0.75 : 0.9; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
} |
71
|
0
|
|
|
|
|
|
push @res, $res; |
72
|
|
|
|
|
|
|
} |
73
|
0
|
|
|
|
|
|
@res; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
1; |
77
|
|
|
|
|
|
|
# ABSTRACT: google |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
__END__ |