#!@WHICHPERL@
=head1 NAME

glam2_webservice - Run glam2 in a restricted mode and create an index webpage.

=head1 SYNOPSIS

glam2_webservice [options] <sequences>

  Options:
    -alpha [DNA|PROTEIN]  Alphabet; default DNA
    -min_seqs <n>         Minimum number of sequences in an alignment (-z)
    -min_cols <n>         Minimum number of aligned columns (-a)
    -max_cols <n>         Maximum number of aligned columns (-b)
    -initial_cols <n>     Initial number of aligned columns (-w)
    -runs <n>             Number of alignment replicates (-r)
    -run_no_impr <n>      Number of iterations without improvement (-n)
    -del_pseudo <n>       Deletion pseudocount (-D)
    -no_del_pseudo <n>    No-deletion pseudocount (-E)
    -ins_pseudo <n>       Insertion pseudocount (-I)
    -no_ins_pseudo <n>    No-insertion pseudocount (-J)
    -rev_comp             Check both strands (-2)
    -embed                Embed the sequences (-M)
    -help                 brief help message

=cut

use strict;
use warnings;

use Fcntl qw(SEEK_SET);
use File::Basename qw(fileparse);
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(is_safe_name 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 = 'glam2-log';

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

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

# required parameters
my $sequences;
# option defaults
my $alpha = 'DNA';
my $min_seqs = undef;
my $min_cols = undef;
my $max_cols = undef;
my $initial_cols = undef;
my $runs = undef;
my $run_no_impr = undef;
my $del_pseudo = undef;
my $no_del_pseudo = undef;
my $ins_pseudo = undef;
my $no_ins_pseudo = undef;
my $rev_comp = 0; #FALSE
my $embed = 0; #FALSE
my $help = 0; #FALSE

# derived defaults

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' => \$alpha,
  'min_seqs=i' => \$min_seqs,
  'min_cols=i' => \$min_cols,
  'max_cols=i' => \$max_cols,
  'initial_cols=i' => \$initial_cols,
  'runs=i' => \$runs,
  'run_no_impr=i' => \$run_no_impr,
  'del_pseudo=f' => \$del_pseudo,
  'no_del_pseudo=f' => \$no_del_pseudo,
  'ins_pseudo=f' => \$ins_pseudo,
  'no_ins_pseudo=f' => \$no_ins_pseudo,
  'rev_comp' => \$rev_comp,
  'embed' => \$embed,
  '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);

# remove any path from the files to ensure they are in this directory
if (defined($sequences)) {
  $sequences = fileparse($sequences);
}

# test the arguments
if ($alpha ne 'DNA' && $alpha ne 'PROTEIN') {
  push(@arg_errors, "Value \"$alpha\" invalid for option alpha (must be DNA or PROTEIN)");
}
if (defined($min_seqs)) {
  if ($min_seqs < 2) {
    push(@arg_errors, "Value \"$min_seqs\" invalid for option min_seqs (must be >= 2)");
  }
}
if (defined($min_cols)) {
  if ($min_cols < 2) {
    push(@arg_errors, "Value \"$min_cols\" invalid for option min_cols (must be >= 2)");
  } elsif ($min_cols > 300) {
    push(@arg_errors, "Value \"$min_cols\" invalid for option min_cols (must be <= 300)");
  }
}
if (defined($max_cols)) {
  if ($max_cols > 300) {
    push(@arg_errors, "Value \"$max_cols\" invalid for option max_cols (must be <= 300)");
  } elsif ($max_cols < 2) {
    push(@arg_errors, "Value \"$max_cols\" invalid for option max_cols (must be >= 2)");
  }
}
if (defined($min_cols) && defined($max_cols)) {
  if ($min_cols > $max_cols) {
    push(@arg_errors, "Value \"$min_cols\" invalid for option min_cols (must <= max_cols $max_cols)");
  }
}
if (defined($initial_cols)) {
  if ($initial_cols < 2 || (defined($min_cols) && $initial_cols < $min_cols)) {
    push(@arg_errors, "Value \"$initial_cols\" invalid for option initial_cols ".
      "(must be >= the minimum columns or 2 if that is unset)");
  } elsif ($initial_cols > 300 || (defined($max_cols) && $initial_cols > $max_cols)) {
    push(@arg_errors, "Value \"$initial_cols\" invalid for option initial_cols ".
      "(must be <= the maximum columns or 300 if that is unset)");
  }
}
if (defined($runs)) {
  if ($runs < 1) {
    push(@arg_errors, "Value \"$runs\" invalid for option runs (must be >= 1)");
  } elsif ($runs > 100) {
    push(@arg_errors, "Value \"$runs\" invalid for option runs (must be <= 100)");
  }
}
if (defined($run_no_impr)) {
  if ($run_no_impr < 1) {
    push(@arg_errors, "Value \"$run_no_impr\" invalid for option runs_no_impr (must be >= 1)");
  } elsif ($run_no_impr > 1000000) {
    push(@arg_errors, "Value \"$run_no_impr\" invalid for option runs_no_impr (must be <= 1000000)");
  }
}
if (defined($del_pseudo)) {
  if ($del_pseudo <= 0) {
    push(@arg_errors, "Value \"$del_pseudo\" invalid for option del_pseudo (must be > 0)");
  }
}
if (defined($no_del_pseudo)) {
  if ($no_del_pseudo <= 0) {
    push(@arg_errors, "Value \"$no_del_pseudo\" invalid for option no_del_pseudo (must be > 0)");
  }
}
if (defined($ins_pseudo)) {
  if ($ins_pseudo <= 0) {
    push(@arg_errors, "Value \"$ins_pseudo\" invalid for option ins_pseudo (must be > 0)");
  }
}
if (defined($no_ins_pseudo)) {
  if ($no_ins_pseudo <= 0) {
    push(@arg_errors, "Value \"$no_ins_pseudo\" invalid for option no_ins_pseudo (must be > 0)");
  }
}

unless (defined($sequences)) {
  push(@arg_errors, "No sequences provided");
} elsif (not is_safe_name($sequences)) {
  push(@arg_errors, "Sequences file \"$sequences\" does not fit allowed file name pattern.");
} elsif (not -e $sequences) {
  push(@arg_errors, "Sequences file \"$sequences\" 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 => 'glam2.html', desc => 'GLAM2 html output'},
    {file => 'glam2.txt', desc => 'GLAM2 txt output'},
    {file => 'glam2.meme', desc => 'GLAM2 output as MEME text format'}, 
    {file => $sequences, desc => 'Input 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 GLAM2
my @glam2_args = ('-Q', '-O', '.');
push(@glam2_args, '-M') if $embed;
# TODO embed address and description
push(@glam2_args, '-2') if ($rev_comp);
push(@glam2_args, '-z', $min_seqs) if (defined($min_seqs));
push(@glam2_args, '-a', $min_cols) if (defined($min_cols));
push(@glam2_args, '-b', $max_cols) if (defined($max_cols));
push(@glam2_args, '-w', $initial_cols) if (defined($initial_cols));
push(@glam2_args, '-r', $runs) if (defined($runs));
push(@glam2_args, '-n', $run_no_impr) if (defined($run_no_impr));
push(@glam2_args, '-D', $del_pseudo) if (defined($del_pseudo));
push(@glam2_args, '-E', $no_del_pseudo) if (defined($no_del_pseudo));
push(@glam2_args, '-I', $ins_pseudo) if (defined($ins_pseudo));
push(@glam2_args, '-J', $no_ins_pseudo) if (defined($no_ins_pseudo));
push(@glam2_args, ($alpha eq 'DNA' ? 'n' : 'p'), $sequences);

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

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

my ($time, $status_code);
# run the program
$status_code = invoke(
  PROG => 'glam2', 
  ARGS => \@glam2_args, 
  BIN => '@BINDIR@', 
  ALL_FILE => $messages, 
  TIME => \$time);

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

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


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