Here is my updated code with errorHTTP 500 that did not happened for the old code, and
the modules I am using.
thank you
justinz
test.cgi:
#!/usr/bin/perl
#use lib '/srv/www/cgi-bin/phrap/perl-lib';
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use warnings;
use diagnostics;
use File::Basename;
use DNAalign;
use fastream;
use DNAseq;
my $dir="/srv/www/httmp/justin/p1/chromat_dir";
my $key;
foreach $key (sort keys(%INC)) {
# print "$key => $INC{$key}\n";
}
chdir($dir);
my $seq1=fastream->new("p1.fasta.screen.contigs");
my $seq2=fastream->new("p1.fasta.screen.contigs");
my $test1=$seq1->next_seq();
my $test2=$seq2->next_seq();
my $s1=$test1->sequence();
my $s2=$test2->sequence();
#print " ****** $s1\n\n\n";
#print "2222 $s2\n\n\n";
my ($sa,$sb)=DNAalign::align($test1,$test2);
my $result1=$sa->sequence();
print "Content-type: text/html\n\n";
print "<html><head><title>Perl CGI Example # 2";
print "</title></head><body><h1>";
print " </h1><p>";
print "<pre>";
print "$result1\n\n\n";
print "</pre>";
print "</p>";
print "</body></html>";
========================
DNAalign.pm
# Keith Anthony Boroevich -- 24.11.2003
package DNAalign;
use strict;
use Carp;
use diagnostics;
use File::Temp 'tempfile', 'tempdir';
use fastream;
my $tdir = tempdir('DNAalignXXXXX', TMPDIR => 1, CLEANUP => 1);
BEGIN { }
sub align {
my $seq1 = shift;
my $seq2 = shift;
my %options = (
ALGORITHM => 'lagan',
FILENAME => undef,
STYLE => undef,
);
%options = (%options, @_) if @_;
# --- align sequences --- #
my @aseq;
if (uc($options{ALGORITHM}) eq 'LAGAN') { @aseq = lagan($seq1,$seq2); }
elsif (uc($options{ALGORITHM}) eq 'CLUSTAL') { croak "Clustal not yet
supported.\n"; return ($seq1,$seq2); }
# elsif other formats
else { croak "Unknown Algorithm: ",$options{ALGORITHM},".\n"; return
($seq1,$seq2); }
#--- output file if requested ---#
if (defined($options{FILENAME})) {
open OFILE, ">$options{FILENAME}";
if ((uc($options{STYLE}) eq 'FASTA')||(! $options{STYLE})) {
foreach my $aseq (@aseq) { print OFILE "$aseq"; }
} elsif (uc($options{STYLE}) eq 'CLUSTAL') {
print OFILE clustal_format(@aseq);
}
close OFILE;
}
return (@aseq);
}
sub lagan {
my $seq1 = shift;
my $seq2 = shift;
# --- create sequence files --- #
my ($ofh1,$ofile1) = tempfile( TEMPLATE => 'kabXXXXX', SUFFIX => '.fas', UNLINK =>
1, DIR => $tdir);
print $ofh1 "$seq1";
system("/data/software/RepeatMasker/current/RepeatMasker -qq -int -nocut $ofile1 >
/dev/null");
my ($ofh2,$ofile2) = tempfile( TEMPLATE => 'kabXXXXX', SUFFIX => '.fas', UNLINK =>
1, DIR => $tdir);
print $ofh2 "$seq2";
system("/data/software/RepeatMasker/current/RepeatMasker -qq -int -nocut $ofile2 >
/dev/null");
# --- align sequences --- #
my ($ifh, $ifile) = tempfile( TEMPLATE => 'kabXXXXX', SUFFIX => '.fas', UNLINK =>
1, DIR => $tdir);
close($ifh);
#print `/data/software/lagan/current/lagan.pl $ofile1 $ofile2 -mfa > $ifile`; #
With lagan reporting
system("/data/software/lagan/current/lagan.pl $ofile1 $ofile2 -mfa > $ifile 2>
/dev/null");
my $istream = fastream->new($ifile);
my @seqs;
while (my $seq = $istream->next_seq()) { push @seqs, $seq; }
return @seqs;
}
sub clustal_format {
my @seqs = @_;
my $count = $#seqs;
my $minlength = $seqs[0]->length();
foreach (@seqs) {
$minlength = $_->length() if $_->length() < $minlength;
}
my $cf = "CLUSTAL X (1.8) multiple sequence alignment\n\n";
for (my $i = 0; $i < $minlength; $i+=50) {
foreach (@seqs) {
$cf .= $_->id().' '.$_->subseq($i,50)."\n";
}
$cf .= "\n";
}
return $cf;
}
END { }
1;
==================
fastream.pm
#Keith Anthony Boroevich
package fastream;
use strict;
use Carp;
use DNAseq;
use diagnostics;
#---------------#
#- Constructor -#
#---------------#
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {
ifile => undef,
ofile => undef,
position => undef,
endoffile => 0
};
if ($_[0]) {
if (-r $_[0]) {
$self->{ifile} = $_[0];
$self->{position} = 0;
} else { croak "Cannot read file ",$self->{ifile},".\n"; }
}
bless($self,$class);
return $self;
}
#--------------#
#- Attributes -#
#--------------#
# retrun or set the filename
sub infilename {
my $self = shift;
if (@_) {
$self->{ifile} = shift;
$self->{position} = 0;
unless (-r $self->{ifile}) {
croak "Cannot read file ",$self->{ifile},".\n";
$self->{file} = undef;
$self->{position} = undef;
}
}
return $self->{ifile};
}
# return the end of file flag (Retruns 1 if the eof has been hit)
sub endoffile {
my $self = shift;
return $self->{endofile};
}
#-----------#
#- Methods -#
#-----------#
sub next_seq {
my $self = shift;
#check validity of reading next sequence
return 0 if $self->{endoffile};
unless(defined($self->{ifile})) {
carp "No input filename is defined";
return 0;
}
#check file position
open iFILE, $self->{ifile};
seek(iFILE,$self->{position},0);
if (eof(iFILE)) {
$self->{endoffile} = 1;
return 0;
}
#read sequence id
my @tseq = (undef,undef);
my $len = 0;
while (<iFILE>) {
if (/^\>(.*)/) {
$tseq[0] = $1;
last;
}
}
#check file position
if (eof(iFILE)) {
$self->{endoffile} = 1;
return 0;
}
#read sequence
while (<iFILE>) {
if (/^\>.*/) {
$len = length($_);
last;
}
else {
chomp;
s/[^[:alpha:]-]//g;
$tseq[1] .= $_;
}
}
if (eof(iFILE)) { $self->{endoffile} = 1; }
else { $self->{position} = tell(iFILE) - $len;}
close iFILE;
my $tDNAseq = DNAseq->new(@tseq);
return $tDNAseq;
}
1;
===========
DNAseq.pm
#Keith Anthony Boroevich
package DNAseq;
use strict;
use Carp;
use diagnostics;
use String::Approx 'aindex';
#---------------------#
#- Const. / Overload -#
#---------------------#
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
$self = {
id => $_[0] || undef,
seq => $_[1] || undef
};
bless($self,$class);
return $self;
}
use overload '+' => \&add;
sub add {
my ($self,$other) = @_;
$self->new($self->{id}, $self->{seq} . (ref($other) ? $other->{seq} : $other) )
}
use overload 'bool' => \&is_valid;
sub is_valid {
my $self = shift;
return (defined($self->{id})&&defined($self->{seq}));
}
use overload q{""} => \&to_string;
sub to_string {
my $self = shift;
my $fstr = '';
for (my $i = 0; $i < length($self->{seq}); $i+=60) {
$fstr .= substr($self->{seq},$i,60)."\n";
}
return '>'.$self->{id}."\n".$fstr;
}
#--------------#
#- Attributes -#
#--------------#
# return or set the fasta id
sub id {
my $self = shift;
if (@_) { $self->{id} = shift }
return $self->{id};
}
# return or set the sequence
sub sequence {
my $self = shift;
if (@_) { $self->{seq} = shift }
return $self->{seq};
}
#
sub subseq {
my $self = shift;
my $offset = shift;
my $length = shift;
return substr($self->{seq},$offset,$length);
}
# return the length of a sequence
sub length {
my $self = shift;
return length($self->{seq})
}
#-----------#
#- Methods -#
#-----------#
# removes all invaild nucleotides from sequence
sub validate {
my $self = shift;
$self->{seq} =~ s/[^ATGCNatgcn-]//g;
}
# reads the first sequence in a sequence file
sub readfile {
my $self = shift;
my $ifile = shift;
open iFILE, $ifile || return 0;
my $id;
my $seq;
while (<iFILE>) {
if (/^>/) {
last if defined($id);
$id = substr($_,1,-1);
next;
}
chomp;
$seq .= $_;
} close iFILE;
$self->{id} = $id;
$self->{seq} = $seq;
return $self;
}
sub reverse_complement {
my $self = shift;
$self->{seq} = rc($self->{seq});
return $self
}
sub rc {
my $rseq = shift;
$rseq = reverse $rseq;
$rseq =~ tr/ATGCatgc/TACGtacg/;
return $rseq;
}
sub scan {
my $self = shift;
my $qseq = uc(shift);
my $degen = shift;
my ($i,$pos) = (0) x 2;
my @hits = ();
while ($i < $self->length()) {
if ($degen) { $pos = aindex($qseq,["i","$degen","initial_position=$i"],$self->{seq});
}
else { $pos = index(uc($self->{seq}),$qseq,$i); }
last if $pos == -1;
$i = $pos + 1;
push @hits, $i;
}
$qseq = rc($qseq);
$i = $pos = 0;
while ($i < $self->length()) {
if ($degen) { $pos =
aindex($qseq,["i","$degen","initial_position=$i"],$self->{seq}); }
else { $pos = index(uc($self->{seq}),$qseq,$i); }
last if $pos == -1;
$i = $pos + 1;
push @hits, -$i;
}
return @hits;
}
1;
"Charles K. Clarkson" <[EMAIL PROTECTED]> wrote:
Xiangli Zhang wrote:
: It does not work, instead HTTP 500 - Internal server
: error happened.Page "test.cgi" cannot even display.
Show us the updated code you are using. We'll also
need to see the modules you are using. They don't seem
to be from CPAN. Either provide their source or a url
where we can view them.
: Note: forwarded message attached.
Attaching forwarded messages is annoying. Just
post below the pertinent information and delete
everything else. Like I did here.
HTH,
Charles K. Clarkson
--
Mobile Homes Specialist
254 968-8328
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Xiangli Zhang (Justin)
306-310 Decaire Street, Coquitlam
BC, Canada, V3K 6X1
phone: 604-9399181
---------------------------------
Do you Yahoo!?
New and Improved Yahoo! Mail - Send 10MB messages!
