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   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