# $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 IO::File;
use Data::Dumper;
use Params::Validate;
use Log::Log4perl;
use COPE::CORBA::ORB;
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::Util::Service;
use Cipres::Util::Registry;
use Cipres::Util::TypeConverter qw(tree2cipres);
use Cipres::IDL::CosEventComm::PushConsumer;
use Cipres::IDL::CosEventComm::PushSupplier;
use Cipres::IDL::CosEventChannelAdmin::ProxyPushConsumer;
use Bio::Phylo::Forest;
use Bio::Phylo::IO qw(parse);
use Bio::Phylo::Util::Exceptions;
use Bio::Phylo::Util::CONSTANT qw(_FOREST_);

Log::Log4perl::init( COPE::CORBA::ORB->LOGPERLCONF );
my $logger = Log::Log4perl::get_logger('AsyncTreeIterator');

print "Starting $0\n";

# helper methods
sub pid {
    $logger->warn(@_);
    my $self = shift;
    $self->{'pid'} = shift if @_;
    return $self->{'pid'};
}
sub file {
    $logger->warn(@_);
    my $self = shift;
    $self->{'file'} = shift if @_;
    return $self->{'file'};
}
sub pollthread {
    $logger->warn("polling files...");
    my $self = shift;
    my @temp_forest;
    foreach my $suffix ( qw(t run1.t run2.t) ) {
        my $file = $self->file() . ".$suffix";
        if ( -e $file ) {
            my $pos;
            if ( $self->{'forest'} ) {
                my @sorted_by_pos_in_file = map { $_->[0] } 
                          sort { $a->[1] <=> $b->[1] } 
                          map  { [ $self->{'forest'}->[$_], $self->{'forest'}->[$_]->{'pos'} ] } 
                          grep { $self->{'forest'}->[$_]->{'file'} eq $file } 
                          ( 0 .. $#{ $self->{'forest'} } );
                $pos = $sorted_by_pos_in_file[-1];
            }
            else {
            	$self->{'forest'} = [];
            	$pos = 0;
            }
            my $fh = IO::File->new;
            $fh->open( "< $file" ) or $logger->warn($!);
            $fh->setpos( $pos );
            while( my $line = $fh->getline ) {
                if ( $line =~ m/^\s+tree\s(rep\.\d+)\s=\s(.+;)/ ) {
                    my ( $name, $newick ) = ( $1, $2 );
                    my $tree = {
                        'file'     => $suffix,
                        'pos'      => $fh->getpos,
                        'name'     => $name,
                        'newick'   => $newick,
                        'biophylo' => undef,
                        'cipres'   => undef,
                        'score'    => undef,
                    };
                    push @temp_forest, $tree;
                } 
            }
        }
        my $pfile = $file;
        $pfile =~ s/t$/p/;
        if ( -e $pfile ) {
            my %trees_by_name = map { $_->{'name'} => $_ } grep { $_->{'file'} eq $suffix } @temp_forest;
            my $fh = IO::File->new;
            $fh->open( "< $pfile" ) or $logger->warn($!);
            while( my $line = $fh->getline ) {
                if ( $line =~ m/^(\d+)\s+(-?\d+\.\d+)\s+/ ) {
                    my ( $rep, $lnl ) = ( $1, $2 );
                    if ( exists $trees_by_name{ 'rep.' . $rep } ) {
                        $trees_by_name{ 'rep.' . $rep }->{'score'} = $lnl;
                    }
                } 
            }
        }
    }
    my %forest = map { $_->{'name'} => $_ } @temp_forest;
    my @forest = sort { $a->{'file'} . $a->{'name'} cmp $b->{'file'} . $b->{'name'} } values %forest;
    $self->{'forest'} = \@forest;
}
sub forest {
    $logger->warn("updating forest");
    my $self = shift;
    $self->pollthread();
    return $self->{'forest'};
}

# CipresIDL_api1::TreeIterator_impl
sub getTreeByIndex {    
    my ( $self, $i ) = @_;
    $logger->warn("getting tree # $i");
    $self->forest();
    if ( not $self->{'forest'}->[$i]->{'cipres'} ) {
        my $biophylo = parse( 
            '-format' => 'fastnewick', 
            '-string' => $self->{'forest'}->[$i]->{'newick'},    
        )->first;
        $biophylo->set_name(  $self->{'forest'}->[$i]->{'file'} . $self->{'forest'}->[$i]->{'name'} );
        $biophylo->set_score( $self->{'forest'}->[$i]->{'score'} );
        my $cipres = tree2cipres( $biophylo );
        $self->{'forest'}->[$i]->{'biophylo'} = $biophylo;
        $self->{'forest'}->[$i]->{'cipres'}   = $cipres;
    }
    return $self->{'forest'}->[$i]->{'cipres'};
}
sub getNumTrees {    
    my $self = CORE::shift;
    my $ntrees = scalar @{ $self->forest() };
    $logger->warn("$ntrees trees in the " . $self->{'forest'});
    return $ntrees;
}
sub exists {
    my ( $self, $i ) = @_;
    $logger->warn("checking if tree $i exists");    
    return exists $self->forest->[$i] ? 1 : 0;
}

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

# CipresIDL_api1::LifeCycle_impl
sub remove {
    $logger->warn("removing @_");
    my $self = CORE::shift;
    warn "removing...";
    exit 0;
}

my $iter    = 'Cipres::IDL::CipresIDL_api1::AsyncTreeIterator_impl::';
my $rv      = 'Cipres::IDL::CipresIDL_api1::RendezVous_impl::';
my $lc      = 'Cipres::IDL::CipresIDL_api1::LifeCycle_impl::';
my $obj = Cipres::Util::Service->host(
    '-service'      => 'Cipres::IDL::CipresIDL_api1::AsyncTreeIterator_impl',
    '-reference'    => {},
    '-argv'         => \@ARGV,
    '-methods'      => {
        $iter . 'getTreeByIndex'  => \&getTreeByIndex,
        $iter . 'getNumTrees'     => \&getNumTrees,
        $iter . 'exists'          => \&exists,
        $iter . 'disconnect'      => \&disconnect,
        $iter . 'reconnect'       => \&reconnect,
        $lc   . 'remove'          => \&remove,
        $iter . 'forest'          => \&forest,
        $iter . 'file'            => \&file,
        $iter . 'pollthread'      => \&pollthread,
        $iter . 'pid'             => \&pid,
    }
);

!NO!SUBS!