/[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 641 - (hide annotations)
Sun Jan 23 02:02:10 2005 UTC (19 years, 2 months ago) by dpavlin
Original Path: trunk/index_DBI_tag.pm
File size: 7132 byte(s)
New implementation of indexes: now it uses only two tables (index for all
data and tags for all tags). Currently, it doesn't enforce relation between
them on RDBMS level (I have to test this code against SQLite and MySQL
before enforcing that).
Removed swish-e output while indexing, database is used as default tag to
enable filtering by database (there isn't possiblity to set tag to something
else yet!). Output usage count in index.

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

  ViewVC Help
Powered by ViewVC 1.1.26