view release on metacpan or  search on metacpan

gbrowse_plugins/BS_ChromosomeSegmenter.pm  view on Meta::CPAN

    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("Chromosome Segmentation<br>")
  );
     
  push @choices, TR(
    {-class => 'searchtitle'},
    th("Editor Name"),
    td(
      textfield(
        -name       => $self->config_name('EDITOR'),
        -default    => $ENV{REMOTE_USER},
        -size       => 25,
        -maxlength  => 20
      )
    )
  );
           
  push @choices, TR(
    {-class => 'searchtitle'},
    th("Notes"),
    td(
      textfield(
        -name =>$self->config_name('MEMO'),
        -size => 50
      )
    )
  );
           
  push @choices, TR(
    {-class => 'searchtitle'},
    th("SEGMENTATION OPTIONS:")
  );
     
  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("Original Chromosome for ISS substitution"),
    td(
      popup_menu(
        -name     => $self->config_name('WTCHR'),
        -values   => \@srcs,
        -default  => $srcs[0]
      )
    )
  );
         
  my $html = table(@choices);
  return $html;
}

=head2 dump

Call BS_ChromosomeSegmenter 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->{PLAN}   = $gbrowse_settings->{source};
    $pa->{OUTPUT} = "html";
   
    $pa->{$_} = "\"$pa->{$_}\"" foreach (grep {$pa->{$_} =~ /\ /} keys %{$pa});