/[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 642 - (hide annotations)
Sun Jan 23 14:31:02 2005 UTC (17 years, 6 months ago) by dpavlin
File size: 7261 byte(s)
renamed tag to finger to avoid confusion (I tried to exmplain why I use term
tag and failed -- it too similar to tags used in import_xml)

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     my $sql = "select count(*) from index where name = ? and upper(item) like upper(?)||'%'";
121    
122     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
123     $sth->execute($field,$where) || die "sql: $sql; ".$self->{dbh}->errstr();
124    
125     my ($total) = $sth->fetchrow_array();
126    
127     # no results, count all
128     if (! $total) {
129     my $sql = "select count(*) from index wheere name = ?";
130    
131     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
132     $sth->execute($field) || die "sql: $sql; ".$self->{dbh}->errstr();
133     $total = $sth->fetchrow_array();
134    
135     }
136    
137     return $total || 1;
138     }
139    
140    
141     sub fetch {
142     my $self = shift;
143    
144     my $field = shift;
145     my $where = shift;
146    
147     my $offset = shift || 0;
148     my $rows = shift || 10;
149     my $from_ord = 0;
150    
151     my @sql_args;
152    
153     my $sql = qq{
154     select item,display,count
155     from index
156     where name = ?
157     and ord > ?
158     order by ord
159     limit ? offset ?
160     };
161    
162     if ($where) {
163     my $sql2 = "select ord from index where name = ? and upper(item) like upper(?)||'%'";
164     my $sth = $self->{dbh}->prepare($sql2) || die "sql2: $sql2; ".$self->{dbh}->errstr();
165    
166     $sth->execute($field, $where) || die "sql2: $sql2; ".$self->{dbh}->errstr();
167     if (my $row = $sth->fetchrow_hashref) {
168     $from_ord += $row->{ord} - 1;
169     } else {
170     # if no match is found when searching from beginning
171     # of word in index, try substring match anywhere
172     $sql2 = "select ord from index where name = ? and upper(item) like '% '||upper(?)||'%'";
173     $sth = $self->{dbh}->prepare($sql2) || die "sql2: $sql2; ".$self->{dbh}->errstr();
174     $sth->execute($field, $where) || die "sql2: $sql2; ".$self->{dbh}->errstr();
175     if (my $row = $sth->fetchrow_hashref) {
176     $from_ord += $row->{ord} - 1;
177     }
178     }
179     }
180    
181     my $sth = $self->{dbh}->prepare($sql) || die "prepare: $sql; ".$self->{dbh}->errstr();
182     $sth->execute($field,$from_ord,$rows,$offset) || die "execute: $sql; ".$self->{dbh}->errstr();
183     my @arr;
184     while (my $row = $sth->fetchrow_hashref) {
185     $row->{item} = HTML::Entities::encode($row->{item},' <>&"');
186     $row->{display} = HTML::Entities::encode($row->{display},'<>&"');
187     $row->{item} =~ s#&amp;(\w)(acute|cedil|circ|grave|ring|slash|tilde|uml);#$1#gi;
188     $row->{display} =~ s#&amp;(\w)(acute|cedil|circ|grave|ring|slash|tilde|uml);#&$1$2;#gi;
189     push @arr,$row;
190     }
191     return @arr;
192     }
193    
194     sub close {
195     my $self = shift;
196    
197     return if (! $self->{dbh});
198    
199     $self->{dbh}->begin_work || die $self->{dbh}->errstr();
200    
201     $self->delete_and_create('index', qq{
202     create table index (
203     name varchar(255),
204     ord int,
205     item text,
206     display text,
207     count int,
208     primary key (name,ord)
209     );
210     });
211    
212 dpavlin 642 $self->delete_and_create('filters', qq{
213     create table filters (
214     filter varchar(255),
215 dpavlin 641 ord int,
216     count int,
217 dpavlin 642 primary key (filter,ord)
218 dpavlin 641 );
219     });
220    
221     $self->bench("getting all entries");
222     my @items = keys %{$self->{c}};
223     $self->bench("got ".($#items+1)." items, now sorting");
224     @items = sort @items;
225    
226     my $sql = "insert into index (name,ord,item,display,count) values (?,?,?,?,?)";
227     my $sth_index = $self->{dbh}->prepare($sql) || confess "$sql: ".$self->{dbh}->errstr();
228    
229 dpavlin 642 $sql = "insert into filters (filter, ord, count) values (?,?,?)";
230     my $sth_filter = $self->{dbh}->prepare($sql) || confess "$sql: ".$self->{dbh}->errstr();
231 dpavlin 641
232     my $ord = 0;
233     foreach my $key (@items) {
234    
235     foreach my $field (keys %{$self->{c}->{$key}}) {
236     # store items
237     $sth_index->execute(
238     $field,
239     ++$ord,
240     $self->{c}->{$key}->{$field}->{item},
241     $self->{c}->{$key}->{$field}->{display},
242     $self->{c}->{$key}->{$field}->{count},
243     );
244    
245 dpavlin 642 # store filters
246     next unless ($self->{c}->{$key}->{$field}->{filter});
247 dpavlin 641
248 dpavlin 642 foreach my $filter (keys %{$self->{c}->{$key}->{$field}->{filter}}) {
249     $sth_filter->execute( $filter, $ord, $self->{c}->{$key}->{$field}->{filter}->{$filter} );
250 dpavlin 641 }
251     }
252    
253    
254     }
255    
256     $self->{dbh}->commit || die $self->{dbh}->errstr();
257    
258     $self->bench("vacuuming");
259    
260     if ($self->{dbd} =~ m/(Pg|SQLite)/) {
261     $self->{dbh}->do(qq{vacuum}) || carp "vacumming failed. It shouldn't if you are using PostgreSQL or SQLite: ".$self->{dbh}->errstr();
262     }
263    
264     $self->bench("disconnecting from database");
265    
266     $self->{dbh}->disconnect;
267     undef $self->{dbh};
268     }
269    
270     END {
271     $Count--;
272     print STDERR "index_DBI fatal error: \$index->close() not called... $Count references left!\n" if ($Count > 0);
273     # FIX: debug output
274     # print STDERR "usage\ttable\n";
275     # foreach (keys %Table) {
276     # print STDERR $Table{$_},"\t$_\n";
277     # }
278     }
279    
280     1;

  ViewVC Help
Powered by ViewVC 1.1.26