view release on metacpan or  search on metacpan

scripts/frend.pl  view on Meta::CPAN

=head1 AUTHOR

Lincoln Stein, lstein@cshl.org

=cut

use strict;
use Bio::Graphics::Panel;
use Bio::Graphics::Feature;
use Bio::Graphics::FeatureFile;
use CGI qw(:standard);
use CGI::Carp;
use File::Temp ':mktemp';
use File::Spec;
use File::Basename 'basename';
use File::Path 'mkpath';
use vars '@COLORS';

use constant WIDTH          => 600;  # default width
use constant BUMP_THRESHOLD => 50;  # if more than this # of features, will stop bumping
@COLORS = qw(cyan blue red yellow green wheat turquoise orange);  # default colors

if (param('cat')) {
  catfile(param('cat'));
  exit 0;
}

print header,start_html('Sequence Feature Renderer');
print h1('Sequence Feature Renderer');

print p('This is a front end to the Bio::Graphics package, a part of the',
	a({-href=>'http://www.bioperl.org'},'BioPerl library.'),
	  'Cut and paste your sequence annotation data into the text field below, or upload it using the',
	'upload button.',
	'The format of the annotation data is explained',a({-href=>'#format'},'below.'));

my $self = url(-relative=>1);
print h3('Instant examples'),
  p('For the impatient, you can paste in an',
    b(a({-href=>"$self?Paste+Example+1"},'example file.')));

read_file() if param('file');

my $example = param('Example 1') 
  ? test_data(0) 
  : param('Example 2')
  ? test_data(1)
  : '';
param(text => $example) if length $example;

render() if param('text') || param('file') =~ /\w/;

print start_multipart_form(),
  table({-border=>0,-width=>300,-cellspacing=>0,-cellpadding=>0},
	TR({-class=>'resultsbody'},
	   td({-colspan=>1},
	      'Cut and Paste the annotation file...'
	     ),
	   td({-colspan=>2},
	      'Image width: ',
	      popup_menu(-name=>'width',-values=>[480,640,800,1024,1280,1600],-default=>800)
	     ),
	   TR({-class=>'resultsbody'},
	      td({-colspan=>3},
		 pre(
		     textarea(-name=>'text',-value=>$example,
			      -cols=>80,-rows=>10,-wrap=>'off',-override=>length $example || param('Clear'))
		    )
		)
	     )
	  ),
	TR({-class=>'resultsbody'},
	   td({-colspan=>1},'Upload it... ',filefield(-name=>'file',-size=>30)),
	   td({-align=>'left',-colspan=>2},
	      'Or paste one of the example files...',
	      submit('Example 1'),
	      submit('Example 2'),
	      submit('Clear'),
	     )
	  ),
	TR({-class=>'resultstitle'},
	   td({-align=>'left',-colspan=>3},
	      "Press",b('Render'),'when ready...',
	      b(submit('Render...'))
	     ),
	   )),
  end_form;

print_format();

print hr(),a({-href=>'http://www.bioperl.org'},'www.bioperl.org'),end_html();

exit 0;

sub read_file {
  my $text;
  my $fh = param('file') or return;
  $text .= $_ while <$fh>;
  param(text => $text);
}

sub render {
  my $text = shift;
  my $color = 0;      # position in color cycle

  $text ||= param('text');
  my $data = $text ? Bio::Graphics::FeatureFile->new(-text => $text) 
                   : Bio::Graphics::FeatureFile->new(-file => param('file'));

  unless ($data->min < $data->max) {
    AceError("This doesn't look like a valid annotation file.  No annotations found.");
    exit 0;
  }

  # adjust the width if requested
  $data->setting(general => 'width',param('width')) if param('width');

  # render the panel
  my $panel = $data->new_panel;
  $data->render($panel);