/[webpac]/trunk/index_DBI_filter.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/index_DBI_filter.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (hide annotations)
Thu Jan 27 20:25:27 2005 UTC (17 years, 5 months ago) by dpavlin
File size: 8274 byte(s)
SQLite fixes: rename index table to data (index is reserved word), 
SQLite doesn't allow placeholders in limit and offset, see:
http://thread.gmane.org/gmane.comp.db.sqlite.general/9707

1 dpavlin 641 #
2     # this file implements index functions using DBI
3     # and huge amounts of memory for cache speedup
4     #
5     # this version doesn't support ident (which sould be location in
6     # library). But, that functionality is not used anyway...
7     #
8    
9     package index_DBI;
10     use strict qw(vars);
11     use vars qw($Count);
12     use HTML::Entities;
13     use URI::Escape;
14     use locale;
15     use Carp;
16    
17     use DBI;
18    
19     # bench time
20     my $bench_time = time();
21    
22     my $debug = 1;
23    
24     sub bench {
25     my $self = shift;
26     my $msg = shift;
27    
28     print STDERR "last operation took ",time()-$bench_time," seconds...\n";
29     $bench_time=time();
30     print STDERR "$msg\n";
31     }
32    
33     sub new {
34     my $class = shift;
35     my $self = {};
36     bless($self, $class);
37    
38     my $dbd = shift || die "need dbi_dbd= in [global] section of configuration file";
39     my $dsn = shift || die "need dbi_dsn= in [global] section of configuration file";
40     my $user = shift || die "need dbi_user= in [global] section of configuration file";
41     my $passwd = shift || die "need dbi_passwd= in [global] section of configuration file";
42    
43     $self->{dbd} = $dbd;
44    
45     $self->{dbh} = DBI->connect("DBI:$dbd:$dsn",$user,$passwd) || die $DBI::errstr;
46     $Count++;
47    
48     $self->bench("connected to $dbd as $user");
49    
50     # force SQLite to support binary 0 in data (which shouldn't
51     # happend, but it did to me)
52     eval {
53     no warnings 'all';
54     $self->{dbh}->{sqlite_handle_binary_nulls} = 1;
55     };
56    
57     return $self;
58     }
59    
60     sub delete_and_create {
61     my $self = shift;
62    
63 dpavlin 651 my $table = shift || croak "need table name!";
64 dpavlin 641 my $sql = shift || croak "need sql to create table!";
65    
66 dpavlin 651 print STDERR "## delete_and_create($table)\n" if ($debug);
67 dpavlin 641
68 dpavlin 651 my $sql_delete = "delete from $table";
69     my $sth = $self->{dbh}->prepare($sql_delete);
70 dpavlin 641
71 dpavlin 651 if ($sth && $sth->execute()) {
72     print STDERR "## deleted rows from table $table\n" if ($debug);
73 dpavlin 642 } else {
74 dpavlin 641 # can't delete from table, assume it doesn't exists!
75     $self->{dbh}->rollback;
76     $self->{dbh}->do($sql) || confess "SQL: $sql ".$self->{dbh}->errstr();
77 dpavlin 651 print STDERR "## creating table $table\n" if ($debug);
78 dpavlin 641 $self->{dbh}->begin_work;
79     }
80     }
81    
82     sub insert {
83     my $self = shift;
84    
85     my $field = shift;
86     my $index_data = shift || print STDERR "\$index->insert($field,NULL,...)";
87     my $display = shift || $index_data;
88 dpavlin 642 my $filter = shift;
89 dpavlin 641
90     if (! $index_data) {
91     print STDERR "\$index->insert() -- no value to insert\n";
92     return;
93     }
94    
95     $index_data =~ s#&(\w)(acute|cedil|circ|grave|ring|slash|tilde|uml);#$1#gi;
96    
97     # strip spaces
98     $index_data =~ s#^\s+##;
99     $index_data =~ s#\s+$##;
100     $index_data =~ s#\s\s+# #g;
101    
102     my $uc = uc($index_data);
103    
104     if (! $self->{c}->{$uc}->{$field}) {
105     #print stderr "in index: $index_data\n";
106     $self->{c}->{$uc}->{$field}->{item} = $index_data;
107     $self->{c}->{$uc}->{$field}->{display} = $display;
108     }
109    
110     $self->{c}->{$uc}->{$field}->{count}++;
111 dpavlin 642 $self->{c}->{$uc}->{$field}->{filter}->{$filter}++ if ($filter);
112 dpavlin 641 }
113    
114     sub count {
115     my $self = shift;
116    
117     my $field = shift;
118     my $where = shift;
119    
120 dpavlin 643 my $filter = shift;
121 dpavlin 641
122 dpavlin 651 my $tables_sql = 'data';
123 dpavlin 643 my $where_sql = '';
124     my @sql_args = ( $field, $where );
125 dpavlin 641
126 dpavlin 643 if ($filter) {
127     $tables_sql .= ",filters";
128     $where_sql .= "
129 dpavlin 651 and data.ord = filters.ord
130 dpavlin 643 and filter = ?
131     ";
132     push @sql_args, $filter;
133     }
134    
135     my $sql = qq{
136     select count(*)
137     from $tables_sql
138     where name = ? and upper(item) like upper(?)||'%'
139     $where_sql
140     };
141    
142     my $sth = $self->{dbh}->prepare($sql) || confess $self->{dbh}->errstr();
143     $sth->execute(@sql_args) || confess "sql: $sql; ".$self->{dbh}->errstr();
144    
145 dpavlin 641 my ($total) = $sth->fetchrow_array();
146    
147     # no results, count all
148     if (! $total) {
149 dpavlin 643 my $sql = qq{
150     select count(*)
151     from $tables_sql
152 dpavlin 651 where data.name = ?
153 dpavlin 643 $where_sql
154     };
155 dpavlin 641
156 dpavlin 643 @sql_args = ( $field );
157     push @sql_args, $filter if ($filter);
158    
159     my $sth = $self->{dbh}->prepare($sql) || confess $self->{dbh}->errstr();
160     $sth->execute(@sql_args) || confess "sql: $sql; ".$self->{dbh}->errstr();
161 dpavlin 641 $total = $sth->fetchrow_array();
162    
163     }
164    
165 dpavlin 643 return $total || '0';
166 dpavlin 641 }
167    
168    
169     sub fetch {
170     my $self = shift;
171    
172     my $field = shift;
173     my $where = shift;
174    
175     my $offset = shift || 0;
176     my $rows = shift || 10;
177 dpavlin 643 my $filter = shift;
178    
179 dpavlin 641 my $from_ord = 0;
180    
181 dpavlin 651 my $tables_sql = 'data';
182 dpavlin 643 my $where_sql = '';
183 dpavlin 641
184 dpavlin 643 my @sql_args = ( $field, $where );
185 dpavlin 641
186 dpavlin 643 if ($filter) {
187     $tables_sql .= ",filters";
188     $where_sql .= "
189 dpavlin 651 and data.ord = filters.ord
190 dpavlin 643 and filter = ?
191     ";
192     push @sql_args, $filter;
193     }
194    
195 dpavlin 641 if ($where) {
196 dpavlin 643 my $sql2 = qq{
197 dpavlin 651 select data.ord as ord
198 dpavlin 643 from $tables_sql
199     where name = ? and upper(item) like upper(?)||'%'
200     $where_sql
201     };
202     my $sth = $self->{dbh}->prepare($sql2) || confess "sql2: $sql2; ".$self->{dbh}->errstr();
203 dpavlin 641
204 dpavlin 643 $sth->execute(@sql_args) || confess "sql2: $sql2; ".$self->{dbh}->errstr();
205 dpavlin 641 if (my $row = $sth->fetchrow_hashref) {
206     $from_ord += $row->{ord} - 1;
207     } else {
208     # if no match is found when searching from beginning
209     # of word in index, try substring match anywhere
210 dpavlin 643 $sql2 = qq{
211 dpavlin 651 select data.ord as ord
212 dpavlin 643 from $tables_sql
213     where name = ? and upper(item) like '% '||upper(?)||'%'
214     $where_sql
215     };
216    
217     $sth = $self->{dbh}->prepare($sql2) || confess "sql2: $sql2; ".$self->{dbh}->errstr();
218     $sth->execute(@sql_args) || confess "sql2: $sql2; ".$self->{dbh}->errstr();
219    
220 dpavlin 641 if (my $row = $sth->fetchrow_hashref) {
221     $from_ord += $row->{ord} - 1;
222     }
223     }
224     }
225    
226 dpavlin 643 @sql_args = ( $field, $from_ord );
227     push @sql_args, $filter if ($filter);
228    
229     my $sql = qq{
230 dpavlin 651 select item,display,data.count as count
231 dpavlin 643 from $tables_sql
232     where name = ?
233 dpavlin 651 and data.ord > ?
234 dpavlin 643 $where_sql
235 dpavlin 651 order by data.ord
236 dpavlin 643 };
237    
238 dpavlin 651 # fix SQLite problem which doesn't allow placeholders in limit and offset
239     # http://thread.gmane.org/gmane.comp.db.sqlite.general/9707
240     $sql .= "limit $rows offset $offset";
241    
242 dpavlin 643 my $sth = $self->{dbh}->prepare($sql) || confess "prepare: $sql; ".$self->{dbh}->errstr();
243 dpavlin 651 $sth->execute(@sql_args) || confess "execute: $sql; ".join("|",@sql_args)." ".$self->{dbh}->errstr();
244 dpavlin 641 my @arr;
245     while (my $row = $sth->fetchrow_hashref) {
246     $row->{item} = HTML::Entities::encode($row->{item},' <>&"');
247     $row->{display} = HTML::Entities::encode($row->{display},'<>&"');
248     $row->{item} =~ s#&amp;(\w)(acute|cedil|circ|grave|ring|slash|tilde|uml);#$1#gi;
249     $row->{display} =~ s#&amp;(\w)(acute|cedil|circ|grave|ring|slash|tilde|uml);#&$1$2;#gi;
250     push @arr,$row;
251     }
252     return @arr;
253     }
254    
255     sub close {
256     my $self = shift;
257    
258     return if (! $self->{dbh});
259    
260 dpavlin 643 $self->{dbh}->begin_work || confess $self->{dbh}->errstr();
261 dpavlin 641
262 dpavlin 651 $self->delete_and_create('data', qq{
263     create table data (
264 dpavlin 641 name varchar(255),
265     ord int,
266     item text,
267     display text,
268     count int,
269     primary key (name,ord)
270     );
271     });
272    
273 dpavlin 642 $self->delete_and_create('filters', qq{
274     create table filters (
275     filter varchar(255),
276 dpavlin 641 ord int,
277     count int,
278 dpavlin 642 primary key (filter,ord)
279 dpavlin 641 );
280     });
281    
282     $self->bench("getting all entries");
283     my @items = keys %{$self->{c}};
284     $self->bench("got ".($#items+1)." items, now sorting");
285     @items = sort @items;
286    
287 dpavlin 651 my $sql = "insert into data (name,ord,item,display,count) values (?,?,?,?,?)";
288 dpavlin 641 my $sth_index = $self->{dbh}->prepare($sql) || confess "$sql: ".$self->{dbh}->errstr();
289    
290 dpavlin 642 $sql = "insert into filters (filter, ord, count) values (?,?,?)";
291     my $sth_filter = $self->{dbh}->prepare($sql) || confess "$sql: ".$self->{dbh}->errstr();
292 dpavlin 641
293     my $ord = 0;
294     foreach my $key (@items) {
295    
296     foreach my $field (keys %{$self->{c}->{$key}}) {
297     # store items
298     $sth_index->execute(
299     $field,
300     ++$ord,
301     $self->{c}->{$key}->{$field}->{item},
302     $self->{c}->{$key}->{$field}->{display},
303     $self->{c}->{$key}->{$field}->{count},
304     );
305    
306 dpavlin 642 # store filters
307     next unless ($self->{c}->{$key}->{$field}->{filter});
308 dpavlin 641
309 dpavlin 642 foreach my $filter (keys %{$self->{c}->{$key}->{$field}->{filter}}) {
310     $sth_filter->execute( $filter, $ord, $self->{c}->{$key}->{$field}->{filter}->{$filter} );
311 dpavlin 641 }
312     }
313    
314    
315     }
316    
317 dpavlin 643 $self->{dbh}->commit || confess $self->{dbh}->errstr();
318 dpavlin 641
319     $self->bench("vacuuming");
320    
321     if ($self->{dbd} =~ m/(Pg|SQLite)/) {
322     $self->{dbh}->do(qq{vacuum}) || carp "vacumming failed. It shouldn't if you are using PostgreSQL or SQLite: ".$self->{dbh}->errstr();
323     }
324    
325     $self->bench("disconnecting from database");
326    
327     $self->{dbh}->disconnect;
328     undef $self->{dbh};
329     }
330    
331     END {
332     $Count--;
333     print STDERR "index_DBI fatal error: \$index->close() not called... $Count references left!\n" if ($Count > 0);
334     # FIX: debug output
335     # print STDERR "usage\ttable\n";
336     # foreach (keys %Table) {
337     # print STDERR $Table{$_},"\t$_\n";
338     # }
339     }
340    
341     1;

  ViewVC Help
Powered by ViewVC 1.1.26