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
|
#!/usr/bin/perl
use strict;
use warnings;
use autodie qw(open close); # open/close succeed or die
# modifiable si le format du fichier change
my $Query_string = '^Query:\s(\d+)\s+(.+)\s(\d+)\s*$';
my $Sbjct_string = '^Sbjct:\s(\d+)\s+(.+)\s(\d+)\s*$';
# peut être passé en parametre au script, etc
my @Query_positions = (24,48,54,92,137,235,275,324);
my @Sbjct_positions = (26,65,145,189);
# fichier de données
my $filename = "out.bl";
# On fait tout dans une subroutine histoire d'avoir le tout bien modulaire
# et les parametres importants comme parametres de la subroutine, ce qui
# facilitera l'écriture avec passage des parametres sur la ligne de commande
# du script (l'extension logique de ce script)
processFile(\$filename, \$Query_string, \@Query_positions, \$Sbjct_string, \@Sbjct_positions);
sub processFile {
my ($filename, $Query_string, $Query_positions, $Sbjct_string, $Sbjct_positions) = @_;
# creation des structures associées a une ligne utile
my $Query = initStructure($Query_string, $Query_positions);
my $Sbjct = initStructure($Sbjct_string, $Sbjct_positions);
open my $fh, '<', "$$filename";
my ($linenum, $bloc, $part) = (0, 0, 0);
use constant {
STATE_START => 0,
STATE_SCORE => 1,
STATE_QUERY => 2,
STATE_SBJCT => 3,
};
my $state = STATE_START;
while (<$fh> ) {
++$linenum;
if (/^Score\s+=/) {
++$bloc;
$part = 0;
if (($state != STATE_START) && ($state != STATE_SBJCT)) {
print "Warning: Unexpected Score at line $linenum\n";
}
$state = STATE_SCORE;
}
if (/${$Query->{pattern}}/o) {
++$part;
adjustData($Query->{data}, $1, $2, $3);
if (($state != STATE_SCORE) && ($state != STATE_SBJCT)) {
print "Warning: Unexpected Query at line $linenum\n";
}
$state = STATE_QUERY;
}
if (/${$Sbjct->{pattern}}/o) {
adjustData($Sbjct->{data}, $1, $2, $3);
if ($state != STATE_QUERY) {
++$part;
print "Warning: Unexpected Sbjct at line $linenum\n";
}
else {
processBlocPart($bloc, $part, $Query, $Sbjct);
}
$state = STATE_SBJCT;
}
}
close $fh;
if ($state != STATE_SBJCT) {
print "Warning: Unexpected end of file\n";
}
}
# cree la structure associee a une ligne de donnees interessantes
sub initStructure {
my ($pattern, $position) = @_;
my $hashref = {
pattern => $pattern, #reference sur la chaine de pattern
positions => $position, #reference sur l'array des positions
data => { #reference sur un hash des infos de la ligne
start => 0,
end => 0,
line => "",
},
};
return $hashref;
}
# remplit les champs d'un hash data passée par reference
sub adjustData {
my $dataref = shift;
$dataref->{start} = shift;
$dataref->{line} = shift;
$dataref->{end} = shift;
}
# on a une portion de bloc, on regarde si on a des matches pour les positions cherchees
sub processBlocPart {
my ($bloc, $part, $Query, $Sbjct) = @_;
foreach my $l (@{$Query->{positions}}) {
next if ($l < $Query->{data}->{start});
last if ($l > $Query->{data}->{end});
my $c = substr($Query->{data}->{line}, $l - $Query->{data}->{start}, 1);
my $d = substr($Sbjct->{data}->{line}, $l - $Query->{data}->{start}, 1);
next if ($c =~ m/[-X]/ or $d =~ m/[-X]/);
my $k = $l - $Query->{data}->{start} + $Sbjct->{data}->{start};
print "Testing in bloc $bloc, part $part: positions ($l, $k) values ($c, $d): " ;
if (grep {$_ eq $k} @{$Sbjct->{positions}} ) {
print "Found a match!\n" ;
} else {
print "no match.\n" ;
} |
