#!/usr/bin/perl -w
#grab interesting mRNA info off the Golden Path site
#http://genome.ucsc.edu/
#
#v0.2 adds: new URL formatting support


use strict;
use LWP::Simple;
use HTML::TokeParser;

my $alignpage;
my $framepage;
my $alignurl;
my $mrna;

system("clear");
print "Enter a GENBANK ID: ";
chomp (my $clone=<STDIN>);

#set pagegrab to grab mRNA info
#this is a minimal set of cgi calls to match an mRNA

my $pagegrab="http://genome.ucsc.edu/cgi-bin/hgc?o=0&t=0&g=mrna&i=$clone&c=0&l=0&r=0db=hg7&pix=610";

#retreive said webpage

my $clonepage=get($pagegrab);

#extract webpage <title>

my $parsedpage=HTML::TokeParser->new(\$clonepage);
$parsedpage->get_tag("title");
$mrna=$parsedpage->get_trimmed_text;
print "Information returned for: $mrna\n";

#now grab all <a (href)> </a> links on the page. 
#the regexp match pulls out the reference to the genomic alignment and 
#ignores links to NCBI.

my $urljumppage=HTML::TokeParser->new(\$clonepage);
while (my $token=$urljumppage->get_tag("a")) {
    my $urljumppage=$token->[1]{href} || "-";
    if ($urljumppage=~/cgi/) {
    $alignpage=$urljumppage;
} else {
   
}}

#The GoldenPath URL is a ../cgi-bin call.  Regexp replaces ../ with suitable
#http:// call for passing back to LWP::Simple

$alignurl=$alignpage;
$alignurl =~ s/\.\./http:\/\/genome\.ucsc\.edu/;

#grab alignment page

my $alignmentgrab=get($alignurl);

#We actually want to grab the 'body' frame for parsing.
#So we need to strip out the 2nd <FRAME SRC> tag
#I'm lazy we just step through a 'while' and return the last <FRAME SRC>

my $alignjumppage=HTML::TokeParser->new(\$alignmentgrab);
while (my $token=$alignjumppage->get_tag("frame")) {
    my $alignjumppage=$token->[1]{src} || "-";
    $framepage=$alignjumppage;
}

#regexp again to get a proper URL

$framepage=~ s/\.\./http:\/\/genome\.ucsc\.edu/;

print "The interesting stuff is on $framepage\n";

my $mrnainfo=get($framepage);

#grab the chromosomal location for the mRNA

my $localisation=HTML::TokeParser->new(\$mrnainfo);
$localisation->get_tag("h2");
my $location=$localisation->get_trimmed_text;

#strip down to the basics

$location=~ s/A(.*)d\s//g;
print "$mrna has position $location in the genome\n";

#Display the cDNA sequence!
#we do need to strip the HTML tags, but we know this makes a mess of the
#output - these regexps convert <<<<<<< >>>>>>> (8) |||||||||| (50) to
#(((((((( ))))))) (8) and converts | to . lousy technique but it works
$mrnainfo=~ s/(\>{8})/\)\)\)\)\)\)\)\)/g;
$mrnainfo=~ s/(\<{8})/\(\(\(\(\(\(\(\(/g;
$mrnainfo=~ s/\|/\./g;
#now strip the HTML tags
$mrnainfo  =~ s/<(?:[^>'"]*|(['"]).*?\1)*>//gs;

#put pipes and <> back in so we retain the original formatting

$mrnainfo=~ s/\./\|/g;
$mrnainfo=~ s/\(/\</g;
$mrnainfo=~ s/\)/\>/g;

#ok here's my regexp to pull out all the sequence between cDNA and Genomic
#which I think *should work* ie grab everything between cDNA(1-any number of 
#spaces)anychar(1-any number of spaces)Genomic(1-any number of spaces).
#we get "Use of uninitialized value in print at ./perlist.pl line 132, 
#<STDIN> line 1."
#What uninitialised value!?!?!
#visual_regexp suggests my match works, but if I use a construct like
#$mrnainfo=~ /cDNA\sA(.*)\s+G/; and then attempt to print $mrnainfo;
#it just returns an unchanged $mrnainfo

(my $cdna) = $mrnainfo=~ /cDNA\s+A(.*)\s+G/;
		     
print $cdna;
