This script is fantastic, but should not be better that SPs and Triggers
support them?

Jacqui Caren escribio':

>Jonathan Neve wrote:
>
>
>>xyvy wrote:
>>
>>
>>
>>
>>>It can be used domains in SP Parameters ?
>>>
>>>Thanks in advance.
>>>
>>>
>>>
>>>
>>Alas, no! :-(
>>
>>
>
>Unless you use a wrapper :-)
>
>I got sick of having to tweak a heap of SP's and triggers
>every time someone modifies the schema to change a domain of field.
>
>I created the attached script which is I freely admit rather nasty
>but does exactly what I want. If you want different, then modify and
>redistribute as you feel fit :-)
>
>The other purpose of this script is to drop and re-create dependant
>objects. OK any errors and I have to manually recreate but that is
>no problem as a use a wrapper to see what is missing and
>do a -load (andother noddy perl script)
>
>I use it as below (first expansion uses table.field type second
>looks up domain type.
>
>create procedure IGP_EBS_DROP_LIST (
> LID MY_TABLE_NAME.FIELD_NAME%TYPE
>/* or LID LIST_ID_DOM%TYPE */
>)
>as
>declare variable lfid integer;
>begin
> /* TODO include list archive functionality here */
> delete from igs_ebs_list_field where list_id = :lid;
> delete from igs_ebs_list where list_id = :lid;
> exit;
>end
>
>HTH,
> Jacqui
>
> ----------
>
>#!perl -w
>#
># vim: sw=2
>#
>use strict;
>
>use Getopt::Long;
>my $action = 'reload';
>my $dbfile = '../demo-ebs.fdb';
>my $dbuser = 'jacqui';
>my $dbpass = '';
>my @sproc = ();
>my @trigger = ();
>my @generator = ();
>my $result = GetOptions (
> '-load' => sub { $action = 'load'},
> '-drop' => sub { $action = 'drop'},
> '-reload'=> sub { $action = 'reload'},
> "sproc=s" => \@sproc,
> "trigger=s" => \@trigger,
> "generator=s" => \@generator,
> "dbfile=s" => \$dbfile,
> "dbuser=s" => \$dbuser,
> "dbpass=s" => \$dbpass);
>
># add usage test here
>unless ($dbfile && $dbuser && $dbpass && $action) {
> die "Usage: $0 (-drop | -load | -reload) -dbfile=../demo-ebs.fdb -dbuser=jacqui -dbpass=password\n";
>}
>
>
>my $dbh = connect_to($dbfile,$dbuser,$dbpass);
>
>my $f;
>foreach my $f (@sproc) { process_sproc($f,$action); }
>foreach my $f (@trigger) { process_trigger($f,$action); }
>foreach my $f (@generator) { process_generator($f,$action); }
>
>print "Done.\n";
>
>exit;
>
>
>sub process_trigger { my ($f,$a) = @_;
> unless (-f $f) {
> $f = '../trigger/'.$f;
> die "no file $f" unless -f $f;
> }
> open(F,$f) || next;
> my $content = join('',<F>);
> close F;
> if ( (lc($a) eq 'drop')
> ||(lc($a) eq 'reload')) {
> my $sql = $content;
> $sql =~ s/^\s*create\s/drop /i;
> $sql =~ s/\sfor\s.*//si;
> print "drop $f\n";
> $dbh->do($sql);
> $dbh->commit();
> }
> if ( (lc($a) eq 'load')
> ||(lc($a) eq 'reload')) {
> my $sql= $content;
> $sql =~ s/(\s)(\w+)\.(\w+)%TYPE/$1.&expand_table_field_type($dbh,$2,$3)/gei;
> $sql =~ s/(\s)([A-Z0-9_]+)%TYPE/$1.&expand_domain_type($dbh,$2)/gei;
> print "load $f\n";
> $dbh->do($sql);
> $dbh->commit();
> }
> return ();
>}
>
>sub process_generator { my ($f,$a) = @_;
> unless (-f $f) {
> $f = '../generator/'.$f;
> die "no file $f" unless -f $f;
> }
> open(F,$f) || next;
> my $content = join('',<F>);
> close F;
> my @things_to_reload = ();
> if ( (lc($a) eq 'drop')
> ||(lc($a) eq 'reload')) {
> my ($name) = ($content =~ m/^\s*create\s+generator\s+(\w+)\s*/i);
> $name =~ s/(;|\s)*$//;
> @things_to_reload = find_dependents($name);
> my $sql = $content;
> $sql =~ s/^\s*create\s/drop /i;
> $sql =~ s/\;.*//s;
> print "drop $f\n";
> $dbh->do($sql);
> $dbh->commit();
> }
> if ( (lc($a) eq 'load')
> ||(lc($a) eq 'reload')) {
> my $sql= $content;
> print "load $f\n";
> $dbh->do($sql);
> $dbh->commit();
> load_dependents(@things_to_reload);
> @things_to_reload = ();
> }
> return @things_to_reload;
>}
>
>sub process_sproc { my ($f,$a) = @_;
> unless (-f $f) {
> $f = '../sproc/'.$f;
> die "no file $f" unless -f $f;
> }
> open(F,$f) || next;
> my $content = join('',<F>);
> close F;
> my $output = '';
> my @things_to_reload = ();
> if ( (lc($a) eq 'drop')
> ||(lc($a) eq 'reload')) {
>
> my ($name) = ($content =~ m/^\s*create\s+procedure\s+(\w+)\s/i);
> $name =~ s/\s+//;
> # TODO first drop dependant SP's and triggers
> # find list of dependants
>
> @things_to_reload = find_dependents($name);
>
> # drop sproc
> my $sql = $content;
> $sql =~ s/^\s*create\s/drop /i;
> $sql =~ s/\(.*//s;
> print "drop $f\n";
> $dbh->do($sql);
> $dbh->commit();
> }
>
> if ( (lc($a) eq 'load')
> ||(lc($a) eq 'reload')) {
>
> # load SP
> my $sql= $content;
> $sql =~ s/(\s)(\w+)\.(\w+)%TYPE/$1.&expand_table_field_type($dbh,$2,$3)/gei;
> $sql =~ s/(\s)([A-Z0-9_]+)%TYPE/$1.&expand_domain_type($dbh,$2)/gei;
> print "load $f\n";
> $dbh->do($sql);
> $dbh->commit();
>
> # TODO then load depenant SP/triggers
> load_dependents(@things_to_reload);
> @things_to_reload = ();
> }
> return @things_to_reload;
>}
>
>sub expand_table_field_type { my ($dbh,$table,$field) = @_;
> my $csr = $dbh->prepare(q{select
> CASE RDB$FIELD_TYPE
> WHEN 7 THEN 'SMALLINT'
> WHEN 8 THEN 'INTEGER'
> WHEN 9 THEN 'QUAD'
> WHEN 10 THEN 'FLOAT'
> WHEN 11 THEN 'D_FLOAT'
> WHEN 14 THEN 'CHAR('||RDB$CHARACTER_LENGTH||')'
> WHEN 27 THEN 'DOUBLE'
> WHEN 35 THEN 'DOUBLE'
> WHEN 37 THEN 'VARCHAR('||RDB$CHARACTER_LENGTH||')'
> ELSE ''
> END as MY_DATATYPE
>from
> RDB$RELATION_FIELDS T,
> RDB$FIELDS F
>where
> T.RDB$RELATION_NAME = ?
>and T.RDB$FIELD_NAME = ?
>and T.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME});
> $csr->execute($table,$field);
> my ($dtype) = $csr->fetchrow_array();
> $csr->finish();
> return $dtype;
>}
>sub expand_domain_type { my ($dbh,$domain) = @_;
> my $csr = $dbh->prepare(q{select
> CASE RDB$FIELD_TYPE
> WHEN 7 THEN 'SMALLINT'
> WHEN 8 THEN 'INTEGER'
> WHEN 9 THEN 'QUAD'
> WHEN 10 THEN 'FLOAT'
> WHEN 11 THEN 'D_FLOAT'
> WHEN 14 THEN 'CHAR('||RDB$CHARACTER_LENGTH||')'
> WHEN 27 THEN 'DOUBLE'
> WHEN 35 THEN 'DOUBLE'
> WHEN 37 THEN 'VARCHAR('||RDB$CHARACTER_LENGTH||')'
> ELSE ''
> END as MY_DATATYPE
>from RDB$FIELDS
>where RDB$FIELD_NAME = ?});
> $csr->execute($domain);
> my ($dtype) = $csr->fetchrow_array();
> $csr->finish();
> return $dtype;
>}
>
>
>sub connect_to { my ($dbfile,$dbuser,$dbpass) = @_;
> use DBI;
> my $dbname = 'dbi:InterBase:dbname='.$dbfile;
> my $dbh = DBI->connect($dbname,$dbuser,$dbpass);
> die "could not connect to ($dbname,$dbuser,$dbpass)".$DBI::errstr
> unless $dbh;
> $dbh->{AutoCommit} = 0; # does not work in connect
> $dbh->{RaiseError} = 0; # we should not ask PGC to catch DB errors
> $dbh->{PrintError} = 1; # but we should log them...
> $dbh->{ib_softcommit} = 1; # DBD::Interbase for FireBird
>
> return $dbh;
>}
>
>
>sub find_dependents { my ($name) = @_;
> my @rv;
> my $csr = $dbh->prepare('SELECT RDB$DEPENDENT_NAME,RDB$DEPENDENT_TYPE
> FROM RDB$DEPENDENCIES
> WHERE RDB$DEPENDED_ON_NAME = ?');
> $csr->execute(uc($name));
> my (@dep,$dep,$dtype);
> while (($dep,$dtype) = $csr->fetchrow_array()) {
> $dep =~ s/\s+$//;
> push @dep,[$dep,$dtype];
> }
> $csr->finish();
> my $d;
> while (defined($d = shift(@dep))) {
> ($dep,$dtype) = @$d;
> if ($dtype == 5) {
> push @rv,process_sproc($dep.'.sql','drop');
> push @rv,{ FUNC=>\&process_sproc, NAME=>$dep.'.sql'};
> next;
> }
> if ($dtype == 2) {
> push @rv,process_trigger($dep.'.sql','drop');
> push @rv,{ FUNC=>\&process_trigger, NAME=>$dep.'.sql'};
> next;
> }
> if ($dtype == 14) {
> push @rv,process_generator($dep.'.sql','drop');
> push @rv,{ FUNC=>\&process_generator, NAME=>$dep.'.sql'};
> next;
> }
> print "ignoring $dep ($dtype)\n";
> }
> return @rv;
>}
>
>sub load_dependents { my (@deps) = @_;
> foreach my $thing (reverse(@deps)) {
> my ($func,$name) = @$thing{qw(FUNC NAME)};
> &$func($name,'load');
> }
> return;
>}
>
>
>[Non-text portions of this message have been removed]
>
>
>
>
>
>Yahoo! Groups Links
>
>
>
>
>
>
>
>
>
>

[Non-text portions of this message have been removed]