/[webpac]/trunk/index_DBI_cache.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_cache.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 188 - (show annotations)
Sat Nov 29 19:07:00 2003 UTC (20 years, 3 months ago) by dpavlin
File size: 5994 byte(s)
implemented index_delimiter which enables to to format index entries in format
(values to be inserted in index);;(values to be displayed) if there is
definition of index_delimiter=";;". This will allow you to index (and
search) through values from original database and still have ability to
display lookup fields.

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
15 use DBI;
16
17 my %Table; # index tables which where visited in this run
18 my %sth_cache; # cache prepared statements
19
20 # cache var
21 my $c_table;
22 my $c_count;
23
24 # bench time
25 my $bench_time = time();
26
27 sub bench {
28 my $self = shift;
29 my $msg = shift;
30
31 print STDERR "last operation took ",time()-$bench_time," seconds...\n";
32 $bench_time=time();
33 print STDERR "$msg\n";
34 }
35
36 sub new {
37 my $class = shift;
38 my $self = {};
39 bless($self, $class);
40
41 my $dbd = shift || die "need dbi_dbd= in [global] section of configuration file";
42 my $dsn = shift || die "need dbi_dsn= in [global] section of configuration file";
43 my $user = shift || die "need dbi_user= in [global] section of configuration file";
44 my $passwd = shift || die "need dbi_passwd= in [global] section of configuration file";
45
46 $self->{dbh} = DBI->connect("DBI:$dbd:$dsn",$user,$passwd) || die $DBI::errstr;
47 $Count++;
48
49 $self->bench("connected to $dbd as $user");
50
51 return $self;
52 }
53
54 sub delete_and_create {
55 my $self = shift;
56
57 my $field = shift;
58
59 #print "#### delete_and_create($field)\n";
60
61 my $sql = "select count(*) from $field";
62 my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
63 # FIX: this is not a good way to check if table exists!
64 if ($sth->execute() && $sth->fetchrow_hashref) {
65 my $sql = "drop table $field";
66 my $sth = $self->{dbh}->do($sql) || die "SQL: $sql ".$self->{dbh}->errstr();
67 }
68 $sql = "create table $field (
69 item varchar(255),
70 display text,
71 count int,
72 ord int,
73 primary key (item)
74 )";
75
76 $sth = $self->{dbh}->do($sql) || warn "SQL: $sql ".$self->{dbh}->errstr();
77 }
78
79 sub insert {
80 my $self = shift;
81
82 my $field = shift;
83 my $index_data = shift || print STDERR "\$index->insert($field,NULL,...)";
84 my $display = shift || $index_data;
85
86 if (! $index_data) {
87 print STDERR "\$index->insert() -- no value to insert\n";
88 return;
89 }
90
91 $Table{$field}++;
92
93 #$sth_cache{$field."select"}->execute($index_data) || die "cache: $field select; ".$self->{dbh}->errstr();
94
95 # XXX for some strange reason, it seems that some entries in my
96 # database produce strings which start with null byte. I suspect
97 # this to be bug in OpenIsis 0.9.0.
98 # This should fix it..
99 $index_data =~ s/^[^\w]+//;
100 $index_data = substr($index_data,0,255);
101
102 my $uc = uc($index_data);
103 if (! $c_table->{$field}->{$uc}) {
104 #print stderr "in index: $index_data\n";
105 $c_table->{$field}->{$uc} = $index_data;
106 $c_table->{$field}->{$uc}->{display} = $display;
107 $c_count->{$field}->{$uc} = 1;
108 } else {
109 $c_count->{$field}->{$uc}++;
110 }
111 }
112
113 sub count {
114 my $self = shift;
115
116 my $field = shift;
117 my $where = shift;
118
119 my $sql = "select count(*) from $field where upper(item) like upper(?)||'%'";
120
121 my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
122 $sth->execute($where) || die "sql: $sql; ".$self->{dbh}->errstr();
123
124 my ($total) = $sth->fetchrow_array();
125
126 # no results, count all
127 if (! $total) {
128 my $sql = "select count(*) from $field";
129
130 my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
131 $sth->execute() || die "sql: $sql; ".$self->{dbh}->errstr();
132 $total = $sth->fetchrow_array();
133
134 }
135
136 return $total || 1;
137 }
138
139
140 sub fetch {
141 my $self = shift;
142
143 my $field = shift;
144 my $where = shift;
145
146 my $from_ord = shift || 0;
147 my $rows = shift || 10;
148
149 my @sql_args;
150
151 my $sql = "select item,display,ord from $field";
152
153 if ($where) {
154 my $sql2 = "select ord from $field where upper(item) like upper(?)||'%'";
155 my $sth = $self->{dbh}->prepare($sql2) || die "sql2: $sql2; ".$self->{dbh}->errstr();
156
157 $sth->execute($where) || die "sql2: $sql2; ".$self->{dbh}->errstr();
158 if (my $row = $sth->fetchrow_hashref) {
159 $from_ord += $row->{ord} - 1;
160 } else {
161 # if no match is found when searching from beginning
162 # of word in index, try substring match anywhere
163 $sql2 = "select ord from $field where upper(item) like '%'||upper(?)||'%'";
164 $sth = $self->{dbh}->prepare($sql2) || die "sql2: $sql2; ".$self->{dbh}->errstr();
165 $sth->execute($where) || die "sql2: $sql2; ".$self->{dbh}->errstr();
166 if (my $row = $sth->fetchrow_hashref) {
167 $from_ord += $row->{ord} - 1;
168 }
169 }
170 }
171 $sql .= " order by ord limit $rows offset $from_ord";
172
173 my $sth = $self->{dbh}->prepare($sql) || die "prepare: $sql; ".$self->{dbh}->errstr();
174 $sth->execute() || die "execute: $sql; ".$self->{dbh}->errstr();
175 my @arr;
176 while (my $row = $sth->fetchrow_hashref) {
177 $row->{item} = HTML::Entities::encode($row->{item},' <>&"');
178 $row->{display} = HTML::Entities::encode($row->{display},'<>&"');
179 push @arr,$row;
180 }
181 return @arr;
182 }
183
184 sub close {
185 my $self = shift;
186
187 return if (! $self->{dbh});
188
189 foreach my $table (keys %Table) {
190 $self->bench("Crating table $table");
191 $self->delete_and_create($table);
192
193 $self->{dbh}->begin_work || die $self->{dbh}->errstr();
194
195 $self->bench("Sorting ".$Table{$table}." items in $table");
196 my @keys = sort keys %{$c_table->{$table}};
197
198 $self->bench("Dumping data into $table");
199 my $sql = "insert into $table (ord,item,display,count) values (?,?,?,?)";
200 my $sth = $self->{dbh}->prepare($sql) || die "sql: $sql; ".$self->{dbh}->errstr();
201
202 my $ord = 0;
203 foreach my $key (@keys) {
204 $sth->execute(++$ord,
205 $c_table->{$table}->{$key},
206 $c_table->{$table}->{$key}->{display},
207 $c_count->{$table}->{$key}
208 );
209 }
210
211 $self->{dbh}->commit || die $self->{dbh}->errstr();
212 }
213 $self->bench("disconnecting from database");
214
215 $self->{dbh}->disconnect;
216 undef $self->{dbh};
217 }
218
219 END {
220 $Count--;
221 print STDERR "index_DBI fatal error: \$index->close() not called... $Count references left!\n" if ($Count > 0);
222 # FIX: debug output
223 # print STDERR "usage\ttable\n";
224 # foreach (keys %Table) {
225 # print STDERR $Table{$_},"\t$_\n";
226 # }
227 }
228
229 1;

Properties

Name Value
cvs2svn:cvs-rev 1.11

  ViewVC Help
Powered by ViewVC 1.1.26