
richter at apache
Sep 28, 2007, 2:44 PM
Post #1 of 1
(350 views)
Permalink
|
|
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[at]perl.apache.org For additional commands, e-mail: embperl-cvs-help[at]perl.apache.org
|