crossref.pm

普通的ETL工具

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: ETL::Pequel3::CrossRef.pm
#  Created	: 21 September 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::CrossRef;
require 5.005_62;
use strict;
use warnings;
use stl;
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::CrossRef; 
	use base qw(Class::STL::Element);
	use Class::STL::ClassMembers 
		qw( 
			err 
			catalogue 
			_ref_list 
			_repository
			xref_key 
			target_obj 
			target_name 
			pequel_ref 
		);
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		use ETL::Pequel3::Error;
		$self->err(ETL::Pequel3::Error->new());
		use ETL::Pequel3::Catalogue;
		$self->catalogue(ETL::Pequel3::Catalogue->new());

#>		$self->err()->user_error(10601, "Attribute @{[ __PACKAGE__ ]}::pequel_ref is undefined!")
		return unless (defined($self->pequel_ref())); # for now
		$self->err()->user_error(10602, "Attribute @{[ __PACKAGE__ ]}::target_name is undefined!")
			unless (defined($self->target_name()));
		$self->err()->user_error(10603, "Attribute @{[ __PACKAGE__ ]}::target_obj is undefined!")
			unless (defined($self->target_obj()));

		$self->_repository(ETL::Pequel3::CrossRef::Repository::Root->new()); # Singleton
		$self->xref_key(
#>			$self->target_obj()->pequel_ref()->pequel_name()
			$self->pequel_ref()->pequel_name()
			. '::'
			. (split(/[:]+/, ref($self->target_obj())))[
				$self->target_obj()->isa('ETL::Pequel3::Type::Field::Abstract') 
					? -1 : -2 ]
			. '::'
			. $self->target_name()
		) unless (defined($self->xref_key()));
		$self->_repository()->push_back($self->_repository()->factory(catalogue_name => $self->xref_key()))
			unless ($self->_repository()->exists($self->xref_key()));
		$self->_ref_list($self->_repository()->exists($self->xref_key()));

		$self->err()->user_error(10901, "Class @{[ __PACKAGE__ ]}::target_name is undefined!")
			unless (defined($self->target_name()));

		return $self;
	}
	sub add
	{
		my $self = shift;
		my $obj_ref = shift;
		my $caller = shift;
		my $direction = shift;

		# TODO: ignore if obj_ref cannot xref() for now;
		return $self unless ($obj_ref->can('xref'));
		return $self unless (defined($self->pequel_ref())); # for now

		# Only insert once:
		return $self if 
		(
			$self->_ref_list()->exists($obj_ref->xref()->xref_key())
			&& $self->_ref_list()->exists($obj_ref->xref()->xref_key())->direction() eq $direction
		);

		$self->_ref_list()->push_back($self->_ref_list()->factory(
			direction => $direction,
			obj_ref => $obj_ref, 
			xref_key => $obj_ref->xref()->xref_key(),
		));
		$self->_ref_list()->back()->comment("@{[ 
				$self->xref_key()
			]}  @{[ 
				$self->_ref_list()->back()->direction()
			]}  @{[
				$obj_ref->xref()->xref_key()
			]} -- @{[
				$self->_ref_list()->size()
			]} -- @{[
				$caller
		   	]} ");
		$self->err()->trace_msg(100, "XREF:@{[ $self->_ref_list()->back()->comment() ]}");
		return $self;
	}
	sub check
	{
		my $self = shift;
		my $node = shift;
		my $path = shift;
		foreach (grep($_->direction() eq '>', $self->_ref_list()->to_array())) 
		{
			$path->push($_);
			$self->err()->user_error(10902, "Circular reference:\n@{[
					$node->xref_key()
					. qq{\n->}
					. join(qq{\n->}, map($_->xref_key(), $path->to_array())) 
				]}")
				if ($node->xref_key() eq $_->xref_key());
			$_->obj_ref()->xref()->check($node, $path);
			$path->pop();
		}
	}
	sub referenced_by
	{
		my $self = shift;
		my $obj_ref = shift;
		my $caller = shift || do{ my $tmp=join('->', caller()); $tmp; };
		return $self->add($obj_ref, $caller, '<');
	}
	sub references
	{
		my $self = shift;
		my $obj_ref = shift;
		my $caller = shift || do{ my $tmp=join('->', caller()); $tmp; };
		$self->add($obj_ref, $caller, '>');
		$self->check($self, stl::stack(element_type => 'ETL::Pequel3::CrossRef::Object'));
		return $self;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::CrossRef::Object; 
	use base qw(Class::STL::Element);
	use Class::STL::ClassMembers qw( obj_ref xref_key comment ),
		Class::STL::ClassMembers::DataMember->new(name => 'direction', default => '>', validate => '^(>|<)$');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::CrossRef::Repository; 
	use base qw(ETL::Pequel3::Type::Catalogue);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'target_mem_name', default => 'xref_key'),
		Class::STL::ClassMembers::DataMember->new(name => 'catalogue_name', default => '__NULL__'),
		Class::STL::ClassMembers::DataMember->new(name => 'element_type', 
													default => 'ETL::Pequel3::CrossRef::Object');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::CrossRef::Repository::Root; 
	use base qw(ETL::Pequel3::Type::Catalogue);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'target_mem_name', default => 'catalogue_name'),
		Class::STL::ClassMembers::DataMember->new(name => 'element_type', 
													default => 'ETL::Pequel3::CrossRef::Repository');
	use Class::STL::ClassMembers::SingletonConstructor;
}
# ----------------------------------------------------------------------------------------------------
1;