/[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 643 - (hide annotations)
Sun Jan 23 15:18:03 2005 UTC (19 years, 2 months ago) by dpavlin
File size: 8177 byte(s)
add filtering to index (using parameter filter, for now single)

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     my $index = shift || croak "need index name!";
64     my $sql = shift || croak "need sql to create table!";
65    
66     print STDERR "## delete_and_create($index)\n" if ($debug);
67    
68     my $sql_delete = "delete from $index";
69     my $sth = $self->{dbh}->prepare($sql_delete) || confess "can't prepare: $sql_delete";
70    
71 dpavlin 642 if ($sth->execute()) {
72     print STDERR "## deleted rows from table $index\n" if ($debug);
73     } 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     print STDERR "## creating table $index\n" if ($debug);
78     $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 643 my $tables_sql = 'index';
123     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     and index.ord = filters.ord
130     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     where index.name = ?
153     $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 643 my $tables_sql = 'index';
182     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     and index.ord = filters.ord
190     and filter = ?
191     ";
192     push @sql_args, $filter;
193     }
194    
195 dpavlin 641 if ($where) {
196 dpavlin 643 my $sql2 = qq{
197     select index.ord as ord
198     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     select index.ord as ord
212     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     push @sql_args, ( $rows, $offset );
229    
230     my $sql = qq{
231     select item,display,index.count as count
232     from $tables_sql
233     where name = ?
234     and index.ord > ?
235     $where_sql
236     order by index.ord
237     limit ? offset ?
238     };
239    
240     my $sth = $self->{dbh}->prepare($sql) || confess "prepare: $sql; ".$self->{dbh}->errstr();
241     $sth->execute(@sql_args) || confess "execute: $sql; ".$self->{dbh}->errstr();
242 dpavlin 641 my @arr;
243     while (my $row = $sth->fetchrow_hashref) {
244     $row->{item} = HTML::Entities::encode($row->{item},' <>&"');
245     $row->{display} = HTML::Entities::encode($row->{display},'<>&"');
246     $row->{item} =~ s#&amp;(\w)(acute|cedil|circ|grave|ring|slash|tilde|uml);#$1#gi;
247     $row->{display} =~ s#&amp;(\w)(acute|cedil|circ|grave|ring|slash|tilde|uml);#&$1$2;#gi;
248     push @arr,$row;
249     }
250     return @arr;
251     }
252    
253     sub close {
254     my $self = shift;
255    
256     return if (! $self->{dbh});
257    
258 dpavlin 643 $self->{dbh}->begin_work || confess $self->{dbh}->errstr();
259 dpavlin 641
260     $self->delete_and_create('index', qq{
261     create table index (
262     name varchar(255),
263     ord int,
264     item text,
265     display text,
266     count int,
267     primary key (name,ord)
268     );
269     });
270    
271 dpavlin 642 $self->delete_and_create('filters', qq{
272     create table filters (
273     filter varchar(255),
274 dpavlin 641 ord int,
275     count int,
276 dpavlin 642 primary key (filter,ord)
277 dpavlin 641 );
278     });
279    
280     $self->bench("getting all entries");
281     my @items = keys %{$self->{c}};
282     $self->bench("got ".($#items+1)." items, now sorting");
283     @items = sort @items;
284    
285     my $sql = "insert into index (name,ord,item,display,count) values (?,?,?,?,?)";
286     my $sth_index = $self->{dbh}->prepare($sql) || confess "$sql: ".$self->{dbh}->errstr();
287    
288 dpavlin 642 $sql = "insert into filters (filter, ord, count) values (?,?,?)";
289     my $sth_filter = $self->{dbh}->prepare($sql) || confess "$sql: ".$self->{dbh}->errstr();
290 dpavlin 641
291     my $ord = 0;
292     foreach my $key (@items) {
293    
294     foreach my $field (keys %{$self->{c}->{$key}}) {
295     # store items
296     $sth_index->execute(
297     $field,
298     ++$ord,
299     $self->{c}->{$key}->{$field}->{item},
300     $self->{c}->{$key}->{$field}->{display},
301     $self->{c}->{$key}->{$field}->{count},
302     );
303    
304 dpavlin 642 # store filters
305     next unless ($self->{c}->{$key}->{$field}->{filter});
306 dpavlin 641
307 dpavlin 642 foreach my $filter (keys %{$self->{c}->{$key}->{$field}->{filter}}) {
308     $sth_filter->execute( $filter, $ord, $self->{c}->{$key}->{$field}->{filter}->{$filter} );
309 dpavlin 641 }
310     }
311    
312    
313     }
314    
315 dpavlin 643 $self->{dbh}->commit || confess $self->{dbh}->errstr();
316 dpavlin 641
317     $self->bench("vacuuming");
318    
319     if ($self->{dbd} =~ m/(Pg|SQLite)/) {
320     $self->{dbh}->do(qq{vacuum}) || carp "vacumming failed. It shouldn't if you are using PostgreSQL or SQLite: ".$self->{dbh}->errstr();
321     }
322    
323     $self->bench("disconnecting from database");
324    
325     $self->{dbh}->disconnect;
326     undef $self->{dbh};
327     }
328    
329     END {
330     $Count--;
331     print STDERR "index_DBI fatal error: \$index->close() not called... $Count references left!\n" if ($Count > 0);
332     # FIX: debug output
333     # print STDERR "usage\ttable\n";
334     # foreach (keys %Table) {
335     # print STDERR $Table{$_},"\t$_\n";
336     # }
337     }
338    
339     1;

  ViewVC Help
Powered by ViewVC 1.1.26