#
# BioStudio Chromosome Segmentation Planner GBrowse interface
#

=head1 NAME

Bio::Graphics::Browser2::Plugin::BS_ChromosomeSegmentationPlanner

=head1 VERSION

Version 2.00

=head1 DESCRIPTION

=head1 AUTHOR

Sarah Richardson <smrichardson@lbl.gov>

=cut

package Bio::Graphics::Browser2::Plugin::BS_ChromosomeSegmentationPlanner;

use Bio::Graphics::Browser2::Plugin;
use Bio::BioStudio;
use Pod::Usage;
use CGI qw(:all delete_all);
use Digest::MD5;
use Bio::BioStudio::GBrowse qw(:BS);
use English qw(-no_match_vars);
use Carp;

use strict;
use warnings;

our $VERSION = '2.00';
our @ISA = qw(Bio::Graphics::Browser2::Plugin);

##Global variables
my $BS;
my $plugin_name = 'BS_ChromosomeSegmentationPlanner';
my $bsversion = $plugin_name . q{_} . $VERSION;
local $OUTPUT_AUTOFLUSH = 1;

=head2 name

Plugin name

=cut

sub name
{
  return 'BioStudio: Propose a Chromosome Segmentation Plan';
}

=head2 type

Plugin type

=cut

sub type
{
  return 'dumper';
}

=head2 verb

Plugin verb

=cut

sub verb
{
  return q{ };
}

=head2 description

Plugin description

=cut

sub description
{
  return p("This plugin will propose a plan for the segmentation of a chromosome
    into modular, assemblable pieces by the placement of restriction enzyme
    recognition sites.");
}

=head2 init

Make a new BioStudio instance

=cut

sub init
{
  my $self = shift;
  $BS = Bio::BioStudio->new();
  return;
}

=head2 config_defaults

Set default configuration

=cut

sub config_defaults
{
  my $self = shift;
  return;
}

=head2 mime_type

Plugin return type

=cut

sub mime_type
{
  return 'text/html';
}

=head2 reconfigure

Recover configuration

=cut

sub reconfigure
{
  my $self  = shift;
  my $current = $self->configuration;
  foreach ( $self->config_param() )
  {
    if ($_ eq 'MARKERS')
    {
      my @choices = $self->config_param($_);
      $current->{$_} = \@choices;
    }
    else
    {
      $current->{$_} = $self->config_param($_)
        ? $self->config_param($_)
        : undef;
    }
  }
  return;
}

=head2 configure_form

Render form, gather configuration from user

=cut

sub configure_form
{
  my $self = shift;
  my $gb_settings = $self->page_settings;
  my $sourcename  = $gb_settings->{source};
  my $chromosome  = $BS->set_chromosome(-chromosome => $sourcename);
  
  #Make sure this is allowed
  unless ($sourcename =~ m{\_PLAN})
  {
    print "You must run this plugin on a source generated by the Chromosome ";
    print "Segmentation Planner.<br>";
    return;
  }
  my $species = $chromosome->species;
  my $seqid = $chromosome->seq_id;

  my $dbs = $BS->source_list();
  my @srcs = grep { $_ =~ m{$species\_$seqid} } keys %{$dbs};
  @srcs = sort grep {$_ !~ m{\_PLAN}} @srcs;

  my @enzlists = $chromosome->GD->list_enzyme_sets();
 
  #Check if overwrite warning is needed
  my $gwarning = $BS->gv_increment_warning($chromosome);
  my $cwarning = $BS->cv_increment_warning($chromosome);

  my $scalewarns = "<br>";
  if ($gwarning)
  {
    my $gwarn  = "$gwarning already exists; if you increment the genome ";
       $gwarn .= "version it will be overwritten.";
    $scalewarns .= p("<strong style=\"color:#FF0000;\">$gwarn</strong><br> ");
  }
  if ($cwarning)
  {
    my $cwarn  = "$cwarning already exists; if you increment the chromosome ";
       $cwarn .= "version it will be overwritten.";
    $scalewarns .= p("<strong style=\"color:#FF0000;\">$cwarn.</strong><br> ");
  }
 
  my $markers = fetch_custom_markers($BS);
  my @markerlist = sort keys %{$markers};
  my @choices = ();
 
  push @choices, TR(
    {-class => 'searchtitle'},
    th("Planning Chromosome Segmentation<br>")
  );
     
  push @choices, TR(
    {-class => 'searchtitle'},
    th("SEGMENTATION OPTIONS:")
  );
     
  push @choices, TR(
    {-class => 'searchbody'},
    th("Chunk Size (bp)"),
    td(
      "min",
      textfield(
        -name => $self->config_name('CHUNKLENMIN'),
        -size => 6,
        -maxlength  => 5,
        -default    => 6000
      ),
      "max",
      textfield(
        -name       => $self->config_name('CHUNKLENMAX'),
        -size       => 6,
        -maxlength  => 5,
        -default    => 9920
      )
    )
  );
         
  push @choices, TR(
    {-class => 'searchbody'},
    th("Number of Chunks per Megachunk"),
    td(
      textfield(
        -name       => $self->config_name('CHUNKNUM'),
        -size       => 2,
        -maxlength  => 1,
        -default    => 4
      ),
      "min",
      textfield(
        -name       => $self->config_name('CHUNKNUMMIN'),
        -size       => 2,
        -maxlength  => 1,
        -default    => 3
      ),
      "max",
      textfield(
        -name       => $self->config_name('CHUNKNUMMAX'),
        -size       => 2,
        -maxlength  => 1,
        -default    => 5
      )
    )
  );
        
  push @choices, TR(
    {-class => 'searchbody'},
    th("Chunks Ovelap by (bp)"),
    td(
      textfield(
        -name       => $self->config_name('CHUNKOLAP'),
        -size       => 3,
        -maxlength  => 2,
        -default    => 40
      )
    )
  );
           
  push @choices, TR(
    {-class => 'searchbody'},
    th("ISS Size (bp)"),
    td("min",
      textfield(
        -name       => $self->config_name('ISSMIN'),
        -size       => 5,
        -maxlength  => 4,
        -default    => 900
      ),
      "max",
      textfield(
        -name       => $self->config_name('ISSMAX'),
        -size       => 5,
        -maxlength  => 4,
        -default    => 1500
      )
    )
  );
           
  push @choices, TR(
    {-class => 'searchbody'},
    th("Original Chromosome for ISS substitution"),
    td(
      popup_menu(
        -name     => $self->config_name('WTCHR'),
        -values   => \@srcs,
        -default  => $srcs[0]
      )
    )
  );
           
  push @choices, TR(
    {-class => 'searchbody'},
    th("Enzyme set"),
    td(
      popup_menu(
        -name     => $self->config_name('RESET'),
        -values   => \@enzlists,
        -default  => "nonpal_and_IIB"
      )
    )
  );
         
  push @choices, TR(
    {-class => 'searchbody'},
    th("Essential / fast growth gene \"UTR\" Padding"),
    td(
      "5\'",
      textfield(
        -name       => $self->config_name('FPUTRPADDING'),
        -size       => 5,
        -maxlength  => 4,
        -default    => 500
      ),
      "3\'",
      textfield(
        -name       => $self->config_name('TPUTRPADDING'),
        -size       => 5,
        -maxlength  => 4,
        -default    => 100
      )
    )
  );
         
  push @choices, TR(
    {-class => 'searchbody'},
    th("Megachunk markers"),
    td(
      checkbox_group(
        -name     => $self->config_name('MARKERS'),
        -values   => \@markerlist,
        -cols     => 4,
        -defaults => ["LEU2", "URA3"]
      )
    )
  );
           
  push @choices, TR(
    {-class => 'searchbody'},
    th("Last chromosomal marker"),
    td(
      radio_group(
        -name     => $self->config_name('LASTMARKER'),
        -values   => \@markerlist,
        -cols     => 4,
        -defaults => ["URA3"]
      )
    )
  );
         
  push @choices, TR(
    {-class => 'searchbody'},
    th("Scope"),
    td(
      radio_group(
        -name   => $self->config_name('SCOPE'),
        -values => ['chrom', 'seg'],
        -default=>'chrom',
        -labels => {
          'chrom' => 'whole chromosome',
          'seg'   => 'the sequence in view now'
        },
      )
    )
  );
           
  push @choices, TR(
    {-class => 'searchbody'},
    th("First Letter"),
    td(
      textfield(
        -name       => $self->config_name('FIRSTLETTER'),
        -size       => 3,
        -maxlength  => 2,
        -default    => "A"
      )
    )
  );
                     
  push @choices, TR(
    {-class => 'searchbody'},
    th("Force recreation of restriction enzyme database"),
    td(
      checkbox(
        -name     => $self->config_name('REDOREDB'),
        -checked  => 0,
        -value    => 1,
        -label    => "YES"
      )
    )
  );
                                 
  my $html = table(@choices);
  return $html;
}

=head2 dump

Call BS_ChromosomeSegmentationPlanner and pass the parameters
Then monitor the scripts progress; print periodic output.

=cut

sub dump
{
  my $self      = shift;
  my $segment   = shift;

  #If we're monitoring the results, print out from the cache and refresh in 5
  if (my $sid = param('session'))
  {
    my $cache = get_cache_handle($plugin_name);
    my $data = $cache->get($sid);
    unless($data and ref $data eq "ARRAY")
    {
      #some kind of error
      exit 0;
    }
    print $data->[0]
      ? start_html(
          -title => "Results for $plugin_name job $sid")
      : start_html(
          -title => "Running $plugin_name job $sid",
          -head=>meta({
            -http_equiv => 'refresh',
            -content    => '5'}));
    print p(i("This page will refresh in 5 seconds")) unless $data->[0];
    print pre($data->[1]);
    print p(i("...continuing...")) unless $data->[0];
    print end_html;
    return;
  }
 
  #Otherwise we're launching the script
  else
  {
   #Prepare persistent variables
    my $sid = Digest::MD5::md5_hex(Digest::MD5::md5_hex(time().{}.rand().$$));
    my $cache = get_cache_handle($plugin_name);
    $cache->set($sid, [0, q{}]);
  
   #Prepare arguments
    my $pa               = $self->configuration;
    my $gbrowse_settings = $self->page_settings;
    my $command;
    $pa->{CHROMOSOME}   = $gbrowse_settings->{source};
    $pa->{STARTPOS} = $segment->start if ($pa->{SCOPE} eq "seg");
    $pa->{STOPPOS}  = $segment->end if ($pa->{SCOPE} eq "seg");
    $pa->{MARKERS} = join(",", @{$pa->{MARKERS}});
   
    $pa->{$_} = "\"$pa->{$_}\"" foreach (grep {$pa->{$_} =~ /\ /} keys %{$pa});
    $command .= "--" . $_ . q{ } . $pa->{$_} . q{ } foreach (keys %{$pa});
   
   #If we're the parent, prepare the url and offer a link.
    if (my $pid = fork)
    {
      delete_all();
      my $addy = self_url();
      $addy .= "?plugin=$plugin_name;plugin_action=Go;";
      $addy .= "session=$sid";
      print start_html(
        -title  => "Launching BioStudio...",
        -head   => meta({
          -http_equiv => 'refresh',
          -content    => "10; URL=\"$addy\""}));
      print p(i("BioStudio is running."));
      print p("Your job number is $sid.");
      print "If you are not redirected in ten seconds, ";
      print "<a href=\"$addy\">click here for your results</a><br>";
      print p("Command:");
      print pre($command);
      print end_html;
      return;
    }
   #If we're a child, launch the script, feed results to the cache
    elsif(defined $pid)
    {
      close STDOUT;
      unless (open F, "-|")
      {
        my $path = $BS->{script_path} . $plugin_name . '.pl';
        open STDERR, ">&=1";
        exec "$path $command"
            || croak "Cannot execute $plugin_name: $OS_ERROR";
      }
      my $buf = q{};
      while (<F>)
      {
        $buf .= $_;
        $cache->set($sid, [0, $buf]);
      }
      $cache->set($sid, [1, $buf]);
      exit 0;
    }
   #Otherwise, uh oh
    else
    {
      croak "Cannot fork: $OS_ERROR";
    }
  }
}

1;

__END__