Bio::Tools::Analysis::Protein::Scansite - a wrapper around the Scansite server

  use Bio::Tools::Analysis::Protein::Scansite;

  my $seq; # a Bio::PrimarySeqI object

  my $tool = Bio::Tools::Analysis::Protein::Scansite->new
     ( -seq => $seq->primary_seq ); 

  # run Scansite prediction on a sequence
  $tool->run();

  # alternatively you can say
  $tool->seq($seq->primary_seq)->run;

  die "Could not get a result" unless $tool->status =~ /^COMPLETED/;

  print $tool->result;     # print raw prediction to STDOUT

  foreach my $feat ( $tool->result('Bio::SeqFeatureI') ) {

      # do something to SeqFeature
      # e.g. print as GFF
      print $feat->gff_string, "\n";
      # or store within the sequence - if it is a Bio::RichSeqI
      $seq->add_SeqFeature($feat);

 }

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  https://redmine.open-bio.org/projects/bioperl/

 Name    : result
 Usage   : $job->result (...)
 Returns : a result created by running an analysis
 Args    : none (but an implementation may choose
           to add arguments for instructions how to process
           the raw result)

 Usage    : $job->stringency(...)
 Returns  : The significance stringency of a prediction
 Args     : None (retrieves value) or 'High', 'Medium' or 'Low'.
 Purpose  : Get/setter of the stringency to be sumitted for analysis.

 Usage    : $job->protein_id(...)
 Returns  : The sequence id of the protein or 'unnamed' if not set. 
 Args     : None  
 Purpose  : Getter of the seq_id. Returns the display_id of the sequence
            object. 

#
# BioPerl module for Bio::Tools::Analysis::Protein::Scansite
#
# Please direct questions and support issues to <bioperl-l@bioperl.org> 
#
# Cared for by Richard Adams <richard.adams@ed.ac.uk>
#
# Copyright Richard Adams
#
# You may distribute this module under the same terms as perl itself

# POD documentation - main docs before the code

# Let the code begin...


package Bio::Tools::Analysis::Protein::Scansite;
use vars qw($FLOAT @STRINGENCY);
use strict;
use IO::String;
use Bio::SeqIO;
use HTTP::Request::Common qw(POST);
use Bio::SeqFeature::Generic;

use base qw(Bio::Tools::Analysis::SimpleAnalysisBase);

$FLOAT = '[+-]?\d*\.\d*';
@STRINGENCY = qw(High Medium Low);
my $URL = 'http://scansite.mit.edu/cgi-bin/motifscan_seq';


    my $ANALYSIS_SPEC =
        {
         'name'        => 'Scansite',
         'type'        => 'Protein',
         'version'     => '2.0',
         'supplier'    => 'Massachusetts Institute of Technology',
         'description' => 'Prediction of serine, threonine and tyrosine
                                                          phosphorylation sites in eukaryotic proteins',
        };

    my $INPUT_SPEC =
        [
         {
          'mandatory' => 'true',
          'type'      => 'Bio::PrimarySeqI',
          'name'      => 'seq',
         },
         {
          'mandatory' => 'false',
          'type'      => 'text',
          'name'      => 'protein_id',
          'default'   => 'unnamed',
         },
         {
          'mandatory' => 'false',
          'type'      => 'text',
          'name'      => 'stringency',
          'default'   => 'High',
         },
        ];

    my $RESULT_SPEC =
        {
         ''                 => 'bulk',  # same as undef
         'Bio::SeqFeatureI' => 'ARRAY of Bio::SeqFeature::Generic',
         'raw'              => 'Array of {motif=>, percentile=>, position=>,
					  					  protein=>, score=>, site=>, zscore=>
                                                                                    sequence=>
	     				 	     				 }',
        };

sub result {
    my ($self,$value) = @_;
	if( !exists($self->{'_result'}) || $self->status ne 'COMPLETED'){
		$self->throw("Cannot get results, analysis not run!");
		}	
    my @fts;

    if ($value ) {
		if ($value eq 'Bio::SeqFeatureI') {
			for my $hit (@{$self->{'_parsed'}}) {
				push @fts, Bio::SeqFeature::Generic->new(
					-start       => $hit->{'position'},
					-end         => $hit->{'position'},
				    -primary_tag => 'Site',
					-source      => 'Scansite',
					-tag => {
						score     => $hit->{'score'},
						zscore    => $hit->{'zscore'},
						motif     => $hit->{'motif'},
						site      => $hit->{'site'},
						sequence  => $hit->{'sequence'},
							},
				);
			}
			return @fts;
		}
		elsif ($value eq 'meta') {
			$self->throw("No meta sequences available in this analysis!");
			}
		## else get here
		return $self->{'_parsed'};
    }

    return $self->{'_result'};
}

sub stringency {
   my ($self,$value) = @_;
   if( $value) {
       if (! grep{$_=~ /$value/i}@STRINGENCY ) {
           $self->throw("I need a stringency of [".
						join " ", @STRINGENCY    .
						"], not [$value]");
       }
       $self->{'_stringency'} = $value;
       return $self;
   }
   return $self->{'_stringency'} || $self->input_spec->[2]{'default'} ;
}

sub protein_id {
	my $self = shift;
	return defined ($self->seq())? $self->seq->display_id()
				     : $self->input_spec->[1]{'default'};
}

sub _init 
		{
	my $self = shift;
	$self->url($URL);
	$self->{'_ANALYSIS_SPEC'} = $ANALYSIS_SPEC;
	$self->{'_INPUT_SPEC'}    = $INPUT_SPEC;
	$self->{'_RESULT_SPEC'}   = $RESULT_SPEC;
	$self->{'_ANALYSIS_NAME'} = $ANALYSIS_SPEC->{'name'};
	return $self;
}

sub _run {
    my $self = shift;

    # format the sequence into fasta
	$self->delay(1);
    # delay repeated calls by default by 3 sec, set delay() to change
    $self->sleep;

    $self->status('TERMINATED_BY_ERROR');

    my $request = POST $self->url,
            Content      => [sequence     => $self->seq->seq(),
							 protein_id   => $self->protein_id(),
							 motif_option => 'all',
							 motifs       => '',
							 motif_groups => '',
							 stringency   => $self->stringency(),
						 	 #domain_flag  => '',
							 submit       => "Submit Request",
							];
	## raw html report, 
    my $content = $self->request($request);
    my $text    = $content->content;

	##access result data from tag in html
	my @parsed_Results = ();
	my @unwantedParams = qw(db source class);
	my @results        = split /sitestats\.phtml\?/, $text;
	shift @results; 

	##this module generates 'parsed' output directly from html,
	## avoids having toparse twice. 

	for my $hit (@results) {
		## get results string
		my ($res) = $hit =~ /^(.+?)"/;

		#get key value pairs
		my %params = $res =~/(\w+)=([^&]+)/g;

		##remove unwanted data from hash
		map{delete $params{$_}} @unwantedParams;
		push @parsed_Results, \%params;
	}  
	
	## now generate text output in table format
	my $out_Str = '';
	$out_Str   .=  $self->_make_header(\@parsed_Results);
	$out_Str   .=  $self->_add_data(\@parsed_Results);
		

    $self->{'_result'} = $out_Str;
	$self->{'_parsed'} = \@parsed_Results;
	
	## is successsful if there are results or if there are no results and
	## this beacuse there are no matches, not because of parsing errors etc.
    $self->status('COMPLETED') if $text ne ''       &&
	(scalar @results > 0 ||	
	(scalar @results == 0 && $text =~/No sites found/));
    if ($text =~ /server\s+error/i) {
    	$self->throw("Internal server error:\n\n $text");
        return; 
    }
}

sub _process_arguments {

    # extra checking for sequence length
    # mitoprot specific argument testing
    my ($self, $args) = @_;
    #use base checking for existence of mandatory fields
    $self->SUPER::_process_arguments($args); 
   
   # specific requirements
   $self->throw("Sequence must be > 15 amino acids long!") 
           if $self->seq->length < 15;
   $self->throw("Sequence must be protein")
          unless $self->seq->alphabet() eq 'protein';
}

sub _make_header {
	my ($self, $res) = @_;
	my $header = '';
	for my $k (sort keys %{$res->[0]} ){
		next if $k eq 'sequence';
		$header .= $k;
		$header .= ' 'x(12 -length($k));
	}
	$header .= "sequence\n\n";
	return $header;
}

sub _add_data {
	my ($self, $res) = @_;
	my $outstr = '';
	for my $hit  (@$res) {
		for my $k (sort keys %$hit ){
			next if $k eq 'sequence';
			$outstr .= $hit->{$k};
			$outstr .= ' 'x(12 - length($hit->{$k}));
			}
		$outstr .= $hit->{'sequence'}. "\n" if $hit->{'sequence'};
	}
	return $outstr;


}
	

1;