line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Locale::Object::DB; |
2
|
|
|
|
|
|
|
|
3
|
8
|
|
|
8
|
|
99822
|
use strict; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
193
|
|
4
|
8
|
|
|
8
|
|
33
|
use warnings;; |
|
8
|
|
|
|
|
12
|
|
|
8
|
|
|
|
|
258
|
|
5
|
8
|
|
|
8
|
|
39
|
use Carp qw(croak); |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
311
|
|
6
|
|
|
|
|
|
|
|
7
|
8
|
|
|
8
|
|
11168
|
use DBI; |
|
8
|
|
|
|
|
135541
|
|
|
8
|
|
|
|
|
490
|
|
8
|
8
|
|
|
8
|
|
85
|
use File::Spec; |
|
8
|
|
|
|
|
44
|
|
|
8
|
|
|
|
|
5100
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '0.78'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# The database should be in the same directory as this file. Get the location. |
13
|
|
|
|
|
|
|
my (undef, $path) = File::Spec->splitpath(__FILE__); |
14
|
|
|
|
|
|
|
my $db = $path . 'locale.db'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Check it's a binary file in the right location. |
17
|
|
|
|
|
|
|
croak "FATAL ERROR: The Locale::Object database was not in '$path', where I expected it. Please check your installation." unless -B $db; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Make a new object. |
20
|
|
|
|
|
|
|
sub new |
21
|
|
|
|
|
|
|
{ |
22
|
29
|
|
|
29
|
0
|
193
|
my $class = shift; |
23
|
29
|
|
33
|
|
|
188
|
my $self = bless {} => ref($class) || $class; |
24
|
|
|
|
|
|
|
|
25
|
29
|
|
|
|
|
112
|
return $self; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# Connect to our database. |
29
|
|
|
|
|
|
|
my $dbh = DBI->connect("dbi:SQLite:dbname=$db", "", "", |
30
|
|
|
|
|
|
|
{ |
31
|
|
|
|
|
|
|
PrintError => 1, RaiseError => 1, AutoCommit => 1 |
32
|
|
|
|
|
|
|
} ) or croak DBI::errstr; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# Method to return all values of 'result_column' in 'table' in rows that |
36
|
|
|
|
|
|
|
# have 'value' in 'search_column'. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub lookup |
39
|
|
|
|
|
|
|
{ |
40
|
1191
|
|
|
1191
|
1
|
4808
|
my ($self, %params) = @_; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# There are four required parameters to this method. |
43
|
1191
|
|
|
|
|
2444
|
my @required = qw(table result_column search_column value); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Croak if any of them are missing. |
46
|
1191
|
|
|
|
|
3085
|
for (0..$#required) |
47
|
|
|
|
|
|
|
{ |
48
|
4764
|
50
|
|
|
|
8740
|
croak "Error: could not do lookup: no '$required[$_]' specified." unless defined($params{$required[$_]}); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# Validate parameters. |
52
|
1191
|
|
|
|
|
3303
|
_check_search_params($params{table}, $params{result_column}, $params{search_column}); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# Prepare the SQL statement. |
55
|
1191
|
50
|
|
|
|
7690
|
my $sth = $dbh->prepare( |
56
|
|
|
|
|
|
|
"SELECT $params{result_column} from $params{table} WHERE $params{search_column}=?" |
57
|
|
|
|
|
|
|
) or croak "Error: Couldn't prepare SQL statement: " . DBI::errstr; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# Execute it. |
60
|
1191
|
50
|
|
|
|
139588
|
$sth->execute($params{value}) or croak "Error: Couldn't execute SQL statement: " . DBI::errstr; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# Return a reference to an array of hashes. |
63
|
1191
|
|
|
|
|
10771
|
return $sth->fetchall_arrayref({}); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# Get a value for a cell in a row which matches 2 columns and their values specified. |
67
|
|
|
|
|
|
|
sub lookup_dual |
68
|
|
|
|
|
|
|
{ |
69
|
401
|
|
|
401
|
1
|
3140
|
my ($self, %params) = @_; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# Required parameters for this method. |
72
|
401
|
|
|
|
|
984
|
my @required = qw(table result_col col_1 val_1 col_2 val_2); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Croak if any of them are missing. |
75
|
401
|
|
|
|
|
1151
|
for (0..$#required) |
76
|
|
|
|
|
|
|
{ |
77
|
2406
|
50
|
|
|
|
4030
|
croak "Error: could not do lookup_dual: no '$required[$_]' specified." unless defined($params{$required[$_]}); |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Validate parameters. |
81
|
401
|
|
|
|
|
1131
|
_check_search_params($params{table}, $params{result_col}, $params{col_1}, $params{val_1}, $params{col_2}, $params{val_2}); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# Prepare the SQL statement. |
84
|
401
|
50
|
|
|
|
2265
|
my $sth = $dbh->prepare( |
85
|
|
|
|
|
|
|
"SELECT $params{result_col} from $params{table} WHERE $params{col_1}=? AND $params{col_2}=?" |
86
|
|
|
|
|
|
|
) or croak "Error: Couldn't prepare SQL statement: " . DBI::errstr; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# Execute it. |
89
|
|
|
|
|
|
|
$sth->execute($params{val_1}, $params{val_2}) |
90
|
401
|
50
|
|
|
|
65432
|
or croak "Error: Couldn't execute SQL statement: " . DBI::errstr; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# Return a reference to an array of hashes. |
93
|
401
|
|
|
|
|
3512
|
return $sth->fetchall_arrayref({}); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
# Make a hash of allowed table names for searches. |
98
|
|
|
|
|
|
|
my %allowed_tables = map { $_ => 1 } |
99
|
|
|
|
|
|
|
qw(continent country currency language language_mappings timezone); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# Make a hash of allowed column names for searches. |
102
|
|
|
|
|
|
|
my %allowed_columns = map { $_ => 1 } |
103
|
|
|
|
|
|
|
qw(country_code name name_native primary_language code code_numeric symbol subunit |
104
|
|
|
|
|
|
|
subunit_amount code_alpha2 code_alpha3 id country language official timezone is_default *); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
# Sub for sanity check on search parameters. Does nothing except croak if an error is encountered. |
107
|
|
|
|
|
|
|
sub _check_search_params |
108
|
|
|
|
|
|
|
{ |
109
|
1592
|
|
|
1592
|
|
2886
|
my ($table, $result_column, $search_column) = @_; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# You can only specify a valid table name. |
112
|
|
|
|
|
|
|
croak "Error: $table is not a valid table." |
113
|
1592
|
50
|
|
|
|
3307
|
unless $allowed_tables{$table}; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# Check parameters. |
116
|
1592
|
50
|
|
|
|
2973
|
if ($result_column) |
117
|
|
|
|
|
|
|
{ |
118
|
|
|
|
|
|
|
# You can only specify a valid column name. |
119
|
|
|
|
|
|
|
croak "Error: $result_column is not a valid result column." |
120
|
1592
|
50
|
|
|
|
2758
|
unless $allowed_columns{$result_column}; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
croak "Error: $search_column is not a valid search column." |
123
|
1592
|
50
|
|
|
|
3309
|
unless $allowed_columns{$search_column}; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
1; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
__END__ |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=head1 NAME |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Locale::Object::DB - do database lookups for Locale::Object modules |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head1 DESCRIPTION |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
This module provides common functionality for the Locale::Object modules by doing lookups in the database that comes with them (which uses L<DBD::SQLite>). |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head1 SYNOPSIS |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
use Locale::Object::DB; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
my $db = Locale::Object::DB->new(); |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
my $table = 'country'; |
146
|
|
|
|
|
|
|
my $what = 'name'; |
147
|
|
|
|
|
|
|
my $value = 'Afghanistan'; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
my @results = $db->lookup($table, $what, $value); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
my %countries; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
$table = 'continent'; |
154
|
|
|
|
|
|
|
my $result_column = 'country_code'; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
my $results = $db->lookup( |
157
|
|
|
|
|
|
|
table => $table, |
158
|
|
|
|
|
|
|
result_column => $result_column, |
159
|
|
|
|
|
|
|
search_column => $what, |
160
|
|
|
|
|
|
|
value => $value |
161
|
|
|
|
|
|
|
); |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
foreach my $item (@{$results}) |
164
|
|
|
|
|
|
|
{ |
165
|
|
|
|
|
|
|
print $item->{$result_column}; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
$result = $db->lookup_dual( |
169
|
|
|
|
|
|
|
table => $table, |
170
|
|
|
|
|
|
|
result_col => $result_column, |
171
|
|
|
|
|
|
|
col_1 => $first_search_column, |
172
|
|
|
|
|
|
|
val_1 => $first_search_value, |
173
|
|
|
|
|
|
|
col_2 => $second_search_column, |
174
|
|
|
|
|
|
|
val_2 => $second_search_value |
175
|
|
|
|
|
|
|
); |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head1 METHODS |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 C<lookup()> |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
$db->lookup( |
182
|
|
|
|
|
|
|
table => $table, |
183
|
|
|
|
|
|
|
result_column => $result_column, |
184
|
|
|
|
|
|
|
search_column => $search_column, |
185
|
|
|
|
|
|
|
value => $value |
186
|
|
|
|
|
|
|
); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
C<lookup> will return a reference to an anonymous array of hashes. The hashes will contain the results for a query of the database for cells in $result_column in $table that are in a row that has $value in $search_column. Use '*' as a value for result_column if you want to retrieve whole rows. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
For information on what db tables are available and where the data came from, see L<Locale::Object::Database>. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
IMPORTANT: The way of using this method has changed as of version 0.2, and in addition it supersedes the place formerly taken by C<lookup_all()>. Apologies for any inconvenience. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head2 C<lookup_dual()> |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
my $result = $db->lookup_dual( |
197
|
|
|
|
|
|
|
table => $table, |
198
|
|
|
|
|
|
|
result_col => $result_column, |
199
|
|
|
|
|
|
|
col_1 => $first_search_column, |
200
|
|
|
|
|
|
|
val_1 => $first_search_value, |
201
|
|
|
|
|
|
|
col_2 => $second_search_column, |
202
|
|
|
|
|
|
|
val_2 => $second_search_value |
203
|
|
|
|
|
|
|
); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
C<lookup_dual> will return a reference to an anonymous array of hashes. The hashes will contain the results for a query of the database for cells in C<$result_column> in C<$table> that are in a row that has two specified values in two specified columns. Use '*' as a value for C<$result_column> if you want to retrieve whole rows. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head1 NOTES |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
The database file itself is named C<locale.db> and must reside in the same directory as this module. If it's not present, the module will croak with a fatal error. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=head1 AUTHOR |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Originally by Earle Martin |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
Originally by Earle Martin. To the extent possible under law, the author has dedicated all copyright and related and neighboring rights to this software to the public domain worldwide. This software is distributed without any warranty. You should have received a copy of the CC0 Public Domain Dedication along with this software. If not, see <http://creativecommons.org/publicdomain/zero/1.0/>. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=cut |
220
|
|
|
|
|
|
|
|