/[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

Annotation of /trunk/index_DBI_cache.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 188 - (hide 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 dpavlin 60 #
2     # this file implements index functions using DBI
3     # and huge amounts of memory for cache speedup
4     #
5 dpavlin 94 # this version doesn't support ident (which sould be location in
6     # library). But, that functionality is not used anyway...
7     #
8 dpavlin 60
9     package index_DBI;
10     use strict qw(vars);
11     use vars qw($Count);
12     use HTML::Entities;
13 dpavlin 188 use URI::Escape;
14 dpavlin 60
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 dpavlin 88 # bench time
25 dpavlin 94 my $bench_time = time();
26 dpavlin 88
27 dpavlin 94 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 dpavlin 60 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 dpavlin 94 $self->bench("connected to $dbd as $user");
50    
51 dpavlin 60 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 dpavlin 188 display text,
71 dpavlin 60 count int,
72     ord int,
73 dpavlin 94 primary key (item)
74 dpavlin 60 )";
75    
76 dpavlin 94 $sth = $self->{dbh}->do($sql) || warn "SQL: $sql ".$self->{dbh}->errstr();
77 dpavlin 60 }
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 dpavlin 188 my $display = shift || $index_data;
85 dpavlin 60
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 dpavlin 93
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 dpavlin 60 $index_data = substr($index_data,0,255);
101 dpavlin 93
102 dpavlin 60 my $uc = uc($index_data);
103 dpavlin 94 if (! $c_table->{$field}->{$uc}) {
104 dpavlin 60 #print stderr "in index: $index_data\n";
105 dpavlin 94 $c_table->{$field}->{$uc} = $index_data;
106 dpavlin 188 $c_table->{$field}->{$uc}->{display} = $display;
107 dpavlin 94 $c_count->{$field}->{$uc} = 1;
108 dpavlin 60 } else {
109 dpavlin 94 $c_count->{$field}->{$uc}++;
110 dpavlin 60 }
111     }
112    
113 dpavlin 140 sub count {
114 dpavlin 60 my $self = shift;
115    
116     my $field = shift;
117 dpavlin 140 my $where = shift;
118 dpavlin 60
119 dpavlin 140 my $sql = "select count(*) from $field where upper(item) like upper(?)||'%'";
120 dpavlin 60
121     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
122 dpavlin 140 $sth->execute($where) || die "sql: $sql; ".$self->{dbh}->errstr();
123 dpavlin 60
124     my ($total) = $sth->fetchrow_array();
125    
126 dpavlin 142 # 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 dpavlin 60 }
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 dpavlin 188 my $sql = "select item,display,ord from $field";
152 dpavlin 60
153     if ($where) {
154 dpavlin 140 my $sql2 = "select ord from $field where upper(item) like upper(?)||'%'";
155 dpavlin 60 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 dpavlin 127 } else {
161     # if no match is found when searching from beginning
162     # of word in index, try substring match anywhere
163 dpavlin 140 $sql2 = "select ord from $field where upper(item) like '%'||upper(?)||'%'";
164 dpavlin 127 $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 dpavlin 60 }
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 dpavlin 188 $row->{item} = HTML::Entities::encode($row->{item},' <>&"');
178     $row->{display} = HTML::Entities::encode($row->{display},'<>&"');
179 dpavlin 60 push @arr,$row;
180     }
181     return @arr;
182     }
183    
184     sub close {
185     my $self = shift;
186    
187 dpavlin 94 return if (! $self->{dbh});
188 dpavlin 60
189 dpavlin 94 foreach my $table (keys %Table) {
190     $self->bench("Crating table $table");
191     $self->delete_and_create($table);
192 dpavlin 60
193     $self->{dbh}->begin_work || die $self->{dbh}->errstr();
194    
195 dpavlin 94 $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 dpavlin 188 my $sql = "insert into $table (ord,item,display,count) values (?,?,?,?)";
200 dpavlin 60 my $sth = $self->{dbh}->prepare($sql) || die "sql: $sql; ".$self->{dbh}->errstr();
201 dpavlin 94
202     my $ord = 0;
203     foreach my $key (@keys) {
204 dpavlin 95 $sth->execute(++$ord,
205 dpavlin 94 $c_table->{$table}->{$key},
206 dpavlin 188 $c_table->{$table}->{$key}->{display},
207 dpavlin 94 $c_count->{$table}->{$key}
208     );
209 dpavlin 60 }
210    
211     $self->{dbh}->commit || die $self->{dbh}->errstr();
212     }
213 dpavlin 94 $self->bench("disconnecting from database");
214 dpavlin 60
215 dpavlin 94 $self->{dbh}->disconnect;
216     undef $self->{dbh};
217 dpavlin 60 }
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