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]