-
Notifications
You must be signed in to change notification settings - Fork 2
/
fasta_checker.pl
135 lines (127 loc) · 2.56 KB
/
fasta_checker.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
#!/usr/bin/perl
use strict;
# fasta_checker.pl
#This program is supposed to: Check the sanity of a fasta sequence file, outputting the
#corrected sequences to standard out, and reporting to standard error.
#Akram Mohammed
#ASIGN-VARIABLES-------------------------------------
my $input;
my $usage;
my $line=0;
my %ids;
my $comment;
my $flag=0;
my $idflag=0;
my $thisline;
my $verbose;
my $one;
my $two;
my $seq;
my $err;
#----------------------------------------------------
#ARGUEMENTS-------------------------------------------
$usage="check_fasta.pl <file.fa> <verbosity #>";
die "Usage: $usage\n" unless (@ARGV > 0);
$input=$ARGV[0];
$verbose=$ARGV[1];
unless (defined($verbose)){
$verbose=0;
}
#-----------------------------------------------------
#CHECK-IT---------------------------------------------
open FILE,("$input");
while (<FILE>){
$line++;
if (/^>/){
#Is there any sequence for the ID?
if($flag == 0 and $line > 1){
print STDERR "No Sequence, line:",($line-1),"\n";
if ($verbose == 1){
print STDERR $_;
}
}
if (/^>\s+(\S+)$/ or /^>\s+(\S+)(\s.*)$/){
print STDERR "Space before identifier, line:$line\n";
if ($verbose == 1){
print STDERR $_;
}
if (defined($2)){
$thisline=">$1$2\n";
}
else{
$thisline=">$1\n";
}
}
else{
$thisline=$_;
}
if ($thisline =~ /^(>\S+)$/ or $thisline =~ /^(>\S+)(\s.*)$/){
#Is ID unique?
if (exists($ids{"$1"})){
print STDERR "ID $1 not unique, line:$line\n";
if ($verbose == 1){
print STDERR $_;
}
$idflag=1;
}
else{
$idflag=0;
$ids{"$1"}=1;
#Does the ID end in a comma?
$one =$1;
$two=$2;
if ($one =~ /^(\S+)\,$/){
$comment = "$1$two\n";
print STDERR "ID $one ends in a comma, line:$line\n";
}
else{
$comment = $thisline;
}
$flag=0;
}
}
#Identifier present?
else{
print STDERR "No identifier, line:$line\n";
if ($verbose == 1){
print STDERR $_;
}
}
}
elsif ($idflag == 0){
if (/\S/){
$seq=$_;
$err = $seq =~ s/\s+//g;
if ($verbose == 1 and $err > 0){
print STDERR "Line:$line contains $err blank characters\n";
}
if ($seq =~ /^(.*)\*$/){
$seq=$1;
print STDERR "Line:$line ends in '*' character. Removed (stop codon)\n";
}
$err = $seq =~ s/[^a-zA-Z]/X/g;
#$err = $err + $seq =~ s/[oj]/x/g;
#$err = $err + $seq =~ s/[OJ]/X/g;
if ($err > 0){
print STDERR "Line:$line contains $err non-amino acid characters\n";
if ($verbose == 1){
print STDERR $_;
}
}
#Is there any sequence for the ID?
if (length($seq) > 0){
if($flag == 0){
$flag=1;
print $comment;
}
print $seq,"\n";
}
}
#Blank line?
elsif($verbose == 1){
print STDERR "Blank line, line:$line\n";
}
}
}
close FILE;
#-----------------------------------------------------