/[webpac2]/trunk/sql/mkindex.pl
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 /trunk/sql/mkindex.pl

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

revision 24 by dpavlin, Sat Jul 23 15:46:24 2005 UTC revision 37 by dpavlin, Tue Aug 2 15:20:44 2005 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl -w  #!/usr/bin/perl -w
2    
3  # Helper script to produce alter tables for inherited tables and  # Helper script to produce alter tables for inherited tables and
4  # indexes from source shema  # indexes from source shema like this:
5    #
6    # ./mkindex schema.sql | psql database_name
7    
8  use strict;  use strict;
9  #use Data::Dumper;  use Data::Dumper;
10    
11  my $out;  my $out;
12    
13  my ($table, $inherit);  my ($table, $inherit);
14    
15    print "begin;\n";
16    
17  while (<>) {  while (<>) {
18          chomp;          chomp;
19    
# Line 26  while (<>) { Line 30  while (<>) {
30                  $out->{index}->{$2}->{$table} = $1;                  $out->{index}->{$2}->{$table} = $1;
31          }          }
32    
33          if (/\s*inherits\s*\(\s*(\S+)\s*\)/) {          if (/\s*inherits\s*\(\s*(\S+)\s*\)/i) {
34                  $out->{inherits}->{$table} = $1;                  $out->{inherits}->{$table} = $1;
35          }          }
36    
37            if (s/^\s*(\S+)(.+?)references\s+(\S+)\s*\((\S+)\)([^,]*)([,\s]*)$/\t$1$2$6/i) {
38    #       if (/^\s*(\S+)(.+?)references\s+(\S+)\s*\((\S+)\)/) {
39                    @{ $out->{references}->{$table}->{$1} } = ( $3, $4, $5 );
40            }
41    
42            print "$_\n";
43            print STDERR "# $_\n";
44    
45  }  }
46    
47  #print STDERR Dumper($out);  print STDERR Dumper($out);
48    
49  foreach my $table (keys %{ $out->{inherits} }) {  foreach my $table (keys %{ $out->{inherits} }) {
50          my $parent = $out->{inherits}->{$table} || die;          my $parent = $out->{inherits}->{$table} || die "$table doesn't inherit anything";
51          my $pk = $out->{table_pk}->{$parent} || die;          my $pk = $out->{table_pk}->{$parent} || die "$parent doesn't have primary key";
52          my $seq = $parent . '_' . $pk . '_seq';          my $seq = $parent . '_' . $pk . '_seq';
53          print qq{alter table $table alter column $pk set default nextval('$seq');\n};          print qq{alter table $table alter column $pk set default nextval('$seq');\n};
54  }  }
# Line 49  foreach my $type (keys %{ $out->{index} Line 61  foreach my $type (keys %{ $out->{index}
61          }          }
62  }  }
63    
64            foreach my $table (keys %{ $out->{references} }) {
65            foreach my $field (keys %{ $out->{references}->{$table} }) {
66                    my $fk = $out->{references}->{$table}->{$field} || die;
67                    my $func = $table . '_' . $field . '_fkey';
68                    print qq{
69    create or replace function $func() returns TRIGGER AS
70    \$\$
71    DECLARE
72    BEGIN
73    IF NEW.$field IN (select $fk->[1] from $fk->[0]) THEN
74            RETURN NEW;
75    ELSE
76            RAISE EXCEPTION 'insert or update on table "%" violates foreign key constraint for "$table" table', TG_RELNAME;
77    END IF;
78    END;
79    \$\$ language 'plpgsql';
80    CREATE TRIGGER $func BEFORE INSERT ON $table FOR EACH ROW EXECUTE PROCEDURE $func();
81    };
82            }
83    }
84    
85    print "commit;\n";
Legend:
Removed from v.24  
changed lines
  Added in v.37
  ViewVC Help
Powered by ViewVC 1.1.26