File Coverage

blib/lib/Locale/Object/DB.pm
Criterion Covered Total %
statement 39 39 100.0
branch 10 20 50.0
condition 1 3 33.3
subroutine 9 9 100.0
pod 2 3 66.6
total 61 74 82.4


line stmt bran cond sub pod time code
1             package Locale::Object::DB;
2              
3 8     8   109433 use strict;
  8         16  
  8         230  
4 8     8   39 use warnings;;
  8         14  
  8         224  
5 8     8   39 use Carp qw(croak);
  8         16  
  8         406  
6              
7 8     8   14195 use DBI;
  8         150221  
  8         574  
8 8     8   77 use File::Spec;
  8         36  
  8         6201  
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 204 my $class = shift;
23 29   33     212 my $self = bless {} => ref($class) || $class;
24            
25 29         97 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 1218     1218 1 6139 my ($self, %params) = @_;
41              
42             # There are four required parameters to this method.
43 1218         3194 my @required = qw(table result_column search_column value);
44            
45             # Croak if any of them are missing.
46 1218         4046 for (0..$#required)
47             {
48 4872 50       11364 croak "Error: could not do lookup: no '$required[$_]' specified." unless defined($params{$required[$_]});
49             }
50              
51             # Validate parameters.
52 1218         4088 _check_search_params($params{table}, $params{result_column}, $params{search_column});
53            
54             # Prepare the SQL statement.
55 1218 50       10645 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 1218 50       192478 $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 1218         14666 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 410     410 1 3731 my ($self, %params) = @_;
70              
71             # Required parameters for this method.
72 410         1453 my @required = qw(table result_col col_1 val_1 col_2 val_2);
73            
74             # Croak if any of them are missing.
75 410         1484 for (0..$#required)
76             {
77 2460 50       5355 croak "Error: could not do lookup_dual: no '$required[$_]' specified." unless defined($params{$required[$_]});
78             }
79              
80             # Validate parameters.
81 410         1585 _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 410 50       3357 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 410 50       67043 or croak "Error: Couldn't execute SQL statement: " . DBI::errstr;
91            
92             # Return a reference to an array of hashes.
93 410         4870 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 1628     1628   3807 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 1628 50       4522 unless $allowed_tables{$table};
114            
115             # Check parameters.
116 1628 50       3585 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 1628 50       3644 unless $allowed_columns{$result_column};
121              
122             croak "Error: $search_column is not a valid search column."
123 1628 50       4311 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