richter 01/05/16 07:05:01
Modified: . Tag: Embperl2c Embperl.pm Embperl.xs ep.h epcomp.c
eputil.c test.pl
Embperl/Syntax Tag: Embperl2c RTF.pm
test/cmp Tag: Embperl2c rtfbasic.asc
test/html/rtf Tag: Embperl2c rtfbasic.asc
Log:
catch errors in cleanup
Revision Changes Path
No revision
No revision
1.118.4.40 +8 -3 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.39
retrieving revision 1.118.4.40
diff -u -r1.118.4.39 -r1.118.4.40
--- Embperl.pm 2001/05/16 06:45:19 1.118.4.39
+++ Embperl.pm 2001/05/16 14:04:23 1.118.4.40
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Embperl.pm,v 1.118.4.39 2001/05/16 06:45:19 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.40 2001/05/16 14:04:23 richter Exp $
#
###################################################################################
@@ -1030,7 +1030,7 @@
$req_rec -> register_cleanup(\&HTML::Embperl::cleanup) if (defined
($req_rec)) ;
}
push @cleanups, $package ;
-
+
cleanup () if (!$r -> SubReq () && !$req_rec) ;
}
else
@@ -1311,8 +1311,13 @@
$Debugflags = dbgShowCleanup if ($package eq 'dbgShowCleanup') ;
next if ($seen{$package}) ;
+ if ($Debugflags & dbgShowCleanup)
+ {
+ print LOG "[$$]CUP: ***** Cleanup package: $package *****\n" ;
+ }
$seen{$package} = 1 ;
- ClearSymtab ($package) ;
+ eval { ClearSymtab ($package, $Debugflags) ; } ;
+ print LOG "[$$]CUP: Error: $@\n" if ($@) ;
}
}
else
1.29.4.17 +3 -2 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.29.4.16
retrieving revision 1.29.4.17
diff -u -r1.29.4.16 -r1.29.4.17
--- Embperl.xs 2001/05/15 14:19:23 1.29.4.16
+++ Embperl.xs 2001/05/16 14:04:25 1.29.4.17
@@ -342,10 +342,11 @@
#ifdef EP2
void
-embperl_ClearSymtab(sPackage)
+embperl_ClearSymtab(sPackage,bDebug)
char * sPackage
+ int bDebug
CODE:
- ClearSymtab (pCurrReq, sPackage) ;
+ ClearSymtab (pCurrReq, sPackage, bDebug) ;
#endif
1.27.4.15 +5 -1 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.27.4.14
retrieving revision 1.27.4.15
diff -u -r1.27.4.14 -r1.27.4.15
--- ep.h 2001/05/11 07:13:47 1.27.4.14
+++ ep.h 2001/05/16 14:04:26 1.27.4.15
@@ -454,6 +454,9 @@
#ifndef WIN32
#define strnicmp strncasecmp
#define stricmp strcasecmp
+#else
+#define strnicmp _strnicmp
+#define stricmp _stricmp
#endif
void Dirname (/*in*/ const char * filename,
@@ -472,7 +475,8 @@
void ClearSymtab (/*i/o*/ register req * r,
- /*in*/ const char * sPackage) ;
+ /*in*/ const char * sPackage,
+ /*in*/ int bDebug) ;
void UndefSub (/*i/o*/ register req * r,
/*in*/ const char * sName,
1.4.2.53 +2 -2 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.52
retrieving revision 1.4.2.53
diff -u -r1.4.2.52 -r1.4.2.53
--- epcomp.c 2001/05/15 14:19:43 1.4.2.52
+++ epcomp.c 2001/05/16 14:04:28 1.4.2.53
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epcomp.c,v 1.4.2.52 2001/05/15 14:19:43 richter Exp $
+# $Id: epcomp.c,v 1.4.2.53 2001/05/16 14:04:28 richter Exp $
#
###################################################################################*/
@@ -305,7 +305,7 @@
{
or = strchr (eq + 1, '|') ;
e = or?or:q ;
- if (strncasecmp (sText, eq, e - eq) == 0)
+ if (strnicmp (sText, eq, e - eq) == 0)
break ;
if (or == NULL)
return 0 ;
1.15.4.11 +57 -8 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.15.4.10
retrieving revision 1.15.4.11
diff -u -r1.15.4.10 -r1.15.4.11
--- eputil.c 2001/05/15 14:20:09 1.15.4.10
+++ eputil.c 2001/05/16 14:04:30 1.15.4.11
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: eputil.c,v 1.15.4.10 2001/05/15 14:20:09 richter Exp $
+# $Id: eputil.c,v 1.15.4.11 2001/05/16 14:04:30 richter Exp $
#
###################################################################################*/
@@ -880,14 +880,15 @@
void ClearSymtab (/*i/o*/ register req * r,
- /*in*/ const char * sPackage)
+ /*in*/ const char * sPackage,
+ /*in*/ int bDebug)
{
dTHXsem
SV * val;
char * key;
I32 klen;
- int bDebug = 0 ;
+
SV * sv;
HV * hv;
AV * av;
@@ -901,6 +902,7 @@
HV * pCleanupHV ;
char * s ;
GV * pFileGV ;
+ char * sObjName ;
/*
GV * symtabgv ;
GV * symtabfilegv ;
@@ -1006,20 +1008,67 @@
*/
}
+ sObjName = NULL ;
- if((sv = GvSV((GV*)val)) && SvOK (sv))
+ lprintf (r, "[%d]CUP: type = %d flags=%x\n", r -> nPid, SvTYPE
(GvSV((GV*)val)), SvFLAGS (GvSV((GV*)val))) ;
+ if((sv = GvSV((GV*)val)) && SvTYPE (sv) == SVt_PVMG)
+ {
+ HV * pStash = SvSTASH (sv) ;
+
+ if (pStash)
+ {
+ sObjName = HvNAME(pStash) ;
+ if (sObjName && strcmp (sObjName, "DBIx::Recordset") == 0)
+ {
+ SV * pSV = newSVpvf ("DBIx::Recordset::Undef ('%s')", s) ;
+
+ if (bDebug)
+ lprintf (r, "[%d]CUP: Recordset *%s\n", r -> nPid, s) ;
+ EvalDirect (r, pSV, 0, NULL) ;
+ SvREFCNT_dec (pSV) ;
+ }
+ }
+ }
+
+ if((sv = GvSV((GV*)val)) && SvROK (sv) && SvOBJECT (SvRV(sv)))
{
+ HV * pStash = SvSTASH (SvRV(sv)) ;
+ lprintf (r, "[%d]CUP: rv type = %d\n", r -> nPid, SvTYPE
(SvRV(GvSV((GV*)val)))) ;
+ if (pStash)
+ {
+ sObjName = HvNAME(pStash) ;
+ if (sObjName && strcmp (sObjName, "DBIx::Recordset") == 0)
+ {
+ SV * pSV = newSVpvf ("DBIx::Recordset::Undef ('%s')", s) ;
+
+ if (bDebug)
+ lprintf (r, "[%d]CUP: Recordset *%s\n", r -> nPid, s) ;
+ EvalDirect (r, pSV, 0, NULL) ;
+ SvREFCNT_dec (pSV) ;
+ }
+ }
+ }
+ if((sv = GvSV((GV*)val)) && (SvOK (sv) || SvROK (sv)))
+ {
if (bDebug)
- lprintf (r, "[%d]CUP: $%s = %s\n", r -> nPid, s, SvPV (sv, l)) ;
+ lprintf (r, "[%d]CUP: $%s = %s %s%s\n", r -> nPid, s, SvPV (sv, l),
sObjName?" Object of ":"", sObjName?sObjName:"") ;
- sv_unmagic (sv, 'q') ; /* untie */
- sv_setsv(sv, &sv_undef);
+ if ((sv = GvSV((GV*)val)) && SvREADONLY (sv))
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: Ignore %s because it's readonly\n", r ->
nPid, s) ;
+ }
+ else
+ {
+ sv_unmagic (sv, 'q') ; /* untie */
+ sv_setsv(sv, &sv_undef);
+ }
}
if((hv = GvHV((GV*)val)))
{
if (bDebug)
lprintf (r, "[%d]CUP: %%%s = ...\n", r -> nPid, s) ;
- sv_unmagic ((SV *)hv, 'P') ; /* untie */
+ sv_unmagic ((SV *)hv, 'P') ; /* untie */
hv_clear(hv);
}
if((av = GvAV((GV*)val)))
1.70.4.59 +2 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.58
retrieving revision 1.70.4.59
diff -u -r1.70.4.58 -r1.70.4.59
--- test.pl 2001/05/15 14:20:12 1.70.4.58
+++ test.pl 2001/05/16 14:04:32 1.70.4.59
@@ -11,7 +11,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: test.pl,v 1.70.4.58 2001/05/15 14:20:12 richter Exp $
+# $Id: test.pl,v 1.70.4.59 2001/05/16 14:04:32 richter Exp $
#
###################################################################################
@@ -590,7 +590,7 @@
'version' => 2,
'syntax' => 'RTF',
'offline' => 1,
- 'param' => { one => 1, hash => { a => 111, b => 222, c =>
[1111,2222,3333,4444]}, array => [11,22,33] },
+ 'param' => { one => 1, hash => { a => 111, b => 222, c =>
[1111,2222,3333,4444]}, array => [11,22,33], uml => '���', brace => 'open { close }
end' },
},
'rtf/rtffull.asc' => {
'version' => 2,
No revision
No revision
1.1.2.10 +6 -6 embperl/Embperl/Syntax/Attic/RTF.pm
Index: RTF.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/RTF.pm,v
retrieving revision 1.1.2.9
retrieving revision 1.1.2.10
diff -u -r1.1.2.9 -r1.1.2.10
--- RTF.pm 2001/05/09 11:11:41 1.1.2.9
+++ RTF.pm 2001/05/16 14:04:44 1.1.2.10
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: RTF.pm,v 1.1.2.9 2001/05/09 11:11:41 richter Exp $
+# $Id: RTF.pm,v 1.1.2.10 2001/05/16 14:04:44 richter Exp $
#
###################################################################################
@@ -154,12 +154,12 @@
{
my ($self) = @_ ;
- $self -> AddInitCode (undef, '$_ep_rtf_ndx=0;', undef) ;
+ $self -> AddInitCode (undef, '$_ep_rtf_ndx=0;$escmode=0;sub esc { my $x = shift
; $x =~ s/([{}])/\\\\$1/g ; $x} ; ', undef) ;
$self -> AddRTFCmd ('DOCVARIABLE',
{
- perlcode => '_ep_rp(%$x%,scalar(join(\'\',',
- perlcodeend => ')));',
+ perlcode => '_ep_rp(%$x%,scalar(esc(join(\'\',',
+ perlcodeend => '))));',
},
{
#'removenode' => 4,
@@ -169,8 +169,8 @@
) ;
$self -> AddRTFCmd ('MERGEFIELD',
{
- perlcode => '_ep_rp(%$x%,scalar(join(\'\',',
- perlcodeend => ')));',
+ perlcode => '_ep_rp(%$x%,scalar(esc(join(\'\',',
+ perlcodeend => '))));',
},
{
#'removenode' => 4,
No revision
No revision
1.1.2.2 +3 -0 embperl/test/cmp/Attic/rtfbasic.asc
Index: rtfbasic.asc
===================================================================
RCS file: /home/cvs/embperl/test/cmp/Attic/rtfbasic.asc,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- rtfbasic.asc 2001/05/07 11:48:54 1.1.2.1
+++ rtfbasic.asc 2001/05/16 14:04:49 1.1.2.2
@@ -10,3 +10,6 @@
{\b\f1\fs80\lang1024 1}
+{���}
+{open \{ close \} end}
+
No revision
No revision
1.1.2.6 +3 -0 embperl/test/html/rtf/Attic/rtfbasic.asc
Index: rtfbasic.asc
===================================================================
RCS file: /home/cvs/embperl/test/html/rtf/Attic/rtfbasic.asc,v
retrieving revision 1.1.2.5
retrieving revision 1.1.2.6
diff -u -r1.1.2.5 -r1.1.2.6
--- rtfbasic.asc 2001/05/07 11:49:01 1.1.2.5
+++ rtfbasic.asc 2001/05/16 14:04:57 1.1.2.6
@@ -9,3 +9,6 @@
{hash.c.3: }{\field{\*\fldinst { MERGEFIELD hash.c.1 }}{\fldrslt }}
{\field{\*\fldinst {\b\f1\fs80\lang1024 MERGEFIELD one }}{\fldrslt
{\b\f1\fs80\lang1024 ----}}}
+
+{\field{\*\fldinst {MERGEFIELD uml }}{\fldrslt {\b\f1\fs80\lang1024 ----}}}
+{\field{\*\fldinst {MERGEFIELD brace }}{\fldrslt {\b\f1\fs80\lang1024 ----}}}
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
