/[pgdiff]/Pg/Scheme.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

Diff of /Pg/Scheme.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by dpavlin, Tue Aug 12 18:45:06 2003 UTC revision 1.5 by dpavlin, Fri Oct 31 11:19:47 2003 UTC
# Line 16  $VERSION       = 1.00; Line 16  $VERSION       = 1.00;
16                                
17  @EXPORT_OK      = qw(  @EXPORT_OK      = qw(
18                                  &list_tables                                  &list_tables
19                                    &get_table_oid
20                                    &explain
21                                    &pg_attribute
22                                    &cols
23                                    &cols_notnull
24                                    &cols_null
25                                    &cols_pk
26                                    &cols_notpk
27                  );                  );
28    
29  my $debug;  my $debug;
# Line 88  sub get_table_oid { Line 96  sub get_table_oid {
96          return $row->{oid};          return $row->{oid};
97  }  }
98    
99  sub explain_table {  sub explain {
100          my $self = shift;          my $self = shift;
101          my $table = shift;          my $table = shift;
102    
103          my @explain;          # XXX if explained, return just results
104            # return $self->{'explained'}->{$table}->{'pg_attribute'} if ($self->{'explained'}->{$table}->{'pg_attribute'});
105            my @pg_attribute;
106    
107          my $oid = $self->get_table_oid($table);          my $oid = $self->get_table_oid($table);
108    
109            # get table description
110          my $sql="          my $sql="
111          SELECT a.attname,          SELECT a.attname,
112          pg_catalog.format_type(a.atttypid, a.atttypmod),          pg_catalog.format_type(a.atttypid, a.atttypmod) as format_type,
113          a.attnotnull, a.atthasdef, a.attnum          a.attnotnull, a.atthasdef, a.attnum
114          FROM pg_catalog.pg_attribute a          FROM pg_catalog.pg_attribute a
115          WHERE a.attrelid = ? AND a.attnum > 0 AND NOT a.attisdropped          WHERE a.attrelid = ? AND a.attnum > 0 AND NOT a.attisdropped
116          ORDER BY a.attnum          ORDER BY a.attnum
117          ";          ";
118    
119            # get default value
120            my $sql_def="
121            SELECT adsrc as def FROM pg_catalog.pg_attrdef
122            WHERE adrelid = ? and adnum=?
123            ";
124    
125            my @cols;       # all columns (for insert)
126            my @cols_null;  # columns compared by a=b or a is null and b is null
127            my @cols_notnull;# columns compared by a=b
128    
129          my $sth = $self->{'dbh'}->prepare($sql);          my $sth = $self->{'dbh'}->prepare($sql);
130            my $sth_def = $self->{'dbh'}->prepare($sql_def);
131          $sth->execute($oid) || die;          $sth->execute($oid) || die;
132          while(my $row = $sth->fetchrow_hashref()) {          while(my $row = $sth->fetchrow_hashref()) {
133                  # attname | format_type | attnotnull | atthasdef | attnum                  # attname | format_type | attnotnull | atthasdef | attnum
134                  push @explain, $row;                  push @cols,$row->{attname};
135    
136                    if ($row->{attnotnull}) {
137                            push @cols_notnull,$row->{attname};
138                    } else {
139                            push @cols_null,$row->{attname};
140                    }
141    
142                    if ($row->{atthasdef}) {
143                            $sth_def->execute($oid,$row->{attnum}) || die;
144                            my $row_def = $sth_def->fetchrow_hashref() || die "can't get attribute '",$row->{attname},"' default value!";
145                            $row->{default} = $row_def->{def};
146                    }
147    
148                    push @pg_attribute, $row;
149            }
150    
151            @{$self->{'explained'}->{$table}->{'pg_attribute'}} = @pg_attribute;
152            @{$self->{'explained'}->{$table}->{'cols'}} = @cols;
153            @{$self->{'explained'}->{$table}->{'cols_notnull'}} = @cols_notnull;
154            @{$self->{'explained'}->{$table}->{'cols_null'}} = @cols_null;
155    
156            # all, just for safe keeping
157            @{$self->{'explained'}->{$table}->{'cols_notpk'}} = @cols;
158    
159            # now, try to find primary key
160    
161            my @cols_pk;    # columns which are primary key
162            my @cols_notpk;
163            my %in_pk;
164    
165            $sql="
166    SELECT
167            i.indexrelid as indexrelid, i.indrelid as indrelid,
168            count(a.attname) as cols_in_pk
169    FROM
170            pg_catalog.pg_class c,
171            pg_catalog.pg_index i,
172            pg_catalog.pg_attribute a
173    WHERE
174            c.oid = i.indrelid
175            and i.indisunique
176            and c.relname = '$table'
177            and a.attrelid = i.indexrelid
178    GROUP BY
179            i.indexrelid, i.indrelid, c.relname, i.indisprimary, i.indisunique
180    ORDER BY
181            cols_in_pk ASC, i.indisprimary DESC, i.indisunique DESC, c.relname DESC
182    ";
183            print STDERR "DEBUG: $sql\n" if ($debug);
184            $sth = $self->{'dbh'}->prepare($sql);
185            $sth->execute() || die;
186            my $row = $sth->fetchrow_hashref();
187            if ($row) {
188                    $sql="
189                    select a1.attname as attname from pg_attribute a1, pg_attribute a2 where a1.attrelid = ".$row->{indexrelid}." and a2.attrelid=".$row->{indrelid}." and a1.attname = a2.attname and a2.attnotnull";
190                    
191                    my $sth2 = $self->{'dbh'}->prepare($sql);
192                    print STDERR "DEBUG: $sql\n" if ($debug);
193                    $sth2->execute() || die;
194                    while (my $row2 = $sth2->fetchrow_hashref()) {
195                            push @cols_pk,$row2->{attname};
196                            $in_pk{$row2->{attname}}++;
197                    }
198                    
199            }
200    
201            foreach my $col (@cols) {
202                    push @cols_notpk,$col if (! $in_pk{$col});
203            }
204    
205            @{$self->{'explained'}->{$table}->{cols_pk}} = @cols_pk;
206            @{$self->{'explained'}->{$table}->{cols_notpk}} = @cols_notpk;
207    
208            # find triggers
209    
210            my @triggers;
211    
212            $sql ="
213    SELECT t.tgname
214    FROM pg_catalog.pg_trigger t
215    WHERE t.tgrelid = ? and (not tgisconstraint  OR NOT EXISTS  (SELECT 1 FROM pg_catalog.pg_depend d JOIN
216     pg_catalog.pg_constraint c ON (d.refclassid = c.tableoid AND d.refobjid = c.oid)    WHERE d.classid = t.tableoid AND d.objid =
217      t.oid AND d.deptype = 'i' AND c.contype = 'f'))
218            ";
219    
220            $sth = $self->{'dbh'}->prepare($sql);
221            $sth->execute($oid) || die;
222            while(my $row = $sth->fetchrow_hashref()) {
223                    push @triggers,$row;
224            }
225    
226            @{$self->{'explained'}->{$table}->{'triggers'}} = @triggers;
227    
228            return @pg_attribute;
229    }
230    
231    # return all rows in PostgreSQL format
232    # attname | format_type | attnotnull | atthasdef | attnum
233    #
234    # somewhat internal function, but still usefull if you want to
235    # do tweaking of columns your way
236    #
237    sub pg_attribute {
238            my $self = shift;
239            my $table = shift;
240    
241            if (! $self->{'explained'}->{$table}) {
242                    $self->explain($table);
243            }
244    
245            return $self->{'explained'}->{$table}->{pg_attribute};
246    }
247    
248    # return columns in given table
249    sub cols {
250            my $self = shift;
251            my $table = shift;
252    
253            if (! $self->{'explained'}->{$table}) {
254                    $self->explain($table);
255            }
256    
257            return $self->{'explained'}->{$table}->{cols};
258    }
259    
260    # return not null columns in given table
261    sub cols_notnull {
262            my $self = shift;
263            my $table = shift;
264    
265            if (! $self->{'explained'}->{$table}) {
266                    $self->explain($table);
267            }
268    
269            return $self->{'explained'}->{$table}->{cols_notnull};
270    }
271    
272    # return columns which *can* be null in given table
273    sub cols_null {
274            my $self = shift;
275            my $table = shift;
276    
277            if (! $self->{'explained'}->{$table}) {
278                    $self->explain($table);
279            }
280    
281            return $self->{'explained'}->{$table}->{cols_null};
282    }
283    
284    # return primary key columns
285    sub cols_pk {
286            my $self = shift;
287            my $table = shift;
288    
289            if (! $self->{'explained'}->{$table}) {
290                    $self->explain($table);
291            }
292    
293            return $self->{'explained'}->{$table}->{cols_pk};
294    }
295    
296    # return columns not in primary key
297    sub cols_notpk {
298            my $self = shift;
299            my $table = shift;
300    
301            if (! $self->{'explained'}->{$table}) {
302                    $self->explain($table);
303            }
304    
305            return $self->{'explained'}->{$table}->{cols_notpk};
306    }
307    
308    # get active triggers
309    sub get_activetriggers {
310            my $self = shift;
311    
312            # find table oid
313            my $sql = "
314            SELECT tgname FROM pg_trigger
315                    WHERE tgname not like 'pg_%' and tgenabled IS TRUE
316            ";
317    
318            my $sth = $self->{'dbh'}->prepare($sql);
319            $sth->execute() || die;
320    
321            my @triggers;
322    
323            while (my ($tr) = $sth->fetchrow_array()) {
324                    push @triggers,$tr;
325          }          }
326          $sth->finish();          $sth->finish();
327    
328          return @explain;          return @triggers;
329  }  }
330    
331    # return triggers
332    sub triggers {
333            my $self = shift;
334            my $table = shift;
335    
336            if (! $self->{'explained'}->{$table}) {
337                    $self->explain($table);
338            }
339    
340            return $self->{'explained'}->{$table}->{triggers};
341    }
342    
343  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.26