File: mextract.pl

package info (click to toggle)
lagan 2.0-3
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 1,360 kB
  • sloc: ansic: 8,542; perl: 7,732; cpp: 3,260; makefile: 85
file content (88 lines) | stat: -rwxr-xr-x 1,839 bytes parent folder | download | duplicates (3)
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
#!/usr/bin/perl

if (@ARGV < 1) {
    print ("usage:\n mextract.pl filename [-masked]\n");
    exit(1);
}

$masked=0;
$filename = $ARGV[0];
if(@ARGV==2) {
    if ($ARGV[1] eq "-masked") {
	$masked = 1;
    }
}

open(FASTAFILE, "$filename") || die "Could not open $filename.\n\n";
$prefix = substr $filename, 0, (rindex $filename, ".");
if ($masked || index ($filename, ".masked") != -1) {
    $prefix = substr $filename, 0, (rindex $prefix, ".");
}

$line = <FASTAFILE>;
chomp $line;

while (substr($line, 0, 1) ne ">") {
    $line = <FASTAFILE>;
    chomp $line;
}

$suffix = "fa";
if ($masked) {
    $suffix = "$suffix.masked";
}

if (substr($line, 0, 1) eq ">") {
    $name = substr($line, 1);
    if (index ($name, " ") != -1){
	$name = substr($name, 0, index ($name, " "));
    }
    if (substr ($name, length ($name) - 1) eq ","){
	$name = substr($name, 0, length ($name) - 1);
    }
#    $name = substr($line, 1);
#    $_ = substr($line, 1);
#    /\w+/g;
#    $name = $&;

#    substr($line, 1)." " =~ /(.+)[,]\s+/g;
#    $name = $1;

    $fname = "$prefix\_$name.$suffix";
    print("$fname\n");
    open(OUTFILE, ">$fname");
    print OUTFILE ">$name\n";
} else {
    print ("$filename is NOT a Multi-FASTA file...\n");
    exit(1);
}

while ($line = <FASTAFILE>) {
    chomp $line;
    if (substr($line, 0, 1) eq ">") {
	close OUTFILE;

#	substr($line, 1)." " =~ /(.+)[,]\s/g;
#	$name = $1;

	$name = substr($line, 1);
	if (index ($name, " ") != -1){
	    $name = substr($name, 0, index ($name, " "));
	}
	if (substr ($name, length ($name) - 1) eq ","){
	    $name = substr($name, 0, length ($name) - 1);
	}
#	$_ = substr($line, 1);
#	/\w+/g;
#	$name = $&;

	$fname = "$prefix\_$name.$suffix";
	print("$fname\n");
	open(OUTFILE, ">$fname");
	print OUTFILE ">$name\n";
    } else {
	print OUTFILE "$line";
    }
}

close OUTFILE;