Showing posts with label script. Show all posts
Showing posts with label script. Show all posts

Monday, 27 June 2011

Deparse an ABI file...

#!/usr/bin/perl -w

use strict;

my $stadenApp = "~/staden-linux-1-6-0/linux-bin/getABIfield";


for my $inputFile (@ARGV){
unless($inputFile =~ /\/(KN654-BAC(\d\d)-(\d\d)_([A-H]\d\d)-(FP|RP))\.ab[1i]$/){
warn "ignoring $inputFile\n";
next;
}

my $fileName = $1;
my $wellId = $4;
open APP, "-|", "$stadenApp -a -t $inputFile"
or die "failed to exec $stadenApp : $!\n";
my %data;
while(){
## Skip some 'data rows' that we can ignore for now.
next unless
/^$inputFile (\S{4}) (\d+) (.*)$/;
chomp;
$data{"$1 $2"} .= $3;
}
if (keys %data == 0){
die "wha? \n"
}
print
join("\t",
$fileName,
$data{"SMPL 1"}, # Trace name (unique id)
$data{"RunN 1"}, # Run name
$wellId,
$data{"TUBE 1"}, # Well id
$data{"GTyp 1"}, # Polymer name
$data{"MCHN 1"}, # Instrument name
$data{"MODL 1"}, # Instrument model
$data{"PDMF 1"}, # Mobility file
$data{"CMNT 1"}, # Comment
## Signal to noise ratio for the 4 dyes
split(/ /, $data{"S/N% 1"}),
## Times of the various 'events'
$data{"RUND 1"}. " ". $data{"RUNT 1"},
$data{"RUND 2"}. " ". $data{"RUNT 2"},
$data{"RUND 3"}. " ". $data{"RUNT 3"},
$data{"RUND 4"}. " ". $data{"RUNT 4"},
## More...
$data{"APrV 1"}, # Analysis protocol version number
$data{"CTNM 1"}, # Plate Name
$data{"CTID 1"}, # Plate barcode
$data{"ASPt 1"}, # Basecall start scan
$data{"AEPt 1"}, # Basecall stop scan
$data{"SPAC 1"}, # Base spaceing
), "\n";
}

here it is wrapped in Perl

#!/usr/bin/perl -w

use strict;

## Set up the Perl modules we need

## Read the command line options
use Getopt::Long;

## Read in the fasta sequence file
use Bio::SeqIO;

## Run the blast query
use LWP::UserAgent;
#use HTTP::Cookies;

## Parse the results
use HTML::Strip;
use Bio::SearchIO;






## Set up the net stuff

## Set up a 'web user agent' object (something like a browser).

my $ua = LWP::UserAgent->new;



## Configure the user agent:

## Response time out (in seconds)
$ua->timeout(10);

## How the user agent should handle cookies:
#$ua->cookie_jar({ file => "lwpcookies.txt", autosave => 1})



## Note the following URI is the form behind the login page:
## http://yh.genomics.org.cn/potato/login.jsp

my $loginUri = 'http://yh.genomics.org.cn/potato/check.jsp';



## Use the user agent to login to the webserver

my $login = $ua->
post( $loginUri, [ username => 'test', password => 'abc123' ]);

#warn $login->as_string, "\n";
#exit;



## Don't know why the above dosn't trigger writing a cookie to the
## cookie.jar! (So cookie code is commented out.)

## Grab the cookie manually

die "CANT FIND MY COOKIES!!!!\n"
unless $login->as_string =~ /^Set-Cookie: JSESSIONID=(\w*);/sm;

my $JSESSIONID = $1;



## Manuall set the cookie in the user agents header, so it will be
## used for all subsequent communication.

$ua->default_header('Set-Cookie' => $JSESSIONID);



## The following URI is the form behind the blast page:
## http://yh.genomics.org.cn/potato/search.jsp

my $blastUri = 'http://yh.genomics.org.cn:8099/blast.cgi';





## Now we are set to loop through the sequences in the fasta sequence
## file and blast each one!

## Process the command line

my $fastaFile;

GetOptions(
"fasta=s" => \$fastaFile,
)
or die "failed to parse command line options!\n";

die "please pass a fasta file to blast\n"
unless $fastaFile && -e $fastaFile;



## Process the fasta file

my $s = Bio::SeqIO->
new( -file => $fastaFile,
-format => 'fasta'
);

while(my $seq = $s->next_seq){
## Lets just dump the results!
my $outFile = 'Scratch/'. $seq->id. '.blast.html';
if(-s $outFile ){
warn "skipping, file exists : $outFile\n";
next;
}
warn "doing ". $seq->id. " (". $seq->length. ")\n";
#warn $seq->seq, "\n";
open(OUT, '>', $outFile)
or die "cant open $outFile\n";
## Blast it!
## Set any blast options you want here!
my $blast = $ua->
post( $blastUri, [ DATALIB => 'potato',
SEQUENCE => $seq->seq ]);
#warn $blast->as_string, "\n";
#exit;
print OUT $blast->as_string;
}




__END__

## below we already moved onto processing the results, which is too much for one script.
## Get the results (scalar) as a file handle for processing with
## SearchIO. Here we also strip out the HTML from the results.
my $string = HTML::Strip->new->parse( $blast->as_string );
open my $fh, '<', \$string
or die "FUCK!\n";

my $in =
Bio::SearchIO->new( -format => "blast", -fh => $fh );
while( my $result = $in->next_result ) {
while( my $hit = $result->next_hit ) {
while( my $hsp = $hit->next_hsp ) {

## Apply some basic filtering
if( $hsp->length('total') > 50 ) {
if ( $hsp->percent_identity >= 75 ) {
print
join("\t",
$hit->name(),
$hsp->percent_identity,
$hsp->length('total'),
# No. mismatches?
$hsp->percent_identity('total'),
# No. gaps
$hsp->gaps('total'),
$hsp->start('query'),
$hsp->end('query'),
$hsp->start('hit'),
$hsp->end('hit'),
$hsp->evalue(),
$hsp->score(),
), "\n";
}
}
}
}
}
last;
}

warn "OK\n";

Thursday, 26 May 2011

Scripting against a remote HTML blast server

## Scripting against the CN Solexa blast server:



## See "blast.form.html", the HTML dump generated by "blast.jsp". This
## file shows how the names for the various options.



## The blast server page
URL=http://.../blast.jsp
URL=http://.../blast.cgi

## Get this from firefox (Note, expires after about 5 min!)
JSESSIONID=
JSESSIONID=BE55C37071E8CE748053DBCC47FCA3F3
JSESSIONID=1D179D4B6EF55555D344E388D6ABEA19
JSESSIONID=8921525F177EE917E5A27D3FB0CC577D

## Sequence file to submit to the form
SEQFILE=test.seq
SEQFILE=C02HBa0008G02.seq



## All other settings will be default ...

## Don't forget to redirect the result somewhere sensible

curl \
--cookie JSESSIONID=$JSESSIONID \
--form SEQFILE=@$SEQFILE \
--form DATALIB=potato \
$URL \
> $SEQFILE.cn.blast



## Try grabbing (lots of) XML output

JSESSIONID=AE961CF9BF250CCF656832143701BE59
SEQFILE=test.seq

curl \
--cookie JSESSIONID=$JSESSIONID \
--form SEQFILE=@$SEQFILE \
--form DATALIB=potato \
--form ALIGNMENT_VIEW=7 \
--form DESCRIPTIONS=500 \
--form ALIGNMENTS=500 \
$URL \
> $SEQFILE.cn.blast.xml



## Test the XML format using BioPerl

perl -e 'use Bio::SearchIO;
while($r = Bio::SearchIO->
new(
-file=>"$SEQFILE.cn.blast.xml",
-format=>blastxml,
)->next_result){
print $r->query_name, "\n";
while( $h = $r->next_hit ) {
print "\t", $h->name, "\n";
}
}
'


## Looks good!

Thursday, 22 October 2009

Perl wrapper for R

This Perl wrapper for R fills in some missing functionality (line number and context on error) and automatically 'dumps' the output of the script.

I can be improved in many ways, but here it is, as is....


   1. #! /usr/bin/perl -w
   2.
   3. unless (@ARGV){
   4.   warn "\n";
   5.   warn "Runs an R script with STDERR dumped to STDOUT\n\n";
   6.   warn "Usage: $0 \n\n";
   7.   exit(1);
   8. }
   9.  
  10. my $rFile = shift @ARGV;
  11.  
  12. die "Stubbornly refusing to run R on a file that doesn't end .R!\n"
  13.   unless $rFile =~ /\.R$/;
  14.  
  15. my $oFile = `basename $rFile .R`; chomp( $oFile );
  16.  
  17. my $args = join(" ", @ARGV);
  18.  
  19. if ($args){
  20.   $args = "--args $args";
  21. }
  22.  
  23. warn "Using: R $args < $rFile > $oFile.dump\n";
  24.  
  25.  
  26.  
  27. open ( OH, ">$oFile.dump" )
  28.   or die "cant : $! \n";
  29.  
  30. my $pid =
  31.   open( PH, "R $rFile -q --vanilla $args < $rFile 2>&1 |" )
  32.     or die "cant : $? : $! \n";
  33.  
  34. my $lineNumber;
  35.  
  36. while(){
  37.   $lineNumber++ if /^(\>|\+)/o;
  38.   print OH;
  39. }
  40.  
  41. close( OH );
  42. close( PH );
  43.  
  44. if ($?) {
  45.   #warn "killed by $?\n";
  46.   warn "FAILED AT LINE $lineNumber\n";
  47.   system("tail -n 5 $oFile.dump");
  48.   exit(1);
  49. }
  50.  
  51. warn "OK (NO ERRORS DETECTED)\n";

Friday, 14 August 2009

vpnc timeout problem solved with Perl

Or ... EXPECT PAIN!!!

I've seen lots of people complaining about a time out problem with vpnc. This happens to me even if I'm ping-ing like crazy or not, so its nothing to do with activity on the connection (I think).

The problem with automatically re-connecting was the need to interactively type a password at prompt. Note that this was not my "Xauth password". For some reason my organisation requires an extra password (there are many ways a VPN can be configured).

If you just need to type one username and password, its probable that you can set up your config file to contain:

Xauth username meUserName
Xauth password meSekretPassword


With the above you could just automatically restart vpnc every time it drops out (i.e. using bash). I have this extra password to deal with though, so its a bit harder. Here is the solution achieved using Perl, Expect [1], and a lot of help from the friendly mst in irc://irc.freenode.net/#Perl

  1. use Expect;
  2. while(1){
  3. $e=Expect->new("vpnc", ("--no-detach", "/home/me/my.VPN.conf"));
  4. $e->debug(1);
  5. $e->log_file("log");
  6. if($e->expect(15, "-re", "Password for VPN")){
  7. $e->send("sekret pwd\n");
  8. $e->interact
  9. }
  10. else{
  11. die "fail!!!\n"
  12. }
  13. print "woop\n";
  14. }


[1] http://search.cpan.org/~rgiersig/Expect-1.21/Expect.pod


Take care,
Dan.