/[webpac]/trunk/index_DBI_tag.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

Contents of /trunk/index_DBI_tag.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 641 - (show annotations)
Sun Jan 23 02:02:10 2005 UTC (15 years, 4 months ago) by dpavlin
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 #
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