package UML::Export;

use 5.6.1;
use strict;
use warnings;


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

=head1 NAME

UML::Export - Base exporter class for UML::MetaModel;

=head1 SYNOPSIS

  use base qw(UML::Export::...);
  my $code = UML::Export::...->new(...);
  $code->export_Model($model);

=head1 DESCRIPTION

This package allow UML (meta-)models to be exported, to XMI or implementation languages.

=head1 USAGE

=head1 EXPORT

None exported.

=head1 AUTHOR

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

=head1 SEE ALSO

L<UML::MetaModel|UML::MetaModel>

=head1 VERSION

$Revision: 1.4 $

=head1 METHODS

=cut


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


package UML::Export;

use UML::MetaMetaModel::Util qw(:all);
use IO::Handle; # *STDOUT below.


=head2 new

=cut
sub new
{
  my ($self, %opts) = @_;
  $self = bless(\%opts, ref($self) || $self);
  $self->initialize();
}


sub initialize
{
  my ($self) = @_;
  
  $self->{'output'} ||= *STDOUT;
  $self->{'output'} = UML::Export::EvalIO->new()
  if ( $self->{'output'} eq 'EVAL' );

  $self;
}



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

use Carp qw(confess);


sub export_Classifier
{
  my ($self, $cls) = @_;

  confess(ref($self) . "->export_Classifier(): not implemented");
}


sub export_AssociationClass
{
  my ($self, $cls) = @_;

  confess(ref($self) . "->export_AssociationClass(): not implemented");
}


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

  # Generate code for each class.
  eval {
    #$DB::single = 1;
    for my $cls ( Namespace_classifier($model) ) {
      $self->export_Classifier($cls);
      $self->{'output'}->flush;
    }
  };
  if ( $@ ) {
    die("While generating Model:\n$@");
  }

  #print STDERR "\n# DONE!\n";
  $self;
}


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

package UML::Export::EvalIO;


sub new
{
  my ($self, %opts) = @_;
  $self = bless(\%opts, ref($self) || $self);
  $self->__initialize;
}


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

  $self->{'code'} ||= '';
  #$self->{'debug'} = 0;

  $self;
}


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

  $self->{'code'} .= join('', @args);

  1;
}


sub close
{
  shift->flush;
}


sub __linenos
{
  my ($c) = @_;

  my $line = 0;

  $c = join("\n",
	    map(sprintf("%-4d ", ++ $line) . $_,
		split("\n", $c, 99999),
		),
	    '',
	    );
  my $sep = '#-' x 40;
  $c = "$sep\n$c$sep\n";

  $c;
}


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

  my $code = $self->{'code'};
  $self->{'code'} = '';

  if ( 1 ) {
    $code =~ /^.*\n.*\n(.*\n).*\n/;
    my $package = $1;
    print STDERR $package;
    if ( 0 && $package =~ /Classifier|ModelElement|Integer|String|Name|Kind/ ) {
      print STDERR $code;
      $DB::single = 1;
    }
  }

  eval($code);
  if ( $@ ) {
    $code = __linenos($code);
    die "$code\nin eval of code above:\n$@";
  }
  if ( $self->{'debug'} ) {
    print STDERR __linenos($code);
  }


  1;
}

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

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

