You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@apache.org on 2007/09/28 23:44:19 UTC
svn commit: r580492 - in /perl/embperl/trunk: Changes.pod DOM.xs Embperl.pod
epcomp.c eputil.c
Author: richter
Date: Fri Sep 28 14:44:19 2007
New Revision: 580492
URL: http://svn.apache.org/viewvc?rev=580492&view=rev
Log:
- Added support for Code ref in language message lookup hash.
That allows for internationalization to call a sub instead
of only looking up keys in a hash.
- Fix segfault that occured during output of an error message
when not inside an Embperl request.
Modified:
perl/embperl/trunk/Changes.pod
perl/embperl/trunk/DOM.xs
perl/embperl/trunk/Embperl.pod
perl/embperl/trunk/epcomp.c
perl/embperl/trunk/eputil.c
Modified: perl/embperl/trunk/Changes.pod
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Changes.pod?rev=580492&r1=580491&r2=580492&view=diff
==============================================================================
--- perl/embperl/trunk/Changes.pod (original)
+++ perl/embperl/trunk/Changes.pod Fri Sep 28 14:44:19 2007
@@ -11,6 +11,9 @@
- Documented all options of embpexec.pl.
- Fixed default_language handling in Embperl::Form::Validate.
Patch from Kathryn Andersen.
+ - Added support for Code ref in language message lookup hash.
+ That allows for internationalization to call a sub instead
+ of only looking up keys in a hash.
- Fixed timezone compiletime error on Mac OS-X. Patch from
Wolfgang Kinkeldei.
- Fixed segfault that might occurs when an value of an input
@@ -22,6 +25,8 @@
- Added internal check and error message when due to a syntax
error in the source a node is parsed as attribute.
Spotted by Kato M. Yoshiro.
+ - Fix segfault that occured during output of an error message
+ when not inside an Embperl request.
=head1 2.2.0 8. Apr. 2006
Modified: perl/embperl/trunk/DOM.xs
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/DOM.xs?rev=580492&r1=580491&r2=580492&view=diff
==============================================================================
--- perl/embperl/trunk/DOM.xs (original)
+++ perl/embperl/trunk/DOM.xs Fri Sep 28 14:44:19 2007
@@ -62,6 +62,8 @@
char * s ;
tReq * r = CurrReq ;
PPCODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
RETVAL = NULL ; /* avoid warning */
SvGETMAGIC_P4(sText) ;
s = SV2String (sText, l) ;
@@ -83,6 +85,8 @@
char * s ;
tReq * r = CurrReq ;
PPCODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
RETVAL = NULL ; /* avoid warning */
SvGETMAGIC_P4(sText) ;
s = SV2String (sText, l) ;
@@ -103,6 +107,8 @@
char * s ;
tReq * r = CurrReq ;
PPCODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
RETVAL = NULL ; /* avoid warning */
r -> Component.bSubNotEmpty = 1 ;
SvGETMAGIC_P4(sText) ;
@@ -124,6 +130,8 @@
const char * s ;
tReq * r = CurrReq ;
PPCODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
r -> Component.bSubNotEmpty = 1 ;
s = embperl_GetText (r, sId) ;
l = strlen (s) ;
@@ -141,6 +149,8 @@
SV * sRet ;
tReq * r = CurrReq ;
PPCODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
RETVAL = NULL ; /* avoid warning */
SvGETMAGIC_P4(sText) ;
sRet = Node_replaceChildWithUrlDATA (r, pDomNode -> xDomTree, pDomNode -> xNode, r -> Component.nCurrRepeatLevel, sText) ;
@@ -156,6 +166,8 @@
SV * sRet ;
tReq * r = CurrReq ;
PPCODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
RETVAL = NULL ; /* avoid warning */
r -> Component.bSubNotEmpty = 1 ;
SvGETMAGIC_P4(sText) ;
@@ -191,6 +203,8 @@
tDomTree * pDomTree ;
tReq * r = CurrReq ;
CODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
sT = SV2String (sText, nText) ;
pDomTree = DomTree_self(pParentNode -> xDomTree) ;
Node_appendChild (r -> pApp, pDomTree, pParentNode -> xNode, r -> Component.nCurrRepeatLevel, (tNodeType)nType, 0, sT, nText, 0, 0, NULL) ;
@@ -210,6 +224,8 @@
int nEscMode = (SvUTF8(sText)?escHtmlUtf8:0) + ((r -> Component.nCurrEscMode & 11)== 3?1 + (r -> Component.nCurrEscMode & 4):r -> Component.nCurrEscMode) ;
char * sT = SV2String (sText, nText) ;
tDomTree * pDomTree = DomTree_self(xDomTree) ;
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
xNode = Node_appendChild (r -> pApp, pDomTree, xParent, r -> Component.nCurrRepeatLevel, (tNodeType)nType, 0, sT, nText, 0, 0, NULL) ;
pNode = Node_self(pDomTree,xNode) ;
pNode -> nType = (nEscMode & 8)?ntypText:((nEscMode & 3)?ntypTextHTML:ntypCDATA) ;
@@ -226,6 +242,8 @@
char * sText ;
tReq * r = CurrReq ;
CODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
sText = Node_childsText (r -> pApp, DomTree_self (xDomTree), xChild, r -> Component.nCurrRepeatLevel, 0, bDeep) ;
RETVAL = sText?sText:"" ;
OUTPUT:
@@ -262,6 +280,8 @@
PREINIT:
tReq * r = CurrReq ;
CODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
r -> Component.nCurrEscMode = r -> Component.Config.nEscMode ;
r -> Component.bEscModeSet = -1 ;
DomTree_checkpoint (r, nCheckpoint) ;
@@ -300,6 +320,8 @@
tReq * r = CurrReq ;
SV * sEscapedText ;
CODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
sT = SV2String (sText, nText) ;
sA = SV2String (sAttr, nAttr) ;
@@ -327,6 +349,8 @@
STRLEN nText ;
char * sT = SV2String (sText, nText) ;
char * sA = SV2String (sAttr, nAttr) ;
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
sEscapedText = Escape (r, sT, nText, (SvUTF8(sText)?escHtmlUtf8:0) + r -> Component.nCurrEscMode, NULL, '\0') ;
sT = SV2String (sEscapedText, nText) ;
pDomTree = DomTree_self (xDomTree) ;
@@ -347,6 +371,8 @@
tDomTree * pDomTree ;
tReq * r = CurrReq ;
CODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
sA = SV2String (sAttr, nAttr) ;
pDomTree = DomTree_self (pDomNode -> xDomTree) ;
@@ -364,6 +390,8 @@
STRLEN nAttr ;
char * sA = SV2String (sAttr, nAttr) ;
tDomTree * pDomTree = DomTree_self (xDomTree) ;
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
Element_selfRemoveAttribut (r -> pApp, pDomTree, Node_self (pDomTree, xNode), r -> Component.nCurrRepeatLevel, sA, nAttr) ;
@@ -382,6 +410,8 @@
char * sAttrText = NULL ;
tReq * r = CurrReq ;
CODE:
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
pDomTree = DomTree_self (pAttr -> xDomTree) ;
Attr_selfValue (r -> pApp, pDomTree, Attr_self(pDomTree, pAttr -> xNode), r -> Component.nCurrRepeatLevel, &sAttrText) ;
@@ -402,6 +432,8 @@
char * sAttrText = NULL ;
tAttrData * pAttr ;
+ if (!r)
+ Perl_croak(aTHX_ "$Embperl::req undefined %s %d", __FILE__, __LINE__) ;
/* lprintf (CurrReq, "xDomTree=%d, xAttr=%d pDomTree=%x\n", xDomTree, xAttr, pDomTree) ;*/
pAttr = Attr_self(pDomTree, xAttr) ;
Modified: perl/embperl/trunk/Embperl.pod
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl.pod?rev=580492&r1=580491&r2=580492&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl.pod (original)
+++ perl/embperl/trunk/Embperl.pod Fri Sep 28 14:44:19 2007
@@ -1395,6 +1395,10 @@
and if not found afterwards the default_message array for the correct message.
Because both are arrays you can push multiple message sets on it. This is handy when
your application object calls it's base class, which also may define some messages.
+Starting with version 2.3.0 it is also possible, to add a code ref instead of a
+hash ref to the arrays. The code is than called with the key as argument and
+must return the translated text.
+
Here is an example:
@@ -1425,6 +1429,20 @@
push @{$r -> messages}, $messages{$lang} ;
push @{$r -> default_messages}, $messages{'en'} if ($lang ne 'en') ;
}
+
+ # Code ref works too...
+ @{$r -> messages} = (\&ecos::I18L::translate::gettext) ;
+
+ # and gettext is defined as
+ sub gettext
+ {
+ my ($key) = @_ ;
+
+ return "translated text" ;
+ }
+
+
+
1 ;
Modified: perl/embperl/trunk/epcomp.c
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/epcomp.c?rev=580492&r1=580491&r2=580492&view=diff
==============================================================================
--- perl/embperl/trunk/epcomp.c (original)
+++ perl/embperl/trunk/epcomp.c Fri Sep 28 14:44:19 2007
@@ -2014,8 +2014,8 @@
if (!r || !r -> Component.bReqRunning)
{
- LogErrorParam (r -> pApp, rcSubCallNotRequest, "", "") ;
- return 0 ;
+ LogErrorParam (r?r -> pApp:NULL, rcSubCallNotRequest, "", "") ;
+ return rcSubCallNotRequest ;
}
av_push (pSaveAV, newSViv (r -> Component.xCurrDomTree)) ;
Modified: perl/embperl/trunk/eputil.c
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/eputil.c?rev=580492&r1=580491&r2=580492&view=diff
==============================================================================
--- perl/embperl/trunk/eputil.c (original)
+++ perl/embperl/trunk/eputil.c Fri Sep 28 14:44:19 2007
@@ -1813,6 +1813,44 @@
if (pHVREF && *pHVREF && SvROK (*pHVREF))
{
HV * pHV = (HV *)SvRV (*pHVREF) ;
+ if (SvTYPE (pHV) == SVt_PVCV)
+ {
+ SV * pSVErr ;
+ SV * pRet ;
+ int num ;
+
+ dSP ;
+ PUSHMARK(sp) ;
+ XPUSHs (sv_2mortal(newSVpv(sMsgId,0))) ;
+ PUTBACK ;
+ num = perl_call_sv ((SV *)pHV, G_EVAL) ;
+ pSVErr = ERRSV ;
+ if (SvTRUE (pSVErr))
+ {
+ STRLEN l ;
+ char * p = SvPV (pSVErr, l) ;
+ if (l > sizeof (r -> errdat1) - 1)
+ l = sizeof (r -> errdat1) - 1 ;
+ strncpy (r -> errdat1, p, l) ;
+ if (l > 0 && r -> errdat1[l-1] == '\n')
+ l-- ;
+ r -> errdat1[l] = '\0' ;
+
+ LogError (r, rcEvalErr) ;
+
+ sv_setpv(pSVErr,"");
+ return NULL ;
+ }
+ else
+ {
+ SPAGAIN ;
+ if (num > 0)
+ pRet = POPs ;
+ PUTBACK ;
+ return num && pRet && SvOK(pRet)?SvPV (pRet, l):NULL ;
+ }
+ }
+
if (SvTYPE (pHV) != SVt_PVHV)
continue ;
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org