view release on metacpan or  search on metacpan

conf/plugins/BatchDumper.pm  view on Meta::CPAN

	  print h1($label),"\n",
	  start_pre();
	  $out->write_seq($segment);
	  print end_pre();
      }
      print end_html;
  } else {
      $out->write_seq($_) for @segments;
  }
  undef $out;
}

sub mime_type {
  my $self = shift;
  my $config = $self->configuration;
  return 'text/plain' if $config->{format} eq 'text';
  return 'text/xml'   if $config->{format} eq 'html' && $FORMATS{$config->{fileformat}}[1]; # this flag indicates xml
  return 'text/html'  if $config->{format} eq 'html';
  return 'application/chemical-na'  if $config->{format} eq 'external_viewer';
  return wantarray ? ('application/octet-stream','dumped_region') : 'application/octet-stream'
    if $config->{format} eq 'todisk';
  return 'text/plain';  # default
}

sub config_defaults {
  my $self = shift;
  return { format           => 'html',
	   fileformat       => 'fasta',
	   wantsorted       => 0,
       };
}

sub reconfigure {
  my $self = shift;
  my $current_config = $self->configuration;

  $current_config->{flip} = '';
  foreach my $p ( $self->config_param() ) {
    $current_config->{$p} = $self->config_param($p);
  }
}

sub configure_form {
  my $self = shift;
  my $current_config = $self->configuration;
  my @choices = TR({-class => 'searchtitle'},
			th({-align=>'RIGHT',-width=>'25%'},"Output",
			   td(radio_group('-name'   => $self->config_name('format'),
					  '-values' => [qw(text html external_viewer todisk)],
					  '-default'=> $current_config->{'format'},
					  -labels   => {'html' => 'html/xml',
							'external_viewer' => 'GenBank Helper Application',
							'todisk' => 'Save to Disk',
						       },
					  '-override' => 1))));
  my $browser = $self->browser_config();
  # this to be fixed as more general

  push @choices, TR({-class => 'searchtitle'}, 
			th({-align=>'RIGHT',-width=>'25%'},"Sequence File Format",
			   td(popup_menu('-name'   => $self->config_name('fileformat'),
					 '-values' => \@ORDER,
					 '-labels' => \%LABELS,
					 '-default'=> $current_config->{'fileformat'} ))));

  push @choices,TR({-class=>'searchtitle'},
		   th({-align=>'RIGHT',-width=>'25%'},"Orientation",
		      td(checkbox(-name    => $self->config_name('flip'),
				  -label   => 'Flip (Fasta and raw sequence only)',
				  -checked => $self->page_settings->{flip},
				  -override => 1))));


  push @choices, TR({-class => 'searchtitle'}, 
		    th({-align=>'RIGHT',-width=>'25%'},
		       "Sorted SubLocations (for VectorNTI input of GenBank)",
		       td(popup_menu('-name'   => $self->config_name('wantsorted'),
				     '-values' => [qw(0 1)],
				     '-labels' => { '0' => 'No',
						    '1' => 'Yes'},
				     '-default'=> $current_config->{'wantsorted'} ))));
  
  push @choices, TR({-class=>'searchtitle'},
			th({-align=>'RIGHT',-width=>'25%'},'Sequence IDs','<p><i>(Entry overrides chosen segment)</i></p>',
			   td(textarea(-name=>$self->config_name('sequence_IDs'),
                           	       -rows=>20,
                              	       -columns=>20,
				       ))));

  my $html= table(@choices);
  $html;
}

sub gff_dump {
  my $self             = shift;
  my ($gff3_flag,$segment,@extra) = @_;
  my $page_settings = $self->page_settings;
  my $conf          = $self->browser_config;
  my $date = localtime;

  my $mime_type = $self->mime_type;
  my $html      = $mime_type =~ /html/;
  print start_html($segment) if $html;
  my @feature_types = $self->selected_features;

  print h1($segment),start_pre() if $html;
  print "##gff-version ",$gff3_flag || 2,"\n";
  print "##date $date\n";
  print "##sequence-region ",join(' ',$segment->ref,$segment->start,$segment->stop),"\n";
  print "##source gbrowse BatchDumper\n";
  print $gff3_flag ? "##See http://song.sourceforge.net/gff3.shtml\n"
                   : "##See http://www.sanger.ac.uk/Software/formats/GFF/\n";
  print "##NOTE: Selected features dumped.\n";
  my $iterator = $segment->get_seq_stream(-types=>\@feature_types) or return;
  do_dump($gff3_flag,$iterator);
  for my $set (@extra) {
    do_dump($gff3_flag,$set->get_seq_stream)  if $set->can('get_seq_stream');
  }
  print end_pre() if $html;
  print end_html() if $html;
}

sub do_dump {
  my $gff3     = shift;
  my $iterator = shift;
  while (my $f = $iterator->next_seq) {
    eval {$f->version($gff3 || 2)};
    my $s = $f->gff_string(1);
    chomp $s;
    print "$s\n";
    for my $ss ($f->sub_SeqFeature) {
      my $string = $ss->gff_string;
      chomp $string;
      print "$string\n";
    }
  }
}