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)); }