| 1 |
package dinfo; |
| 2 |
|
| 3 |
use Carp; |
| 4 |
use PApp::SQL; |
| 5 |
|
| 6 |
=head1 dinfo - THIS IS A PRIVATE MODULE, DON't COPY |
| 7 |
|
| 8 |
=cut |
| 9 |
|
| 10 |
BEGIN { |
| 11 |
$VERSION = 0.1; |
| 12 |
use XSLoader; |
| 13 |
XSLoader::load __PACKAGE__, $VERSION; |
| 14 |
} |
| 15 |
|
| 16 |
sub new { |
| 17 |
my ($class, $dsn, $user, $pass) = @_; |
| 18 |
|
| 19 |
my $self = bless { |
| 20 |
dbh => (PApp::SQL::connect_cached "dinfo::", $dsn, $user, $pass), |
| 21 |
}, $class; |
| 22 |
|
| 23 |
$self->{dbh}{mysql_auto_reconnect} = 1;#d# |
| 24 |
|
| 25 |
$self; |
| 26 |
} |
| 27 |
|
| 28 |
=item $result = $dinfo->search (column => type => value, ...) |
| 29 |
|
| 30 |
Initiate a search on the given columns. C<type> can be one of C<exact>, |
| 31 |
C<prefix>, C<like>, C<regexp> or C<match>, which specifies the sql-search |
| 32 |
mode used. For C<nummer>-columns, only C<exact> and C<prefix> are |
| 33 |
supported. |
| 34 |
|
| 35 |
Returns a C<dinfo::result> object. |
| 36 |
|
| 37 |
my $r = $dinfo->search(name => like => "Marc%"); |
| 38 |
|
| 39 |
my $r = $dinfo->search(plz => exact => 76139, branche => match => "psychologe"); |
| 40 |
|
| 41 |
Not all types are efficient on all columns.. check your indices! :) |
| 42 |
|
| 43 |
=cut |
| 44 |
|
| 45 |
my @cols = ( |
| 46 |
[ 1 => "name"], |
| 47 |
[ 2 => "vorname"], |
| 48 |
[ 3 => "zusatz1"], |
| 49 |
[ 4 => "zusatz2"], |
| 50 |
[ 5 => "zusatz3"], |
| 51 |
[ 6 => "vorwahl"], |
| 52 |
[ 7 => "strasse"], |
| 53 |
[ 8 => "hausnr"], |
| 54 |
[ 9 => "plz"], |
| 55 |
[10 => "ort"], |
| 56 |
[11 => "branche"], |
| 57 |
[12 => "typ"], |
| 58 |
); |
| 59 |
|
| 60 |
sub search { |
| 61 |
my ($self, @pred) = @_; |
| 62 |
|
| 63 |
my @args; |
| 64 |
my $select = "select\n nummer, " . (join ", ", map "$_->[1].data", @cols) . "\n" |
| 65 |
. "from row\n". (join "", map " inner join $_->[1] on (row.$_->[1] = $_->[1].id)\n", @cols) |
| 66 |
. "where (1=1)\n"; |
| 67 |
|
| 68 |
while (@pred) { |
| 69 |
my ($column, $type, $match) = splice @pred, 0, 3, (); |
| 70 |
$select .= " and "; |
| 71 |
if ($column eq "nummer") { |
| 72 |
if ($type eq "exact") { |
| 73 |
$select .= "$column = ?"; |
| 74 |
push @args, nummer2str $match, 10; |
| 75 |
} elsif ($type eq "prefix") { |
| 76 |
$select .= "($column between ? and ?)"; |
| 77 |
push @args, |
| 78 |
(nummer2str $match, 0), |
| 79 |
(nummer2str $match, 10); |
| 80 |
} else { |
| 81 |
croak "illegal search type '$type', must be one of exact, prefix"; |
| 82 |
} |
| 83 |
} else { |
| 84 |
push @args, $match; |
| 85 |
if ($type eq "exact") { |
| 86 |
$select .= "($column.data = ?)"; |
| 87 |
} elsif ($type eq "like") { |
| 88 |
$select .= "($column.data like ?)"; |
| 89 |
} elsif ($type eq "prefix") { |
| 90 |
$select .= "($column.data like ?)"; |
| 91 |
$args[-1] .= "%"; |
| 92 |
} elsif ($type eq "regexp") { |
| 93 |
$select .= "($column.data regexp ?)"; |
| 94 |
} elsif ($type eq "match") { |
| 95 |
$select .= "(match $column.data against (?))"; |
| 96 |
} else { |
| 97 |
croak "illegal search type '$type', must be one of exact, like, regexp or match"; |
| 98 |
} |
| 99 |
} |
| 100 |
} |
| 101 |
|
| 102 |
my $st = sql_exec $self->{dbh}, $select, @args |
| 103 |
or die "sql_exec returned no statement handle"; |
| 104 |
|
| 105 |
return bless { |
| 106 |
dinfo => $self, |
| 107 |
st => $st, |
| 108 |
}, dinfo::result; |
| 109 |
} |
| 110 |
|
| 111 |
=item my ($prefix, $local) = $dinfo->split_number($number) |
| 112 |
|
| 113 |
split a number into prefix and local part. |
| 114 |
|
| 115 |
=cut |
| 116 |
|
| 117 |
sub split_number { |
| 118 |
my ($self, $number) = @_; |
| 119 |
|
| 120 |
for ($number) { |
| 121 |
y/0-9//cd; |
| 122 |
s/^/0/ unless /^0/; |
| 123 |
|
| 124 |
for (3..6) { |
| 125 |
my $prefix = substr $number, 0, $_; |
| 126 |
my $isprefix = |
| 127 |
$cache{$prefix} |
| 128 |
||= sql_fetch $self->{dbh}, |
| 129 |
"select 1 + count(*) from vorwahl where data = ?", |
| 130 |
$prefix; |
| 131 |
return ($prefix, substr $number, $_) |
| 132 |
if $isprefix == 2; |
| 133 |
} |
| 134 |
|
| 135 |
return (); |
| 136 |
} |
| 137 |
} |
| 138 |
|
| 139 |
=item my $hash = $dinfo->identify_number ($number) |
| 140 |
|
| 141 |
Try to find out as much as possible about the given number. |
| 142 |
|
| 143 |
=cut |
| 144 |
|
| 145 |
sub identify_number { |
| 146 |
my ($self, $number) = @_; |
| 147 |
my %r; |
| 148 |
my ($prefix, $number) = $self->split_number ($number); |
| 149 |
|
| 150 |
if ($prefix) { |
| 151 |
$r{vorwahl} = $prefix; |
| 152 |
$r{match} = "exact"; |
| 153 |
|
| 154 |
while (1 < length $number) { |
| 155 |
for ($number, "${number}0") { |
| 156 |
my $result = $self->search (vorwahl => exact => $prefix, |
| 157 |
nummer => exact => $_); |
| 158 |
if ($result->rows > 1) { |
| 159 |
return { %r, %{$result->fetch} }; |
| 160 |
} elsif ($result->rows == 1) { |
| 161 |
return { %r, %{$result->fetch} }; |
| 162 |
} |
| 163 |
|
| 164 |
$r{match} = "approx"; |
| 165 |
} |
| 166 |
|
| 167 |
substr $number, -1, 1, ""; |
| 168 |
} |
| 169 |
} |
| 170 |
|
| 171 |
#$r{ort} = join ", ", |
| 172 |
# sql_fetchall $self->{dbh}, |
| 173 |
# "select distinct ort.data |
| 174 |
# from row |
| 175 |
# inner join vorwahl on (vorwahl.id = row.vorwahl) |
| 176 |
# inner join ort on (ort.id = row.ort) |
| 177 |
# where vorwahl.data = ?", |
| 178 |
# $r{vorwahl}; |
| 179 |
|
| 180 |
\%r; |
| 181 |
} |
| 182 |
|
| 183 |
=head2 dinfo::result |
| 184 |
|
| 185 |
=item $count = $result->rows |
| 186 |
|
| 187 |
=cut |
| 188 |
|
| 189 |
sub dinfo::result::rows { |
| 190 |
$_[0]{st}->rows; |
| 191 |
} |
| 192 |
|
| 193 |
=item $hash = $result->fetch |
| 194 |
|
| 195 |
Fetch and return the next result row. |
| 196 |
|
| 197 |
=cut |
| 198 |
|
| 199 |
my %typ; |
| 200 |
|
| 201 |
sub dinfo::result::fetch { |
| 202 |
my ($self) = @_; |
| 203 |
|
| 204 |
my $row = $self->{st}->fetchrow_arrayref; |
| 205 |
|
| 206 |
if ($row) { |
| 207 |
my %r; |
| 208 |
|
| 209 |
$r{$_->[1]} = $row->[$_->[0]] for @cols; |
| 210 |
|
| 211 |
$r{nummer} = str2nummer $row->[0]; |
| 212 |
|
| 213 |
\%r; |
| 214 |
} else { |
| 215 |
return (); |
| 216 |
} |
| 217 |
} |
| 218 |
|
| 219 |
1; |
