Hi Jeff,
I have a program listed below that shows what I think
is a bug.
you can call the script with these parameters:
-G user_name -D database -r
uncomment the line that is a "select user_name()" and
you will get this error:
The following actions have been performed:
DBD::ODBC::db do failed: [Microsoft][ODBC SQL Server
Driver]Connection is busy with results for another
hstmt (SQL-S1000)(DBD: st_execute/SQLExecute err=-1)
at t line 68.
DBD::ODBC::db do failed: [Microsoft][ODBC SQL Server
Driver]Connection is busy with results for another
hstmt (SQL-S1000)(DBD: st_execute/SQLExecute err=-1)
at t line 68.
----------------
use DBI;
my $h = { RaiseError =>1, PrintError => 1 } ;
my $dbistr = "DBI:ODBC:HOMER";
$dbistr .= ";TargetUser=$user;TargetAuth=$password" if
defined $user or defined $password;
my $hDB = DBI->connect( $dbistr, undef, undef, $h )
or die $DBI::errstr;
my $hDB2 = DBI->connect( $dbistr, undef, undef, $h )
or die $DBI::errstr;
# ERROR below at DO if this is uncommented
($user) = $hDB2->selectrow_array( "select user_name()"
);
$hDB2->disconnect;
# check database name is a legit database
my $dbname = $opt_D || $ENV{DBPASSWORD};
eval { local $hDB->{PrintError} = 0; $hDB->do( "use
$dbname" ); };
die "Unable to find database '$dbname'\n" if( $@ );
# check grantee is a legit user
die "Error: User '$opt_G' does not exist in database
'$opt_D'" unless
$hDB->selectrow_array( "select 1 from sysusers where
name = '$opt_G'" );
my $sth = $hDB->prepare( <<SQL );
select o.name
from sysobjects o, sysusers u
where o.type = 'U'
and u.uid = o.uid
and u.name = ?
SQL
$sth->execute( $user );
my $c=0;
while( my $aref = $sth->fetchrow_arrayref ) {
my @params;
print "The following actions have been performed:\n"
unless $c++;
perms( 'select', $aref->[0], $opt_G )
if defined $opt_s || defined $opt_w || defined
$opt_r;
perms( 'update', $aref->[0], $opt_G )
if defined $opt_u || defined $opt_w;
perms( 'delete', $aref->[0], $opt_G )
if defined $opt_d || defined $opt_w;
perms( 'insert', $aref->[0], $opt_G )
if defined $opt_i || defined $opt_w;
} # end while
sub perms( $ $ $ ) {
my $perm = shift;
my $object = shift;
my $grantee = shift;
# ERROR here if code above is uncommented
$hDB->do( "grant $perm on $object to $grantee" );
print "grant $perm on $object to $grantee\n";
} # end sub
1; # Ancient Druid Custom
__________________________________________________
Do You Yahoo!?
Listen to your Yahoo! Mail messages from any phone.
http://phone.yahoo.com
