package UML::MetaMetaModel::Factory;

use 5.6.1;
use strict;
use warnings;

our $AUTHOR = q{ ks.perl@kurtstephens.com 2004/04/06 };
our $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf "%d." . "%03d" x $#r, @r };

=head1 NAME

UML::MetaModel::Factory - Defines a factory for (meta-)model construction.

=head1 SYNOPSIS

  use UML::MetaMetaModel::Factory;
  $factory = UML::MetaMetaModel::Factory->new('classMap' => ...,
                                             );
  $factory->create(...);
  $factory->createInstance(...);

=head1 DESCRIPTION

=head1 USAGE

=head1 EXPORT

None exported.

=head1 AUTHOR

Kurt Stephens, ks.perl@kurtstephens.com 2003/04/06

=head1 SEE ALSO

L<UML::XMI|UML::XMI>

=head1 VERSION

$Revision: 1.6 $

=head1 METHODS

=cut


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


use base qw(UML::MetaMetaModel::Object);

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

use Carp qw(confess);

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


my $loaded = { };

sub initialize
{
  my ($self, $expr) = @_;

  confess("classMap undefined") unless $self->{'classMap'};

  $self->{'debugCreate'} ||= 0;

  # Use global loaded hash.
  $self->{'.loaded'} ||= $loaded;

  $self->SUPER::initialize;
}


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

sub classMap
{
  my ($self) = @_;

  unless ( $self->{'classMapInited'} ) {

    #$DB::single = 1;
    # Get rid of the next line!!!
    # $self->{'classMap'} ||= 'UML::MetaMetaModel';
    confess("classMap undefined") unless $self->{'classMap'};
    
    # Get class factory map from a class?
    unless ( ref($self->{'classMap'}) ) { 
      eval "use $self->{classMap};"; die $@ if $@;
      $self->{'classMap'} = $self->{'classMap'}->factory_map;
    }
    
    if ( ref($self->{'classMap'}) eq 'ARRAY' ) {
      my %map;
      
      my @x = @{$self->{'classMap'}};
      
      while ( @x ) {
	my ($name, $cls) = splice(@x, 0, 2);
	if ( exists $map{$name} && $map{$name} ne $cls ) {
	  # This will cause error for ambigous names.
	  $map{$name} .= ' ' . $cls;
	} else {
	  $map{$name} = $cls;
	}
      }
      
      $self->{'classMap'} = \%map;
    }
    
    # $DB::single = 1;
    
    confess("classMap not a hash") unless ref($self->{'classMap'}) eq 'HASH';
    
    $self->{'classMapInited'} ++; 
  }

  $self->{'classMap'};
}


sub class
{
  my ($self, $name, @args) = @_;

  my $cls = $self->classMap->{$name};
  confess("Unknown Classifier '$name'") unless $cls;

  # Dynamically load it?
  unless ( $self->{'.loaded'}{$cls} ) {
    # $DB::single = 1;
    no strict 'refs';
    unless ( ${"${cls}::VERSION"} ) {
      # $DB::single = 1;
      eval "use $cls"; die $@ if $@;
      ${"${cls}::VERSION"} ||= 1;
    }
    $self->{'.loaded'}{$cls} = 1;
  }

  $cls;
}


sub create_instance
{
  my ($self, $name, @args) = @_;

  # Get the class for the name.
  my $cls = $self->class($name);

  # Call the classes new method.
  my $obj = $cls->__new_instance(@args);

  # Print some crap.
  if ( $self->{'debugCreate'} ) {
    local $" = ', ';
    print STDERR ref($self),"->create_instance($name, @args) = $obj\n";
  }

  $obj;
}


sub create
{
  my ($self, $name, @args) = @_;
  
  #$DB::single = $name eq 'Model';
  
  # Get the class for the name.
  my $cls = $self->class($name);

  # Call the classes new method.
  my $obj = $cls->new(@args);

  # Print some crap.
  if ( $self->{'debugCreate'} ) {
    local $" = ', ';
    print STDERR ref($self),"->create($name, @args) = $obj\n";
  }

  # die("Attribute 2561!!!\n") if $obj->{'_id'} eq 2561;

  $obj;
}


sub flush
{
  $_[0];
}


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

1;

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


### Keep these comments at end of file: ks.perl@kurtstephens.com 2003/04/06 ###
### Local Variables: ###
### mode:perl ###
### perl-indent-level:2 ###
### perl-continued-statement-offset:0 ###
### perl-brace-offset:0 ###
### perl-label-offset:0 ###
### End: ###

