view release on metacpan or  search on metacpan

gbrowse_plugins/BS_ChromosomeCutter.pm  view on Meta::CPAN

  {
    $current->{$_} = $self->config_param($_) ? $self->config_param($_) : undef;
  }
}

=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 %DELHASH;

  my $popupseqdelbsfeat = popup_menu(
    -name     => $self->config_name("seqdel.INSERT"),
    -values   => \@inskeys,
    -default  => $featdefault);
  $DELHASH{'seqdel'} = "delete this segment (and replace with a $popupseqdelbsfeat)<br>";
 
  $DELHASH{'seqdelprp'} = "propose this segment for deletion<br>";

  my $popupfeatdel = popup_menu(
    -name     => $self->config_name("featdel.TYPE"),
    -values   => \@featkeys,
    -default  => $featdefault);
  my $popupfeatdelbsfeat = popup_menu(
    -name     => $self->config_name("featdel.INSERT"),
    -values   => \@inskeys,
    -default  => $featdefault);
  $DELHASH{'featdel'} = "delete the $popupfeatdel features wholly contained within this segment (and replace with $popupfeatdelbsfeat)<br>";
 
  my $popupfeatdelprp = popup_menu(
    -name     => $self->config_name("featdelprp.TYPE"),
    -values   => \@featkeys,
    -default  => $featdefault);
  $DELHASH{'featdelprp'} = "propose the $popupfeatdelprp features wholly contained within this segment for deletion<br>";

  my $tfield = textfield(
    -name     => $self->config_name("listdel.FEATURES"),
    -value    => q{},
    -size     => 50);
  $DELHASH{'listdel'} = "delete the features with the following names: $tfield<br>";
  
  my @choices = ();
  
  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'],
        -default  => 'chrom',
        -labels   => {
          'chrom'   => 'chromosome version',
          'genome'  => 'genome version'
        },
      )
    )
  );
           
  autoEscape(0);
 
  push @choices, TR(
    {-class => 'searchbody'},
    th(
      {-align=>'RIGHT', -width=>'25%'},