git.rot13.org Git - webpac/blob - index_DBI_tag.pm

   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;