File Coverage

blib/lib/Class/MixinFactory/Factory.pm

Criterion	Covered	Total	%
statement	51	55	92.7
branch	6	10	60.0
condition	7	10	70.0
subroutine	10	10	100.0
pod	2	3	66.6
total	76	88	86.3

package Class::MixinFactory::Factory;

$VERSION = 0.91;

########################################################################

use strict;
use Carp ();

########################################################################

use Class::MixinFactory::InsideOutAttr qw(base_class mixin_prefix mixed_prefix);

use Class::MixinFactory::NEXT;
sub next_dispatch_class { 'Class::MixinFactory::NEXT' }

########################################################################

sub new {
  my $sym;
  my $self = bless \$sym, shift;
  while ( my $method = shift @_ ) {
    $self->$method( shift );
  }
  $self;
}

########################################################################

sub class {
  my $factory = shift;
  my @mixins = ( @_ == 1 and ref($_[0]) ) ? @{ $_[0] } : @_;

  my $base_class = $factory->base_class();
  my $mixin_prefix = $factory->mixin_prefix() || $base_class || '';
  my $mixed_prefix = $factory->mixed_prefix() || ( $base_class ? $base_class : ref($factory) || $factory ) . "::AUTO";

  my @classes = map { ( $_ =~ /::/ ) ? $_ : $mixin_prefix ? $mixin_prefix . '::' . $_ : $_ } @mixins;

  my $label = join '_', map { s/^\Q$mixin_prefix\E:://; s/:://g; $_ } map "$_", @classes;

  my $new_class = $mixed_prefix . "::" . ( $label || "Base" );

  return $new_class if do { no strict 'refs'; @{ "$new_class\::ISA" } };

  my @isa = ( @classes, $base_class, $factory->next_dispatch_class );

  foreach my $package ( @classes ) {
    next if do { no strict 'refs'; scalar keys %{ $package . '::' } };
    my $filename = "$package.pm";
    $filename =~ s{::}{/}g;
    # warn "require $filename";
    require $filename;
  }

  { no strict; @{ "$new_class\::ISA" } = @isa; }

  $new_class;
}

########################################################################

1;

__END__