This patch makes the perl driver segfault *much* less, I still get
segfaults with the patch, but the driver seems much more surdy.
I've included the C part as well for people who want the perl driver to
work now, but don't want to search the archive, please note that the C
part seems to have been merged long ago, so only apply it to 7.3.0.15
(or .17 or whatever it is that is released)
The new stuff is in pms.diff.
The fix is to actually do something when $sth->finish $dbh->disconnect
and misc DESTROY methods are called.
There are a couple of extra sanity checks thrown in too, that removes
the warnings about "calling EXISTS on undef" on global cleanup.
Current issues:
1) It still segfaults under heavy pathological load.
2) It still leaks memory, but that's not too bad.
3) Using Apache::DBI doesn't work at all, defining $dbh->ping makes the
driver break in strange ways (try it).
*aaaahg* I almost feel like rewriting the entire thing using only the
published ODBC interface...
diff -ur orig/V73_00_17/SAPDB_ORG/sys/src/in/SAP_DB.pm
V73_00_17/SAPDB_ORG/sys/src/in/SAP_DB.pm
--- orig/V73_00_17/SAPDB_ORG/sys/src/in/SAP_DB.pm Mon Sep 10 15:07:05 2001
+++ V73_00_17/SAPDB_ORG/sys/src/in/SAP_DB.pm Wed Oct 24 20:28:00 2001
@@ -1,4 +1,4 @@
-# SAP_DB.pm
+# SAP_DB.pm
#
# Copyright (c) 2000-2001, SAP AG
#
@@ -118,6 +118,7 @@
DBD::SAP_DB::parseError ($dbh, $@);
return undef;
}
+ print STDERR "Connected $dbh \n";
return $dbh;
}
@@ -131,7 +132,11 @@
sub disconnect {
my($dbh)= @_;
- $dbh->FETCH ('sapdb_session')->release ();
+ my $sess = $dbh->FETCH ('sapdb_session');
+ if (defined $sess) {
+ print STDERR "Disconnecting $dbh\n";
+ $sess->release ();
+ }
}
sub commit {
@@ -197,9 +202,7 @@
#
# store attributes
#
- my $completelyUnnecessaryLocalVariable = @{$pinfos};
- #CAAL: how do I pass the length of @{$pinfos} in one expression?
- $sth->STORE ('NUM_OF_PARAMS', $completelyUnnecessaryLocalVariable);
+ $sth->STORE ('NUM_OF_PARAMS', scalar(@{$pinfos}));
$sth->STORE ('sapdb_inmap', \@inMap);
$sth->STORE ('sapdb_outmap', \@outMap);
$sth->STORE ('sapdb_inparameters', []);
@@ -260,7 +263,11 @@
return $dbh->DBD::_::db::STORE($attrib, $value);
}
- sub DESTROY { undef }
+ sub DESTROY {
+ my ($dbh) = @_;
+ print STDERR "Destroying $dbh \n";
+ $dbh->disconnect;
+ }
}
@@ -271,6 +278,10 @@
my ($sth, @args) = @_;
my ($result, $parameters);
+ unless (defined $sth->FETCH ('sapdb_prepared')) {
+ die "Tried to execute a finish()ed sth";
+ }
+
$result = '0E0';
eval {
if (@args == 0) {
@@ -466,6 +477,7 @@
sub finish {
my($sth) = @_;
+ $sth->STORE ('sapdb_cursor', undef);
}
sub FETCH {
@@ -511,7 +523,10 @@
return $sth->DBD::_::st::STORE($attrib, $value);
}
- sub DESTROY { undef }
+ sub DESTROY {
+ my ($sth) = @_;
+ $sth->STORE ('sapdb_prepared', undef);
+ }
}
1;
diff -ur orig/V73_00_17/SAPDB_ORG/sys/src/in/sapdb.pm
V73_00_17/SAPDB_ORG/sys/src/in/sapdb.pm
--- orig/V73_00_17/SAPDB_ORG/sys/src/in/sapdb.pm Mon Sep 10 15:07:06 2001
+++ V73_00_17/SAPDB_ORG/sys/src/in/sapdb.pm Wed Oct 24 19:17:42 2001
@@ -26,7 +26,6 @@
package SAP::DBTech::sapdb;
my %OWNER = ();
-my %ITERATORS = ();
### class SapDB_LongReader ###
@@ -49,31 +48,20 @@
sub DESTROY {
my $self;
eval {$self = tied(%{$_[0]});};
- if ($@) {
+ if ($@ || !defined $self) {
undef $@;
return;
}
- delete $ITERATORS{$self};
- SAP::DBTech::sapdbc::SapDB_LongReader_destructor ($self);
+ if (exists $OWNER{$self}) {
+ SAP::DBTech::sapdbc::SapDB_LongReader_destructor ($self);
+ delete $OWNER{$self};
+ }
}
sub read {
return SAP::DBTech::sapdbc::SapDB_LongReader_read(@_);
}
-
-sub DISOWN {
- my $self = shift;
- my $ptr = tied(%$self);
- delete $OWNER{$ptr};
- };
-
-sub ACQUIRE {
- my $self = shift;
- my $ptr = tied(%$self);
- $OWNER{$ptr} = 1;
- };
-
### end of class SapDB_LongReader ###
package sapdb;
@@ -98,12 +86,14 @@
sub DESTROY {
my $self;
eval {$self = tied(%{$_[0]});};
- if ($@) {
+ if ($@ || !defined $self) {
undef $@;
return;
}
- delete $ITERATORS{$self};
- SAP::DBTech::sapdbc::SapDB_ResultSet_destructor ($self);
+ if (exists $OWNER{$self}) {
+ SAP::DBTech::sapdbc::SapDB_ResultSet_destructor ($self);
+ delete $OWNER{$self};
+ }
}
@@ -150,19 +140,6 @@
sub getDescription {
return SAP::DBTech::sapdbc::SapDB_ResultSet_getDescription(@_);
}
-
-sub DISOWN {
- my $self = shift;
- my $ptr = tied(%$self);
- delete $OWNER{$ptr};
- };
-
-sub ACQUIRE {
- my $self = shift;
- my $ptr = tied(%$self);
- $OWNER{$ptr} = 1;
- };
-
### end of class SapDB_ResultSet ###
package sapdb;
@@ -187,12 +164,14 @@
sub DESTROY {
my $self;
eval {$self = tied(%{$_[0]});};
- if ($@) {
+ if ($@ || !defined $self) {
undef $@;
return;
}
- delete $ITERATORS{$self};
- SAP::DBTech::sapdbc::SapDB_Prepared_destructor ($self);
+ if (exists $OWNER{$self}) {
+ SAP::DBTech::sapdbc::SapDB_Prepared_destructor ($self);
+ delete $OWNER{$self};
+ }
}
@@ -203,19 +182,6 @@
sub getDescription {
return SAP::DBTech::sapdbc::SapDB_Prepared_getDescription(@_);
}
-
-sub DISOWN {
- my $self = shift;
- my $ptr = tied(%$self);
- delete $OWNER{$ptr};
- };
-
-sub ACQUIRE {
- my $self = shift;
- my $ptr = tied(%$self);
- $OWNER{$ptr} = 1;
- };
-
### end of class SapDB_Prepared ###
package sapdb;
@@ -240,12 +206,14 @@
sub DESTROY {
my $self;
eval {$self = tied(%{$_[0]});};
- if ($@) {
+ if ($@ || !defined $self) {
undef $@;
return;
}
- delete $ITERATORS{$self};
- SAP::DBTech::sapdbc::SapDB_Session_destructor ($self);
+ if (exists $OWNER{$self}) {
+ SAP::DBTech::sapdbc::SapDB_Session_destructor ($self);
+ delete $OWNER{$self};
+ }
}
@@ -262,7 +230,7 @@
my $self = SAP::DBTech::sapdbc::SapDB_Session_prepare(@_);
return undef if (!defined($self));
bless $self, $clazzName;
- $SapDB_Prepared::OWNER{$self} = 1;
+ $OWNER{$self} = 1;
my %retval;
tie %retval, $clazzName, $self;
return bless \%retval, $clazzName;
@@ -312,19 +280,6 @@
sub maxbuf {
return SAP::DBTech::sapdbc::SapDB_Session_maxbuf(@_);
}
-
-sub DISOWN {
- my $self = shift;
- my $ptr = tied(%$self);
- delete $OWNER{$ptr};
- };
-
-sub ACQUIRE {
- my $self = shift;
- my $ptr = tied(%$self);
- $OWNER{$ptr} = 1;
- };
-
### end of class SapDB_Session ###
package sapdb;
@@ -334,7 +289,7 @@
my $self = SAP::DBTech::sapdbc::sapdb_connect(@_);
return undef if (!defined($self));
bless $self, $clazzName;
- $SapDB_Session::OWNER{$self} = 1;
+ $OWNER{$self} = 1;
my %retval;
tie %retval, $clazzName, $self;
return bless \%retval, $clazzName;
@@ -346,7 +301,7 @@
my $self = SAP::DBTech::sapdbc::sapdb_utilitySession(@_);
return undef if (!defined($self));
bless $self, $clazzName;
- $SapDB_Session::OWNER{$self} = 1;
+ $OWNER{$self} = 1;
my %retval;
tie %retval, $clazzName, $self;
return bless \%retval, $clazzName;
@@ -362,7 +317,7 @@
my $self = SAP::DBTech::sapdbc::sapdb_createCursorZombie(@_);
return undef if (!defined($self));
bless $self, $clazzName;
- $SapDB_ResultSet::OWNER{$self} = 1;
+ $OWNER{$self} = 1;
my %retval;
tie %retval, $clazzName, $self;
return bless \%retval, $clazzName;
@@ -374,7 +329,7 @@
my $self = SAP::DBTech::sapdbc::sapdb_createReaderZombie(@_);
return undef if (!defined($self));
bless $self, $clazzName;
- $SapDB_LongReader::OWNER{$self} = 1;
+ $OWNER{$self} = 1;
my %retval;
tie %retval, $clazzName, $self;
return bless \%retval, $clazzName;
@@ -384,3 +339,15 @@
# End of module
1;
Only in V73_00_17/SAPDB_DEV: sys
Only in V73_00_17/SAPDB_DEV: tmp
Only in V73_00_17/SAPDB_DEV: usr
diff -ru orig/V73_00_17/SAPDB_ORG/sys/src/in/vin76.c
V73_00_17/SAPDB_ORG/sys/src/in/vin76.c
--- orig/V73_00_17/SAPDB_ORG/sys/src/in/vin76.c Mon Sep 10 15:07:09 2001
+++ V73_00_17/SAPDB_ORG/sys/src/in/vin76.c Mon Sep 24 19:28:27 2001
@@ -36,32 +36,47 @@
#define bool char
#define HAS_BOOL 1
#endif
+
#include "EXTERN.h"/* no check */
#include "perl.h"/* no check */
+
#if defined (PERL_OBJECT)
#include "perlCAPI.h"/* no check */
#endif
+
#include "XSUB.h"/* no check */
#undef free
#undef malloc
#undef realloc
#include <string.h>
+
+// What the hell are you smoking?
#if defined (bool)
#undef bool
+#endif
+
+/* No, this fails when the
+
#if !defined (PL_sv_undef)
#define PL_sv_undef sv_undef
#endif
+
#if !defined (PL_sv_yes)
#define PL_sv_yes sv_yes
#endif
+
#if !defined (PL_errgv)
#define PL_errgv errgv
#endif
-#endif
+
+*/
+
#ifdef __cplusplus
}
#endif
+
+
#if defined (_WIN32)
#define GLUEEXPORT __declspec(dllexport)
#else
@@ -80,6 +95,15 @@
#define PERL_GLUE 1
+
+#define SL_None &PL_sv_undef
+/* #define SL_isNone(val) (val == SL_None) */
+/* #define SL_isNone(val) (SvTYPE (val) == SVt_NULL) */
+#define SL_isNone(val) (!SvOK (val))
+#define SL_isTrue(val) SvTRUE (val)
+
+
+
static const char * invalidArgCount_C = "Invalid number of arguments";
static void *
@@ -114,7 +138,8 @@
tmp = SvIV((SV*)SvRV(sv));
}
}
- else if (sv == &PL_sv_undef) { /* Check for undef */
+/* else if (sv == &PL_sv_undef) { /* Check for undef */
+ else if (SL_isNone(sv)) { /* Check for undef, the correct way */
strcpy (croakBuf, "Undef object not allowed");
return NULL;
}
@@ -791,11 +816,6 @@
}
}
-#define SL_None &PL_sv_undef
-/* #define SL_isNone(val) (val == SL_None) */
-/* #define SL_isNone(val) (SvTYPE (val) == SVt_NULL) */
-#define SL_isNone(val) SvOK (val)
-#define SL_isTrue(val) SvTRUE (val)
static bool
SL_isString (
Only in V73_00_17/SAPDB_ORG/sys/src/in: vin76.c~
Only in V73_00_17/: initDev_SAPDB
