File Coverage

lib/Egg/Component.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Egg::Component;
#
# Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
#
# $Id: Component.pm 337 2008-05-14 12:30:09Z lushe $
#
use strict;
use warnings;
use UNIVERSAL::require;
use Class::C3;
use Tie::Hash::Indexed;
use Carp qw/ croak /;
use base qw/ Class::Data::Inheritable /;
use Egg::Component::Base;

our $VERSION= '3.02';

sub initialize {
	my $class= ref($_[0]) || $_[0];
	for my $method (qw/ namespace regists config /) {
		next if $class->can($method);
		$class->mk_classdata($method);
	}
	unless ($class->namespace) {
		$class->namespace($class);
		$class->regists($class->ixhash);
##		$class->config({}) unless $class->config;
	}
	no strict 'refs';  ## no critic.
	no warnings 'redefine';
	*{"${class}::___add_regists"}= sub {
		my $self = shift;
		my $label= shift || die q{I want label name.};
		my $pkg  = shift || die q{I want package name.};
		my $conf = shift || undef;
		$self->regists->{$label}= [$pkg, ($pkg->VERSION || '0.00'), $conf];
	  };
	$class;
}
sub isa_register {
	my($proto, $label, $pkg)= _get_args(@_);
	$proto= ref($proto) if ref($proto);
	no strict 'refs';  ## no critic.
	push @{"${proto}::ISA"}, $pkg;
	$proto->___add_regists($label, $pkg);
}
sub add_register {
	my($proto, $label, $pkg, $conf)= _get_args(@_);
	$proto->___add_regists($label, $pkg, $conf);
}
sub isa_terminator {
	my $proto= shift;
	$proto= ref($proto) if ref($proto);
	no strict 'refs';  ## no critic.
	my $isa= \@{"${proto}::ISA"};
	if (my $base= shift) {
		my $regex= quotemeta($base);
		@$isa= grep !/^$regex$/, @$isa;
		push @$isa, $base;
	}
	return $proto if ($isa->[$#{$isa}] eq 'Egg::Component::Base');
	@$isa= grep !/^Egg\:+Component\:+Base/, @$isa;
	push @$isa, 'Egg::Component::Base';
	$proto;
}
sub ixhash {
	shift;
	tie my %hash, 'Tie::Hash::Indexed';
	%hash= @_ if @_;
	\%hash;
}
sub _get_args {
	my $proto = shift;
	   $proto = ref($proto) if ref($proto);
	my $load  = shift || 0;
	my $label = shift || croak q{ I want label name. };
	my $pkg   = shift || $label;
	my $config= shift || undef;
	if ($load) {
		$load > 1 ? do { $pkg->use     or croak "$proto - $@" }
		          : do { $pkg->require or croak "$proto - $@" };
	}
	$pkg->config($config) if ($config and $pkg->can('config'));
	($proto, lc($label), $pkg, $config, @_);
}
sub ___add_regists { $_[0] }

1;

__END__

=head1 NAME

Egg::Component - Base class to treat Egg component.

=head1 SYNOPSIS

  package MyComponent;
  use strict;
  use base qw/ Egg::Component /;

  our @ISA;

  sub import {
     my $class= shift;
     $class->initialize;
     for (@_) {
         $class->isa_register(1, $_);
     }
     $class->isa_terminator;
     $class;
  }

=head1 DESCRIPTION

It is a base class to handle various components of the plug-in, the model, and the
view, etc.

This module contains the class for the terminal corresponding to the hook call.

=head1 METHODS

=head2 initialize

It initializes it.

Namespace, config, and the regists method of the relation to the class that calls
it by this method are generated.

=head2 namespace

The class name that calls initialize is returned.

=head2 config

The configuration that relates to the class that calls initialize is returned.

=head2 regists

It returns it with HASH to which the list of the component that relates to the
class that calls initialize is generated by the ixhash method.

The value of HASH is ARRAY reference.
The first element is a package name.
The second element is a version of the package.
The third element is a configuration.
It becomes a structure.

=head2 isa_register ([LOAD_BOOL], [LABEL_STRING], [PACKAGE_STRING], [CONFIG_DATA])

It registers in @ISA that relates to the class that calls the component, and
it registers in the component list by the regists method.

Require does PACKAGE_STRING at the same time as passing an effective value to
LOAD_BOOL.

LABEL_STRING is a name of the key when registering in the regists method.

PACKAGE_STRING is a package name of the component module. It is assumed the one
that the package name is specified for LABEL_STRING when omitting it.

When registering in regists, it preserves it in the third element when CONFIG_DATA
is specified.  It calls it in PACKAGE_STRING, and in addition, CONFIG_DATA is
passed and called to the Japanese oak including the config method and the method.

=head2 isa_terminator

L<Egg::Component::Base> is added to @ISA that relates to the class that calls the
component.

If the terminal class has already been registered, nothing is done.
Moreover, if the terminal class is not located at the end of @ISA, @ISA is
adjusted.

This method assumes the thing called after a series of 'isa_register' method is
processed.  Please call this method and adjust @ISA when you call 'isa_register'
again afterwards.

  for (@comps) {
      ............
      .....
      $class->isa_register( .... );
  }
  $class->isa_terminator;

=head2 add_register ([LOAD_BOOL], [LABEL_STRING], [PACKAGE_STRING], [CONFIG_DATA])

The operation of @ISA does all processing similar to the isa_register method
excluding the thing not done.

=head2 ixhash ([HASH_DATA])

L<Tie::Hash::Indexed> ¤Ë¤è¤ëHASH¤òÀ¸À®¤·¤Æ¡¢¤½¤ì¤òHASH¥ê¥Õ¥¡¥ì¥ó¥¹¤ÇÊÖ¤·¤Þ¤¹¡£

HASH defined to pass HASH_DATA is returned.

HASH_DATA is bad in the reference. It is made to pass with usual HASH.

  my $hash= $component->ixhash(
    hoge => 'booo',
    zooo => 'baaa',
    .....
    );

=head1 SEE ALSO

L<Egg::Release>,
L<Egg::Component::Base>,
L<UNIVERSAL::require>,
L<Class::C3>,
L<Tie::Hash::Indexed>,
L<Class::Data::Inheritable>,

=head1 AUTHOR

Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.

=cut