xmlparser.pm

普通的ETL工具

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: ETL::Pequel3::Type::XmlParser.pm
#  Created	: 23 May 2006
#  Author	: Mario Gaffiero (gaffie)
#
# Copyright 1999-2007 Mario Gaffiero.
# 
# This file is part of Pequel(TM).
# 
# Pequel is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
# 
# Pequel is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with Pequel; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
# ----------------------------------------------------------------------------------------------------
# Modification History
# When          Version     Who     What
# ----------------------------------------------------------------------------------------------------
package ETL::Pequel3::Type::XmlParser;
require 5.005_62;
use strict;
use warnings;
use stl;
# ----------------------------------------------------------------------------------------------------
# Conversions: xml-file | xml-string --> hash --> pequel --> xml-dom --> xml-file | xml-string
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::XmlParser::Abstract;
	use base qw(Class::STL::Element);
	use Class::STL::ClassMembers qw( err catalogue POM configuration parser_name xml_doc );
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		use ETL::Pequel3::Type::DataMember;
		use ETL::Pequel3::Error;
		$self->err(ETL::Pequel3::Error->new());
		$self->catalogue(ETL::Pequel3::Catalogue->new());
		defined($self->POM()->config())
			? $self->configuration($self->POM()->config())
			: $self->configuration(ETL::Pequel3::Type::Properties::User->new());
		return $self;
	}
	sub pequel2xml # virtual
	{
		my $self = shift;
		my $POM = shift || $self->POM(); # sub || root
		my $xml_node = shift || do { };
	}
	sub xml2string # virtual -- override should call this
	{
		my $self = shift;
		$self->pequel2xml() unless (defined($self->xml_doc()));
	}
	sub file2hash
	{
		require XML::Simple;
		my $self = shift;
		my $filename = shift;
		return XML::Simple->new()->XMLin($filename, NormaliseSpace => 2);
	}
	sub string2hash
	{
		require XML::Simple;
		my $self = shift;
		my $string = shift;
		return XML::Simple->new()->XMLin($string, NormaliseSpace => 2);
	}
	sub hash2xml
	{
		my $self = shift;
		my $hash = shift;
		$self->POM()->hash2pequel($hash);
		$self->pequel2xml();
	}
	sub xml2hash
	{
		my $self = shift;
		return $self->string2hash($self->xml2string());
	}
	sub readfile
	{
		my $self = shift;
		my $filename = shift || do {
			$self->POM()->config()->prefix() 
			. '/' 
			. (split(/[\/]+/, $self->POM()->script_filename()))[-1]
			. ".xml"
		};
		$self->POM()->hash2pequel($self->file2hash($filename));
		return $filename;
	}
	sub writefile
	{
		my $self = shift;
		my $filename = shift || do {
			$self->POM()->config()->prefix() 
			. '/' 
			. (split(/[\/]+/, $self->POM()->script_filename()))[-1]
			. ".xml"
		};
		open(XML, ">$filename");
		print XML $self->xml2string();
		close(XML);
		return $filename;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::XmlParser::Default;
	use base qw(ETL::Pequel3::Type::XmlParser::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'parser_name', default => 'default');
	use Class::STL::ClassMembers::Constructor;
	sub pequel2xml # recursive
	{
		require XML::Mini::Document;
		my $self = shift;
		my $POM = shift || $self->POM();
		my $xml_node = shift || do { 
			$self->xml_doc(XML::Mini::Document->new());
			my $n = $self->xml_doc()->getRoot()->createChild('pequel');
			$n->attribute('version', $ETL::Pequel3::VERSION);
			$n->attribute('script_version', $self->configuration()->script_version());
#?			$n->attribute('script_version', $POM->config()->script_version());
			$n->attribute('xmlns:xs', 'http://www.w3.org/2001/XMLSchema-instance');
			$n->attribute('xs:noNamespaceSchemaLocation', 'pequel.xsd');
			$n;
		};
		$xml_node->attribute('pequel_name', $POM->pequel_name());
		$xml_node->attribute('script_filename', $POM->script_filename())
			if (defined($POM->script_filename()));
		return $xml_node
			if 
			(
				defined($POM->script_filename())
				&& $POM->script_filename() =~ /\.(xml|xpq|dump)$/
			);
		foreach (map($_->to_array(), $POM->user_sections()->to_array()))
		{
			my $xml_sub_node = $xml_node->createChild($_->section_name());
			foreach my $k (grep(defined($_->value()), $_->attributes()->to_array())) {
				my $att = $xml_sub_node->createChild($k->name());
				$att->text($k->value());
			}
			if ($_->user_notes()->size()) {
				my $xml_notes = $xml_sub_node->createChild("user_notes");
				map($xml_notes->text($_->data()), $_->user_notes()->to_array());
			}
			foreach my $item ($_->items()->to_array()) {
				my $xml_child = $xml_sub_node->createChild("item");
				foreach my $i (grep(defined($_->value()), $item->attributes()->to_array())) {
					my $att = $xml_child->createChild($i->name());
					$att->text($i->value());
				}
			}
		}
		map
		(
			$self->pequel2xml($_, $xml_node->createChild('pequel')), 
			$POM->user_pequels()->to_array()
		); # recurse
		return $xml_node;
	}
	sub xml2string
	{
		my $self = shift;
		$self->SUPER::xml2string(@_);
		return $self->xml_doc()->toString();
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::XmlParser::Element;
	use base qw(ETL::Pequel3::Type::XmlParser::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'parser_name', default => 'element');
	use Class::STL::ClassMembers::Constructor;
	sub pequel2xml
	{
		require XML::Element;
		my $self = shift;
		my $POM = shift || $self->POM();
		my $xml_node = shift || do { 
			my $n = $self->xml_doc(XML::Element->new('pequel'));
			$n->attr('version', $ETL::Pequel3::VERSION);
			$n->attr('xmlns:xs', 'http://www.w3.org/2001/XMLSchema-instance');
			$n->attr('xs:noNamespaceSchemaLocation', 'pequel.xsd');
			$n;
		};
		$xml_node->attr('pequel_name', $POM->pequel_name());
		$xml_node->attr('script_filename', $POM->script_filename())
			if (defined($POM->script_filename()));
		foreach (map($_->to_array(), $POM->user_sections()->to_array()))
		{
			my $xml_sub_node = XML::Element->new($_->section_name());
			$xml_node->push_content($xml_sub_node);
			foreach my $k (grep(defined($_->value()), $_->attributes()->to_array())) 
			{
				my $sub = XML::Element->new($k->name());
				$xml_sub_node->push_content($sub);
				$sub->push_content($k->value());
			}
			foreach my $item ($_->items()->to_array()) 
			{
				my $xml_child = XML::Element->new('item');
				$xml_sub_node->push_content($xml_child);
				foreach my $i (grep(defined($_->value()), $item->attributes()->to_array())) 
				{
					my $sub = XML::Element->new($i->name());
					$xml_child->push_content($sub);
					$sub->push_content($i->value());
				}
			}
		}
		map 
		(
			do {
				my $node = XML::Element->new('pequel');
				$xml_node->push_content($node);
				$self->pequel2xml($_, $node); # recurse
			},
			$POM->user_pequels()->to_array()
		); 
		return $xml_node;
	}
	sub xml2string
	{
		require XML::Element;
		my $self = shift;
		$self->SUPER::xml2string(@_);
		return join("\n",
			XML::Element->new('~pi', text => 'xml version="1.0"')->as_XML,
			$self->xml_doc()->as_XML()
		);
	}
}
# ----------------------------------------------------------------------------------------------------
# CATALOGUE
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::XmlParser::Catalogue::Abstract;
	use base qw(ETL::Pequel3::Type::Catalogue);
	use Class::STL::ClassMembers qw( POM ),
		Class::STL::ClassMembers::DataMember->new(name => 'catalogue_name', default => 'xml_parsers'),
		Class::STL::ClassMembers::DataMember->new(name => 'target_mem_name', default => 'parser_name'),
		Class::STL::ClassMembers::DataMember->new(name => 'element_type', default => 'ETL::Pequel3::Type::XmlParser::Abstract');
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		$self->push_back(
			ETL::Pequel3::Type::XmlParser::Default->_new(),
			ETL::Pequel3::Type::XmlParser::Element->_new(),
		);
		return $self;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::XmlParser::Catalogue;
	use base qw(ETL::Pequel3::Type::XmlParser::Catalogue::Abstract);
	use Class::STL::ClassMembers;
	use Class::STL::ClassMembers::SingletonConstructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::XmlParser::Catalogue::User;
	use base qw(ETL::Pequel3::Type::XmlParser::Catalogue::Abstract);
	use Class::STL::ClassMembers;
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
1;