/[webpac]/trunk2/index_DBI.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 /trunk2/index_DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 18 - (hide annotations)
Sat Feb 22 21:37:25 2003 UTC (21 years, 1 month ago) by dpavlin
Original Path: trunk/index_DBI.pm
File size: 4751 byte(s)
make drop/create table actually work

1 dpavlin 10 #
2     # this file implements index functions using DBI
3     #
4    
5     package index_DBI;
6     use strict qw(vars);
7     use vars qw($Count);
8 dpavlin 12 use HTML::Entities;
9 dpavlin 10
10     use DBI;
11    
12     my %Table; # index tables which where visited in this run
13    
14     sub new {
15     my $class = shift;
16     my $self = {};
17     bless($self, $class);
18    
19     # FIX: config params
20 dpavlin 11 $self->{dbh} = DBI->connect("DBI:Pg:dbname=webpac","dpavlin","") || die $DBI::errstr;
21 dpavlin 10 # begin transaction
22     $self->{dbh}->begin_work || die $self->{dbh}->errstr();
23    
24     $Count++;
25    
26     return $self;
27     }
28    
29     sub delete_and_create {
30     my $self = shift;
31    
32     my $field = shift;
33    
34     $self->{dbh}->commit;
35     $self->{dbh}->begin_work;
36    
37     my $sql = "select count(*) from $field";
38     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
39     # FIX: this is not a good way to check if table exists!
40 dpavlin 18 if ($sth->execute() && $sth->fetchrow_hashref) {
41 dpavlin 10 my $sql = "drop table $field";
42 dpavlin 18 my $sth = $self->{dbh}->do($sql) || die "SQL: $sql ".$self->{dbh}->errstr();
43 dpavlin 10 }
44     $sql = "create table $field (
45     item varchar(255),
46     ident varchar(255),
47     count int,
48 dpavlin 12 ord int,
49 dpavlin 10 primary key (item,ident)
50     )";
51 dpavlin 18 $sth = $self->{dbh}->do($sql); # || warn "SQL: $sql ".$self->{dbh}->errstr();
52 dpavlin 10
53     $self->{dbh}->commit;
54     $self->{dbh}->begin_work;
55     }
56    
57     sub insert {
58     my $self = shift;
59    
60     my $field = shift;
61 dpavlin 18 my $index_data = shift || print STDERR "\$index->insert($field,NULL,...)";
62     my $ident = shift || ''; # e.g. library id
63 dpavlin 10
64     if (! $index_data) {
65     print STDERR "\$index->insert() -- no value to insert\n";
66     return;
67     }
68    
69     if (! $Table{$field}) {
70     $self->delete_and_create($field);
71     }
72     $Table{$field}++;
73    
74     my $sql = "select item from $field where upper(item)=upper(?)";
75     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
76 dpavlin 11 $sth->execute($index_data) || die "sql: $sql; ".$self->{dbh}->errstr();
77 dpavlin 10 if (! $sth->fetchrow_hashref) {
78     my $sql = "insert into $field (item,ident,count) values (?,?,?)";
79     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
80 dpavlin 11 $sth->execute($index_data,$ident,1) || die "sql: $sql; ".$self->{dbh}->errstr();
81     #print stderr "in index: $index_data\n";
82 dpavlin 10 } else {
83     my $sql = "update $field set count = count + 1 where item = ? and ident = ?";
84     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
85 dpavlin 11 $sth->execute($index_data,$ident) || die "sql: $sql; ".$self->{dbh}->errstr();
86 dpavlin 10 }
87     }
88    
89 dpavlin 11 sub check {
90     my $self = shift;
91    
92     my $field = shift;
93    
94     my $sql = "select count(*) from $field";
95 dpavlin 12
96     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
97     $sth->execute() || die "sql: $sql; ".$self->{dbh}->errstr();
98    
99     my ($total) = $sth->fetchrow_array();
100    
101     return $total;
102 dpavlin 11 }
103    
104    
105     sub fetch {
106     my $self = shift;
107    
108     my $field = shift;
109     my $what = shift || 'item'; # 'item,ident'
110     my $where = shift;
111    
112 dpavlin 12 my $from_ord = shift || 0;
113     my $rows = shift || 10;
114    
115 dpavlin 11 my @sql_args;
116    
117 dpavlin 13 my $sql = "select $what,ord from $field";
118 dpavlin 12
119 dpavlin 11 if ($where) {
120 dpavlin 12 my $sql2 = " select ord from $field where upper($what) like upper(?)||'%'";
121     my $sth = $self->{dbh}->prepare($sql2) || die "sql2: $sql2; ".$self->{dbh}->errstr();
122    
123     $sth->execute($where) || die "sql2: $sql2; ".$self->{dbh}->errstr();
124     if (my $row = $sth->fetchrow_hashref) {
125 dpavlin 13 $from_ord += $row->{ord} - 1;
126 dpavlin 12 }
127 dpavlin 11 }
128 dpavlin 12 $sql .= " order by ord limit $rows offset $from_ord";
129 dpavlin 11
130 dpavlin 12 my $sth = $self->{dbh}->prepare($sql) || die "prepare: $sql; ".$self->{dbh}->errstr();
131     $sth->execute() || die "execute: $sql; ".$self->{dbh}->errstr();
132 dpavlin 11 my @arr;
133     while (my $row = $sth->fetchrow_hashref) {
134 dpavlin 12 $row->{item} = HTML::Entities::encode($row->{item});
135 dpavlin 11 push @arr,$row;
136     }
137     return @arr;
138     }
139    
140 dpavlin 10 sub close {
141     my $self = shift;
142    
143 dpavlin 12
144     # re-create ord column (sorted order) in table
145     sub create_ord {
146    
147     my $table = shift;
148    
149     $self->{dbh}->begin_work || die $self->{dbh}->errstr();
150    
151     my $sql = "select oid from $table order by item";
152     my $sth = $self->{dbh}->prepare($sql) || die "sql: $sql; ".$self->{dbh}->errstr();
153     $sql = "update $table set ord=? where oid=?";
154     my $sth_update = $self->{dbh}->prepare($sql) || die "sql: $sql; ".$self->{dbh}->errstr();
155     $sth->execute() || die "sql: $sql; ".$self->{dbh}->errstr();
156     my $ord = 1;
157     while (my $row = $sth->fetchrow_hashref) {
158     $sth_update->execute($ord++,$row->{oid});
159     }
160    
161     $self->{dbh}->commit || die $self->{dbh}->errstr();
162     }
163     #--- end of sub
164    
165 dpavlin 10 if ($self->{dbh}) {
166 dpavlin 12
167     # commit
168 dpavlin 10 $self->{dbh}->commit || die $self->{dbh}->errstr();
169 dpavlin 12
170     foreach my $table (keys %Table) {
171     # FIX
172     print STDERR "creating ord for $table...\n";
173     create_ord($table);
174     }
175    
176 dpavlin 10 $self->{dbh}->disconnect;
177     undef $self->{dbh};
178     }
179     }
180    
181     END {
182     $Count--;
183 dpavlin 11 print STDERR "index_DBI fatal error: \$index->close() not called... $Count references left!\n" if ($Count > 0);
184 dpavlin 10 # FIX: debug output
185 dpavlin 11 # print STDERR "usage\ttable\n";
186     # foreach (keys %Table) {
187     # print STDERR $Table{$_},"\t$_\n";
188     # }
189 dpavlin 10 }
190    
191     1;

Properties

Name Value
cvs2svn:cvs-rev 1.5

  ViewVC Help
Powered by ViewVC 1.1.26