view release on metacpan or  search on metacpan

examples/db/dbfetch  view on Meta::CPAN

    elsif ($style eq 'raw') { 
        print "Content-Type: text/plain; charset=UTF-8\n\n";
    }
    $FH = tempfile('dbfetchXXXXXX', DIR => TMPDIR, UNLINK => 1 ); #automatic unlinking

    # Check the number of IDs
    my @ids = split (/ /, $value);
    input_error($q, $style, "6 Too many IDs [". scalar @ids. "]. Max [". MAXIDS. "] allowed.")
        if scalar @ids >  MAXIDS;

    # XEMBL cannot 'glue' single entries due to XML setup 
    #- we need to send things in one go.
    if ($style eq 'xml') {
	&xml($format, @ids);
    } else {
        my $counter;
        foreach my $id (@ids) {
            &$style($db, $id, $format);
        }
        no_entries($q, $value) if $style eq 'html' and tell($FH) == 0;
    }
    seek $FH, 0, 0;
    print '<pre>' if $style eq 'html';
    print $_ while <$FH>;
} else {
    print_prompt($q);
}


=head2 print_prompt

 Title   : print_prompt
 Usage   :
 Function: Prints the default page with the query form
           to STDOUT (Web page)
 Args    :
 Returns :

=cut

sub print_prompt {
    print $q->header(),
         $q->start_html(-title => 'DB Entry Retrieval',
                        -bgcolor => 'white',
			-author => 'heikki-at-bioperl-dot-org'
			),
	 '<IMG align=middle SRC="/icons/ebibanner.gif">',
	  $q->h1('Generic DB Entry Retrieval'),
	  $q->p("This page allows you to retrieve up to ". MAXIDS .
		 " entries at the time from various up-to-date biological databases."),
	  $q->p("For EMBL, enter an  accession number (e.g. J00231) or entry name (e.g.
		 HSFOS) or a sequence version (e.g. J00231.1), or any combination of them
		 separated by a non-word character into your browser's search dialog.
		 SWALL examples are: fos_human, p53_human.
		 For short Ensembl entries, try : AL122059, AL031002, AL031030 .
		 'Random' Medline entry examples are: 20063307, 98276153.
		 PDB entry examples are: 100D, 1FOS. Try NM_006732 for RefSeq.
		 Only one copy of the latest version of the entry is returned."),
	  $q->hr,
	  $q->startform,
	  $q->popup_menu(-name => 'db',
			 -values => ['EMBL',
				     'SWALL',
				     'PDB',
				     'Medline',
				     'Ensembl',
				     'RefSeq'
				     ]),
	  $q->textfield(-name => 'id',
			 -size => 40,
			 -maxlength => 1000),
	  $q->popup_menu(-name => 'format',
			 -values => ['default','Fasta','bsml','agave']),
	  $q->popup_menu(-name => 'style',
			 -values => ['html','raw']),
	  $q->submit('Retrieve'),
	  $q->endform,
	  $q->hr,
	  $q->h2('Direct access'),
	  $q->p('For backward compatibility, the script defaults to EMBL:'),
	  $q->code('<A href="http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?J00231">
		     http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?J00231</a>'),
	  $q->p('but the preferred way of calling it is:'),
	  $q->code('<A href="http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?id=J00231.1,hsfos,bum">
		     http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?id=J00231.1,hsfos,bum</a>'),
	  $q->p('which can be extended to retrieve entries in alternative sequence formats
		      and other databases:'),
	  $q->code('<A href="http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?db=swall&format=fasta&id=fos_human">
		     http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?db=swall&format=fasta&id=fos_human</a>'),
	  $q->p('Set style to <code>raw</code> to retrieve plain text entries for computational purposes
                 and saving to disk:'),
	  $q->code('<A href="http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?db=medline&style=raw&id=21131735">
                    http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?db=medline&style=raw&id=21131735</a>'),
 	  $q->p('There is now the possibility to retrieve EMBL sequences formatterd into two XML standards:
                Bsml (Bioinformatic Sequence Markup Language - from 
                Labbook, Inc.) or as AGAVE (Architecture for Genomic Annotation, 
                Visualisation, and Exchange - from Labbook, Inc.). To do this, use the 
                formats \'bsml\' or \'agave\', as follows:'),
	  $q->code('<A href="http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?format=bsml&id=J00231">
                   http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?format=bsml&id=J00231</a><br>'),
	  $q->code('<A href="http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?format=agave&id=J00231">
                   http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?format=agave&id=J00231</a>'),
          $q->p("Version numbers are not supported with the XML retrieval."),
	  $q->hr,
          $q->address("Version $VERSION, $DATE, <a href=\"mailto:support\@ebi.ac.uk\">support\@ebi.ac.uk</a>"),
	  $q->end_html, "\n" ;
}

=head2 protect

 Title   : protect
 Usage   : $value = protect($q->param('id'));
 Function:

           Removes potentially dangerous characters from the input
	   string.  At the same time, converts word separators into a
	   single space character.

 Args    : scalar, string with one or more IDs or accession numbers
 Returns : scalar

=cut

sub protect {
    my ($s) = @_;
    $s =~ s![^\w\.\_]+! !g; # allow version numbers with '.' & RefSeq IDs with '_'
    $s =~ s|^\W+||;
    $s =~ s|\W+$||;
    return $s;
}

=head2 input_error

 Title   : input_error