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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (hide annotations)
Sun Feb 16 22:41:37 2003 UTC (16 years, 10 months ago) by dpavlin
File size: 4793 byte(s)
added configuration file with database descriptions,
moved isis.xml definition file in separate directory (in preparation for MARK),
support for different encodings in different files,
various fixes, improvements and badly written parts which will change ;-)

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     if (1 || $sth->execute() && $sth->fetchrow_hashref) {
41     my $sql = "drop table $field";
42     # my $sth = $self->{dbh}->do($sql) || die "SQL: $sql ".$self->{dbh}->errstr();
43     }
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     # $sth = $self->{dbh}->do($sql) || die "SQL: $sql ".$self->{dbh}->errstr();
52     $sth = $self->{dbh}->do($sql) || warn "SQL: $sql ".$self->{dbh}->errstr();
53    
54     $self->{dbh}->commit;
55     $self->{dbh}->begin_work;
56     }
57    
58     sub insert {
59     my $self = shift;
60    
61     my $field = shift;
62 dpavlin 13 my $index_data = shift || return;
63     my $ident = shift || return; # e.g. library id
64 dpavlin 10
65     if (! $index_data) {
66     print STDERR "\$index->insert() -- no value to insert\n";
67     return;
68     }
69    
70     if (! $Table{$field}) {
71     $self->delete_and_create($field);
72     }
73     $Table{$field}++;
74    
75     my $sql = "select item from $field where upper(item)=upper(?)";
76     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
77 dpavlin 11 $sth->execute($index_data) || die "sql: $sql; ".$self->{dbh}->errstr();
78 dpavlin 10 if (! $sth->fetchrow_hashref) {
79     my $sql = "insert into $field (item,ident,count) values (?,?,?)";
80     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
81 dpavlin 11 $sth->execute($index_data,$ident,1) || die "sql: $sql; ".$self->{dbh}->errstr();
82     #print stderr "in index: $index_data\n";
83 dpavlin 10 } else {
84     my $sql = "update $field set count = count + 1 where item = ? and ident = ?";
85     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
86 dpavlin 11 $sth->execute($index_data,$ident) || die "sql: $sql; ".$self->{dbh}->errstr();
87 dpavlin 10 }
88     }
89    
90 dpavlin 11 sub check {
91     my $self = shift;
92    
93     my $field = shift;
94    
95     my $sql = "select count(*) from $field";
96 dpavlin 12
97     my $sth = $self->{dbh}->prepare($sql) || die $self->{dbh}->errstr();
98     $sth->execute() || die "sql: $sql; ".$self->{dbh}->errstr();
99    
100     my ($total) = $sth->fetchrow_array();
101    
102     return $total;
103 dpavlin 11 }
104    
105    
106     sub fetch {
107     my $self = shift;
108    
109     my $field = shift;
110     my $what = shift || 'item'; # 'item,ident'
111     my $where = shift;
112    
113 dpavlin 12 my $from_ord = shift || 0;
114     my $rows = shift || 10;
115    
116 dpavlin 11 my @sql_args;
117    
118 dpavlin 13 my $sql = "select $what,ord from $field";
119 dpavlin 12
120 dpavlin 11 if ($where) {
121 dpavlin 12 my $sql2 = " select ord from $field where upper($what) like upper(?)||'%'";
122     my $sth = $self->{dbh}->prepare($sql2) || die "sql2: $sql2; ".$self->{dbh}->errstr();
123    
124     $sth->execute($where) || die "sql2: $sql2; ".$self->{dbh}->errstr();
125     if (my $row = $sth->fetchrow_hashref) {
126 dpavlin 13 $from_ord += $row->{ord} - 1;
127 dpavlin 12 }
128 dpavlin 11 }
129 dpavlin 12 $sql .= " order by ord limit $rows offset $from_ord";
130 dpavlin 11
131 dpavlin 12 my $sth = $self->{dbh}->prepare($sql) || die "prepare: $sql; ".$self->{dbh}->errstr();
132     $sth->execute() || die "execute: $sql; ".$self->{dbh}->errstr();
133 dpavlin 11 my @arr;
134     while (my $row = $sth->fetchrow_hashref) {
135 dpavlin 12 $row->{item} = HTML::Entities::encode($row->{item});
136 dpavlin 11 push @arr,$row;
137     }
138     return @arr;
139     }
140    
141 dpavlin 10 sub close {
142     my $self = shift;
143    
144 dpavlin 12
145     # re-create ord column (sorted order) in table
146     sub create_ord {
147    
148     my $table = shift;
149    
150     $self->{dbh}->begin_work || die $self->{dbh}->errstr();
151    
152     my $sql = "select oid from $table order by item";
153     my $sth = $self->{dbh}->prepare($sql) || die "sql: $sql; ".$self->{dbh}->errstr();
154     $sql = "update $table set ord=? where oid=?";
155     my $sth_update = $self->{dbh}->prepare($sql) || die "sql: $sql; ".$self->{dbh}->errstr();
156     $sth->execute() || die "sql: $sql; ".$self->{dbh}->errstr();
157     my $ord = 1;
158     while (my $row = $sth->fetchrow_hashref) {
159     $sth_update->execute($ord++,$row->{oid});
160     }
161    
162     $self->{dbh}->commit || die $self->{dbh}->errstr();
163     }
164     #--- end of sub
165    
166 dpavlin 10 if ($self->{dbh}) {
167 dpavlin 12
168     # commit
169 dpavlin 10 $self->{dbh}->commit || die $self->{dbh}->errstr();
170 dpavlin 12
171     foreach my $table (keys %Table) {
172     # FIX
173     print STDERR "creating ord for $table...\n";
174     create_ord($table);
175     }
176    
177 dpavlin 10 $self->{dbh}->disconnect;
178     undef $self->{dbh};
179     }
180     }
181    
182     END {
183     $Count--;
184 dpavlin 11 print STDERR "index_DBI fatal error: \$index->close() not called... $Count references left!\n" if ($Count > 0);
185 dpavlin 10 # FIX: debug output
186 dpavlin 11 # print STDERR "usage\ttable\n";
187     # foreach (keys %Table) {
188     # print STDERR $Table{$_},"\t$_\n";
189     # }
190 dpavlin 10 }
191    
192     1;

Properties

Name Value
cvs2svn:cvs-rev 1.4

  ViewVC Help
Powered by ViewVC 1.1.26