Initial Commit

database/perl/vendor/lib/XML/SAX/PurePerl/DTDDecls.pm

@@ -0,0 +1,603 @@
+# $Id$
+
+package XML::SAX::PurePerl;
+
+use strict;
+use XML::SAX::PurePerl::Productions qw($SingleChar);
+
+sub elementdecl {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(9);
+    return 0 unless $data =~ /^<!ELEMENT/;
+    $reader->move_along(9);
+    
+    $self->skip_whitespace($reader) ||
+        $self->parser_error("No whitespace after ELEMENT declaration", $reader);
+    
+    my $name = $self->Name($reader);
+    
+    $self->skip_whitespace($reader) ||
+        $self->parser_error("No whitespace after ELEMENT's name", $reader);
+        
+    $self->contentspec($reader, $name);
+    
+    $self->skip_whitespace($reader);
+    
+    $reader->match('>') or $self->parser_error("Closing angle bracket not found on ELEMENT declaration", $reader);
+    
+    return 1;
+}
+
+sub contentspec {
+    my ($self, $reader, $name) = @_;
+    
+    my $data = $reader->data(5);
+    
+    my $model;
+    if ($data =~ /^EMPTY/) {
+        $reader->move_along(5);
+        $model = 'EMPTY';
+    }
+    elsif ($data =~ /^ANY/) {
+        $reader->move_along(3);
+        $model = 'ANY';
+    }
+    else {
+        $model = $self->Mixed_or_children($reader);
+    }
+
+    if ($model) {
+        # call SAX callback now.
+        $self->element_decl({Name => $name, Model => $model});
+        return 1;
+    }
+    
+    $self->parser_error("contentspec not found in ELEMENT declaration", $reader);
+}
+
+sub Mixed_or_children {
+    my ($self, $reader) = @_;
+
+    my $data = $reader->data(8);
+    $data =~ /^\(/ or return; # $self->parser_error("No opening bracket in Mixed or children", $reader);
+    
+    if ($data =~ /^\(\s*\#PCDATA/) {
+        $reader->match('(');
+        $self->skip_whitespace($reader);
+        $reader->move_along(7);
+        my $model = $self->Mixed($reader);
+        return $model;
+    }
+
+    # not matched - must be Children
+    return $self->children($reader);
+}
+
+# Mixed ::= ( '(' S* PCDATA ( S* '|' S* QName )* S* ')' '*' )
+#               | ( '(' S* PCDATA S* ')' )
+sub Mixed {
+    my ($self, $reader) = @_;
+
+    # Mixed_or_children already matched '(' S* '#PCDATA'
+
+    my $model = '(#PCDATA';
+            
+    $self->skip_whitespace($reader);
+
+    my %seen;
+    
+    while (1) {
+        last unless $reader->match('|');
+        $self->skip_whitespace($reader);
+
+        my $name = $self->Name($reader) || 
+            $self->parser_error("No 'Name' after Mixed content '|'", $reader);
+
+        if ($seen{$name}) {
+            $self->parser_error("Element '$name' has already appeared in this group", $reader);
+        }
+        $seen{$name}++;
+
+        $model .= "|$name";
+        
+        $self->skip_whitespace($reader);
+    }
+    
+    $reader->match(')') || $self->parser_error("no closing bracket on mixed content", $reader);
+
+    $model .= ")";
+
+    if ($reader->match('*')) {
+        $model .= "*";
+    }
+    
+    return $model;
+}
+
+# [[47]] Children ::= ChoiceOrSeq Cardinality?
+# [[48]] Cp ::= ( QName | ChoiceOrSeq ) Cardinality?
+#       ChoiceOrSeq ::= '(' S* Cp ( Choice | Seq )? S* ')'
+# [[49]] Choice ::= ( S* '|' S* Cp )+
+# [[50]] Seq    ::= ( S* ',' S* Cp )+
+#        // Children ::= (Choice | Seq) Cardinality?
+#        // Cp ::= ( QName | Choice | Seq) Cardinality?
+#        // Choice ::= '(' S* Cp ( S* '|' S* Cp )+ S* ')'
+#        // Seq    ::= '(' S* Cp ( S* ',' S* Cp )* S* ')'
+# [[51]] Mixed ::= ( '(' S* PCDATA ( S* '|' S* QName )* S* ')' MixedCardinality )
+#                | ( '(' S* PCDATA S* ')' )
+#        Cardinality ::= '?' | '+' | '*'
+#        MixedCardinality ::= '*'
+sub children {
+    my ($self, $reader) = @_;
+    
+    return $self->ChoiceOrSeq($reader) . $self->Cardinality($reader);
+}
+
+sub ChoiceOrSeq {
+    my ($self, $reader) = @_;
+    
+    $reader->match('(') or $self->parser_error("choice/seq contains no opening bracket", $reader);
+    
+    my $model = '(';
+    
+    $self->skip_whitespace($reader);
+
+    $model .= $self->Cp($reader);
+    
+    if (my $choice = $self->Choice($reader)) {
+        $model .= $choice;
+    }
+    else {
+        $model .= $self->Seq($reader);
+    }
+
+    $self->skip_whitespace($reader);
+
+    $reader->match(')') or $self->parser_error("choice/seq contains no closing bracket", $reader);
+
+    $model .= ')';
+    
+    return $model;
+}
+
+sub Cardinality {
+    my ($self, $reader) = @_;
+    # cardinality is always optional
+    my $data = $reader->data;
+    if ($data =~ /^([\?\+\*])/) {
+        $reader->move_along(1);
+        return $1;
+    }
+    return '';
+}
+
+sub Cp {
+    my ($self, $reader) = @_;
+
+    my $model;
+    my $name = eval
+    {
+	if (my $name = $self->Name($reader)) {
+	    return $name . $self->Cardinality($reader);
+	}
+    };
+    return $name if defined $name;
+    return $self->ChoiceOrSeq($reader) . $self->Cardinality($reader);
+}
+
+sub Choice {
+    my ($self, $reader) = @_;
+    
+    my $model = '';
+    $self->skip_whitespace($reader);
+    
+    while ($reader->match('|')) {
+        $self->skip_whitespace($reader);
+        $model .= '|';
+        $model .= $self->Cp($reader);
+        $self->skip_whitespace($reader);
+    }
+
+    return $model;
+}
+
+sub Seq {
+    my ($self, $reader) = @_;
+    
+    my $model = '';
+    $self->skip_whitespace($reader);
+    
+    while ($reader->match(',')) {
+        $self->skip_whitespace($reader);
+        my $cp = $self->Cp($reader);
+        if ($cp) {
+            $model .= ',';
+            $model .= $cp;
+        }
+        $self->skip_whitespace($reader);
+    }
+
+    return $model;
+}
+
+sub AttlistDecl {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(9);
+    if ($data =~ /^<!ATTLIST/) {
+        # It's an attlist
+        
+        $reader->move_along(9);
+        
+        $self->skip_whitespace($reader) || 
+            $self->parser_error("No whitespace after ATTLIST declaration", $reader);
+        my $name = $self->Name($reader);
+
+        $self->AttDefList($reader, $name);
+
+        $self->skip_whitespace($reader);
+        
+        $reader->match('>') or $self->parser_error("Closing angle bracket not found on ATTLIST declaration", $reader);
+        
+        return 1;
+    }
+    
+    return 0;
+}
+
+sub AttDefList {
+    my ($self, $reader, $name) = @_;
+
+    1 while $self->AttDef($reader, $name);
+}
+
+sub AttDef {
+    my ($self, $reader, $el_name) = @_;
+
+    $self->skip_whitespace($reader) || return 0;
+    my $att_name = $self->Name($reader) || return 0;
+    $self->skip_whitespace($reader) || 
+        $self->parser_error("No whitespace after Name in attribute definition", $reader);
+    my $att_type = $self->AttType($reader);
+
+    $self->skip_whitespace($reader) ||
+        $self->parser_error("No whitespace after AttType in attribute definition", $reader);
+    my ($mode, $value) = $self->DefaultDecl($reader);
+    
+    # fire SAX event here!
+    $self->attribute_decl({
+            eName => $el_name, 
+            aName => $att_name, 
+            Type => $att_type, 
+            Mode => $mode, 
+            Value => $value,
+            });
+    return 1;
+}
+
+sub AttType {
+    my ($self, $reader) = @_;
+
+    return $self->StringType($reader) ||
+            $self->TokenizedType($reader) ||
+            $self->EnumeratedType($reader) ||
+            $self->parser_error("Can't match AttType", $reader);
+}
+
+sub StringType {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(5);
+    return unless $data =~ /^CDATA/;
+    $reader->move_along(5);
+    return 'CDATA';
+}
+
+sub TokenizedType {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(8);
+    if ($data =~ /^(IDREFS?|ID|ENTITIES|ENTITY|NMTOKENS?)/) {
+        $reader->move_along(length($1));
+        return $1;
+    }
+    return;
+}
+
+sub EnumeratedType {
+    my ($self, $reader) = @_;
+    return $self->NotationType($reader) || $self->Enumeration($reader);
+}
+
+sub NotationType {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(8);
+    return unless $data =~ /^NOTATION/;
+    $reader->move_along(8);
+    
+    $self->skip_whitespace($reader) ||
+        $self->parser_error("No whitespace after NOTATION", $reader);
+    $reader->match('(') or $self->parser_error("No opening bracket in notation section", $reader);
+    
+    $self->skip_whitespace($reader);
+    my $model = 'NOTATION (';
+    my $name = $self->Name($reader) ||
+        $self->parser_error("No name in notation section", $reader);
+    $model .= $name;
+    $self->skip_whitespace($reader);
+    $data = $reader->data;
+    while ($data =~ /^\|/) {
+        $reader->move_along(1);
+        $model .= '|';
+        $self->skip_whitespace($reader);
+        my $name = $self->Name($reader) ||
+            $self->parser_error("No name in notation section", $reader);
+        $model .= $name;
+        $self->skip_whitespace($reader);
+        $data = $reader->data;
+    }
+    $data =~ /^\)/ or $self->parser_error("No closing bracket in notation section", $reader);
+    $reader->move_along(1);
+    
+    $model .= ')';
+
+    return $model;
+}
+
+sub Enumeration {
+    my ($self, $reader) = @_;
+    
+    return unless $reader->match('(');
+    
+    $self->skip_whitespace($reader);
+    my $model = '(';
+    my $nmtoken = $self->Nmtoken($reader) ||
+        $self->parser_error("No Nmtoken in enumerated declaration", $reader);
+    $model .= $nmtoken;
+    $self->skip_whitespace($reader);
+    my $data = $reader->data;
+    while ($data =~ /^\|/) {
+        $model .= '|';
+        $reader->move_along(1);
+        $self->skip_whitespace($reader);
+        my $nmtoken = $self->Nmtoken($reader) ||
+            $self->parser_error("No Nmtoken in enumerated declaration", $reader);
+        $model .= $nmtoken;
+        $self->skip_whitespace($reader);
+        $data = $reader->data;
+    }
+    $data =~ /^\)/ or $self->parser_error("No closing bracket in enumerated declaration", $reader);
+    $reader->move_along(1);
+    
+    $model .= ')';
+
+    return $model;
+}
+
+sub Nmtoken {
+    my ($self, $reader) = @_;
+    return $self->Name($reader);
+}
+
+sub DefaultDecl {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(9);
+    if ($data =~ /^(\#REQUIRED|\#IMPLIED)/) {
+        $reader->move_along(length($1));
+        return $1;
+    }
+    my $model = '';
+    if ($data =~ /^\#FIXED/) {
+        $reader->move_along(6);
+        $self->skip_whitespace($reader) || $self->parser_error(
+                "no whitespace after FIXED specifier", $reader);
+        my $value = $self->AttValue($reader);
+        return "#FIXED", $value;
+    }
+    my $value = $self->AttValue($reader);
+    return undef, $value;
+}
+
+sub EntityDecl {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(8);
+    return 0 unless $data =~ /^<!ENTITY/;
+    $reader->move_along(8);
+    
+    $self->skip_whitespace($reader) || $self->parser_error(
+        "No whitespace after ENTITY declaration", $reader);
+    
+    $self->PEDecl($reader) || $self->GEDecl($reader);
+    
+    $self->skip_whitespace($reader);
+    
+    $reader->match('>') or $self->parser_error("No closing '>' in entity definition", $reader);
+    
+    return 1;
+}
+
+sub GEDecl {
+    my ($self, $reader) = @_;
+
+    my $name = $self->Name($reader) || $self->parser_error("No entity name given", $reader);
+    $self->skip_whitespace($reader) || $self->parser_error("No whitespace after entity name", $reader);
+
+    # TODO: ExternalID calls lexhandler method. Wrong place for it.
+    my $value;
+    if ($value = $self->ExternalID($reader)) {
+        $value .= $self->NDataDecl($reader);
+    }
+    else {
+        $value = $self->EntityValue($reader);
+    }
+
+    if ($self->{ParseOptions}{entities}{$name}) {
+        warn("entity $name already exists\n");
+    } else {
+        $self->{ParseOptions}{entities}{$name} = 1;
+        $self->{ParseOptions}{expanded_entity}{$name} = $value; # ???
+    }
+    # do callback?
+    return 1;
+}
+
+sub PEDecl {
+    my ($self, $reader) = @_;
+    
+    return 0 unless $reader->match('%');
+
+    $self->skip_whitespace($reader) || $self->parser_error("No whitespace after parameter entity marker", $reader);
+    my $name = $self->Name($reader) || $self->parser_error("No parameter entity name given", $reader);
+    $self->skip_whitespace($reader) || $self->parser_error("No whitespace after parameter entity name", $reader);
+    my $value = $self->ExternalID($reader) ||
+                $self->EntityValue($reader) ||
+                $self->parser_error("PE is not a value or an external resource", $reader);
+    # do callback?
+    return 1;
+}
+
+my $quotre = qr/[^%&\"]/;
+my $aposre = qr/[^%&\']/;
+
+sub EntityValue {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data;
+    my $quote = '"';
+    my $re = $quotre;
+    if ($data !~ /^"/) {
+        $data =~ /^'/ or $self->parser_error("Not a quote character", $reader);
+        $quote = "'";
+        $re = $aposre;
+    }
+    $reader->move_along(1);
+    
+    my $value = '';
+    
+    while (1) {
+        my $data = $reader->data;
+
+        $self->parser_error("EOF found while reading entity value", $reader)
+            unless length($data);
+        
+        if ($data =~ /^($re+)/) {
+            my $match = $1;
+            $value .= $match;
+            $reader->move_along(length($match));
+        }
+        elsif ($reader->match('&')) {
+            # if it's a char ref, expand now:
+            if ($reader->match('#')) {
+                my $char;
+                my $ref = '';
+                if ($reader->match('x')) {
+                    my $data = $reader->data;
+                    while (1) {
+                        $self->parser_error("EOF looking for reference end", $reader)
+                            unless length($data);
+                        if ($data !~ /^([0-9a-fA-F]*)/) {
+                            last;
+                        }
+                        $ref .= $1;
+                        $reader->move_along(length($1));
+                        if (length($1) == length($data)) {
+                            $data = $reader->data;
+                        }
+                        else {
+                            last;
+                        }
+                    }
+                    $char = chr_ref(hex($ref));
+                    $ref = "x$ref";
+                }
+                else {
+                    my $data = $reader->data;
+                    while (1) {
+                        $self->parser_error("EOF looking for reference end", $reader)
+                            unless length($data);
+                        if ($data !~ /^([0-9]*)/) {
+                            last;
+                        }
+                        $ref .= $1;
+                        $reader->move_along(length($1));
+                        if (length($1) == length($data)) {
+                            $data = $reader->data;
+                        }
+                        else {
+                            last;
+                        }
+                    }
+                    $char = chr($ref);
+                }
+                $reader->match(';') ||
+                    $self->parser_error("No semi-colon found after character reference", $reader);
+                if ($char !~ $SingleChar) { # match a single character
+                    $self->parser_error("Character reference '&#$ref;' refers to an illegal XML character ($char)", $reader);
+                }
+                $value .= $char;
+            }
+            else {
+                # entity refs in entities get expanded later, so don't parse now.
+                $value .= '&';
+            }
+        }
+        elsif ($reader->match('%')) {
+            $value .= $self->PEReference($reader);
+        }
+        elsif ($reader->match($quote)) {
+            # end of attrib
+            last;
+        }
+        else {
+            $self->parser_error("Invalid character in attribute value: " . substr($reader->data, 0, 1), $reader);
+        }
+    }
+    
+    return $value;
+}
+
+sub NDataDecl {
+    my ($self, $reader) = @_;
+    $self->skip_whitespace($reader) || return '';
+    my $data = $reader->data(5);
+    return '' unless $data =~ /^NDATA/;
+    $reader->move_along(5);
+    $self->skip_whitespace($reader) || $self->parser_error("No whitespace after NDATA declaration", $reader);
+    my $name = $self->Name($reader) || $self->parser_error("NDATA declaration lacks a proper Name", $reader);
+    return " NDATA $name";
+}
+
+sub NotationDecl {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(10);
+    return 0 unless $data =~ /^<!NOTATION/;
+    $reader->move_along(10);
+    $self->skip_whitespace($reader) ||
+        $self->parser_error("No whitespace after NOTATION declaration", $reader);
+    $data = $reader->data;
+    my $value = '';
+    while(1) {
+        $self->parser_error("EOF found while looking for end of NotationDecl", $reader)
+            unless length($data);
+        
+        if ($data =~ /^([^>]*)>/) {
+            $value .= $1;
+            $reader->move_along(length($1) + 1);
+            $self->notation_decl({Name => "FIXME", SystemId => "FIXME", PublicId => "FIXME" });
+            last;
+        }
+        else {
+            $value .= $data;
+            $reader->move_along(length($data));
+            $data = $reader->data;
+        }
+    }
+    return 1;
+}
+
+1;

database/perl/vendor/lib/XML/SAX/PurePerl/DebugHandler.pm

@@ -0,0 +1,95 @@
+# $Id$
+
+package XML::SAX::PurePerl::DebugHandler;
+
+use strict;
+
+sub new {
+    my $class = shift;
+    my %opts = @_;
+    return bless \%opts, $class;
+}
+
+# DocumentHandler
+
+sub set_document_locator {
+    my $self = shift;
+    print "set_document_locator\n" if $ENV{DEBUG_XML};
+    $self->{seen}{set_document_locator}++;
+}
+
+sub start_document {
+    my $self = shift;
+    print "start_document\n" if $ENV{DEBUG_XML};
+    $self->{seen}{start_document}++;    
+}
+
+sub end_document {
+    my $self = shift;
+    print "end_document\n" if $ENV{DEBUG_XML};
+    $self->{seen}{end_document}++;
+}
+
+sub start_element {
+    my $self = shift;
+    print "start_element\n" if $ENV{DEBUG_XML};
+    $self->{seen}{start_element}++;
+}
+
+sub end_element {
+    my $self = shift;
+    print "end_element\n" if $ENV{DEBUG_XML};
+    $self->{seen}{end_element}++;
+}
+
+sub characters {
+    my $self = shift;
+    print "characters\n" if $ENV{DEBUG_XML};
+#    warn "Char: ", $_[0]->{Data}, "\n";
+    $self->{seen}{characters}++;
+}
+
+sub processing_instruction {
+    my $self = shift;
+    print "processing_instruction\n" if $ENV{DEBUG_XML};
+    $self->{seen}{processing_instruction}++;
+}
+
+sub ignorable_whitespace {
+    my $self = shift;
+    print "ignorable_whitespace\n" if $ENV{DEBUG_XML};
+    $self->{seen}{ignorable_whitespace}++;
+}
+
+# LexHandler
+
+sub comment {
+    my $self = shift;
+    print "comment\n" if $ENV{DEBUG_XML};
+    $self->{seen}{comment}++;
+}
+
+# DTDHandler
+
+sub notation_decl {
+    my $self = shift;
+    print "notation_decl\n" if $ENV{DEBUG_XML};
+    $self->{seen}{notation_decl}++;
+}
+
+sub unparsed_entity_decl {
+    my $self = shift;
+    print "unparsed_entity_decl\n" if $ENV{DEBUG_XML};
+    $self->{seen}{entity_decl}++;
+}
+
+# EntityResolver
+
+sub resolve_entity {
+    my $self = shift;
+    print "resolve_entity\n" if $ENV{DEBUG_XML};
+    $self->{seen}{resolve_entity}++;
+    return '';
+}
+
+1;

database/perl/vendor/lib/XML/SAX/PurePerl/DocType.pm

@@ -0,0 +1,180 @@
+# $Id$
+
+package XML::SAX::PurePerl;
+
+use strict;
+use XML::SAX::PurePerl::Productions qw($PubidChar);
+
+sub doctypedecl {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(9);
+    if ($data =~ /^<!DOCTYPE/) {
+        $reader->move_along(9);
+        $self->skip_whitespace($reader) ||
+            $self->parser_error("No whitespace after doctype declaration", $reader);
+        
+        my $root_name = $self->Name($reader) ||
+            $self->parser_error("Doctype declaration has no root element name", $reader);
+        
+        if ($self->skip_whitespace($reader)) {
+            # might be externalid...
+            my %dtd = $self->ExternalID($reader);
+            # TODO: Call SAX event
+        }
+        
+        $self->skip_whitespace($reader);
+        
+        $self->InternalSubset($reader);
+        
+        $reader->match('>') or $self->parser_error("Doctype not closed", $reader);
+        
+        return 1;
+    }
+    
+    return 0;
+}
+
+sub ExternalID {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(6);
+    
+    if ($data =~ /^SYSTEM/) {
+        $reader->move_along(6);
+        $self->skip_whitespace($reader) ||
+            $self->parser_error("No whitespace after SYSTEM identifier", $reader);
+        return (SYSTEM => $self->SystemLiteral($reader));
+    }
+    elsif ($data =~ /^PUBLIC/) {
+        $reader->move_along(6);
+        $self->skip_whitespace($reader) ||
+            $self->parser_error("No whitespace after PUBLIC identifier", $reader);
+        
+        my $quote = $self->quote($reader) || 
+            $self->parser_error("Not a quote character in PUBLIC identifier", $reader);
+        
+        my $data = $reader->data;
+        my $pubid = '';
+        while(1) {
+            $self->parser_error("EOF while looking for end of PUBLIC identifiier", $reader)
+                unless length($data);
+            
+            if ($data =~ /^([^$quote]*)$quote/) {
+                $pubid .= $1;
+                $reader->move_along(length($1) + 1);
+                last;
+            }
+            else {
+                $pubid .= $data;
+                $reader->move_along(length($data));
+                $data = $reader->data;
+            }
+        }
+        
+        if ($pubid !~ /^($PubidChar)+$/) {
+            $self->parser_error("Invalid characters in PUBLIC identifier", $reader);
+        }
+        
+        $self->skip_whitespace($reader) ||
+            $self->parser_error("Not whitespace after PUBLIC ID in DOCTYPE", $reader);
+        
+        return (PUBLIC => $pubid, 
+                SYSTEM => $self->SystemLiteral($reader));
+    }
+    else {
+        return;
+    }
+    
+    return 1;
+}
+
+sub SystemLiteral {
+    my ($self, $reader) = @_;
+    
+    my $quote = $self->quote($reader);
+    
+    my $data = $reader->data;
+    my $systemid = '';
+    while (1) {
+        $self->parser_error("EOF found while looking for end of System Literal", $reader)
+            unless length($data);
+        if ($data =~ /^([^$quote]*)$quote/) {
+            $systemid .= $1;
+            $reader->move_along(length($1) + 1);
+            return $systemid;
+        }
+        else {
+            $systemid .= $data;
+            $reader->move_along(length($data));
+            $data = $reader->data;
+        }
+    }
+}
+
+sub InternalSubset {
+    my ($self, $reader) = @_;
+    
+    return 0 unless $reader->match('[');
+    
+    1 while $self->IntSubsetDecl($reader);
+    
+    $reader->match(']') or $self->parser_error("No close bracket on internal subset (found: " . $reader->data, $reader);
+    $self->skip_whitespace($reader);
+    return 1;
+}
+
+sub IntSubsetDecl {
+    my ($self, $reader) = @_;
+
+    return $self->DeclSep($reader) || $self->markupdecl($reader);
+}
+
+sub DeclSep {
+    my ($self, $reader) = @_;
+
+    if ($self->skip_whitespace($reader)) {
+        return 1;
+    }
+
+    if ($self->PEReference($reader)) {
+        return 1;
+    }
+    
+#    if ($self->ParsedExtSubset($reader)) {
+#        return 1;
+#    }
+    
+    return 0;
+}
+
+sub PEReference {
+    my ($self, $reader) = @_;
+    
+    return 0 unless $reader->match('%');
+    
+    my $peref = $self->Name($reader) ||
+        $self->parser_error("PEReference did not find a Name", $reader);
+    # TODO - load/parse the peref
+    
+    $reader->match(';') or $self->parser_error("Invalid token in PEReference", $reader);
+    return 1;
+}
+
+sub markupdecl {
+    my ($self, $reader) = @_;
+    
+    if ($self->elementdecl($reader) ||
+        $self->AttlistDecl($reader) ||
+        $self->EntityDecl($reader) ||
+        $self->NotationDecl($reader) ||
+        $self->PI($reader) ||
+        $self->Comment($reader))
+    {
+        return 1;
+    }
+    
+    return 0;
+}
+
+1;

database/perl/vendor/lib/XML/SAX/PurePerl/EncodingDetect.pm

@@ -0,0 +1,105 @@
+# $Id$
+
+package XML::SAX::PurePerl; # NB, not ::EncodingDetect!
+
+use strict;
+
+sub encoding_detect {
+    my ($parser, $reader) = @_;
+    
+    my $error = "Invalid byte sequence at start of file";
+    
+    my $data = $reader->data;
+    if ($data =~ /^\x00\x00\xFE\xFF/) {
+        # BO-UCS4-be
+        $reader->move_along(4);
+        $reader->set_encoding('UCS-4BE');
+        return;
+    }
+    elsif ($data =~ /^\x00\x00\xFF\xFE/) {
+        # BO-UCS-4-2143
+        $reader->move_along(4);
+        $reader->set_encoding('UCS-4-2143');
+        return;
+    }
+    elsif ($data =~ /^\x00\x00\x00\x3C/) {
+        $reader->set_encoding('UCS-4BE');
+        return;
+    }
+    elsif ($data =~ /^\x00\x00\x3C\x00/) {
+        $reader->set_encoding('UCS-4-2143');
+        return;
+    }
+    elsif ($data =~ /^\x00\x3C\x00\x00/) {
+        $reader->set_encoding('UCS-4-3412');
+        return;
+    }
+    elsif ($data =~ /^\x00\x3C\x00\x3F/) {
+        $reader->set_encoding('UTF-16BE');
+        return;
+    }
+    elsif ($data =~ /^\xFF\xFE\x00\x00/) {
+        # BO-UCS-4LE
+        $reader->move_along(4);
+        $reader->set_encoding('UCS-4LE');
+        return;
+    }
+    elsif ($data =~ /^\xFF\xFE/) {
+        $reader->move_along(2);
+        $reader->set_encoding('UTF-16LE');
+        return;
+    }
+    elsif ($data =~ /^\xFE\xFF\x00\x00/) {
+        $reader->move_along(4);
+        $reader->set_encoding('UCS-4-3412');
+        return;
+    }
+    elsif ($data =~ /^\xFE\xFF/) {
+        $reader->move_along(2);
+        $reader->set_encoding('UTF-16BE');
+        return;
+    }
+    elsif ($data =~ /^\xEF\xBB\xBF/) { # UTF-8 BOM
+        $reader->move_along(3);
+        $reader->set_encoding('UTF-8');
+        return;
+    }
+    elsif ($data =~ /^\x3C\x00\x00\x00/) {
+        $reader->set_encoding('UCS-4LE');
+        return;
+    }
+    elsif ($data =~ /^\x3C\x00\x3F\x00/) {
+        $reader->set_encoding('UTF-16LE');
+        return;
+    }
+    elsif ($data =~ /^\x3C\x3F\x78\x6D/) {
+        # $reader->set_encoding('UTF-8');
+        return;
+    }
+    elsif ($data =~ /^\x3C\x3F\x78/) {
+        # $reader->set_encoding('UTF-8');
+        return;
+    }
+    elsif ($data =~ /^\x3C\x3F/) {
+        # $reader->set_encoding('UTF-8');
+        return;
+    }
+    elsif ($data =~ /^\x3C/) {
+        # $reader->set_encoding('UTF-8');
+        return;
+    }
+    elsif ($data =~ /^[\x20\x09\x0A\x0D]+\x3C[^\x3F]/) {
+        # $reader->set_encoding('UTF-8');
+        return;
+    }
+    elsif ($data =~ /^\x4C\x6F\xA7\x94/) {
+        $reader->set_encoding('EBCDIC');
+        return;
+    }
+    
+    warn("Unable to recognise encoding of this document");
+    return;
+}
+
+1;
+

database/perl/vendor/lib/XML/SAX/PurePerl/Exception.pm

@@ -0,0 +1,67 @@
+# $Id$
+
+package XML::SAX::PurePerl::Exception;
+
+use strict;
+
+use overload '""' => "stringify";
+
+use vars qw/$StackTrace/;
+
+$StackTrace = $ENV{XML_DEBUG} || 0;
+
+sub throw {
+    my $class = shift;
+    die $class->new(@_);
+}
+
+sub new {
+    my $class = shift;
+    my %opts = @_;
+    die "Invalid options" unless exists $opts{Message};
+    
+    if ($opts{reader}) {
+        return bless { Message => $opts{Message},
+                        Exception => undef, # not sure what this is for!!!
+                        ColumnNumber => $opts{reader}->column,
+                        LineNumber => $opts{reader}->line,
+                        PublicId => $opts{reader}->public_id,
+                        SystemId => $opts{reader}->system_id,
+                        $StackTrace ? (StackTrace => stacktrace()) : (),
+                    }, $class;
+    }
+    return bless { Message => $opts{Message},
+                    Exception => undef, # not sure what this is for!!!
+                  }, $class;
+}
+
+sub stringify {
+    my $self = shift;
+    local $^W;
+    return $self->{Message} . " [Ln: " . $self->{LineNumber} . 
+                ", Col: " . $self->{ColumnNumber} . "]" .
+                ($StackTrace ? stackstring($self->{StackTrace}) : "") . "\n";
+}
+
+sub stacktrace {
+    my $i = 2;
+    my @fulltrace;
+    while (my @trace = caller($i++)) {
+        my %hash;
+        @hash{qw(Package Filename Line)} = @trace[0..2];
+        push @fulltrace, \%hash;
+    }
+    return \@fulltrace;
+}
+
+sub stackstring {
+    my $stacktrace = shift;
+    my $string = "\nFrom:\n";
+    foreach my $current (@$stacktrace) {
+        $string .= $current->{Filename} . " Line: " . $current->{Line} . "\n";
+    }
+    return $string;
+}
+
+1;
+

database/perl/vendor/lib/XML/SAX/PurePerl/NoUnicodeExt.pm

@@ -0,0 +1,28 @@
+# $Id$
+
+package XML::SAX::PurePerl;
+use strict;
+
+sub chr_ref {
+    my $n = shift;
+    if ($n < 0x80) {
+        return chr ($n);
+    }
+    elsif ($n < 0x800) {
+        return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80));
+    }
+    elsif ($n < 0x10000) {
+        return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80),
+                                    (($n & 0x3f) | 0x80));
+    }
+    elsif ($n < 0x110000)
+    {
+        return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80),
+        ((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80));
+    }
+    else {
+        return undef;
+    }
+}
+
+1;

database/perl/vendor/lib/XML/SAX/PurePerl/Productions.pm

@@ -0,0 +1,147 @@
+# $Id$
+
+package XML::SAX::PurePerl::Productions;
+
+use Exporter;
+@ISA = ('Exporter');
+@EXPORT_OK = qw($S $Char $VersionNum $BaseChar $Ideographic
+    $Extender $Digit $CombiningChar $EncNameStart $EncNameEnd $NameChar $CharMinusDash
+    $PubidChar $Any $SingleChar);
+
+### WARNING!!! All productions here must *only* match a *single* character!!! ###
+
+BEGIN {
+$S = qr/[\x20\x09\x0D\x0A]/;
+
+$CharMinusDash = qr/[^-]/x;
+
+$Any = qr/ . /xms;
+
+$VersionNum = qr/ [a-zA-Z0-9_.:-]+ /x;
+
+$EncNameStart = qr/ [A-Za-z] /x;
+$EncNameEnd = qr/ [A-Za-z0-9\._-] /x;
+
+$PubidChar = qr/ [\x20\x0D\x0Aa-zA-Z0-9'()\+,.\/:=\?;!*\#@\$_\%-] /x;
+
+if ($] < 5.006) {
+    eval <<'    PERL';
+    $Char = qr/^ [\x09\x0A\x0D\x20-\x7F]|([\xC0-\xFD][\x80-\xBF]+) $/x;
+
+    $SingleChar = qr/^$Char$/;
+
+    $BaseChar = qr/ [\x41-\x5A\x61-\x7A]|([\xC0-\xFD][\x80-\xBF]+) /x;
+    
+    $Extender = qr/ \xB7 /x;
+    
+    $Digit = qr/ [\x30-\x39] /x;
+    
+    # can't do this one without unicode
+    # $CombiningChar = qr/^$/msx;
+    
+    $NameChar = qr/^ (?: $BaseChar | $Digit | [._:-] | $Extender )+ $/x;
+    PERL
+    die $@ if $@;
+}
+else {
+    eval <<'    PERL';
+    
+    use utf8; # for 5.6
+ 
+    $Char = qr/^ [\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}] $/x;
+
+    $SingleChar = qr/^$Char$/;
+
+    $BaseChar = qr/
+[\x{0041}-\x{005A}\x{0061}-\x{007A}\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}] |
+[\x{00F8}-\x{00FF}\x{0100}-\x{0131}\x{0134}-\x{013E}\x{0141}-\x{0148}] |
+[\x{014A}-\x{017E}\x{0180}-\x{01C3}\x{01CD}-\x{01F0}\x{01F4}-\x{01F5}] |
+[\x{01FA}-\x{0217}\x{0250}-\x{02A8}\x{02BB}-\x{02C1}\x{0386}\x{0388}-\x{038A}] |
+[\x{038C}\x{038E}-\x{03A1}\x{03A3}-\x{03CE}\x{03D0}-\x{03D6}\x{03DA}] |
+[\x{03DC}\x{03DE}\x{03E0}\x{03E2}-\x{03F3}\x{0401}-\x{040C}\x{040E}-\x{044F}] |
+[\x{0451}-\x{045C}\x{045E}-\x{0481}\x{0490}-\x{04C4}\x{04C7}-\x{04C8}] |
+[\x{04CB}-\x{04CC}\x{04D0}-\x{04EB}\x{04EE}-\x{04F5}\x{04F8}-\x{04F9}] |
+[\x{0531}-\x{0556}\x{0559}\x{0561}-\x{0586}\x{05D0}-\x{05EA}\x{05F0}-\x{05F2}] |
+[\x{0621}-\x{063A}\x{0641}-\x{064A}\x{0671}-\x{06B7}\x{06BA}-\x{06BE}] |
+[\x{06C0}-\x{06CE}\x{06D0}-\x{06D3}\x{06D5}\x{06E5}-\x{06E6}\x{0905}-\x{0939}] |
+[\x{093D}\x{0958}-\x{0961}\x{0985}-\x{098C}\x{098F}-\x{0990}] |
+[\x{0993}-\x{09A8}\x{09AA}-\x{09B0}\x{09B2}\x{09B6}-\x{09B9}\x{09DC}-\x{09DD}] |
+[\x{09DF}-\x{09E1}\x{09F0}-\x{09F1}\x{0A05}-\x{0A0A}\x{0A0F}-\x{0A10}] |
+[\x{0A13}-\x{0A28}\x{0A2A}-\x{0A30}\x{0A32}-\x{0A33}\x{0A35}-\x{0A36}] |
+[\x{0A38}-\x{0A39}\x{0A59}-\x{0A5C}\x{0A5E}\x{0A72}-\x{0A74}\x{0A85}-\x{0A8B}] |
+[\x{0A8D}\x{0A8F}-\x{0A91}\x{0A93}-\x{0AA8}\x{0AAA}-\x{0AB0}] |
+[\x{0AB2}-\x{0AB3}\x{0AB5}-\x{0AB9}\x{0ABD}\x{0AE0}\x{0B05}-\x{0B0C}] |
+[\x{0B0F}-\x{0B10}\x{0B13}-\x{0B28}\x{0B2A}-\x{0B30}\x{0B32}-\x{0B33}] |
+[\x{0B36}-\x{0B39}\x{0B3D}\x{0B5C}-\x{0B5D}\x{0B5F}-\x{0B61}\x{0B85}-\x{0B8A}] |
+[\x{0B8E}-\x{0B90}\x{0B92}-\x{0B95}\x{0B99}-\x{0B9A}\x{0B9C}] |
+[\x{0B9E}-\x{0B9F}\x{0BA3}-\x{0BA4}\x{0BA8}-\x{0BAA}\x{0BAE}-\x{0BB5}] |
+[\x{0BB7}-\x{0BB9}\x{0C05}-\x{0C0C}\x{0C0E}-\x{0C10}\x{0C12}-\x{0C28}] |
+[\x{0C2A}-\x{0C33}\x{0C35}-\x{0C39}\x{0C60}-\x{0C61}\x{0C85}-\x{0C8C}] |
+[\x{0C8E}-\x{0C90}\x{0C92}-\x{0CA8}\x{0CAA}-\x{0CB3}\x{0CB5}-\x{0CB9}\x{0CDE}] |
+[\x{0CE0}-\x{0CE1}\x{0D05}-\x{0D0C}\x{0D0E}-\x{0D10}\x{0D12}-\x{0D28}] |
+[\x{0D2A}-\x{0D39}\x{0D60}-\x{0D61}\x{0E01}-\x{0E2E}\x{0E30}\x{0E32}-\x{0E33}] |
+[\x{0E40}-\x{0E45}\x{0E81}-\x{0E82}\x{0E84}\x{0E87}-\x{0E88}\x{0E8A}] |
+[\x{0E8D}\x{0E94}-\x{0E97}\x{0E99}-\x{0E9F}\x{0EA1}-\x{0EA3}\x{0EA5}\x{0EA7}] |
+[\x{0EAA}-\x{0EAB}\x{0EAD}-\x{0EAE}\x{0EB0}\x{0EB2}-\x{0EB3}\x{0EBD}] |
+[\x{0EC0}-\x{0EC4}\x{0F40}-\x{0F47}\x{0F49}-\x{0F69}\x{10A0}-\x{10C5}] |
+[\x{10D0}-\x{10F6}\x{1100}\x{1102}-\x{1103}\x{1105}-\x{1107}\x{1109}] |
+[\x{110B}-\x{110C}\x{110E}-\x{1112}\x{113C}\x{113E}\x{1140}\x{114C}\x{114E}] |
+[\x{1150}\x{1154}-\x{1155}\x{1159}\x{115F}-\x{1161}\x{1163}\x{1165}] |
+[\x{1167}\x{1169}\x{116D}-\x{116E}\x{1172}-\x{1173}\x{1175}\x{119E}\x{11A8}] |
+[\x{11AB}\x{11AE}-\x{11AF}\x{11B7}-\x{11B8}\x{11BA}\x{11BC}-\x{11C2}] |
+[\x{11EB}\x{11F0}\x{11F9}\x{1E00}-\x{1E9B}\x{1EA0}-\x{1EF9}\x{1F00}-\x{1F15}] |
+[\x{1F18}-\x{1F1D}\x{1F20}-\x{1F45}\x{1F48}-\x{1F4D}\x{1F50}-\x{1F57}] |
+[\x{1F59}\x{1F5B}\x{1F5D}\x{1F5F}-\x{1F7D}\x{1F80}-\x{1FB4}\x{1FB6}-\x{1FBC}] |
+[\x{1FBE}\x{1FC2}-\x{1FC4}\x{1FC6}-\x{1FCC}\x{1FD0}-\x{1FD3}] |
+[\x{1FD6}-\x{1FDB}\x{1FE0}-\x{1FEC}\x{1FF2}-\x{1FF4}\x{1FF6}-\x{1FFC}] |
+[\x{2126}\x{212A}-\x{212B}\x{212E}\x{2180}-\x{2182}\x{3041}-\x{3094}] |
+[\x{30A1}-\x{30FA}\x{3105}-\x{312C}\x{AC00}-\x{D7A3}]
+    /x;
+
+    $Extender = qr/
+[\x{00B7}\x{02D0}\x{02D1}\x{0387}\x{0640}\x{0E46}\x{0EC6}\x{3005}\x{3031}-\x{3035}\x{309D}-\x{309E}\x{30FC}-\x{30FE}]
+/x;
+
+    $Digit = qr/
+[\x{0030}-\x{0039}\x{0660}-\x{0669}\x{06F0}-\x{06F9}\x{0966}-\x{096F}] |
+[\x{09E6}-\x{09EF}\x{0A66}-\x{0A6F}\x{0AE6}-\x{0AEF}\x{0B66}-\x{0B6F}] |
+[\x{0BE7}-\x{0BEF}\x{0C66}-\x{0C6F}\x{0CE6}-\x{0CEF}\x{0D66}-\x{0D6F}] |
+[\x{0E50}-\x{0E59}\x{0ED0}-\x{0ED9}\x{0F20}-\x{0F29}]
+/x;
+
+    $CombiningChar = qr/
+[\x{0300}-\x{0345}\x{0360}-\x{0361}\x{0483}-\x{0486}\x{0591}-\x{05A1}] |
+[\x{05A3}-\x{05B9}\x{05BB}-\x{05BD}\x{05BF}\x{05C1}-\x{05C2}\x{05C4}] |
+[\x{064B}-\x{0652}\x{0670}\x{06D6}-\x{06DC}\x{06DD}-\x{06DF}\x{06E0}-\x{06E4}] |
+[\x{06E7}-\x{06E8}\x{06EA}-\x{06ED}\x{0901}-\x{0903}\x{093C}] |
+[\x{093E}-\x{094C}\x{094D}\x{0951}-\x{0954}\x{0962}-\x{0963}\x{0981}-\x{0983}] |
+[\x{09BC}\x{09BE}\x{09BF}\x{09C0}-\x{09C4}\x{09C7}-\x{09C8}] |
+[\x{09CB}-\x{09CD}\x{09D7}\x{09E2}-\x{09E3}\x{0A02}\x{0A3C}\x{0A3E}\x{0A3F}] |
+[\x{0A40}-\x{0A42}\x{0A47}-\x{0A48}\x{0A4B}-\x{0A4D}\x{0A70}-\x{0A71}] |
+[\x{0A81}-\x{0A83}\x{0ABC}\x{0ABE}-\x{0AC5}\x{0AC7}-\x{0AC9}\x{0ACB}-\x{0ACD}] |
+[\x{0B01}-\x{0B03}\x{0B3C}\x{0B3E}-\x{0B43}\x{0B47}-\x{0B48}] |
+[\x{0B4B}-\x{0B4D}\x{0B56}-\x{0B57}\x{0B82}-\x{0B83}\x{0BBE}-\x{0BC2}] |
+[\x{0BC6}-\x{0BC8}\x{0BCA}-\x{0BCD}\x{0BD7}\x{0C01}-\x{0C03}\x{0C3E}-\x{0C44}] |
+[\x{0C46}-\x{0C48}\x{0C4A}-\x{0C4D}\x{0C55}-\x{0C56}\x{0C82}-\x{0C83}] |
+[\x{0CBE}-\x{0CC4}\x{0CC6}-\x{0CC8}\x{0CCA}-\x{0CCD}\x{0CD5}-\x{0CD6}] |
+[\x{0D02}-\x{0D03}\x{0D3E}-\x{0D43}\x{0D46}-\x{0D48}\x{0D4A}-\x{0D4D}\x{0D57}] |
+[\x{0E31}\x{0E34}-\x{0E3A}\x{0E47}-\x{0E4E}\x{0EB1}\x{0EB4}-\x{0EB9}] |
+[\x{0EBB}-\x{0EBC}\x{0EC8}-\x{0ECD}\x{0F18}-\x{0F19}\x{0F35}\x{0F37}\x{0F39}] |
+[\x{0F3E}\x{0F3F}\x{0F71}-\x{0F84}\x{0F86}-\x{0F8B}\x{0F90}-\x{0F95}] |
+[\x{0F97}\x{0F99}-\x{0FAD}\x{0FB1}-\x{0FB7}\x{0FB9}\x{20D0}-\x{20DC}\x{20E1}] |
+[\x{302A}-\x{302F}\x{3099}\x{309A}]
+/x;
+
+    $Ideographic = qr/
+[\x{4E00}-\x{9FA5}\x{3007}\x{3021}-\x{3029}]
+/x;
+
+    $NameChar = qr/^ (?: $BaseChar | $Ideographic | $Digit | [._:-] | $CombiningChar | $Extender )+ $/x;
+    PERL
+
+    die $@ if $@;
+}
+
+}
+
+1;

database/perl/vendor/lib/XML/SAX/PurePerl/Reader.pm

@@ -0,0 +1,136 @@
+# $Id$
+
+package XML::SAX::PurePerl::Reader;
+
+use strict;
+use XML::SAX::PurePerl::Reader::URI;
+use Exporter ();
+
+use vars qw(@ISA @EXPORT_OK);
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(
+    EOF
+    BUFFER
+    LINE
+    COLUMN
+    ENCODING
+    XML_VERSION
+);
+
+use constant EOF => 0;
+use constant BUFFER => 1;
+use constant LINE => 2;
+use constant COLUMN => 3;
+use constant ENCODING => 4;
+use constant SYSTEM_ID => 5;
+use constant PUBLIC_ID => 6;
+use constant XML_VERSION => 7;
+
+require XML::SAX::PurePerl::Reader::Stream;
+require XML::SAX::PurePerl::Reader::String;
+
+if ($] >= 5.007002) {
+    require XML::SAX::PurePerl::Reader::UnicodeExt;
+}
+else {
+    require XML::SAX::PurePerl::Reader::NoUnicodeExt;
+}
+
+sub new {
+    my $class = shift;
+    my $thing = shift;
+    
+    # try to figure if this $thing is a handle of some sort
+    if (ref($thing) && UNIVERSAL::isa($thing, 'IO::Handle')) {
+        return XML::SAX::PurePerl::Reader::Stream->new($thing)->init;
+    }
+    my $ioref;
+    if (tied($thing)) {
+        my $class = ref($thing);
+        no strict 'refs';
+        $ioref = $thing if defined &{"${class}::TIEHANDLE"};
+    }
+    else {
+        eval {
+            $ioref = *{$thing}{IO};
+        };
+        undef $@;
+    }
+    if ($ioref) {
+        return XML::SAX::PurePerl::Reader::Stream->new($thing)->init;
+    }
+    
+    if ($thing =~ /</) {
+        # assume it's a string
+        return XML::SAX::PurePerl::Reader::String->new($thing)->init;
+    }
+    
+    # assume it is a    uri
+    return XML::SAX::PurePerl::Reader::URI->new($thing)->init;
+}
+
+sub init {
+    my $self = shift;
+    $self->[LINE] = 1;
+    $self->[COLUMN] = 1;
+    $self->read_more;
+    return $self;
+}
+
+sub data {
+    my ($self, $min_length) = (@_, 1);
+    if (length($self->[BUFFER]) < $min_length) {
+        $self->read_more;
+    }
+    return $self->[BUFFER];
+}
+
+sub match {
+    my ($self, $char) = @_;
+    my $data = $self->data;
+    if (substr($data, 0, 1) eq $char) {
+        $self->move_along(1);
+        return 1;
+    }
+    return 0;
+}
+
+sub public_id {
+    my $self = shift;
+    @_ and $self->[PUBLIC_ID] = shift;
+    $self->[PUBLIC_ID];
+}
+
+sub system_id {
+    my $self = shift;
+    @_ and $self->[SYSTEM_ID] = shift;
+    $self->[SYSTEM_ID];
+}
+
+sub line {
+    shift->[LINE];
+}
+
+sub column {
+    shift->[COLUMN];
+}
+
+sub get_encoding {
+    my $self = shift;
+    return $self->[ENCODING];
+}
+
+sub get_xml_version {
+    my $self = shift;
+    return $self->[XML_VERSION];
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+XML::Parser::PurePerl::Reader - Abstract Reader factory class
+
+=cut

database/perl/vendor/lib/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm

@@ -0,0 +1,25 @@
+# $Id$
+
+package XML::SAX::PurePerl::Reader;
+use strict;
+
+sub set_raw_stream {
+    # no-op
+}
+
+sub switch_encoding_stream {
+    my ($fh, $encoding) = @_;
+    throw XML::SAX::Exception::Parse (
+        Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding",
+    ) if $encoding !~ /(ASCII|UTF\-?8)/i;
+}
+
+sub switch_encoding_string {
+    my (undef, $encoding) = @_;
+    throw XML::SAX::Exception::Parse (
+        Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding",
+    ) if $encoding !~ /(ASCII|UTF\-?8)/i;
+}
+
+1;
+

database/perl/vendor/lib/XML/SAX/PurePerl/Reader/Stream.pm

@@ -0,0 +1,84 @@
+# $Id$
+
+package XML::SAX::PurePerl::Reader::Stream;
+
+use strict;
+use vars qw(@ISA);
+
+use XML::SAX::PurePerl::Reader qw(
+    EOF
+    BUFFER
+    LINE
+    COLUMN
+    ENCODING
+    XML_VERSION
+);
+use XML::SAX::Exception;
+
+@ISA = ('XML::SAX::PurePerl::Reader');
+
+# subclassed by adding 1 to last element
+use constant FH => 8;
+use constant BUFFER_SIZE => 4096;
+
+sub new {
+    my $class = shift;
+    my $ioref = shift;
+    XML::SAX::PurePerl::Reader::set_raw_stream($ioref);
+    my @parts;
+    @parts[FH, LINE, COLUMN, BUFFER, EOF, XML_VERSION] =
+        ($ioref, 1,   0,      '',     0,   '1.0');
+    return bless \@parts, $class;
+}
+
+sub read_more {
+    my $self = shift;
+    my $buf;
+    my $bytesread = read($self->[FH], $buf, BUFFER_SIZE);
+    if ($bytesread) {
+        $self->[BUFFER] .= $buf;
+        return 1;
+    }
+    elsif (defined($bytesread)) {
+        $self->[EOF]++;
+        return 0;
+    }
+    else {
+        throw XML::SAX::Exception::Parse(
+            Message => "Error reading from filehandle: $!",
+        );
+    }
+}
+
+sub move_along {
+    my $self = shift;
+    my $discarded = substr($self->[BUFFER], 0, $_[0], '');
+    
+    # Wish I could skip this lot - tells us where we are in the file
+    my $lines = $discarded =~ tr/\n//;
+    $self->[LINE] += $lines;
+    if ($lines) {
+        $discarded =~ /\n([^\n]*)$/;
+        $self->[COLUMN] = length($1);
+    }
+    else {
+        $self->[COLUMN] += $_[0];
+    }
+}
+
+sub set_encoding {
+    my $self = shift;
+    my ($encoding) = @_;
+    # warn("set encoding to: $encoding\n");
+    XML::SAX::PurePerl::Reader::switch_encoding_stream($self->[FH], $encoding);
+    XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding);
+    $self->[ENCODING] = $encoding;
+}
+
+sub bytepos {
+    my $self = shift;
+    tell($self->[FH]);
+}
+
+1;
+

database/perl/vendor/lib/XML/SAX/PurePerl/Reader/String.pm

@@ -0,0 +1,78 @@
+# $Id$
+
+package XML::SAX::PurePerl::Reader::String;
+
+use strict;
+use vars qw(@ISA);
+
+use XML::SAX::PurePerl::Reader qw(
+    LINE
+    COLUMN
+    BUFFER
+    ENCODING
+    EOF
+);
+
+@ISA = ('XML::SAX::PurePerl::Reader');
+
+use constant DISCARDED  => 8;
+use constant STRING     => 9;
+use constant USED       => 10;
+use constant CHUNK_SIZE => 2048;
+
+sub new {
+    my $class = shift;
+    my $string = shift;
+    my @parts;
+    @parts[BUFFER, EOF, LINE, COLUMN, DISCARDED, STRING, USED] =
+        ('',   0,   1,    0,       0, $string, 0);
+    return bless \@parts, $class;
+}
+
+sub read_more () {
+    my $self = shift;
+    if ($self->[USED] >= length($self->[STRING])) {
+        $self->[EOF]++;
+        return 0;
+    }
+    my $bytes = CHUNK_SIZE;
+    if ($bytes > (length($self->[STRING]) - $self->[USED])) {
+       $bytes = (length($self->[STRING]) - $self->[USED]);
+    }
+    $self->[BUFFER] .= substr($self->[STRING], $self->[USED], $bytes);
+    $self->[USED] += $bytes;
+    return 1;
+ }
+
+
+sub move_along {
+    my($self, $bytes) = @_;
+    my $discarded = substr($self->[BUFFER], 0, $bytes, '');
+    $self->[DISCARDED] += length($discarded);
+    
+    # Wish I could skip this lot - tells us where we are in the file
+    my $lines = $discarded =~ tr/\n//;
+    $self->[LINE] += $lines;
+    if ($lines) {
+        $discarded =~ /\n([^\n]*)$/;
+        $self->[COLUMN] = length($1);
+    }
+    else {
+        $self->[COLUMN] += $_[0];
+    }
+}
+
+sub set_encoding {
+    my $self = shift;
+    my ($encoding) = @_;
+
+    XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding, "utf-8");
+    $self->[ENCODING] = $encoding;
+}
+
+sub bytepos {
+    my $self = shift;
+    $self->[DISCARDED];
+}
+
+1;

database/perl/vendor/lib/XML/SAX/PurePerl/Reader/URI.pm

@@ -0,0 +1,57 @@
+# $Id$
+
+package XML::SAX::PurePerl::Reader::URI;
+
+use strict;
+
+use XML::SAX::PurePerl::Reader;
+use File::Temp qw(tempfile);
+use Symbol;
+
+## NOTE: This is *not* a subclass of Reader. It just returns Stream or String
+## Reader objects depending on what it's capabilities are.
+
+sub new {
+    my $class = shift;
+    my $uri = shift;
+    # request the URI
+    if (-e $uri && -f _) {
+        my $fh = gensym;
+        open($fh, $uri) || die "Cannot open file $uri : $!";
+        return XML::SAX::PurePerl::Reader::Stream->new($fh);
+    }
+    elsif ($uri =~ /^file:(.*)$/ && -e $1 && -f _) {
+        my $file = $1;
+        my $fh = gensym;
+        open($fh, $file) || die "Cannot open file $file : $!";
+        return XML::SAX::PurePerl::Reader::Stream->new($fh);
+    }
+    else {
+        # request URI, return String reader
+        require LWP::UserAgent;
+        my $ua = LWP::UserAgent->new;
+        $ua->agent("Perl/XML/SAX/PurePerl/1.0 " . $ua->agent);
+        
+        my $req = HTTP::Request->new(GET => $uri);
+        
+        my $fh = tempfile();
+        
+        my $callback = sub {
+            my ($data, $response, $protocol) = @_;
+            print $fh $data;
+        };
+        
+        my $res = $ua->request($req, $callback, 4096);
+        
+        if ($res->is_success) {
+            seek($fh, 0, 0);
+            return XML::SAX::PurePerl::Reader::Stream->new($fh);
+        }
+        else {
+            die "LWP Request Failed";
+        }
+    }
+}
+
+
+1;

database/perl/vendor/lib/XML/SAX/PurePerl/Reader/UnicodeExt.pm

@@ -0,0 +1,23 @@
+# $Id$
+
+package XML::SAX::PurePerl::Reader;
+use strict;
+
+use Encode ();
+
+sub set_raw_stream {
+    my ($fh) = @_;
+    binmode($fh, ":bytes");
+}
+
+sub switch_encoding_stream {
+    my ($fh, $encoding) = @_;
+    binmode($fh, ":encoding($encoding)");
+}
+
+sub switch_encoding_string {
+    $_[0] = Encode::decode($_[1], $_[0]);
+}
+
+1;
+

database/perl/vendor/lib/XML/SAX/PurePerl/UnicodeExt.pm

@@ -0,0 +1,22 @@
+# $Id$
+
+package XML::SAX::PurePerl;
+use strict;
+
+no warnings 'utf8';
+
+sub chr_ref {
+    return chr(shift);
+}
+
+if ($] >= 5.007002) {
+    require Encode;
+    
+    Encode::define_alias( "UTF-16" => "UCS-2" );
+    Encode::define_alias( "UTF-16BE" => "UCS-2" );
+    Encode::define_alias( "UTF-16LE" => "ucs-2le" );
+    Encode::define_alias( "UTF16LE" => "ucs-2le" );
+}
+
+1;
+

database/perl/vendor/lib/XML/SAX/PurePerl/XMLDecl.pm

@@ -0,0 +1,129 @@
+# $Id$
+
+package XML::SAX::PurePerl;
+
+use strict;
+use XML::SAX::PurePerl::Productions qw($S $VersionNum $EncNameStart $EncNameEnd);
+
+sub XMLDecl {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(5);
+    # warn("Looking for xmldecl in: $data");
+    if ($data =~ /^<\?xml$S/o) {
+        $reader->move_along(5);
+        $self->skip_whitespace($reader);
+        
+        # get version attribute
+        $self->VersionInfo($reader) || 
+            $self->parser_error("XML Declaration lacks required version attribute, or version attribute does not match XML specification", $reader);
+        
+        if (!$self->skip_whitespace($reader)) {
+            my $data = $reader->data(2);
+            $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
+            $reader->move_along(2);
+            return;
+        }
+        
+        if ($self->EncodingDecl($reader)) {
+            if (!$self->skip_whitespace($reader)) {
+                my $data = $reader->data(2);
+                $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
+                $reader->move_along(2);
+                return;
+            }
+        }
+        
+        $self->SDDecl($reader);
+        
+        $self->skip_whitespace($reader);
+        
+        my $data = $reader->data(2);
+        $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
+        $reader->move_along(2);
+    }
+    else {
+        # warn("first 5 bytes: ", join(',', unpack("CCCCC", $data)), "\n");
+        # no xml decl
+        if (!$reader->get_encoding) {
+            $reader->set_encoding("UTF-8");
+        }
+    }
+}
+
+sub VersionInfo {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(11);
+    
+    # warn("Looking for version in $data");
+    
+    $data =~ /^(version$S*=$S*(["'])($VersionNum)\2)/o or return 0;
+    $reader->move_along(length($1));
+    my $vernum = $3;
+    
+    if ($vernum ne "1.0") {
+        $self->parser_error("Only XML version 1.0 supported. Saw: '$vernum'", $reader);
+    }
+
+    return 1;
+}
+
+sub SDDecl {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(15);
+    
+    $data =~ /^(standalone$S*=$S*(["'])(yes|no)\2)/o or return 0;
+    $reader->move_along(length($1));
+    my $yesno = $3;
+    
+    if ($yesno eq 'yes') {
+        $self->{standalone} = 1;
+    }
+    else {
+        $self->{standalone} = 0;
+    }
+    
+    return 1;
+}
+
+sub EncodingDecl {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(12);
+    
+    $data =~ /^(encoding$S*=$S*(["'])($EncNameStart$EncNameEnd*)\2)/o or return 0;
+    $reader->move_along(length($1));
+    my $encoding = $3;
+    
+    $reader->set_encoding($encoding);
+    
+    return 1;
+}
+
+sub TextDecl {
+    my ($self, $reader) = @_;
+    
+    my $data = $reader->data(6);
+    $data =~ /^<\?xml$S+/ or return;
+    $reader->move_along(5);
+    $self->skip_whitespace($reader);
+    
+    if ($self->VersionInfo($reader)) {
+        $self->skip_whitespace($reader) ||
+                $self->parser_error("Lack of whitespace after version attribute in text declaration", $reader);
+    }
+    
+    $self->EncodingDecl($reader) ||
+        $self->parser_error("Encoding declaration missing from external entity text declaration", $reader);
+    
+    $self->skip_whitespace($reader);
+    
+    $data = $reader->data(2);
+    $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
+    
+    return 1;
+}
+
+1;