summaryrefslogtreecommitdiff
path: root/Xerl/XML
diff options
context:
space:
mode:
authorPaul Buetow (mars.fritz.box) <paul@buetow.org>2013-09-28 14:36:08 +0200
committerPaul Buetow (mars.fritz.box) <paul@buetow.org>2013-09-28 14:36:08 +0200
commitf3edcebfc981ac077bcd61aac2dd3d1682c41bc2 (patch)
tree8947dbab833b5e8c133bd949f9ddc793bb454480 /Xerl/XML
parent6687ecb69c355c987948d4a2fcfce90b60904acd (diff)
parent6460ff71ae10f85d7dc12fae40d4c7f05ea41db7 (diff)
Merge branch 'hosts' of git.buetow.org:/git/xerl into hosts
Diffstat (limited to 'Xerl/XML')
-rw-r--r--Xerl/XML/Element.pm111
-rw-r--r--Xerl/XML/Reader.pm163
2 files changed, 0 insertions, 274 deletions
diff --git a/Xerl/XML/Element.pm b/Xerl/XML/Element.pm
deleted file mode 100644
index ba94807..0000000
--- a/Xerl/XML/Element.pm
+++ /dev/null
@@ -1,111 +0,0 @@
-# Xerl (c) 2005-2011,2013 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 buetow.org 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
deleted file mode 100644
index 3605c04..0000000
--- a/Xerl/XML/Reader.pm
+++ /dev/null
@@ -1,163 +0,0 @@
-# Xerl (c) 2005-2011,2013 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 buetow.org 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() );
-
- return -1 if -1 == $xmlfile->fslurp();
- $self->set_array( $xmlfile->get_array() );
-
- return 0;
-}
-
-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;
-
- my $flag = 0;
-
- do {
-
- # Open XML tag
- if ( $line =~ s#<([^/].+?)( (.*?))? *>##o ) {
- my ( $name, $params ) = ( $1, $3 );
- $flag = 1;
-
- my $DEBUG = $name =~ /^=/ ? 1 : 0;
- $self->debug($name, $params) if $DEBUG;
-
- # 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);
-
- $next->print() if $DEBUG;
-
- # 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 ) {
- $flag = 1;
-
- #print "XML::<$1>\n";
-
- $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);
- }
- } while ( $flag == 1 );
- }
-
- $root->set_name('root');
-
- # $root->print();
- $self->set_root($root);
-
- return undef;
-}
-
-1;