summaryrefslogtreecommitdiff
path: root/Xerl/XML
diff options
context:
space:
mode:
Diffstat (limited to 'Xerl/XML')
-rw-r--r--Xerl/XML/Element.pm111
-rw-r--r--Xerl/XML/Reader.pm195
2 files changed, 306 insertions, 0 deletions
diff --git a/Xerl/XML/Element.pm b/Xerl/XML/Element.pm
new file mode 100644
index 0000000..a094ee6
--- /dev/null
+++ b/Xerl/XML/Element.pm
@@ -0,0 +1,111 @@
+# Xerl (c) 2005-2009, Dipl.-Inform. (FH) Paul C. Buetow
+#
+# E-Mail: xerl@dev.buetow.org WWW: http://xerl.buetow.org
+#
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+# * Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# * Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# * Neither the name of P. B. Labs nor the names of its contributors may
+# be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED Paul C. Buetow ``AS IS'' AND ANY EXPRESS OR
+# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+# DISCLAIMED. IN NO EVENT Paul C. Buetow BE LIABLE FOR ANY DIRECT,
+# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+# IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+package Xerl::XML::Element;
+
+use strict;
+use warnings;
+
+use Xerl::Base;
+
+sub starttag($$) {
+ my Xerl::XML::Element $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 Xerl::XML::Element $self = $_[0];
+ my ( $name, $after ) = @_[ 1 ... 2 ];
+
+ my Xerl::XML::Element $element = $self->starttag($name);
+ return $element->starttag($after) if defined $element;
+
+ return undef;
+}
+
+sub params_str($) {
+ my Xerl::XML::Element $self = $_[0];
+ my $params = $self->get_params();
+
+ return if $params eq '';
+
+ return join '', map { " $_=\"" . $params->{$_} . '"' } keys %$params;
+}
+
+# Only for testing
+sub print($) {
+ my Xerl::XML::Element $self = $_[0];
+ print $self. "::print(\$)\n";
+
+ my $sub;
+ $sub = sub {
+ my ( $element, $spaceing ) = @_;
+ my $spaces = ' ' x $spaceing;
+
+ print $spaces, '<', $element->get_name(), ">\n";
+ print "$spaces [$_=", _no_newline( $$element{$_} ), "]\n"
+ for keys %$element;
+
+ #if ($element->exists('params')) {
+ if ( $element->params_exists() ) {
+ print "$spaces Params:\n";
+ while ( my ( $key, $val ) = each %{ $element->get_params() } ) {
+ print "$spaces $key=$val\n";
+ }
+ }
+
+ return unless ref $element->get_array() eq 'ARRAY';
+ $sub->( $_, $spaceing + 1 ) for @{ $element->get_array() };
+ };
+
+ $sub->( $self, 0 );
+ print $self. "::print(\$)::END\n";
+
+ return undef;
+}
+
+sub _no_newline($) {
+ my $line = $_[0];
+
+ $line =~ s/\n//g;
+
+ return $line;
+}
+
+1;
diff --git a/Xerl/XML/Reader.pm b/Xerl/XML/Reader.pm
new file mode 100644
index 0000000..1a9288b
--- /dev/null
+++ b/Xerl/XML/Reader.pm
@@ -0,0 +1,195 @@
+# Xerl (c) 2005-2009, Dipl.-Inform. (FH) Paul C. Buetow
+#
+# E-Mail: xerl@dev.buetow.org WWW: http://xerl.buetow.org
+#
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+# * Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# * Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# * Neither the name of P. B. Labs nor the names of its contributors may
+# be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED Paul C. Buetow ``AS IS'' AND ANY EXPRESS OR
+# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+# DISCLAIMED. IN NO EVENT Paul C. Buetow BE LIABLE FOR ANY DIRECT,
+# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+# IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+package Xerl::XML::Reader;
+
+use strict;
+use warnings;
+
+use Xerl::Base;
+use Xerl::XML::Element;
+
+sub open($) {
+ my Xerl::XML::Reader $self = $_[0];
+
+ my Xerl::Tools::FileIO $xmlfile =
+ Xerl::Tools::FileIO->new( path => $self->get_path() );
+
+ $xmlfile->fslurp();
+
+ # Xerl::Main::Global::PLAIN($self->get_path());
+ # Xerl::Main::Global::DEBUG(@{$xmlfile->get_array()});
+
+ $self->set_array( $xmlfile->get_array() );
+
+ return undef;
+}
+
+sub parse($) {
+ my Xerl::XML::Reader $self = $_[0];
+
+ my $rarray = $self->get_array();
+ return $self unless ref $rarray eq 'ARRAY';
+
+ my Xerl::XML::Element $element = Xerl::XML::Element->new();
+ my Xerl::XML::Element( $root, $next, $prev, $insert );
+
+ # Prove and remove XML Header.
+ Xerl::Main::Global::ERROR( 'No valid XML header', caller() )
+ unless $rarray->[0] =~ s/<\?xml .*?version.+?\?>//io;
+
+ my ( $newlineadd, $linecount, $notrim ) = ( 0, 0, 0 );
+
+ #for my $line (@$rarray) {
+ for my $line (@$rarray) {
+ $newlineadd = 1 if length $line == 1 and $linecount > 3;
+ ++$linecount;
+
+ $line =~ s/\\</!!LT!!/g;
+ $line =~ s/\\>/!!GT!!/g;
+
+ # Allow <tag />
+ my $is_single_tag = $line =~ s#<([^/].+?)( (.*?))? ?/ *>#<$1 $3></$1>#o;
+
+ # Open XML tag
+ if ( $line =~ s#<([^/].+?)( (.*?))? *>##o ) {
+ my ( $name, $params ) = ( $1, $3 );
+
+ # Ignore XML comments
+ next if $name =~ /^!--/o;
+
+ $next = Xerl::XML::Element->new();
+ $next->set_name($name);
+ $next->set_prev($element);
+ $next->set_single($is_single_tag);
+
+ # Handle tag parameters
+ if ( defined $params ) {
+ my %params = $params =~ /
+ (?: ( [^\s]+? ) \s*=\s* (
+ (?: '(?:.|(?:\\'))*?' ) |
+ (?: "(?:.|(?:\\"))*?" ) |
+ (?: [^\s]+ ) ) )
+ /gox;
+
+ # Remove " and '
+ $params{$_} =~ s/^(?:"|')|(?:"|')$//go for keys %params;
+ $next->set_params( \%params );
+ $notrim = 1 if exists $params{notrim};
+ }
+
+ $element->push_array($next);
+
+ $root = $element unless defined $root;
+ $element = $next;
+ $insert = $element;
+
+ redo;
+ }
+
+ # Close XML tag
+ if ( $line =~ s#<(/.+?)>##o ) {
+
+ #print "XML::<$1>\n";
+ if ( $element->get_name() eq 'includefiles' ) {
+ my $config = $self->get_config();
+ my $params = $element->get_params();
+ my $path =
+ $config->get_hostpath() . 'content/' . $params->{reldir};
+ my $pattern = $params->{pattern};
+ my $maxitems =
+ exists $params->{maxitems} ? $params->{maxitems} : 100;
+ my $startindex =
+ exists $params->{startindex} ? $params->{startindex} : 0;
+
+ my Xerl::Tools::FileIO $io =
+ Xerl::Tools::FileIO->new( path => $path );
+
+ $io->dslurp();
+ $io->reverse_array() if exists $params->{reversed};
+
+ for my $include ( grep { /$pattern/o } @{ $io->get_array() } ) {
+ last unless $maxitems--;
+ next if 0 < $startindex--;
+
+ my Xerl::XML::Reader $reader = Xerl::XML::Reader->new(
+ path => $include,
+ config => $config
+ );
+
+ $reader->open();
+ $reader->parse();
+
+ my Xerl::XML::Element $starttag =
+ $reader->get_root()->starttag('content');
+
+ my $sep =
+ exists $params->{separator}
+ ? $params->{separator}
+ : 'noop';
+ $starttag->set_name($sep);
+ $element->set_name('noop');
+ $element->push_array($starttag);
+ }
+ }
+
+ $insert = $element;
+ $prev = $element->get_prev();
+ $element = $prev if defined $prev;
+ $notrim = 0 if $notrim;
+
+ redo;
+ }
+
+ # XML text
+ if ( defined $insert
+ and $line =~ s/^( *)(.+?) *$/$notrim ? $1.$2 : $2/oe )
+ {
+
+ if ($newlineadd) {
+ $insert->append_text("\n");
+ $newlineadd = 0;
+ }
+
+ $line =~ s/!!LT!!/</g;
+ $line =~ s/!!GT!!/>/g;
+
+ $insert->append_text($line);
+ }
+ }
+
+ $root->set_name('root');
+
+ # $root->print();
+ $self->set_root($root);
+
+ return undef;
+}
+
+1;
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-02 11:18:18 +0000