| … | |
… | |
| 50 | [ 7 => "strasse"], |
50 | [ 7 => "strasse"], |
| 51 | [ 8 => "hausnr"], |
51 | [ 8 => "hausnr"], |
| 52 | [ 9 => "plz"], |
52 | [ 9 => "plz"], |
| 53 | [10 => "ort"], |
53 | [10 => "ort"], |
| 54 | [11 => "branche"], |
54 | [11 => "branche"], |
|
|
55 | [12 => "typ"], |
| 55 | ); |
56 | ); |
| 56 | |
57 | |
| 57 | sub search { |
58 | sub search { |
| 58 | my ($self, @pred) = @_; |
59 | my ($self, @pred) = @_; |
| 59 | |
60 | |
| … | |
… | |
| 70 | $select .= "$column = ?"; |
71 | $select .= "$column = ?"; |
| 71 | push @args, nummer2str $match, 10; |
72 | push @args, nummer2str $match, 10; |
| 72 | } elsif ($type eq "prefix") { |
73 | } elsif ($type eq "prefix") { |
| 73 | $select .= "($column between ? and ?)"; |
74 | $select .= "($column between ? and ?)"; |
| 74 | push @args, |
75 | push @args, |
| 75 | (nummer2str $match), |
76 | (nummer2str $match, 0), |
| 76 | (nummer2str $match, 10); |
77 | (nummer2str $match, 10); |
| 77 | } else { |
78 | } else { |
| 78 | croak "illegal search type '$type', must be one of exact, prefix"; |
79 | croak "illegal search type '$type', must be one of exact, prefix"; |
| 79 | } |
80 | } |
| 80 | } else { |
81 | } else { |
| … | |
… | |
| 87 | $select .= "($column.data like ?)"; |
88 | $select .= "($column.data like ?)"; |
| 88 | $args[-1] .= "%"; |
89 | $args[-1] .= "%"; |
| 89 | } elsif ($type eq "regexp") { |
90 | } elsif ($type eq "regexp") { |
| 90 | $select .= "($column.data regexp ?)"; |
91 | $select .= "($column.data regexp ?)"; |
| 91 | } elsif ($type eq "match") { |
92 | } elsif ($type eq "match") { |
| 92 | $select .= "(match $column.data against (?)"; |
93 | $select .= "(match $column.data against (?))"; |
| 93 | } else { |
94 | } else { |
| 94 | croak "illegal search type '$type', must be one of exact, like, regexp or match"; |
95 | croak "illegal search type '$type', must be one of exact, like, regexp or match"; |
| 95 | } |
96 | } |
| 96 | } |
97 | } |
| 97 | } |
98 | } |
| 98 | |
99 | |
| 99 | warn $select, @args; |
|
|
| 100 | my $st = sql_exec $self->{dbh}, $select, @args |
100 | my $st = sql_exec $self->{dbh}, $select, @args |
| 101 | or die "sql_exec returned no statement handle"; |
101 | or die "sql_exec returned no statement handle"; |
| 102 | |
102 | |
| 103 | return bless { |
103 | return bless { |
| 104 | dinfo => $self, |
104 | dinfo => $self, |
| … | |
… | |
| 114 | |
114 | |
| 115 | sub split_number { |
115 | sub split_number { |
| 116 | my ($self, $number) = @_; |
116 | my ($self, $number) = @_; |
| 117 | |
117 | |
| 118 | for ($number) { |
118 | for ($number) { |
|
|
119 | y/0-9//cd; |
| 119 | s/^/0/ unless /^0/; |
120 | s/^/0/ unless /^0/; |
| 120 | |
121 | |
| 121 | for (3..6) { |
122 | for (3..6) { |
| 122 | my $prefix = substr $number, 0, $_; |
123 | my $prefix = substr $number, 0, $_; |
| 123 | my $isprefix = |
124 | my $isprefix = |
| … | |
… | |
| 144 | my %r; |
145 | my %r; |
| 145 | my ($prefix, $number) = $self->split_number ($number); |
146 | my ($prefix, $number) = $self->split_number ($number); |
| 146 | |
147 | |
| 147 | if ($prefix) { |
148 | if ($prefix) { |
| 148 | $r{vorwahl} = $prefix; |
149 | $r{vorwahl} = $prefix; |
|
|
150 | $r{match} = "exact"; |
| 149 | |
151 | |
| 150 | while (1 < length $number) { |
152 | while (1 < length $number) { |
| 151 | for ($number, "${number}0") { |
153 | for ($number, "${number}0") { |
| 152 | my $result = $self->search (vorwahl => exact => $prefix, |
154 | my $result = $self->search (vorwahl => exact => $prefix, |
| 153 | nummer => exact => $_); |
155 | nummer => exact => $_); |
| 154 | if ($result->rows > 1) { |
156 | if ($result->rows > 1) { |
| 155 | return $result->fetch; |
157 | return { %r, %{$result->fetch} }; |
| 156 | } elsif ($result->rows == 1) { |
158 | } elsif ($result->rows == 1) { |
| 157 | return $result->fetch; |
159 | return { %r, %{$result->fetch} }; |
| 158 | } |
160 | } |
|
|
161 | |
|
|
162 | $r{match} = "approx"; |
| 159 | } |
163 | } |
| 160 | |
164 | |
| 161 | substr $number, -1, 1, ""; |
165 | substr $number, -1, 1, ""; |
| 162 | } |
166 | } |
| 163 | } |
167 | } |
| 164 | |
168 | |
| 165 | #my @orte = sql_fetchall $self->{dbh}, |
169 | #$r{ort} = join ", ", |
| 166 | |
170 | # sql_fetchall $self->{dbh}, |
|
|
171 | # "select distinct ort.data |
|
|
172 | # from row |
|
|
173 | # inner join vorwahl on (vorwahl.id = row.vorwahl) |
|
|
174 | # inner join ort on (ort.id = row.ort) |
|
|
175 | # where vorwahl.data = ?", |
|
|
176 | # $r{vorwahl}; |
|
|
177 | |
| 167 | \%r; |
178 | \%r; |
| 168 | } |
179 | } |
| 169 | |
180 | |
| 170 | =head2 dinfo::result |
181 | =head2 dinfo::result |
| 171 | |
182 | |
| … | |
… | |
| 193 | if ($row) { |
204 | if ($row) { |
| 194 | my %r; |
205 | my %r; |
| 195 | |
206 | |
| 196 | $r{$_->[1]} = $row->[$_->[0]] for @cols; |
207 | $r{$_->[1]} = $row->[$_->[0]] for @cols; |
| 197 | |
208 | |
| 198 | my $nummer = unpack "H*", $row->[0]; |
209 | $r{nummer} = str2nummer $row->[0]; |
| 199 | |
|
|
| 200 | my $len = hex substr $nummer, -2, 1; |
|
|
| 201 | my $typ = hex substr $nummer, -1, 1; |
|
|
| 202 | |
|
|
| 203 | $r{nummer} = substr $nummer, 0, 12 - $len; |
|
|
| 204 | $r{typ} = $typ{$typ} |
|
|
| 205 | ||= sql_fetch $self->{dinfo}{dbh}, |
|
|
| 206 | "select data from typ where id = ?", |
|
|
| 207 | $typ; |
|
|
| 208 | |
210 | |
| 209 | \%r; |
211 | \%r; |
| 210 | } else { |
212 | } else { |
| 211 | return (); |
213 | return (); |
| 212 | } |
214 | } |
