schemagen.pm

普通的ETL工具

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: ETL::Pequel3::Type::SchemaGen.pm
#  Created	: 23 March 2007
#  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::SchemaGen;
require 5.005_62;
use strict;
use warnings;
use stl;
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::SchemaGen::Abstract;
	use base qw(Class::STL::Element);
	use Class::STL::ClassMembers 
		qw( 
			err 
			catalogue 
			properties 
			configuration 
			POM 
			name 
			xsd_root 
			schema_root 
			schema_tags 
		),
		Class::STL::ClassMembers::DataMember->new(name => 'xml_version', default => '1.0'),
		Class::STL::ClassMembers::DataMember->new(name => 'w3_schema_namespace', 
			default => 'http://www.w3.org/2001/XMLSchema'),
		Class::STL::ClassMembers::DataMember->new(name => 'elementFormDefault', default => 'qualified'),
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Pequel schema (XSD) generator abstract'),
		Class::STL::ClassMembers::DataMember->new(name => 'namespace_prefix', default => 'xs'); #TODO: should be property?
	use Class::STL::ClassMembers::Constructor;
	use vars qw( $AUTOLOAD );
	sub AUTOLOAD
	{
		my $self = shift;
		(my $funcname = $AUTOLOAD) =~ s/.*:://;
		if ($funcname =~ s/^xs_//) {
#>			$self->err()->user_error(10601, "Unknown xml-schema tag name '$funcname'!")
#>				unless ($self->POM()->catalogue()->xsd_schema_tags()->exists($funcname));
			return $self->xs_abstract($self->namespace_prefix() . ':' . $funcname, @_);
		}
	}
	sub DESTROY { }
	sub new_extra
	{
		my $self = shift;
		use ETL::Pequel3::Error;
		$self->err(ETL::Pequel3::Error->new());
		use ETL::Pequel3::Type::Catalogue;
		$self->catalogue(ETL::Pequel3::Catalogue->new());
		$self->properties($self->catalogue()->properties());
		defined($self->POM()->config())
			? $self->configuration($self->POM()->config())
			: $self->configuration($self->properties());
		$self->namespace_prefix($self->configuration()->xmlschema_ns_prefix());
		return $self;
	}
	sub xs_abstract # virtual -- must override
	{
		my $self = shift;
		my $tag = shift;
		my $node = shift;
		my %attrs = @_;
		return; # leaf
	}
	sub attribute # virtual -- must override
	{
		my $self = shift;
		my $node = shift;
		return $self; # for chaining attribute calls;
	}
	sub comment # virtual -- must override
	{
		my $self = shift;
		my $node = shift;
		return $self; # for chaining attribute calls;
	}
	sub text # virtual -- must override
	{
		my $self = shift;
		my $node = shift;
		my $text = shift;
		return $self; # for chaining attribute calls;
	}
	sub to_string # virtual -- must override
	{
		my $self = shift;
		return; # return text for xml document;
	}
	sub exists # virtual -- must override
	{
		my $self = shift;
		my $tag = shift;
		my $name = shift;
		my $xs_node = shift;
		return; # true if tag-type name exists in xs_node tree
	}
	sub generate
	{
		my $self = shift;
		my $complex_type = $self->xs_complexType(
			$self->xs_element($self->schema_root(), name => 'pequel'));
		my $sequence = $self->xs_sequence($complex_type);
		# Section Type:
		foreach ($self->POM()->catalogue()->sections()->to_array()) 
		{
			my $elem = $self->xs_element($sequence, 
				'ref' => $_->section_name(),
#?				( do { $_->required() ? () : (minOccurs => '0') } ),
				( minOccurs => '0' ),
				#TODO maxOccures => '1' for configuration, etc
				( do { $_->attributes()->exists('on') ? (maxOccurs => '2') : () } ),
				( do { $_->target_mem_name() ne 'section_name' ? (maxOccurs => 'unbounded') : () } ),
			);
			$_->xml_schema($self, $self->schema_root());
		}
		{
			# Element: pequel -- sub pequels
			my $elem = $self->xs_element($sequence, 
				'ref' => 'pequel', 
				minOccurs => '0', 
				maxOccurs => 'unbounded'
			);
		}
		#TODO: grep all ETL::Pequel3::Type::DataMember::XSDAttribute member types:
		{
			# Attribute: version
			my $attribute = $self->xs_attribute($complex_type, 
				name => 'version',
				use => 'optional'
			);
			my $restriction = $self->xs_restriction($self->xs_simpleType($attribute),
				base => "@{[ $self->namespace_prefix() ]}:decimal" #TODO: ->xs_type()
			);
		}
		{
			# Attribute: script_version
			my $attribute = $self->xs_attribute($complex_type, 
				name => 'script_version',
				use => 'optional'
			);
			my $restriction = $self->xs_restriction($self->xs_simpleType($attribute),
				base => "@{[ $self->namespace_prefix() ]}:decimal" #TODO: ->xs_type()
			);
		}
		{
			# Attribute: pequel_name
			my $attribute = $self->xs_attribute($complex_type, 
				name => 'pequel_name',
				use => 'required'
			);
			my $restriction = $self->xs_restriction($self->xs_simpleType($attribute),
			   	base => "@{[ $self->namespace_prefix() ]}:NMTOKEN" #TODO: ->xs_type()
			);
		}
		{
			# Attribute: script_filename
			my $attribute = $self->xs_attribute($complex_type, 
				name => 'script_filename',
				use => 'optional'
			);
			my $restriction = $self->xs_restriction($self->xs_simpleType($attribute),
			   	base => "@{[ $self->namespace_prefix() ]}:token" #TODO: ->xs_type()
			);
		}
		# Property Type:
		map
		(
			$_->xml_schema($self, $self->schema_root()), 
			$self->POM()->catalogue()->properties()->to_array()
		);
		{
			# Aggregate Type:
			$self->comment($self->schema_root(), 'Aggregate Type');
			my $element = $self->xs_element($self->schema_root(), name => 'aggregate_types');
			my $choice = $self->xs_choice($self->xs_complexType($element));
			map
			(
				$_->xml_schema($self, $choice), 
				$self->POM()->catalogue()->aggregates()->to_array()
			);
		}
		{
			# Pequel Type:
			$self->comment($self->schema_root(), 'Pequel Type');
			my $element = $self->xs_element($self->schema_root(), name => 'pequel_types');
			my $choice = $self->xs_choice($self->xs_complexType($element));
			map
			(
				$_->xml_schema($self, $choice), 
				$self->POM()->catalogue()->pequel_types()->to_array()
			);
		}
		# dataset types
		# macro types
		# ...
	}
	sub writefile
	{
		my $self = shift;
		my $filename = shift || do {
			(
				defined($self->configuration()->prefix()) && $self->configuration()->prefix() ne ''
				? $self->configuration()->prefix()
				: $self->POM()->catalogue()->properties()->exec_dir()
			) . '/pequel.xsd';

		};
		open(XML, ">$filename");
		print XML $self->to_string();
		close(XML);
		return $filename;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::SchemaGen::Default; # based on XML::Mini;
	use base qw(ETL::Pequel3::SchemaGen::Abstract);
	use Class::STL::ClassMembers qw( xml_doc ),
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Pequel schema (XSD) generator XML:Mini based'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'default');
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		use XML::Mini::Document;
		my $self = shift;
		$self->xml_doc(XML::Mini::Document->new()); # XML::Mini
		$self->xsd_root($self->xml_doc()->getRoot());
		$self->xsd_root()->header('xml')->attribute('version', $self->xml_version());
		$self->xsd_root()->comment("W3C Schema generated by Pequel3 @{[
			$self->properties()->version() 
			]} (@{[ $self->properties()->pequel_home_page() ]})");
		$self->copynotice();
		$self->schema_root($self->xs_schema($self->xsd_root(),
			"xmlns:@{[ $self->namespace_prefix() ]}" => $self->w3_schema_namespace(),
			'elementFormDefault' => $self->elementFormDefault(),
		));
	}
	sub copynotice
	{
		my $self = shift;
		$self->xsd_root()->comment("Copyright @ 1999-2007, Mario Gaffiero. All Rights Reserved.");
		$self->xsd_root()->comment("'Pequel' TM Copyright 1999-2007, Mario Gaffiero. All Rights Reserved.");
		$self->xsd_root()->comment("This program and all its component contents is copyrighted free software by Mario Gaffiero and is released under the GNU General Public License (GPL), Version 2, a copy of which may be found at http://www.opensource.org/licenses/gpl-license.html");
		$self->xsd_root()->comment("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.");
		$self->xsd_root()->comment("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.");
		$self->xsd_root()->comment("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");
	}
	sub to_string
	{
		my $self = shift;
		return $self->xml_doc()->toString() # XML::Mini
	}
	sub exists 
	{
		my $self = shift;
		my $tag = shift;
		my $name = shift;
		my $xs_node = shift;
		return grep
		(
			$_->name() eq "@{[ $self->namespace_prefix() ]}:$tag" 
				&& $_->attribute('name') eq $name, 
			@{$xs_node->getAllChildren()}
		); # true if tag-type name exists in xs_node tree
	
	}
	sub xs_abstract
	{
		my $self = shift;
		my $tag = shift;
		my $node = shift;
		my %attrs = @_;
		$self->err()->user_error(10000, "@{[ __PACKAGE__]}->xs_abstract($tag,...) undefined \$node (2nd) arg!")
		unless (defined($node));
		my $leaf = $node->createChild($tag); # XML::Mini
		$self->attribute($leaf, %attrs);
		return $leaf;
	}
	sub attribute
	{
		my $self = shift;
		my $node = shift;
		my %attrs = @_;
		map($node->attribute($_, $attrs{$_}), keys(%attrs)); # XML::Mini
		return $self; # for chaining attribute calls;
	}
	sub comment
	{
		my $self = shift;
		my $node = shift;
		my $comment = shift;
		$node->comment($comment); # XML::Mini
		return $self; # for chaining comment calls;
	}
	sub text # virtual -- must override
	{
		my $self = shift;
		my $node = shift;
		my $text = shift;
		$node->text($text); # XML::Mini
		return $self; # for chaining attribute calls;
	}
}
# ----------------------------------------------------------------------------------------------------
# CATALOGUE
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::SchemaGen::Catalogue::Abstract;
	use base qw(ETL::Pequel3::Type::Catalogue);
	use Class::STL::ClassMembers qw( pequel_ref ),
		Class::STL::ClassMembers::DataMember->new(name => 'catalogue_name', default => 'xml_schemas'),
		Class::STL::ClassMembers::DataMember->new(name => 'target_mem_name', default => 'name'),
		Class::STL::ClassMembers::DataMember->new(name => 'element_type', default => 'ETL::Pequel3::SchemaGen::Abstract');
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		$self->push_back(
			ETL::Pequel3::SchemaGen::Default->_new(),
		);
		return $self;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::SchemaGen::Catalogue;
	use base qw(ETL::Pequel3::SchemaGen::Catalogue::Abstract);
	use Class::STL::ClassMembers;
	use Class::STL::ClassMembers::SingletonConstructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::SchemaGen::Catalogue::User;
	use base qw(ETL::Pequel3::SchemaGen::Catalogue::Abstract);
	use Class::STL::ClassMembers;
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
1;