view release on metacpan or  search on metacpan

gbrowse_plugins/BS_ChromosomeSplicer.pm  view on Meta::CPAN

  }
}

=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);

  #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 $db    = $self->db_search;
  my $start = $gb_settings->{view_start};
  my $stop  = $gb_settings->{view_stop};

  my @a = $db->features(-range=>"contains");
  my @flankers =  grep {($_->start < $start && ($_->end <= $stop && $_->end >= $start))
                    || ($_->end > $stop && ($_->start >= $start && $_->start <= $stop))} @a;
  @flankers = map {$_->primary_tag . q{ } . $_->Tag_load_id . "<br>"} @flankers;
 
  my %FEATTYPES = ();
  my @contained = grep {$_->start >= $start && $_->end <= $stop} @a;
  $FEATTYPES{$_->primary_tag}++ foreach (@contained);
  my @featcounts = map { $FEATTYPES{$_} . q{ } . $_  . "<br>"} sort keys %FEATTYPES;
  my @featkeys = sort {$a cmp $b} keys %FEATTYPES;
  unshift @featkeys, $featdefault;
 
  my $BS_FEATS = $BS->custom_features();
  my @BSKINDS = map {"<strong>" . $_->prototype . "</strong> " . $_->primary_tag . "<br>"} values %{$BS_FEATS};
  @BSKINDS = sort {$a cmp $b} @BSKINDS;
  my @inskeys = sort {$a cmp $b} map {$_->prototype} values %{$BS_FEATS};
  unshift @inskeys, $featdefault;
 
  #my %dirlabels = {"3'" => "W", "5'" => 5, "5' and 3'" => 35};
  my $dirlabels = {"3" => "3'", "5" => "5'", "35" => "5' and 3'"};
  my %BSFEATINSHASH;
 
  my $popupsegmflankbsfeat = popup_menu(
    -name     => $self->config_name("segmentflank.INSERT"),
    -values   => \@inskeys,
    -default  => $featdefault);
  $BSFEATINSHASH{"segmentflank"} = "flank this segment with $popupsegmflankbsfeat features (intrusive)<br>";
 
  my $popupfeatflank = popup_menu(
    -name     => $self->config_name("featflank.FEATURE"),
    -values   => \@featkeys,
    -default  => $featdefault);
  my $flankdist = textfield (
    -name       => $self->config_name("featflank.DISTANCE"),
    -default    =>'10',
    -size       => 4,
    -maxlength  => 3);
  my $flankdir = popup_menu(
    -name     => $self->config_name("featflank.DIRECTION"),
    -labels   => $dirlabels,
    -values   => [5, 3, 35],
    -default  => 35);
  my $popupfeatflankbsfeat = popup_menu(
    -name     => $self->config_name("featflank.INSERT"),
    -values   => \@inskeys,
    -default  => $featdefault);
  $BSFEATINSHASH{"featflank"} = "put $popupfeatflankbsfeat features $flankdist bases $flankdir of the $popupfeatflank features in this segment (non-intrusive)<br>";
 
  my $popupbsfeatins = popup_menu(
    -name     => $self->config_name("featins.INSERT"),
    -values   => \@inskeys,
    -default  => $featdefault);
  my $namebsfeatins = textfield (
    -name       => $self->config_name("featins.NAME"),
    -default    => "$sourcename:$start..$stop",
    -size       => 30,
    -maxlength  => 30);
  $BSFEATINSHASH{"featins"} = "insert a $popupbsfeatins feature here and name it $namebsfeatins (intrusive)<br>";
 
  my (@choices, @facts) = ((), ());
  
  push @choices, TR(
    {-class => 'searchtitle'},
    th("Editing Chromosome Features<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("Increment genome version or chromosome version?$scalewarns"),
    td(
      radio_group(
        -name   => $self->config_name('SCALE'),
        -values => ['genome', 'chrom'],
        -labels =>  {
          'chrom'  => 'chromosome version',
          'genome' => 'genome version'},
        -default=>'chrom'
      )
    )
  );
           
  autoEscape(0);
  push @choices, TR(
    {-class => 'searchbody'},
    th(
      {-align => 'RIGHT', -width => '25%'},
      "CUSTOM FEATURE INSERTIONS"
    ),
    td("<br>",
      radio_group(
        -name   => $self->config_name('ACTION'),
        -values => \%BSFEATINSHASH
      ),
      "<br><br>"