xmlChar *
Sv2C( SV* scalar, const xmlChar *encoding )
{
xmlChar *retval = NULL;
xs_warn("SV2C: start!\n");
if ( scalar != NULL && scalar != &PL_sv_undef ) {
STRLEN len = 0;
char * t_pv =SvPV(scalar, len);
xmlChar* ts = NULL;
xmlChar* string = xmlStrdup((xmlChar*)t_pv);
if ( xmlStrlen(string) > 0 ) {
xs_warn( "SV2C: no undefs\n" );
#ifdef HAVE_UTF8
xs_warn( "SV2C: use UTF8\n" );
if( !DO_UTF8(scalar) && encoding != NULL ) {
#else
if ( encoding != NULL ) {
#endif
xs_warn( "SV2C: domEncodeString!\n" );
ts= PmmEncodeString( (const char *)encoding, string );
xs_warn( "SV2C: done encoding!\n" );
if ( string != NULL ) {
xmlFree(string);
}
string=ts;
}
}
retval = xmlStrdup(string);
if (string != NULL ) {
xmlFree(string);
}
}
xs_warn("SV2C: end!\n");
return retval;
}
SV*
nodeC2Sv( const xmlChar * string, xmlNodePtr refnode )
{
/* this is a little helper function to avoid to much redundand
code in LibXML.xs */
SV* retval = &PL_sv_undef;
STRLEN len = 0;
xmlChar * decoded = NULL;
if ( refnode != NULL ) {
xmlDocPtr real_doc = refnode->doc;
if ( real_doc != NULL && real_doc->encoding != NULL ) {
xs_warn( " encode node !!" );
/* The following statement is to handle bad
values set by XML::LibXSLT */
if ( PmmNodeEncoding(real_doc) == XML_CHAR_ENCODING_NONE ) {
PmmNodeEncoding(real_doc) = XML_CHAR_ENCODING_UTF8;
}
decoded = PmmFastDecodeString( PmmNodeEncoding(real_doc) ,
(const xmlChar *)string,
(const xmlChar*)real_doc->encoding);
xs_warn( "push decoded string into SV" );
len = xmlStrlen( decoded );
retval = newSVpvn( (const char *)decoded, len );
xmlFree( decoded );
if ( PmmNodeEncoding( real_doc ) == XML_CHAR_ENCODING_UTF8 ) {
/* most probably true, since libxml2 always
* sets doc->charset to UTF8, see tree.c:
*
* The in memory encoding is always UTF8
* This field will never change and would
* be obsolete if not for binary compatibility.
*/
#ifdef HAVE_UTF8
xs_warn("nodeC2Sv: set UTF8-SV-flag\n");
SvUTF8_on(retval);
#endif
}
return retval;
}
}
return C2Sv(string, NULL );
}
xmlChar *
nodeSv2C( SV * scalar, xmlNodePtr refnode )
{
/* this function requires conditionized compiling, because we
request a function, that does not exists in earlier versions of
perl. in this cases the library assumes, all strings are in
UTF8. if a programmer likes to have the intelligent code, he
needs to upgrade perl */
if ( refnode != NULL ) {
xmlDocPtr real_dom = refnode->doc;
xs_warn("nodeSv2C: have node!\n");
if (real_dom != NULL && real_dom->encoding != NULL ) {
xs_warn("nodeSv2C: encode string!\n");
/* speed things a bit up.... */
if ( scalar != NULL && scalar != &PL_sv_undef ) {
STRLEN len = 0;
char * t_pv =SvPV(scalar, len);
xmlChar* ts = NULL;
xmlChar* string = xmlStrdup((xmlChar*)t_pv);
if ( xmlStrlen(string) > 0 ) {
xs_warn( "nodeSv2C: no undefs\n" );
#ifdef HAVE_UTF8
xs_warn( "nodeSv2C: use UTF8\n" );
if( !DO_UTF8(scalar) && real_dom != NULL && real_dom->encoding != NULL )
#else
if ( real_dom != NULL && real_dom->encoding != NULL )
#endif
{
xs_warn( "nodeSv2C: domEncodeString!\n" );
/* if ( string == NULL || *string == 0 ) warn("string is empty" ); */
/* The following statement is to handle bad
values set by XML::LibXSLT */
if ( PmmNodeEncoding(real_dom) == XML_CHAR_ENCODING_NONE ) {
PmmNodeEncoding(real_dom) = XML_CHAR_ENCODING_UTF8;
}
ts= PmmFastEncodeString( PmmNodeEncoding(real_dom),
string,
(const xmlChar*)real_dom->encoding );
xs_warn( "nodeSv2C: done!\n" );
if ( string != NULL ) {
xmlFree(string);
}
string=ts;
}
else {
xs_warn( "nodeSv2C: no encoding set, use UTF8!\n" );
}
}
/* if ( string == NULL ) warn( "nodeSv2C: string is NULL\n" ); */
return string;
}
else {
xs_warn( "nodeSv2C: return NULL\n" );
return NULL;
}
}
else {
xs_warn( "nodeSv2C: document has no encoding defined! use simple SV extraction\n" );
}
}
xs_warn("nodeSv2C: no encoding !!\n");
return Sv2C( scalar, NULL );
}
/*
* This is the main Load function.
* It takes a yaml stream and turns it into 0 or more Perl objects.
*/
void
Load(SV *yaml_sv)
{
dXSARGS;
perl_yaml_loader_t loader;
SV *node;
const unsigned char *yaml_str;
STRLEN yaml_len;
yaml_str = (const unsigned char *)SvPV_const(yaml_sv, yaml_len);
if (DO_UTF8(yaml_sv)) {
yaml_sv = sv_mortalcopy(yaml_sv);
if (!sv_utf8_downgrade(yaml_sv, TRUE))
croak("%s", "Wide character in YAML::XS::Load()");
yaml_str = (const unsigned char *)SvPV_const(yaml_sv, yaml_len);
}
sp = mark;
if (0 && (items || ax)) {} /* XXX Quiet the -Wall warnings for now. */
yaml_parser_initialize(&loader.parser);
loader.document = 0;
yaml_parser_set_input_string(
&loader.parser,
yaml_str,
yaml_len
);
/* Get the first event. Must be a STREAM_START */
if (!yaml_parser_parse(&loader.parser, &loader.event))
goto load_error;
if (loader.event.type != YAML_STREAM_START_EVENT)
croak("%sExpected STREAM_START_EVENT; Got: %d != %d",
ERRMSG,
loader.event.type,
YAML_STREAM_START_EVENT
);
loader.anchors = newHV();
sv_2mortal((SV *)loader.anchors);
/* Keep calling load_node until end of stream */
while (1) {
loader.document++;
/* We are through with the previous event - delete it! */
yaml_event_delete(&loader.event);
if (!yaml_parser_parse(&loader.parser, &loader.event))
goto load_error;
if (loader.event.type == YAML_STREAM_END_EVENT)
break;
node = load_node(&loader);
/* We are through with the previous event - delete it! */
yaml_event_delete(&loader.event);
hv_clear(loader.anchors);
if (! node) break;
XPUSHs(sv_2mortal(node));
if (!yaml_parser_parse(&loader.parser, &loader.event))
goto load_error;
if (loader.event.type != YAML_DOCUMENT_END_EVENT)
croak("%sExpected DOCUMENT_END_EVENT", ERRMSG);
}
/* Make sure the last event is a STREAM_END */
if (loader.event.type != YAML_STREAM_END_EVENT)
croak("%sExpected STREAM_END_EVENT; Got: %d != %d",
ERRMSG,
loader.event.type,
YAML_STREAM_END_EVENT
);
yaml_parser_delete(&loader.parser);
PUTBACK;
return;
load_error:
croak("%s", loader_error_msg(&loader, NULL));
}
