package UML::MetaModel;

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.4 $ =~ /\d+/g); sprintf "%d." . "%03d" x $#r, @r };

=head1 NAME

UML::MetaModel - An implementation of UML 1.5 Meta-model (M1).

=head1 SYNOPSIS

  use UML::MetaModel;
  use UML::Export::XMI;
  use UML::Export::Perl;
  my $f = UML::MetaModel->factory;
  my $model = $f->create('Model');
  my $cls = $f->create('Class', 
                       'name' => 'AClass',
                       'namespace' => $root,
		       );
  my $attr = $f->create('Attribute',
	 	        'type' => $cls,
		        'name' => 'foobar',
		        'visibility' => 'public',
		        'owner' => $cls,
		        );

  # Generate XMI for the model.
  UML::Export::XMI->new()->export_Model($model);
  # Generate Perl code of the model.
  UML::Export::Perl->new('packagePrefix' => 'My::Package')->export_Model($model);


  # Generate XMI for the UML meta-model itself!!!
  my $metamodel = UML::MetaModel->model;
  UML::Export::XMI->new()->export_Model($metamodel);


=head1 DESCRIPTION

This package allow UML models to be represented and queried from within perl.
It implements both the UML meta-meta-model and meta-model.

=head1 USAGE

=head1 PATTERNS

=head1 EXPORT

None exported.

=head1 AUTHOR

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

=head1 SEE ALSO

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

=head1 VERSION

$Revision: 1.4 $

=head1 METHODS

=cut

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


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


####################################################################################
####################################################################################
####################################################################################
# Below is a ad-hoc description of the UML 1.5 Metamodel.
#
# This description is parsed into objects in the UML::MetaMetaModel package.
# UML::MetaMetaModel implements a subset of the UML Metamodel for the purpose
# of boot-strapping the UML.
#
# The UML::Export classes only use a the meta-meta-model subset interfaces
# while exporting.
#
# Thus the Export classes have double-duty:
# 1. Generate code for the UML Meta-model implementation
# 2. Generate code for new models generated by UML editors.
#
####################################################################################
####################################################################################
####################################################################################

my $metamodel_description =
 q{

/***********************************************************************************
 ***********************************************************************************
 ****
 **** UML 1.5 Metamodel 
 ****
 ***********************************************************************************
 ***********************************************************************************
 */

Package Foundation
{

Package Data_Types 
{ 

  /* Subprimitives */
  Class Integer;
  Class UnlimitedInteger;
  Class String;

  Enumeration AggregationKind 
  {
    none;
    aggregate;
    composite;
  }

  Enumeration Boolean
  {
    false;
    true;
  }

  Enumeration CallConcurrencyKind
  {
    sequential;
    guarded;
    concurrent;
  }

  Enumeration ChangeableKind
  {
    changeable;
    frozen;
    addOnly;
  }

  Enumeration OrderingKind
  {
    unordered;
    ordered;
  }

  Enumeration PseudostateKind
  {
    choice;
    deepHistory;
    fork;
    initial;
    join;
    junction;
    shallowHistory;
  }

  Enumeration ScopeKind
  {
    instance;
    classifier;
  }

  Enumeration VisibilityKind
  {
    public;
    protected;
    private;
    package;
  }

  Enumeration ParameterDirectionKind
  {
    in;
    out;
    inout;
    return;
  }

  Class Geometry;
  Class LocationReference;

  Class Mapping
  {
    body : String;
  }

  Class Multiplicity
  {
    @ 1 , range : MultiplicityRange 1..*;
  }

  Class MultiplicityRange
  {
    lower : Integer;
    upper : UnlimitedInteger;
  }

  Class Name;

  Class Expression
  {
    language : Name;
    body : String;
  }

  : Expression
  {
    Class ArgListExpression;
    Class BooleanExpression;
    Class MappingExpression;
    Class ProcedureExpression;
    Class TimeExpression;
    Class TypeExpression;
  }

} /* End Package Foundation::Data_Types */


Package Core
{
  :: Foundation::Data_Types::*;


  /* Page 2-13; Core Package - Backbone */

  Class Element;

  Class ModelElement : Element
  {
    name            : Name;
    visibility      : VisibilityKind; /* ElementOwnership ???*/
    isSpecification : Boolean;        /* ElementOwnership ???*/
  }

/*
  AssociationClass ElementOwnership
  {
    visibility      : VisibilityKind;
    isSpecification : Boolean;

    @ . ownedElement : ModelElement * , namespace : Namespace 0..1;
  }
*/

  Class Namespace : ModelElement
  {
    @ namespace  0..1 , ownedElement : ModelElement *; /* ElementOwnership ??? */
  }

  Class GeneralizableElement : ModelElement
  {
    isRoot : Boolean;
    isLeaf : Boolean;
    isAbstract : Boolean;
  }

  Class Classifier : Namespace, GeneralizableElement;

/**/
  Class Parameter : ModelElement
  {
    defaultValue  : Expression;
    kind          : ParameterDirectionKind;
    
    @            * , +type : Classifier;
    @ +parameter * ,       : BehavioralFeature 0..1;
  }

/**/

  Class Constraint : ModelElement
  {
    body : BooleanExpression;

    @ +constraint * , +constrainedElement : ModelElement 0..1;
  }

  Class Feature : ModelElement
  {
    ownerScope : ScopeKind;
    visibility : VisibilityKind;
    
    @ +feature * , +owner : Classifier 0..1;
  }

  Class StructuralFeature : Feature
  {
    multiplicity : Multiplicity;
    changeability : ChangeableKind;
    targetScope : ScopeKind;
    ordering : OrderingKind;

    @ +typedFeature *, +type : Classifier;
  }

  Class Attribute : StructuralFeature
  {
    initialValue : Expression;
  }

  Class BehavioralFeature : Feature
  {
    isQuery : Boolean;
  }

  : BehavioralFeature
  {
    Class Operation
    {
      concurrency : CallConcurrencyKind;
      isRoot : Boolean;
      isLeaf : Boolean;
      isAbstract : Boolean;
      /* specification : String; /* Error? see UML 1.5 Spec, pg. 2-13, 2-45 */
      
      @ +specification , : Method *;
    }

    Class Method
    {
      body : ProcedureExpression;
    }
  }

  /* Page 2-13; Core Package - Relationships */

  Class Relationship : ModelElement;

  : Relationship
  {

    Class Flow
    {
      @ +sourceFlow * , +source : ModelElement *;
      @ +targetFlow * , +target : ModelElement *;
    }

    Class Generalization
    {
      @ +generalization * , +child     : GeneralizableElement *;
      @ +specialization * , +parent    : ModelElement         *;
      @ +powertypeRange * , +powertype : Classifier           0..1;
    }

  }

  Class Association : Relationship, GeneralizableElement;
  Class AssociationClass :  Association, Class;

  Class AssociationEnd : ModelElement
  {
    isNavigable : Boolean;
    ordering : OrderingKind;
    aggregation : AggregationKind;
    targetScope : ScopeKind;
    multiplicity : Multiplicity;
    changability : ChangeableKind;
    visibility : VisibilityKind;
    
    @ +connection     2..* ,               : Association 1;
    @ +association    *    , +participant   : Classifier 1;
    @ +specifiedEnd   *    , +specification : Classifier *;
    @ +associationEnd 0..1 , +qualifier     : Attribute  *;
  }

  /* Page 2-15; Core Package - Dependencies */

  Class Dependency :Relationship
  {
    @ +supplierDependency * , +supplier : ModelElement 1..*;
    @ +clientDependency   * , +client   : ModelElement 1..*;
  }

  : Dependency
  {

    Class Binding;
    Class Usage;
    Class Permission;
    Class Abstraction
    {
      mapping : MappingExpression;
    }

  }

  /* Page 2-16: Core Package - Classifiers */

  : Classifier
  {

    Class "Class"
    {
      isActive : Boolean;
    }

    Class Interface;

    Class Node
    {
      @ +deploymentLocation *    , +deployedComponent : Component *;
    }

    Class Component
    {
      @ +implementationLocation * , +implementation : Artifact *;
      @ +container              * , +resident       : ModelElement *;
    }

    Class Artifact;
    Class DataType;

  }

  : DataType
  {

    Class Primitive;
    Class ProgrammingLanguageDataType
    {
      expression : TypeExpression;
    }

    Class "Enumeration"
    {
      @ +enumeration , +literal : EnumerationLiteral 1..*;
    }

  }

  Class EnumerationLiteral : ModelElement;
 
  /* Page 2-17: Core Package - Auxililary elements */

  : Element /* Implied?? */
  {

    AssociationClass TemplateParameter
    {
      @                                   1 , +defaultElement : ModelElement 0..1;
      @ . +templateParameter : ModelElement * , +template       : ModelElement 1..*;
    }

    Class TemplateArgument
    {
      @           *    , +modelElement : ModelElement 1;
      @ +argument 1..* , +binding      : Binding      1;
    }

    Class PresentationElement
    {
      @ +presentation  * , +subject : ModelElement *;
    }

  }

  Class Comment : ModelElement
  {
    name : String;
    @ * , +annotatedElement : ModelElement *;
  }
  
} /* End Package Foundation::Core */


Package Extension_Mechanisms
{
  :: Foundation::Core::*, Foundation::Data_Types::*;

  /* Page 2-76; Extension Mechanisms */


  Class Stereotype : GeneralizableElement
  {
    icon : Geometry;
    baseClass : Name[*];

    @ +constrainedStereotype 0..1 , +stereotypeConstraint : Constraint    *;
    @ +owner                 0..1 , +definedTag           : TagDefinition *;
  }

  Class TagDefinition : ModelElement
  {  
    tagType : Name;
    multiplicity : Multiplicity;
    
    @ +type 1 , +typedValue : TaggedValue *;
  }

  Class TaggedValue : ModelElement
  {
    dataValue : String[*];
    @ +taggedValue  1 ,                : ModelElement 1;
    @ +referenceTag * , +referenceValue : ModelElement *;
  }

} /* End Package Foundation::Extension_Mechanisms */


/* Page 2-182: Model Management */

Package Model_Management
{
  :: Foundation::Core::*, Foundation::Data_Types::*;

  Class "Package" : Namespace;
  Class Subsystem : Package, Classifier
  {
    isInstantiable : Boolean;
  }

  Class Model : Package;

  AssociationClass ElementImport
  { 
    visiblitity : VisibilityKind;
    alias : Name;
    isSpecification : Boolean;

    @ . : Package * , +importedElement : ModelElement *;
  }
}

} /* End Package Foundation */
/* END */
};

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



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

  unless ( $model ) {
    $desc ||= $metamodel_description;
    # $DB::single = 1;
    
    use UML::MetaMetaModel::Factory;
    use UML::Import::MetaMetaModel;
    
    # $DB::single = 1;
    my $factory = new UML::MetaMetaModel::Factory();
    # $DB::single = 1;

    my $importer = new UML::Import::MetaMetaModel('factory' =>  $factory);
    $model = $importer->import_input($desc);
    $DB::single = 1;
  }

  $model;
}


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' => 
     {
       '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' => 1,
       },
	 'Foundation::Data_Types::Integer' => {
	   'primitive' => 1,
	   'validate' => q{$x =~ /^[-+]?[0-9]+$/},
	 },
       'Foundation::Data_Types::UnlimitedInteger' => {
	 'primitive' => 1,
	 'validate' => q{$x =~ /^[-+]?[0-9]+|\*$/},
       },
       'Foundation::Data_Types::String' => {
	 'primitive' => 1,
	 'validate' => 1,
       },
       'Foundation::Data_Types::Name' => {
	 'primitive' => 1,
	 'validate' => q{$x =~ /^[a-z_][a-z_0-9]*$/i},
       },
     },
     %opts,
     );
  }

  $exporter;
}


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

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


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


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

  unless ( $factory ) {
    $factory = UML::MetaMetaModel::Factory->new('classMap' => $self->factory_map);
  }

  $factory;
}


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

  unless ( @factory_map ) {
    my $model = $self->model;

    $DB::single = 1;

    # Get all Classifiers in the model.
    my @classifier = Namespace_classifier($model);

    for my $x ( @classifier ) {
      my $name = $x->name;
      my $nameq = ModelElement_name_qualified($x);
      my $cls = (ref($self) || $self) . '::' . $nameq;
      
      push(@factory_map,
	   $name => $cls,
	   $nameq => $cls,
	   );
    }

    $DB::single = 1;
  }

  \@factory_map;
}

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


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

