trunk/sql/mkindex.pl

#!/usr/bin/perl -w

# Helper script to produce alter tables for inherited tables and
# indexes from source shema like this:
#
# ./mkindex schema.sql | psql database_name

use strict;
use Data::Dumper;

my $out;

my ($table, $inherit);

print "begin;\n";

while (<>) {
        chomp;

        if (/create\s+table\s+(\S+)/i) {
                $table = $1;
        }

        next unless ($table);

        if (/primary\s+key\s*\(\s*(\S+)\s*\)/i ) {
                $out->{table_pk}->{$table} = $1;
        }
        if (/^\s*(\S+)\s*.+?--\s*((?:unique\s+)*index)/i) {
                $out->{index}->{$2}->{$table} = $1;
        }

        if (/\s*inherits\s*\(\s*(\S+)\s*\)/i) {
                $out->{inherits}->{$table} = $1;
        }

        if (s/^\s*(\S+)(.+?)references\s+(\S+)\s*\((\S+)\)([^,]*)([,\s]*)$/\t$1$2$6/i) {
#       if (/^\s*(\S+)(.+?)references\s+(\S+)\s*\((\S+)\)/) {
                @{ $out->{references}->{$table}->{$1} } = ( $3, $4, $5 );
        }

        print "$_\n";
        print STDERR "# $_\n";

}

print STDERR Dumper($out);

foreach my $table (keys %{ $out->{inherits} }) {
        my $parent = $out->{inherits}->{$table} || die "$table doesn't inherit anything";
        my $pk = $out->{table_pk}->{$parent} || die "$parent doesn't have primary key";
        my $seq = $parent . '_' . $pk . '_seq';
        print qq{alter table $table alter column $pk set default nextval('$seq');\n};
}

foreach my $type (keys %{ $out->{index} }) {
        foreach my $table (keys %{ $out->{index}->{$type} }) {
                my $f = $out->{index}->{$type}->{$table} || die;
                my $i = $table . '_' . $f . '_ind';
                print qq{create $type $i on $table($f);\n};
        }
}

foreach my $table (keys %{ $out->{references} }) {
        foreach my $field (keys %{ $out->{references}->{$table} }) {
                my $fk = $out->{references}->{$table}->{$field} || die;
                my $func = $table . '_' . $field . '_fkey';
                print qq{
create or replace function $func() returns TRIGGER AS
\$\$
DECLARE
BEGIN
IF NEW.$field IN (select $fk->[1] from $fk->[0]) THEN
        RETURN NEW;
ELSE
        RAISE EXCEPTION 'insert or update on table "%" violates foreign key constraint for "$table" table', TG_RELNAME;
END IF;
END;
\$\$ language 'plpgsql';
CREATE TRIGGER $func BEFORE INSERT ON $table FOR EACH ROW EXECUTE PROCEDURE $func();
};
        }
}

print "commit;\n";
1	dpavlin	24	#!/usr/bin/perl -w
2
3			# Helper script to produce alter tables for inherited tables and
4	dpavlin	25	# indexes from source shema like this:
5			#
6			# ./mkindex schema.sql \| psql database_name
7	dpavlin	24
8			use strict;
9	dpavlin	25	use Data::Dumper;
10	dpavlin	24
11			my $out;
12
13			my ($table, $inherit);
14
15	dpavlin	25	print "begin;\n";
16
17	dpavlin	24	while (<>) {
18			chomp;
19
20			if (/create\s+table\s+(\S+)/i) {
21			$table = $1;
22			}
23
24			next unless ($table);
25
26			if (/primary\s+key\s\(\s(\S+)\s*\)/i ) {
27			$out->{table_pk}->{$table} = $1;
28			}
29			if (/^\s(\S+)\s.+?--\s((?:unique\s+)index)/i) {
30			$out->{index}->{$2}->{$table} = $1;
31			}
32
33	dpavlin	34	if (/\sinherits\s\(\s(\S+)\s\)/i) {
34	dpavlin	24	$out->{inherits}->{$table} = $1;
35			}
36
37	dpavlin	37	if (s/^\s(\S+)(.+?)references\s+(\S+)\s\((\S+)\)([^,])([,\s])$/\t$1$2$6/i) {
38	dpavlin	34	# if (/^\s(\S+)(.+?)references\s+(\S+)\s\((\S+)\)/) {
39	dpavlin	37	@{ $out->{references}->{$table}->{$1} } = ( $3, $4, $5 );
40	dpavlin	25	}
41
42			print "$_\n";
43			print STDERR "# $_\n";
44
45	dpavlin	24	}
46
47	dpavlin	25	print STDERR Dumper($out);
48	dpavlin	24
49			foreach my $table (keys %{ $out->{inherits} }) {
50	dpavlin	37	my $parent = $out->{inherits}->{$table} \|\| die "$table doesn't inherit anything";
51			my $pk = $out->{table_pk}->{$parent} \|\| die "$parent doesn't have primary key";
52	dpavlin	24	my $seq = $parent . '_' . $pk . '_seq';
53			print qq{alter table $table alter column $pk set default nextval('$seq');\n};
54			}
55
56			foreach my $type (keys %{ $out->{index} }) {
57			foreach my $table (keys %{ $out->{index}->{$type} }) {
58			my $f = $out->{index}->{$type}->{$table} \|\| die;
59			my $i = $table . '_' . $f . '_ind';
60			print qq{create $type $i on $table($f);\n};
61			}
62			}
63
64	dpavlin	25	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	dpavlin	34	CREATE TRIGGER $func BEFORE INSERT ON $table FOR EACH ROW EXECUTE PROCEDURE $func();
81	dpavlin	25	};
82			}
83			}
84
85			print "commit;\n";