###################################################################################
#
# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de
# Embperl - Copyright (c) 2008-2015 Gerald Richter
# Embperl - Copyright (c) 2015-2023 actevy.io
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
# For use with Apache httpd and mod_perl, see also Apache copyright.
#
# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
###################################################################################
MODULE = Embperl PACKAGE = Embperl::Syntax PREFIX = embperl_
void
embperl_BuildTokenTable (pSyntaxObj)
SV * pSyntaxObj ;
CODE:
MAGIC * mg ;
tTokenTable * pTab ;
HV * pHV ;
SV ** ppSV ;
int
rc ;
STRLEN l ;
char
* sName ;
if
(!SvROK (pSyntaxObj) || SvTYPE(pHV = (HV *)SvRV(pSyntaxObj)) != SVt_PVHV || (mg = mg_find ((SV *)pHV,
'~'
)))
{
croak (
"Internal Error: pSyntaxObj has already a TokenTable"
) ;
}
pTab =
malloc
(
sizeof
(tTokenTable)) ;
sv_unmagic ((SV *)pHV,
'~'
) ;
sv_magic ((SV *)pHV, NULL,
'~'
, (
char
*)&pTab,
sizeof
(pTab)) ;
ppSV = hv_fetch (pHV,
"-name"
, 5, 0) ;
if
(ppSV == NULL || *ppSV == NULL || !SvPOK (*ppSV))
croak (
"Internal Error: pSyntaxObj has no -name"
) ;
pTab -> _perlsv = newSVsv (pSyntaxObj) ;
sName = strdup (SvPV(*ppSV, l)) ;
ppSV = hv_fetch (pHV,
"-root"
, 5, 0) ;
if
(ppSV == NULL || *ppSV == NULL || !SvROK (*ppSV))
croak (
"Internal Error: pSyntaxObj has no -root"
) ;
else
if
((rc = BuildTokenTable (CurrReq, 0, sName, (HV *)(SvRV(*ppSV)),
""
, NULL, pTab)) != ok)
LogError (CurrReq, rc) ;