ankit
Novice
Apr 9, 2010, 12:37 AM
Post #1 of 4
(1684 views)
|
|
HOW TO RUN PERL SCRIPT ON WEBBROWSER
|
Can't Post
|
|
Hi Friends,
can any one tell me taht i am not able to run my script on webpage but it is running in command promt & I am also try Cgi module but i am not suceed can any one help me.
my script is--
and i am also attached the file bionet for the list of restriction enzymes.
[#!/usr/bin/perl
#Make restriction map from user queries on names of restriction enzymes
use strict;
use warnings;
#Declare and intialize variables
my %rebase_hash = ( );
my @file_data =( );
my $query = ' ';
my $dna = ' ';
my $recognition_site = ' ';
my $regexp = ' ';
my @locations = ( );
my $dnafilename = ( );
my @DNA = ( );
my @positions = ( );
my $ sequence = ( );
my $RNA = ( );
# Read in the file "sample.dna"
print "ENTER THE FILENAME OF THE DNA SEQUENCE:= ";
$dnafilename = <STDIN>;
chomp $dnafilename;
unless ( open(DNAFILE, $dnafilename) ) {
print "Cannot open file \"$dnafilename\"\n\n";
}
@DNA = <DNAFILE>;
print "The original DNA Sequence :=\n\n";
@file_data=@DNA;
print"@file_data";
# Extract the DNA sequence data from the contents of the file "sample.dna"
$dna = extract_sequence_from_fasta_data(@file_data);
# Get the REBASE data into a hash, from file "bionet.txt"
%rebase_hash = parseREBASE('bionet.txt');
# Promt user for restriction enzyme names, create restriction map
do {
print "Search for what restriction site for (or quit)?: ";
$query = <STDIN>;
chomp $query;
print"$query";
#
#Exit if empty query
if ( $query =~ /^\s*$/ ) {
exit;
}
# Perform the search in the DNA sequence
if ( exists $rebase_hash{$query} ) {
($recognition_site, $regexp) = split ( " " , $rebase_hash{$query});
print " -------------------------->$regexp#:\n\n";
#Create the restriction map
@locations = match_positions($regexp, $dna);
#Report the restriction map to the user
if (@locations) {
print "Searching for $query $recognition_site $regexp\n";
print "A restriction site for $query at location:\n";
print join(" \n",@locations), "\n";
exit;
} else {
print " A restriction site for $query is not in the DNA:\n";
}
}
print "\n";
} until ( $query =~ /quit/ );
exit;
#############################
#
# Subroutine
#
# Find locations of a match of a regular expression in a string #
#
# return an array of positions where the regular expression
# appears in the string
#
sub match_positions {
my($regexp, $sequence) = @_;
use strict;
#
# Declare varibles
#
my @positions = ( );
#
# Determine positions of regular expression matches
#
while ( $sequence =~ /$regexp/ig ) {
push ( @positions, pos($sequence) - length($&) + 1 );
}
return @positions;
}
###########
# From example9-1.pl
# Example 9-1 Translate IUB ambiguity codes to regular expressions
# IUB_to_regexp
#
# A subroutine that, given a sequence with IUB ambiguity codes,
# outputs a translation with IUB codes changed to regular expressions
#
# These are the IUB ambiguity codes
# (Eur. J. Biochem. 150: 1-5, 1985):
# R = G or A
# Y = C or T
# M = A or C
# K = G or T
# S = G or C
# W = A or T
# B = not A (C or G or T)
# D = not C (A or G or T)
# H = not G (A or C or T)
# V = not T (A or C or G)
# N = A or C or G or T
sub IUB_to_regexp {
my($iub) = @_;
my $regular_expression = '';
my %iub2character_class = (
A => 'A',
C => 'C',
G => 'G',
T => 'T',
R => '[GA]',
Y => '[CT]',
M => '[AC]',
K => '[GT]',
S => '[GC]',
W => '[AT]',
B => '[CGT]',
D => '[AGT]',
H => '[ACT]',
V => '[ACG]',
N => '[ACGT]',
);
# Remove the ^ signs from the recognition sites
$iub =~ s/\^//g;
# Translate each character in the iub sequence
for ( my $i = 0 ; $i < length($iub) ; ++$i ) {
$regular_expression
.= $iub2character_class{substr($iub, $i, 1)};
}
return $regular_expression;
}
###########
# From example9-2.pl
# Example 9-2 Subroutine to parse a REBASE datafile
# parseREBASE-Parse REBASE bionet file
#
# A subroutine to return a hash where
# key = restriction enzyme name
# value = whitespace-separated recognition site and regular expression
sub parseREBASE {
my($rebasefile) = @_;
use strict;
use warnings;
# Declare variables
my @rebasefile = ( );
my %rebase_hash = ( );
my $name;
my $site;
my $regexp;
# Read in the REBASE file
my $rebase_filehandle = open_file($rebasefile);
while(<$rebase_filehandle>) {
# Discard header lines
( 1 .. /Rich Roberts/ ) and next;
# Discard blank lines
/^\s*$/ and next;
# Split the two (or three if includes parenthesized name) fields
my @fields = split( " ", $_);
# Get and store the name and the recognition site
# Remove parenthesized names, for simplicity's sake,
# by not saving the middle field, if any,
# just the first and last
$name = shift @fields;
$site = pop @fields;
# Translate the recognition sites to regular expressions
$regexp = IUB_to_regexp($site);
# Store the data into the hash
$rebase_hash{$name} = "$site $regexp";
}
# Return the hash containing the reformatted REBASE data
return %rebase_hash;
}
# extract_sequence_from_fasta_data
#
# A subroutine to extract FASTA sequence data from an array
sub extract_sequence_from_fasta_data {
my(@fasta_file_data) = @_;
use strict;
use warnings;
# Declare and initialize variables
my $sequence = '';
my $line = '';
foreach my $line (@fasta_file_data) {
# discard blank line
if ($line =~ /^\s*$/) {
next;
# discard comment line
} elsif($line =~ /^\s*#/) {
next;
# discard fasta header line
} elsif($line =~ /^>/) {
next;
# keep line, add to sequence string
} else {
$sequence .= $line;
}
}
# remove non-sequence data (in this case, whitespace) from $sequence string
$sequence =~ s/\s//g;
return $sequence;
}
############################################################
# open_file
#
# - given filename, set filehandle
sub open_file {
my($filename) = @_;
my $fh;
unless(open($fh, $filename)) {
print "Cannot open file $filename\n";
exit;
}
return $fh;
}
][quote][/quote][quote][/quote][quote][/quote][quote][reply][/code][code]
|
MAIN
SEARCH
WHO'S 
LOG 