#!/usr/local/bin/perl
# $Id: ummf.pl,v 1.24 2006/05/14 01:40:03 kstephens Exp $

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

use 5.6.0;
use strict;
use warnings;

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

=head1 NAME

ummf - driver for UMMF

=head1 SYNOPSIS

C<ummf> [-I I<dir>] [-M I<MetaModel>] [-m I<Main::Module>] [-o {I<dir>|C<->}] [-e I<exporter>] I<input> ...

=head1 DESCRIPTION

This is a driver for the UMMF toolkit.  It translates UML input documents into the export targets specified by the C<-e> option.  If C<-o -> is specified the output is generated to STDOUT, otherwise the output is multiplexed into files underneath the directory specified by the C<-o> option, using L<files2dirs|files2dirs>.

If I<input> is C<'UML-1.5'>, then the internal UML 1.5 meta-model (from L<UMMF::UML::MetaModel|UMMF::UML::MetaModel>) is used as input.

Input files can be C<.zargo> (ArgoUML and Poseidon for UML 1.x), C<.zuml> (Poseidon for UML 2.x) or XMI 1.0 or 1.2 documents.

=head1 USAGE

  ummf -e java -e perl -o gen test/test1.xmi

Generates Java and Perl code in directory C<gen> from C<test/test1.xmi>.

  ummf  -e perl::hibernate -o gen test/test2.zargo

Generates Java Hibernate hbn.xml file in directory C<gen> from C<test/test2.zargo>.

  ummf -e XMI -o - UML-1.5

Generates XMI for the UML 1.5 meta-model on the standard output stream.

  ummf --perl5lib

Print the PERL5LIB path needed for Perl code generated by UMMF.

  ummf -L Some::Package 

Loads C<Some::Package>.

  ummf -m Some::Package @args ...

Loads C<Some::Package> and executes C<<Some::Package->main(@args)>>.

  ummf -I dir/with/perl/modules

Executes C<use lib 'dir/with/perl/modules'>; including modules from the specified directory in the search path.

  ummf -M UMMF::Boot::MetaModel

Uses UMMF::Boot::MetaModel for the meta-model, defaults to C<'UMMF::UML_1_5'>.

  ummf -profile MyMagicProfile -e Perl UML-1.5

Applies C<MyMagicProfile> during export of Perl code on the UML 1.5 meta-model.  This overides the default C<lib/ummf/profile/UML-1.5.ummfprofile> file.

=head1 EXPORT

None exported.

=head1 AUTHOR

Kurt Stephens, kstephens@users.sourceforge.net 2003/05/15

=head1 SEE ALSO

L<UMMF::Core::MetaModel|UMMF::Core::MetaModel>, L<UMMF::Export|UMMF::Export>

=head1 VERSION

$Revision: 1.24 $

=cut

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

use File::Basename;
use File::Spec;

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

my ($_0dir, $basedir);

BEGIN
{
  # $DB::single = 1;

  # Force subcommands not to invoke the debugger.
  no warnings; # Use of uninitialized value in substitution (s///) at bin/ummf.pl line 72.
  $ENV{'UMMF_PERL'} =~ s/ -d:DProf//;
  $ENV{'UMMF_PERL'} =~ s/ -d//;
  $ENV{'UMMF_PERL'} =~ s/ -MDevel::Profiler//;

  $_0dir = dirname($0);
  $basedir = File::Spec->rel2abs(File::Spec->catdir($_0dir, File::Spec->updir));

  $basedir =~ tr@\\@/@; # for Win32 \\ paths.
  $basedir =~ tr@\\@@d;
  # $basedir = quotemeta($basedir); # For Win32 \\ paths.

  # Remove '/foo/../'
  while ( $basedir =~ s@/[^/]+/\.\./@/@s ) {
  }

  my $perl_version = join('.', unpack('C*', $^V));
  my $local = "$basedir/local";

  for my $d ( 
             map(("$_/$perl_version",
		  "$_/site_perl/$perl_version",
		  ),
		 "$local/lib",
		 "$local/perl/lib",
		 ),
	     "$basedir/lib/perl",
	     "$basedir/gen/perl",
	     ( $ENV{UMMF_BOOTSTRAPPING} ? (
					   "$basedir/gen1/perl",
					   "$basedir/gen2/perl",
					  ) : () )
	    ) {
    if ( -d $d ) {
      eval "use lib '$d';";
      die $@ if $@;
    }
  }

  eval q{
    use UMMF;
    use UMMF::Core::MetaModel;
    use UMMF::Boot::MetaModel;
    use UMMF::Core::Config;
    use UMMF::Config::Profile;
  }; die $@ if $@;

  UMMF->set_base_dir($basedir);
}


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

if ( 0 ) {
  local $" = ', '; 
  print STDERR "INC = @INC\n";
}

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

use File::Path;
use IO::Handle;
use IO::Pipe;

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

# $DB::single = 1;

my $file2dirs_opts = '';
my $errors = 0; # Number of errors.

my @exporter;     # Current exporters.
my $output = '-'; # Current output name.
my $output_h;     # Current output handle.

my @input;           # Current list of [ $input, $input_type ] to merge.
my $input_type = ''; # Current input type.

my $packagePrefix; # Current package prefix.

my $config = UMMF::Core::Config              ->instance_or_new;
my $prof   = UMMF::Config::Profile           ->instance_or_new;

my $metamodel;

my ($profile, $profile_default);

while ( @ARGV ) {
  local $_ = shift @ARGV;
  # $DB::single = 1;

  if ( /^-m/) {
    my $pkg = shift;
    my @args = @ARGV;

    eval qq{ use $pkg }; die $@ if $@;

    my $code = $pkg->main(@args);
    exit($code);

    last;
  }
  elsif ( /^-M/ ) {
    $metamodel = shift;
  }
  elsif ( /^-l/ ) {
    my $module = shift;
    print STDERR "ummf: loading $module\n";
    eval qq{use $module;}; die $@ if $@;
  }
  elsif ( /^-I/ ) {
    my $inc = shift;
    lib->import($inc);
  }
  elsif ( /^-D/ ) {
    if ( $_ =~ /^([^=]+)=(.*)$/ ) {
      unshift(@ARGV, $1, $2);
    }
    $_ = shift;
    $config->set_value($_);
  }
  elsif ( /^-profile/ ) {
    $profile = shift;
  }
  elsif ( /^-t/ ) {
    $file2dirs_opts .= "$_ ";
  }
  elsif ( /^-o/ ) {
    # $DB::single = 1;
    close_output();
    $output = shift;
  } 
  elsif ( /^-e/ ) {
    $_ = shift;
    if ( $_ eq '-' ) {
      @exporter = ();
    } else {
      push(@exporter, $_);
    }
  }
  elsif ( /^-i/ ) {
    $_ = shift;
    if ( $_ eq '-' ) {
      $input_type = undef;
    } else {
      $input_type = $_;
    }
  }
  elsif ( /^--perl5lib/ ) {
    print join(':', @INC), "\n";
    exit(0);
  }
  elsif ( /^-p/ ) {
    $_ = shift;
    if ( $_ eq '-' ) {
      $packagePrefix = undef;
    } else {
      $packagePrefix = [ split('::', $_) ];
    }
  } else {
    process_input($_, $input_type);
  }
}

flush_input();

close_output();

exit($errors);


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


sub process_input
{
  my ($input, $input_type) = @_;

  push(@input, [ $input, $input_type ]);
}


sub flush_input
{
  return unless @input;

  init_output();

  init_exporters();

  # Load the metamodel.
  $metamodel ||= 'UMMF::UML_1_5'; # Default metamodel.
  eval qq{ use $metamodel; }; 
  die $@ if $@;

  # Get model factory.
  my $factory = $metamodel->factory;

  my @model;
  for my $x ( @input ) {
    my ($input, $input_type) = @$x;

    print STDERR "ummf: reading $input $input_type\n";
    my $m = get_input($input, $input_type, $factory);
    print STDERR "ummf: reading $input $input_type: DONE\n";

    push(@model, $m);
  }

  # Initialize profile.
  $prof->set_profile($profile || $profile_default);

  @input = ();

  # Get model from input models.
  use UMMF::XForm::Merge;
  my $merger = UMMF::XForm::Merge->new;
  my $model = $merger->apply_Model(\@model);

  # Process through each exporter.
  for my $exporter ( @exporter ) {
    UMMF::Core::MetaModel->export_Model(
				  'factory' => $factory,
				  'model' => $model,
				  'exporter' => $exporter, 
				  'output' => $output_h,
				  'packagePrefix' => $packagePrefix,
				  );
  }
}


sub init_output
{
  # Create output handle.
  unless ( $output_h ) {
    # $DB::single = 1;

    # Set up output stream
    if ( $output eq '-' ) {
      $output_h = \*STDOUT;
    } else {
      mkpath($output);
      $output_h = new IO::Pipe;
      my $cmd = "$_0dir/files2dirs $file2dirs_opts -d '$output' -";
      $output_h->writer($cmd) || die("Cannot pipe to 'cmd': $!");
      # print STDERR "Output to '$cmd'\n";
    }
  }
}


sub close_output
{
  if ( $output_h ) {
    $output_h->close() unless $output_h eq \*STDOUT;
    $output_h = undef;
  }
}


sub init_exporters
{
  # Initialize exporters
  @exporter = ( 'perl' ) unless @exporter;
  for my $exporter ( @exporter ) {
    $exporter = "UMMF::Export::" . join('::', map(ucfirst($_), split('\.', $exporter)))
    unless $exporter =~ /::/;
  }
}


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


sub get_input
{
  my ($input, $input_type, $factory) = @_;

  $factory ||= $metamodel->factory;

  my $model;

  # Internal model?
  if ( $input =~ /^(UML|MOF)-(.*)$/i ) {
    my ($model_name, $version) = ($1, $2);
    # print STDERR "UMMF::UML::MetaModel = ", $INC{'UMMF/UML/MetaModel.pm'}, "\n";

    $profile_default = $input;
    $model = UMMF::Boot::MetaModel->model
    (
     'factory' => $factory, 
     'model_name' => $model_name,
     'version' => $version,
     );
  }
  # XMI?
  elsif ( $input_type eq 'xmi' || $input =~ /\.(uml|xmi|xml)$/i ) {
    use UMMF::Import::XMI;

    my $fh = ref($input) ? $input : IO::File->new($input);
    my $importer = UMMF::Import::XMI->new('factory' => $factory);
    my $results = $importer->import_input($fh);

    # $profile_default = undef;
    ($model) = grep($_->isaModel, @$results);
  }
  # Other UML representation?
  elsif ( $input =~ /\.(zargo|zuml)$/i ) {
    # $DB::single = 1;
    my $fh = IO::Pipe->new();
    my @cmd = ( "$basedir/bin/uml2xmi", $input );
    {
      local $" = ' ';
      $fh->reader(@cmd) || die("Cannot run '@cmd': $!");
    }

    # ArgoUML and Poseidon are "Java-centric",
    # as if that's a good feature! :)
    $profile_default = 'Java-centric';
    $model = get_input($fh, 'xmi', $factory);
  }

  $model;
}
#$DB::single = 1;

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

1;

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


### Keep these comments at end of file: kstephens@users.sourceforge.net 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: ###


