# $Id$
use Config;
use File::Basename qw(basename dirname);
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
        if ($Config{'osname'} eq 'VMS' or
            $Config{'osname'} eq 'OS2');  # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
chmod(0755, $file);
print "Extracting $file (with variable substitutions)\n";

print OUT <<"!GROK!THIS!";
$Config{'startperl'} -w
    eval 'exec perl -S \$0 "\$@"'
        if 0;

!GROK!THIS!

print OUT <<'!NO!SUBS!';

use strict;
use warnings;
use Data::Dumper;
use Params::Validate;
use Log::Log4perl;
use File::Temp qw(tempfile);
use COPE::CORBA::ORB;
use Cipres::IDL::CipresIDL_api1;
use Cipres::IDL::CipresIDL_api1::Scriptable_skel;
use Cipres::IDL::CipresIDL_api1::LifeCycle_skel;
use Cipres::IDL::CipresIDL_api1::RendezVous_skel;
use Cipres::IDL::CipresIDL_api1::TreeIterator_skel;
use Cipres::IDL::CipresIDL_api1::AsyncTreeIterator_skel;
use Cipres::IDL::CipresIDL_api1::AsyncTreeInfer_skel;
use Cipres::IDL::CipresIDL_api1::Scriptable_impl;
use Cipres::IDL::CipresIDL_api1::LifeCycle_impl;
use Cipres::IDL::CipresIDL_api1::RendezVous_impl;
use Cipres::IDL::CipresIDL_api1::TreeIterator_impl;
use Cipres::IDL::CipresIDL_api1::AsyncTreeIterator_impl;
use Cipres::IDL::CipresIDL_api1::LifeCycle;
use Cipres::IDL::CipresIDL_api1::Scriptable;
use Cipres::IDL::CipresIDL_api1::RendezVous;
use Cipres::IDL::CipresIDL_api1::TreeIterator;
use Cipres::IDL::CipresIDL_api1::AsyncTreeIterator;
use Cipres::Util::Service;
use Cipres::Registry;
use Cipres::Util::TypeConverter;
use Cipres::IDL::CosEventComm::PushConsumer;
use Cipres::IDL::CosEventComm::PushSupplier;
use Cipres::IDL::CosEventChannelAdmin::ProxyPushConsumer;
use IPC::Open2;
use Bio::Phylo::Util::CONSTANT qw(_FOREST_);
use Bio::Phylo::Util::Exceptions;
use Bio::Phylo::Forest;
use Bio::Phylo::IO qw(parse);

Log::Log4perl::init( COPE::CORBA::ORB->LOGPERLCONF );
print "Starting $0\n";

$ENV{'MBPATH'}   = 'C:\phylo\mb\mrbayes-3.1.1.exe' if not $ENV{'MBPATH'};
$ENV{'MBGUIXML'} = 'C:\winCIPRES\CIPRES-1.0.1\cipres\cipres_dist\xml\gui\mrbayes.xml' if not $ENV{'MBGUIXML'};

my $logger = Log::Log4perl::get_logger('AsyncTreeInfer');

############################### helper methods #################################
sub file {
    $logger->debug(@_);
    my $self = shift;
    $self->{'file'} = shift if @_;
    if ( not $self->{'file'} ) {
         ( $self->{'fh'}, $self->{'file'} ) = tempfile( 'UNLINK' => 1 );
    }
    return $self->{'file'};
}
sub _clean_temp_files {
    $logger->debug("cleaning temp files");
    my $self = CORE::shift;
    if ( $self->file() ) {
        for my $suffix ( qw(.p .t .mcmc .run1.p .run1.t .run2.p .run2.t .log) ) {
            if ( -e $self->file() . $suffix ) {
                unlink $self->file() . $suffix;
            }
        }
    }
}
sub pid {
    $logger->debug("touching singleton readfh instance");
    my $self = shift;
    $self->{'pid'} = shift if @_;
    return $self->{'pid'};
}
sub make_iterator {
    my $self = shift;
    my $reg = Cipres::Util::Registry->new();
    my $rei = $reg->RegistryEntryInfo(
        'registryInstanceID' => '',
        'repositoryID'       => 'IDL:CipresIDL_api1/AsyncTreeIterator:1.0',
        'applicationName'    => '',
        'description'        => '',
    );    
    my $service = $reg->getObject( $reg->findFirst( $rei ) );
    if ( $service->is_a('IDL:CipresIDL_api1/AsyncTreeIterator:1.0') ) {
          $service = Cipres::IDL::CipresIDL_api1::AsyncTreeIterator->_narrow( $service );
          $logger->warn("started asynchronous iterator");
    }    
    my $file = $self->file();
    $service->reconnect( $rei, $file );
    return $service;
}

#################### CipresIDL_api1::AsyncTreeInfer_impl #######################
sub setMatrix {
    $logger->debug("setting matrix");    
    my ( $self, $matrix ) = @_;
    $self->{'matrix'} = Cipres::Util::TypeConverter::cipres2matrix( $matrix );
}
sub inferTrees {
    $logger->debug("inferring trees");
    my ( $self, $proxyConsumer ) = @_;
    $self->{'proxyConsumer'} = $proxyConsumer;
    $self->_clean_temp_files;
    open my $fh, '>', $self->file() or die $!;
    print $fh "#NEXUS\n";
    print $fh $self->{'matrix'}->to_nexus;
    print $fh $self->{'execute'};
    my $pid = fork;
    if ( defined $pid and $pid != 0 ) {
        $self->pid( $pid );
        return $self->make_iterator;
    }
    elsif ( defined $pid and $pid == 0 ) {
        system( $ENV{'MBPATH'}, $self->file() );
        while(1) {
        	# TODO: somehow I need to stay alive?
        }
    }
    else {
        die "couldn't fork!";
    }
}

##################### CipresIDL_api1::RendezVous_impl ##########################
sub disconnect {
    $logger->debug("disconnecting");
    my ( $self, $receipt ) = @_;
    $$receipt = $self->file();
    my $rei = Cipres::Util::Registry->RegistryEntryInfo(
        'registryInstanceID' => '',
        'repositoryID'       => 'IDL:CipresIDL_api1/AsyncTreeInfer:1.0',
        'applicationName'    => $0,
        'description'        => '',
    );
    return $rei;
}
sub reconnect {
    $logger->debug("reconnecting");
    my ( $self, $receipt ) = @_;
    $self->file($receipt);
    return 1;
}

##################### CipresIDL_api1::LifeCycle_impl ###########################
sub remove {
    $logger->debug("removing");
    my $self = CORE::shift;
    warn "removing...";
    kill 9, $self->pid if ( $self->pid and kill 0, $self->pid );
    $self->_clean_temp_files;
    exit 0;
}

################### CipresIDL_api1::Scriptable_impl ############################
sub getUIXml {
    $logger->debug("getting ui xml");
    my $xml = '';
    if ( -e $ENV{'MBGUIXML'} ) {
        open my $fh, '<', $ENV{'MBGUIXML'} or die $!;
        while(<$fh>) {
            $xml .= $_;
        }
        close $fh;
    }
    else {
    	warn "Can't find gui xml at \$MBGUIXML=\"$ENV{'MBGUIXML'}\"";
    }
    return $xml;
}
sub execute {
    $logger->debug("executing");
    my ( $self, $command, $display ) = @_;
    my $time = localtime();
    $self->{'execute'}  = "BEGIN MRBAYES;\n";
    $self->{'execute'} .= "\[! Mrbayes block written by $0 on $time \]\n";
    $self->{'execute'} .= "\tLOG START FILENAME=" . $self->file() . ".log REPLACE;\n";
    $self->{'execute'} .= "\t$command\n\tMCMC;\n\tQUIT;\nEND;\n";
	$$display = $self->{'execute'};
    return 1;
}

############################## DESTRUCTOR ######################################
sub DESTROY {
#    my $self = shift;
#    $self->remove;
}

########################## instantiate service #################################
my $service = 'Cipres::IDL::CipresIDL_api1::AsyncTreeInfer_impl::';
my $iter    = 'Cipres::IDL::CipresIDL_api1::TreeIterator_impl::';
my $rv      = 'Cipres::IDL::CipresIDL_api1::RendezVous_impl::';
my $lc      = 'Cipres::IDL::CipresIDL_api1::LifeCycle_impl::';
my $scr     = 'Cipres::IDL::CipresIDL_api1::Scriptable_impl::';
my $obj = Cipres::Util::Service->host(
    '-service'      => 'Cipres::IDL::CipresIDL_api1::AsyncTreeInfer_impl',
    '-reference'    => {},
    '-argv'         => \@ARGV,
    '-methods'      => {
        $service . 'setMatrix'    => \&setMatrix,
        $service . 'inferTrees'   => \&inferTrees,
        $rv . 'disconnect'        => \&disconnect,
        $rv . 'reconnect'         => \&reconnect,
        $service . 'remove'       => \&remove,
        $service . 'getUIXml'     => \&getUIXml,
        $service . 'execute'      => \&execute,
        $service . 'file'         => \&file,
        $service . 'pid'          => \&pid,
        $service . 'DESTROY'           => \&DESTROY,
        $service . 'make_iterator'     => \&make_iterator,
        $service . '_clean_temp_files' => \&_clean_temp_files,        
    }
);

!NO!SUBS!