Commits

Anonymous committed b1027eb

Log: moved strucutred error callbacks to perl layer
PR: none

In order to move the code more to the perl layer the structured error
callback was refactored. The xmlError2SV function is now obsolete, but
not yet removed.

In order to access the libxml2 error structure from perl I introduced the
XML::LibXML::LibError class.

TODOs:
o At the moment only parse_string() uses the new code, but the new style can
easily transfered to all the other parsing functions.

o make the error code aware of libxml2's userData. This requires some
refactoring of the parser functions.

o move the old error callback to perl layer

o remove xmlError2Sv from perl-libxml-mm.*

Modified Files:
Tag: structerror
LibXML.pm
+ made parse_string use the new code.

LibXML.xs
+ perlish struct_error_callback
+ XML::LibXML::LibError class
o adoption of LibXML_report_error().

lib/XML/LibXML/Error.pm
+ perl level callbacks

Added Files:
Tag: structerror
t/29_struct_errors.t
+ minimal tests (prove of concept)

  • Participants
  • Parent commits e47e328
  • Branches structerror

Comments (0)

Files changed (4)

 
     $self->{_State_} = 1;
     my $result;
-
+    my $err;
     if ( defined $self->{SAX} ) {
         my $string = shift;
         $self->{SAX_ELSTACK} = [];
-        eval { $result = $self->_parse_sax_string($string); };
+        eval {
+            $result = $self->_parse_sax_string($string); 
+            XML::LibXML::Error::_report_error( );
+        };
 
-        my $err = $@;
+        $err = $@;
         $self->{_State_} = 0;
         if ($err) {
             croak $err;
         }
     }
     else {
-        eval { $result = $self->_parse_string( @_ ); };
+        eval { 
+            $result = $self->_parse_string( @_ );
+            XML::LibXML::Error::_report_error();
+        };
 
-        my $err = $@;
+        $err = $@;
         $self->{_State_} = 0;
         if ($err) {
             croak $err;
         }
-
-        $result = $self->_auto_expand( $result, $self->{XML_LIBXML_BASE_URI} );
+        else {
+            $result = $self->_auto_expand( $result, 
+                                           $self->{XML_LIBXML_BASE_URI} );
+        }
     }
 
     return $result;
 #  include <unistd.h>
 #endif
 
-/* libxml2 configuration properties */
-#include <libxml/xmlversion.h>
-
 #define DEBUG_C14N
 
 /* libxml2 stuff */
     SvREFCNT_dec(sv);
 }
 
-void
-LibXML_serror2SV(SV** dest, xmlErrorPtr err, SV* prev_error) {
-    HV* herror;
-    SV* hr;
-    herror = newHV();
-    if (err->level == XML_ERR_NONE)
-        return;
-    if (prev_error != NULL && SvOK(prev_error))
-      hv_store(herror, "_prev", 5, prev_error,0);
-    hv_store(herror, "domain", 6, newSViv(err->domain),0);
-    hv_store(herror, "code", 4, newSViv(err->code),0);
-    if (err->message) {
-        int len = strlen(err->message);
-        if (err->message[len-1] == '\n') 
-            hv_store(herror, "message", 7, newSVpvn(err->message,len-1),0);
-        else
-            hv_store(herror, "message", 7, newSVpvn(err->message,len),0);
-    }
-    hv_store(herror, "level", 5, newSViv(err->level),0);
-    if (err->file)
-        hv_store(herror, "file", 4, newSVpvn(err->file,strlen(err->file)),0);
-    hv_store(herror, "line", 4, newSViv(err->line),0);
-    if (err->str1)
-        hv_store(herror, "str1", 4, newSVpvn(err->str1,strlen(err->str1)),0);
-    if (err->str2)
-        hv_store(herror, "str2", 4, newSVpvn(err->str2,strlen(err->str2)),0);
-    if (err->str3)
-        hv_store(herror, "str3", 4, newSVpvn(err->str3,strlen(err->str3)),0);
-    hv_store(herror, "int1", 4, newSViv(err->int1),0);
-    hv_store(herror, "int2", 4, newSViv(err->int2),0);
-    if (err->node) {
-      /* hv_store(herror, "node", 4, 
-	 PmmNodeToSv( (xmlNodePtr) err->node, NULL ),0); */
-      /* Passing the node isn't at all safe at this point, so I'll just
-         pass its name
-      */
-      xmlChar* name =  (xmlChar*)domName( err->node );
-      if ( name != NULL ) {
-	hv_store(herror, "nodename", 8, C2Sv(name,NULL) ,0);
-	xmlFree( name );
-      }
-    }
-    hr = newRV_noinc((SV *)herror);
-    sv_bless(hr, gv_stashpv("XML::LibXML::Error", TRUE));
-    *dest = hr;
-}
-
 #ifdef HAVE_SERRORS
 void
-LibXML_serror_handler(void *userData, xmlErrorPtr err) {
-  xmlError2Sv(&LibXML_error,err,LibXML_error); 
+LibXML_struct_error_handler(void * userData, xmlErrorPtr error )
+{
+    int count, extend;
+    const char * CLASS = "XML::LibXML::LibError";
+    SV* uData;
+    SV* libErr;
+
+    dTHX;
+    dSP;
+
+    xs_warn( "init SE handler\n" );
+    if ( userData != NULL ) {
+        xs_warn( "have user data \n" );
+        uData  = (SV*) userData;
+    }
+    else {
+        xs_warn( "have no user data!\n" );
+    }
+    xs_warn( "init LibError Class\n" );
+
+    libErr = NEWSV(0,0);
+    sv_setref_pv( libErr, CLASS, (void*)error );
+    
+    extend = (userData == NULL ? 1 : 2);
+
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    EXTEND(SP, extend);
+    
+    PUSHs(sv_2mortal(libErr));
+    if ( userData != NULL ) {
+        PUSHs(uData);
+    }
+    PUTBACK;
+    
+    count = perl_call_pv( "XML::LibXML::Error::_callback_error",
+                          G_SCALAR | G_EVAL );
+    SPAGAIN;
+
+    if ( SvTRUE(ERRSV) ) {
+        croak( "DIE: %s", SvPV_nolen(ERRSV) );
+        POPs;
+    }
+
+    FREETMPS;
+    LEAVE;
 }
+
 #endif /* HAVE_SERRORS */
 
 void
 #ifdef HAVE_SERRORS
     xmlSetGenericErrorFunc(NULL, LibXML_dummy_handler);
     xmlSetStructuredErrorFunc(NULL,
-			      (xmlStructuredErrorFunc)LibXML_serror_handler);
+			      (xmlStructuredErrorFunc)LibXML_struct_error_handler);
     LibXML_error = &PL_sv_undef;
 #else
     LibXML_error = NEWSV(0, 512);
 LibXML_report_error(SV * saved_error, int recover)
 {
 #ifdef HAVE_SERRORS
-    if (LibXML_error_OK) {
-      if ( recover ) {
-	if ( recover == 1 ) {
-	    warn("%s",SvPV_nolen(LibXML_error));
-	}
-	SvREFCNT_dec(LibXML_error);
-	LibXML_error = saved_error;
-      } else {
-	SV* perl_err_var;
-	perl_err_var = get_sv("@", TRUE);
-	sv_setsv(perl_err_var, LibXML_error);
-	LibXML_error = saved_error;
-	croak(Nullch);
-       }
-   } else {
-     LibXML_error = saved_error;
-   }
+   /* if (LibXML_error_OK) {
+        if ( recover ) {
+            if ( recover == 1 ) {
+                warn("%s",SvPV_nolen(LibXML_error));
+            }
+            SvREFCNT_dec(LibXML_error);
+            LibXML_error = saved_error;
+        } else {
+            SV* perl_err_var;
+            perl_err_var = get_sv("@", TRUE);
+            sv_setsv(perl_err_var, LibXML_error);
+            LibXML_error = saved_error;
+            croak(Nullch);
+        }
+    } else {
+        LibXML_error = saved_error;
+    } */
 #else
     SV *my_error = sv_2mortal(LibXML_error);
     LibXML_error = saved_error;
         RETVAL
 
 #endif /* HAVE_SCHEMAS */
+
+#ifdef HAVE_SERRORS
+
+MODULE = XML::LibXML       PACKAGE = XML::LibXML::LibError
+
+int
+domain( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = self->domain;
+    OUTPUT:
+        RETVAL
+
+int
+code( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = self->code;
+    OUTPUT:
+        RETVAL
+
+int
+line( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = self->line;
+    OUTPUT:
+        RETVAL
+
+int
+num1( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = self->int1;
+    OUTPUT:
+        RETVAL
+
+int
+num2( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = self->int2;
+    OUTPUT:
+        RETVAL
+
+int
+level( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = (int)self->level;
+    OUTPUT:
+        RETVAL
+
+char *
+message( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = self->message;
+    OUTPUT:
+        RETVAL
+
+char *
+file( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = (char*)self->file;
+    OUTPUT:
+        RETVAL
+
+char *
+str1( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = (char*)self->str1;
+    OUTPUT:
+        RETVAL
+
+char *
+str2( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = (char*)self->str2;
+    OUTPUT:
+        RETVAL
+
+char *
+str3( self )
+        xmlErrorPtr self
+    CODE:
+        RETVAL = (char*)self->str3;
+    OUTPUT:
+        RETVAL
+
+
+#endif /* HAVE_SERRORS */

lib/XML/LibXML/Error.pm

 package XML::LibXML::Error;
 
 use strict;
-use vars qw($AUTOLOAD @error_domains);
+use vars qw($AUTOLOAD @error_domains $ERROR);
 use Carp;
 use overload
   '""' => \&as_string;
 		  "Relax-NG parser", "Relax-NG validity",
 		  "Catalog", "C14N", "XSLT", "validity");
 
+
+sub _callback_error {
+    my $xE = shift;
+
+    my $terr =bless {
+        domain  => $xE->domain(),
+        level   => $xE->level(),
+        code    => $xE->code(),
+        message => $xE->message(),
+        file    => $xE->file(),
+        line    => $xE->line(),
+        str1    => $xE->str1(),
+        str2    => $xE->str2(),
+        str3    => $xE->str3(),
+        int1    => $xE->num1(),
+        int2    => $xE->num2(),
+    }, "XML::LibXML::Error";
+
+    unless ( defined $terr->{file} and length $terr->{file} ) {
+        $terr->{file} = 'string()'; # make it easier to recognize parsed strings
+    }
+
+    if ( defined $ERROR ) {
+        $terr->{prev} = $ERROR;
+    }
+
+    $ERROR = $terr;
+}
+
+sub _report_error {
+    die $ERROR;
+}
+
+
 sub AUTOLOAD {
   my $self=shift;
   return undef unless ref($self);
 sub DESTROY {}
 
 sub domain {
-  my ($self)=@_;
-  return undef unless ref($self);
-  return $error_domains[$self->{domain}]
+    my ($self)=@_;
+    return undef unless ref($self);
+    return $error_domains[$self->{domain}];
 }
 
 sub as_string {
-  my ($self)=@_;
-  my $msg = "";
-  my $level;
-
-  if (defined($self->{_prev})) {
-    $msg = $self->{_prev}->as_string;
-  }
-
-  if ($self->{level} == XML_ERR_NONE) {
-    $level = "";
-  } elsif ($self->{level} == XML_ERR_WARNING) {
-    $level = "warning";
-  } elsif ($self->{level} == XML_ERR_ERROR ||
-	   $self->{level} == XML_ERR_FATAL) {
-    $level = "error";
-  }
-  my $where="";
-  if (defined($self->{file})) {
-    $where="$self->{file}:$self->{line}";
-  } elsif (($self->{domain} == XML_ERR_FROM_PARSER)
-	   and
-	   $self->{line})  {
-    $where="Entity: line $self->{line}";
-  }
-  if ($self->{nodename}) {
-    $where.=": element ".$self->{nodename};
-  }
-  $msg.=$where.": " if $where ne "";
-  $msg.=$error_domains[$self->{domain}]." ".$level." :";
-  my $str=$self->{message};
-  chomp($str);
-  $msg.=" ".$str."\n";
-  if (($self->{domain} == XML_ERR_FROM_XPATH) and
-      defined($self->{str1})) {
-    $msg.=$self->{str1}."\n";
-    $msg.=(" " x $self->{int1})."^\n";
-  }
-  return $msg;
+    my ($self)=@_;
+    my $msg = "";
+    my $level;
+    
+    if (defined($self->{_prev})) {
+        $msg = $self->{_prev}->as_string;
+    }
+    
+    if ($self->{level} == XML_ERR_NONE) {
+        $level = "";
+    } elsif ($self->{level} == XML_ERR_WARNING) {
+        $level = "warning";
+    } elsif ($self->{level} == XML_ERR_ERROR ||
+             $self->{level} == XML_ERR_FATAL) {
+        $level = "error";
+    }
+    my $where="";
+    if (defined($self->{file})) {
+        $where="$self->{file}:$self->{line}";
+    } elsif (($self->{domain} == XML_ERR_FROM_PARSER)
+             and
+             $self->{line})  {
+        $where="Entity: line $self->{line}";
+    }
+    if ($self->{nodename}) {
+        $where.=": element ".$self->{nodename};
+    }
+    $msg.=$where.": " if $where ne "";
+    $msg.=$error_domains[$self->{domain}]." ".$level." :";
+    my $str=$self->{message};
+    chomp($str);
+    $msg.=" ".$str."\n";
+    if (($self->{domain} == XML_ERR_FROM_XPATH) and
+        defined($self->{str1})) {
+        $msg.=$self->{str1}."\n";
+        $msg.=(" " x $self->{int1})."^\n";
+    }
+    return $msg;
 }
 
 sub dump {

t/29_struct_errors.t

+# $Id$
+# First version of the new structured error test suite
+
+use Test;
+BEGIN { plan tests => 4}
+END { ok(0) unless $loaded }
+
+use XML::LibXML;
+use XML::LibXML::Error;
+
+$loaded = 1;
+ok(1);
+
+my $p = XML::LibXML->new();
+
+my $xmlstr = <<EOX;
+<X></Y>
+EOX
+
+eval {
+    my $doc = $p->parse_string( $xmlstr );
+};
+if ( $@ ) {
+    if ( ref( $@ ) ) {
+        ok(ref($@), "XML::LibXML::Error");
+        ok($@->domain(), "parser");
+        ok($@->line(), 1);
+        warn "se: ", $@;
+    }
+}
+