package UML::MetaModel1;

use 5.6.1;
use strict;
use warnings;

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

=head1 NAME

UML::MetaModel1 - Bootstrapping implemenation of UML meta-model M1.

=head1 SYNOPSIS

  use UML::MetaModel1;

  my $f = UML::MetaModel->factory;
  my $metamodel = UML::MetaModel1->model;
  UML::Export::XMI->new()->export_Model($metamodel);

=head1 DESCRIPTION


=head1 USAGE

=head1 PATTERNS

=head1 EXPORT

None exported.

=head1 AUTHOR

Kurt Stephens, ks.perl@kurtstephens.com 2003/05/03

=head1 SEE ALSO

L<UML::MetaMetaModel|UML::MetaMetaModel>

=head1 VERSION

$Revision: 1.5 $

=head1 METHODS

=cut

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


use UML::MetaMetaModel::Util qw(:all);

our $metamodel_spec;
sub metamodel_spec
{
  unless ( $metamodel_spec ) {
    my $file = __PACKAGE__;

    #$DB::single = 1;
    $file =~ s@::@/@sg;
    $file .= '.pm';
    $file = $INC{$file};
    $file =~ s/1\.pm/\.spec/sg;

    use IO::File;
    use Carp qw(confess);

    my $fh = IO::File->new;
    $fh->open("< $file") || confess("Cannot read $file: $!");
    $metamodel_spec = join('', <$fh>);
    $fh->close;
  }

  $metamodel_spec;
}

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

my $model;
sub model
{
  my ($self, %opts) = @_;

  unless ( $model ) {
    my $desc = $opts{'desc'};

    $desc ||= $self->metamodel_spec;
    # $DB::single = 1;
    
    use UML::Import::MetaMetaModel;
      
    # $DB::single = 1;
    my $factory = $opts{'factory'};
    delete $opts{'factory'};
    $factory = $self->factory unless $factory;
    # confess("factory not specified") unless $factory;
    unless ( ref($factory) ) {
      eval "use $factory;"; die $@ if $@;
      $factory = $factory->new();
    }

    # $DB::single = 1;

    my $importer = new UML::Import::MetaMetaModel('factory' =>  $factory);

    $model = $importer->import_input($desc);

    if ( 0 ) {
      #local $UML::MetaMetaModel::Util::namespace_trace = 1;
      my (@ac) = Namespace_ownedElement_match($model, 'isaAssociationClass', 1);
      $DB::single = 1;
      
      print STDERR "AC: ", join(', ', map($_->name, @ac)), "\n";
    }

    # $DB::single = 1;
  }

  $model;
}


sub factory
{
  'UML::MetaMetaModel::FactoryBoot';
}


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


sub exporter
{
  my ($self, %opts) = @_;

  ####################################################################################
  # Generate metamodel code directely into Perl.
  #
  
  #$DB::single = 1;
  #use UML::Code;

  my $exporter = $opts{'exporter'} || 'UML::Export::Perl';
  delete $opts{'exporter'};

  if ( ! ref($exporter) ) {
    eval "use $exporter"; die $@ if $@;
    $exporter = $exporter->new
    (
     'output' => 'EVAL',
     'packagePrefix' => [ 'UML', 'MetaModel' ],
     'override' => 
     {
       'Perl' => {
	 '*' => {
	   '' => 1, # Enable generation for all Classifiers.
	 },
	 'Foundation::Data_Types::Boolean' => {
	   'primitive' => 1,
	   'construct' => q{(defined($x) && 
			     $x ne '' && 
			     $x ne '0' && 
			     $x ne 'false' && 
			     $x ne 'no'
			     )
			  },
	   'deconstruct' => q{ $x ? 'true' : 'false' },
	   'validate_type' => 1,
	 },
	   'Foundation::Data_Types::Integer' => {
	     'primitive' => 1,
	     'validate_type' => q{$x =~ /^[-+]?[0-9]+$/},
	   },
	 'Foundation::Data_Types::UnlimitedInteger' => {
	   'primitive' => 1,
	   'validate_type' => q{$x =~ /^[-+]?[0-9]+|\*$/},
	 },
	 'Foundation::Data_Types::String' => {
	   'primitive' => 1,
	   'validate_type' => 1,
	 },
	 'Foundation::Data_Types::Name' => {
	   'primitive' => 1,
	   # As far as I know this is the criteria for a Name.
	   'validate_type' => q{$x !~ /::/},
	 },
       },

       'Java' => {
	 '*' => {
	   '' => 1,
	 },
	 'Foundation::Data_Types::Boolean' => {
	   'primitive' => 1,
	   'primitive_type' => 'boolean',
	   'construct_type' => 'java.lang.String',
	   'construct' => q{
	     (x != null && 
	      ! x.equals("") && 
	      ! x.equals("0") && 
	      ! x.equals("false") && 
	      ! x.equals("no")
	      )
	   },
	   'deconstruct_type' => 'java.lang.String',
	   'deconstruct' => q{ x ? "true" : "false" },
	   'validate_type' => 'true',
	   'validate_type_type' => 'java.lang.String',
	 },
	   'Foundation::Data_Types::Integer' => {
	     'primitive' => 1,
	     'primitive_type' => 'int',
	     'validate_type' => q{true /* $x =~ /^[-+]?[0-9]+$/ */ }, # FIX ME
	   },
	 'Foundation::Data_Types::UnlimitedInteger' => {
	   'primitive' => 1,
	   'primitive_type' => 'int',
	   'construct_type' => 'java.lang.String',
	   'construct' => q{ x.equals("*") ? java.lang.Integer.MAX_VALUE : java.lang.Integer.parseInt(x) },
	   'deconstruct_type' => 'java.lang.String',
	   'deconstruct' => q{ x == java.lang.Integer.MAX_VALUE ? "*" : java.lang.Integer.toString(x) },
	   'validate_type' => q{ true }, # FIX ME
	 },
	 'Foundation::Data_Types::String' => {
	   'primitive' => 1,
	   'primitive_type' => 'java.lang.String',
	   'validate_type' => 'true',
	 },
	 'Foundation::Data_Types::Name' => {
	   'primitive' => 1,
	   'primitive_type' => 'java.lang.String',
	   # As far as I know this is the criteria for a Name.
	   'validate_type' => q{ true /* x !~ /::/ */}, # FIX ME
	 },
       },

     },
     %opts,
     );
  }

  $exporter;
}


sub export_Model
{
  my ($self, %opts) = @_;

  my $model = $opts{'model'};
  delete $opts{'model'};

  confess("model not specified") unless $model;
  unless ( ref($model) ) {
    eval "use $model;"; die if $@;
    $model = $model->model;
  }

  $self->exporter(%opts)->export_Model($model);
}



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


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: ###

