3 files changed, 186 insertions, 0 deletions
diff --git a/Xerl/XML/Element.pm b/Xerl/XML/Element.pm
new file mode 100644
index 0000000..aadccec
--- /dev/null
+++ b/Xerl/XML/Element.pm
@@ -0,0 +1,48 @@
+# Xerl (c) 2005-2011, 2013-2015 by Paul Buetow
+#
+# 	E-Mail: xerl@dev.buetow.org 	WWW: https://xerl.buetow.org
+#
+# This is free software, you may use it and distribute it under the same
+# terms as Perl itself.
+
+package Xerl::XML::Element;
+
+use strict;
+use warnings;
+
+use Xerl::Base;
+
+sub starttag {
+  my $self = $_[0];
+  my ( $name, $temp ) = ( $_[1], undef );
+
+  return $self if $self->get_name() eq $name;
+  return undef if ref $self->get_array() ne 'ARRAY';
+
+  for ( @{ $self->get_array() } ) {
+    $temp = $_->starttag($name);
+    return $temp if defined $temp;
+  }
+
+  return undef;
+}
+
+sub starttag2 {
+  my $self = $_[0];
+  my ( $name, $after ) = @_[ 1 ... 2 ];
+
+  my $element = $self->starttag($name);
+  return $element->starttag($after) if defined $element;
+
+  return undef;
+}
+
+sub params_str {
+  my $self   = $_[0];
+  my $params = $self->get_params();
+
+  return undef if $params eq '';
+  return join '', map { " $_=\"" . $params->{$_} . '"' } keys %$params;
+}
+
+1;
diff --git a/Xerl/XML/Reader.pm b/Xerl/XML/Reader.pm
new file mode 100644
index 0000000..a744025
--- /dev/null
+++ b/Xerl/XML/Reader.pm
@@ -0,0 +1,45 @@
+# Xerl (c) 2005-2011, 2013-2015 by Paul Buetow
+#
+# 	E-Mail: xerl@dev.buetow.org 	WWW: https://xerl.buetow.org
+#
+# This is free software, you may use it and distribute it under the same
+# terms as Perl itself.
+
+package Xerl::XML::Reader;
+
+use strict;
+use warnings;
+
+use v5.14.0;
+
+use XML::SAX;
+
+use Xerl::Base;
+use Xerl::XML::Element;
+use Xerl::XML::SAXHandler;
+
+sub open {
+  my $self = shift;
+
+  if ( -f $self->get_path() ) {
+    return 0;
+  }
+  else {
+    return 1;
+  }
+}
+
+sub parse {
+  my $self = shift;
+
+  XML::SAX->add_parser(q(XML::SAX::PurePerl));
+  my $sax_handler = Xerl::XML::SAXHandler->new();
+
+  my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
+  $parser->parse_uri( $self->get_path() );
+  $self->set_root( $sax_handler->{xerl}{root} );
+
+  return undef;
+}
+
+1;
diff --git a/Xerl/XML/SAXHandler.pm b/Xerl/XML/SAXHandler.pm
new file mode 100644
index 0000000..69759ef
--- /dev/null
+++ b/Xerl/XML/SAXHandler.pm
@@ -0,0 +1,93 @@
+# Xerl (c) 2005-2011, 2013-2015 by Paul Buetow
+#
+# 	E-Mail: xerl@dev.buetow.org 	WWW: https://xerl.buetow.org
+#
+# This is free software, you may use it and distribute it under the same
+# terms as Perl itself.
+
+package Xerl::XML::SAXHandler;
+
+use base qw(XML::SAX::Base);
+
+use strict;
+use warnings;
+
+use 5.14.0;
+
+use Data::Dumper;
+
+use Xerl::Base;
+use Xerl::XML::Element;
+
+sub start_document {
+  my ( $self, $doc ) = @_;
+
+  $self->{xerl}{root}    = undef;
+  $self->{xerl}{current} = undef;
+  $self->{xerl}{stack}   = [];
+
+  return undef;
+}
+
+sub start_element {
+  my ( $self, $doc ) = @_;
+  my $x = $self->{xerl};
+
+  if ( defined $x->{current} ) {
+    push @{ $x->{stack} }, $x->{current};
+    $x->{root} = $x->{current} unless defined $x->{root};
+  }
+
+  my %params = map { $_->{Name} => $_->{Value} } values %{ $doc->{Attributes} };
+
+ # Extract name and flags from a tag such as: <NAME.xerl.FLAG1.FLAG2.FLAGN...>..
+  my ( $name, @flags ) = _GET_NAME_N_FLAG( $doc->{Name} );
+
+  $x->{current} = Xerl::XML::Element->new();
+  $x->{current}->set_text('');
+  $x->{current}->set_name($name);
+  $x->{current}->set( "flag_$_", 1 ) for @flags;
+  $x->{current}->set_params( \%params ) if %params;
+
+  ${ $x->{stack} }[-1]->push_array( $x->{current} ) if @{ $x->{stack} };
+
+  return undef;
+}
+
+sub characters {
+  my ( $self, $doc ) = @_;
+  my $x = $self->{xerl};
+
+  my $data = $doc->{Data};
+  $data =~ s/!!LT!!/</g;
+  $data =~ s/!!GT!!/>/g;
+  $data =~ s/!!N!!/&/g;
+
+  $x->{current}{text} .= $data;
+
+  return undef;
+}
+
+sub end_element {
+  my ( $self, $doc ) = @_;
+  my $x = $self->{xerl};
+
+  $x->{current} = pop @{ $x->{stack} };
+
+  return undef;
+}
+
+sub _GET_NAME_N_FLAG ($) {
+  my $string = shift;
+
+  my ( $name, $flags ) = $string =~ /^(.+)\.xerl\.(.*)$/;
+
+  if ( defined $flags ) {
+    return ( $name, split( /\./, $flags ) );
+  }
+  else {
+    return ($string);
+  }
+}
+
+1;