#!@WHICHPERL@
=head1 NAME

meme_webservice - Run meme and mast in a restricted mode and create an index webpage.

=head1 SYNOPSIS

meme_webservice [options] <sequences>

  Options: 
    -alpha [dna|protein]      The alphabet of the sequences. Default: dna
    -mod [oops|zoops|anr]     The expected number of motif repeats per sequence.
                              Default: zoops
    -nmotifs <count>          The number of motif to find. Default: 3
    -minw <width>             The minimum width of the motif. Default: 6
    -maxw <width>             The maximum width of the motif. Default: 50
    -minsites <num>           The minimum number of sites per motif.
    -maxsites <num>           The maximum number of sites per motif.
    -bfile <file>             A background file.
    -neg <file>               A negative sequences set, for generating PSPs.
    -norevcomp                Restrict sites to only given strand.
    -pal                      Only find palindromes.
    -help                     Show this brief help message.

=cut

use strict;
use warnings;

use Fcntl qw(SEEK_SET);
use File::Spec::Functions qw(tmpdir);
use File::Temp qw(tempfile);
use Getopt::Long;
use Pod::Usage;

use lib qw(@PERLLIBDIR@);

use ExecUtils qw(stringify_args invoke);
use MemeWebUtils qw(add_status_msg update_status loggable_date write_invocation_log);
use Globals;

# constants
my $tmpdir = '@TMP_DIR@';
# use the perl default if none is supplied or the replace fails
$tmpdir = &tmpdir() if ($tmpdir eq '' || $tmpdir =~ m/^\@TMP[_]DIR\@$/);

# variables for the service invocation log
my $log_args = stringify_args(@ARGV);
my $log_date = loggable_date();
my $log_file = 'meme-log';

# error files
my $messages = "messages.txt";

#status page
my $file_list;
my @arg_errors = ();
my $msg_list = [];
my $program = 'MEME';
my $page = 'index.html';
my $refresh = 10;

# required parameters
my $sequences;
# option defaults
my $alphabet = 'dna';
my $mode = "zoops";
my $nmotifs = 3;
my $minw = 6;
my $maxw = 50;
my $minsites = undef;
my $maxsites = undef;
my $bfile = undef;
my $negfile = undef;
my $norevcomp = 0; #FALSE
my $pal = 0; #FALSE
my $help = 0; # FALSE

add_status_msg('Parsing arguments', $msg_list);

# redirect stderr so we can get the error message from GetOpts
my ($err_old, $err_tmp, $opts_ok, $opts_msg);
open($err_old, ">&STDERR") or die("Can't dup STDERR: $!");
$err_tmp = tempfile('GetOptions_XXXXXXXXXX', DIR => $tmpdir, UNLINK => 1); # make a temporary file
open(STDERR, '>&', $err_tmp) or die("Can't redirect STDERR: $!");
# parse options
$opts_ok = GetOptions(
  'alpha=s' => \$alphabet,
  'mod=s' => \$mode,
  'nmotifs=i' => \$nmotifs,
  'minw=i' => \$minw,
  'maxw=i' => \$maxw,
  'minsites=i' => \$minsites,
  'maxsites=i' => \$maxsites,
  'bfile=s' => \$bfile,
  'neg=s' => \$negfile,
  'norevcomp' => \$norevcomp,
  'pal' => \$pal,
  'help|?' => \$help
);
($sequences) = @ARGV;
# display help
pod2usage(1) if $help;
# reset stderr and get the error message if any
open(STDERR, ">&", $err_old) or die("Can't reset STDERR: $!");
seek($err_tmp, 0, SEEK_SET);
while ($opts_msg = <$err_tmp>) {
  chomp($opts_msg);
  push(@arg_errors, $opts_msg);
}
close($err_tmp);

# test the arguments
unless (defined($sequences)) {
  push(@arg_errors, "No sequences provided");
} elsif (not -e $sequences) {
  push(@arg_errors, "Sequences file \"$sequences\" does not exist");
}
unless ($alphabet eq 'dna' || $alphabet eq 'protein') {
  push(@arg_errors, "Value \"$alphabet\" invalid for option alpha (dna or protein expected)");
}
unless ($mode eq "zoops" or $mode eq "oops" or $mode eq "anr") {
  push(@arg_errors, "Value \"$mode\" invalid for option mod (zoops, oops or anr expected)");
}
unless ($nmotifs > 0) {
  push(@arg_errors, "Value \"$nmotifs\" invalid for option nmotifs (positive number expected)");
}
unless ($minw >= 2) {
  push(@arg_errors, "Value \"$minw\" invalid for option minw (minw >= 2 expected)");
}
unless ($maxw <= 300) {
  push(@arg_errors, "Value \"$maxw\" invalid for option maxw (maxw <= 300 expected)");
}
if (defined($minsites)) {
  unless ($minsites >= 2) {
    push(@arg_errors, "Value \"$minsites\" invalid for option minsites (minsites >= 2 expected)");
  }
}
if (defined($maxsites)) {
  unless ($maxsites <= 300) {
    push(@arg_errors, "Value \"$maxsites\" invalid for option maxsites (maxsites <= 300 expected");
  }
}
if (defined($bfile)) {
  unless (-e $bfile) {
    push(@arg_errors, "Value \"$bfile\" invalid for option bfile (file does not exist)");
  }
}
if (defined($negfile)) {
  unless (-e $negfile) {
    push(@arg_errors, "Value \"$negfile\" invalid for option neg (file does not exist)")
  }
}
$opts_ok = 0 if (scalar(@arg_errors) > 0);
foreach my $arg_error (@arg_errors) {
  print STDERR $arg_error, "\n";
  add_status_msg($arg_error, $msg_list);
}

# setup status page
$file_list = [
    {file => 'meme.html', desc => 'MEME html output'},
    {file => 'meme.xml', desc => 'MEME xml output'}, 
    {file => 'meme.txt', desc => 'MEME txt output'},
    {file => 'mast.html', desc => 'MAST html output'},
    {file => 'mast.xml', desc => 'MAST xml output'}, 
    {file => 'mast.txt', desc => 'MAST txt output'},
    {file => $sequences, desc => 'Input sequences'},
    {file => $bfile, desc => 'Background Markov model'},
    {file => 'priors.psp', desc => 'Position-specific priors'},
    {file => $negfile, desc => 'Negative sequences'}
];


if ($opts_ok) {
  add_status_msg('Arguments ok', $msg_list);
} else {
  add_status_msg("Error parsing arguments", $msg_list);
}

update_status($page, $program, ($opts_ok ? $refresh : 0), $file_list, 
    $msg_list, ($opts_ok ? "Starting" : "Error"));

# exit if there was an error reading the arguments
unless ($opts_ok) {
  write_invocation_log($log_file, $log_date, $log_args);
  pod2usage(2);
}

# Run PSPGen
if (defined($negfile)) { 
  # use the minw and maxw settings for MEME for finding the PSP but
  # trim to the allowed range for PSPs
  # the actual width set by the PSP finder is that with the highest
  # score before normalizing; allow X or N or other nonspecific residue/base
  # codes (but score any sites containing them as zero)
  my $psp_minw = $minw < $MINPSPW ? $MINPSPW : $minw;
  my $psp_maxw = $maxw > $MAXPSPW ? $MAXPSPW : $maxw;
  my @pspgen_args = ('-pos', $sequences, '-neg', $negfile, '-alpha', $alphabet, 
    '-minw', $psp_minw, '-maxw', $psp_maxw, '-arbitraryOK');
  push(@pspgen_args, '-maxrange', '-triples') if ($alphabet eq 'prot');
  run_prog(
    PROG => 'psp-gen', 
    ARGS => \@pspgen_args,
    BIN => '@BINDIR@', 
    OUT_FILE => 'priors.psp',
    ERR_FILE => $messages
  );
}

# Run MEME
my @meme_args = ($sequences, "-$alphabet", '-oc', '.', '-nostatus', '-time', $MAXTIME, '-maxsize', $MAXDATASET, 
  '-mod', $mode, '-nmotifs', $nmotifs, '-minw', $minw, '-maxw', $maxw);
push(@meme_args, '-minsites', $minsites) if (defined($minsites));
push(@meme_args, '-maxsites', $maxsites) if (defined($maxsites));
if ($alphabet eq 'dna') {
  push(@meme_args, '-revcomp') unless $norevcomp;
  push(@meme_args, '-pal') if $pal;
}
push(@meme_args, '-bfile', $bfile) if (defined($bfile));
push(@meme_args, '-psp', 'priors.psp') if (defined($negfile));
run_prog(
  PROG => 'meme', 
  ARGS => \@meme_args,
  BIN => '@BINDIR@', 
  ALL_FILE => $messages
);

# Run MAST
my @mast_args = ('meme.xml', $sequences, '-oc', '.', '-nostatus');
push(@mast_args, '-bfile', $bfile) if (defined($bfile));
run_prog(
  PROG => 'mast', 
  ARGS => \@mast_args,
  BIN => '@BINDIR@', 
  ALL_FILE => $messages
);

# Finish up
push(@{$file_list}, {file => $messages, desc => 'Warning Messages'});
update_status($page, $program, 0, $file_list, $msg_list, "Done");
write_invocation_log($log_file, $log_date, $log_args);

exit(0);

# Run the program and record if it succeeded to the status messages
sub run_prog {
  my (%options) = @_;

  my $prog = $options{PROG};
  my @args = @{$options{ARGS}};

  add_status_msg('Starting '.$prog.'<br><code>' . stringify_args($prog, @args) . '</code>', $msg_list);

  update_status($page, $program, $refresh, $file_list, $msg_list, "Starting");

  my ($time, $status_code);
  # run the program
  $status_code = invoke(@_, TIME => \$time);
  my $status_msg;
  if ($status_code != 0) {
    if ($status_code == -1) {
      $status_msg = $prog . " failed to run";
    } elsif ($status_code & 127) {
      $status_msg = $prog . " process died with signal " . 
          ($status_code & 127) . ", " . 
          (($status_code & 128) ? 'with' : 'without') . " coredump";
    } else {
      $status_msg = $prog . " exited with error code " . ($status_code >> 8);
    }
    print STDERR $status_msg;
    push(@{$file_list}, {file => $messages, desc => 'Error Messages'});
  } else {
    $status_msg = $prog . ' ran successfully in ' . 
        (int($time * 100 + 0.5) / 100) . ' seconds';
  }
  add_status_msg($status_msg, $msg_list);

  update_status($page, $program, 0, $file_list, $msg_list, 
      ($status_code ? "Error" : ""));

  if ($status_code) {
    write_invocation_log($log_file, $log_date, $log_args);
    exit(1);
  }
}

1;