File: create-sql-drop-file.pl

package info (click to toggle)
dotlrn 2.5.0+dfsg-6+wheezy4
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 108,272 kB
  • sloc: tcl: 219,601; sql: 202,152; xml: 127,658; java: 7,268; php: 4,780; sh: 2,486; perl: 1,207; makefile: 137
file content (72 lines) | stat: -rw-r--r-- 1,838 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
#!/usr/local/bin/perl -w

# @author: Jim Guggemoos		created it
# @author: Christian Brechbuehler	some maintenance

# From a -create.sql script, construct the matching -drop.sql script.
#
# Does not follow @ or @@; rather there should be a -drop for every -create,
# like, e.g., in /packags/acs-kernel/sql.


if ( @ARGV != 1 ) {
    die "usage: $0 x-create.sql [ > x-drop.sql ]\n"
}

open( INFILE, "$ARGV[0]" ) or die "could not open $ARGV[0] for read\n";

$commit = 0;

while ( <INFILE> )
{
    chop( $_ );
    $_ =~ s/--.*$//;
    $_ =~ s/\s+or\s+replace//i;
    $_ =~ s/replace\s+or\s+//i;
    $_ =~ s/^\s+$//;

    if ( $_ =~ /^create\s+([^\s]+\s+[^\s\(;]+)/ ) {
	$x = $1;
	$x =~ s/\s+$//;
	push( @obj_list, "$x" );
    } elsif ( $_ =~ /begin\s+create_group_type_fields\(\s*('[^']+'),/i ) {
        $group = $1;
	push( @obj_list, "GTF:$group" );
    } elsif ( $_ =~ /commit\s*;/i ) {
        $commit = 1;
    } elsif ( $_ =~ /alter\s+table\s+([^\s]+)\s+add\s+constraint\s+([^\s]+)/i ) {
    	push( @obj_list, "CONS:$1:$2" );
    } elsif ( $_ =~ /(@@?)\s*(\S+)-create(\.sql)?/i ) {
        push( @obj_list, "$1 $2")
    }
}

close( INFILE );

$tailname = $ARGV[0];
if ( $tailname =~ /\/([^\/]+$)/ ) {
    $tailname = $1;
}

$t = localtime(time());
print "-- Uninstall file for the data model created by '$tailname'\n";
print "-- (This file created automatically by create-sql-uninst.pl.)\n";
$uname=$ENV{"USER"};
print "--\n-- $uname ($t)\n--\n-- \$Id\$\n--\n\n";

foreach $x (reverse( @obj_list )) {
    if ( $x =~ /^GTF:(.+)$/ ) {
	print "BEGIN remove_group_type_fields( $1 );\nEND;\n/\n";
    } elsif ( $x =~ /^CONS:([^:]+):(.*)/ ) {
    	print "alter table $1 drop constraint $2;\n";
    } elsif ( $x =~ /^@/) {
        print "$x-drop\n";
    }
      else {
	print "drop $x;\n";
    }
}

if ( $commit ) {
    print "\nCOMMIT;\n";
}