1. Code :
2. #!usr/bin/perl
4. use strict;
5. use warnings;
9. my $query_seq = 'DSVIAAMSKRGQDRLHHVIRILAEKGHVKELATAFYGNYTVQDLLDATHXXXXXXXXXXX';
10. my $sbjct_seq = 'EQAINALQRKSYQKLTRVVDILIESGKVPELVTHYFGNYSIQDLMEACFKLRKSFEKQGR';
12. my $q_start = 160;
13. my $s_start = 264;
16. my @tab1 = split(//,$query_seq);
17. my @tab2 = split(//,$sbjct_seq);
19. for my $i (0..$#tab1){
21. if (($tab1[$i] !~ m/[-X]/) && ($tab2[$i] !~ m/[-X]/)){
22.  # vérification que les positions n'existent pas déjà dans tables positions
23.  # ???
24. }
26. $q_start ++;
27. $s_start ++;
28. }

1. #!/usr/bin/perl
3. use strict;
4. use warnings;
7. #Variables
8. my @positions=(24,48,54,92,137,235,275,324); #Liste des positions que tu souhaites verifier
9. my @positions2=(26,65,145,189);
10. my $query_seq;
11. my $sbjct_seq;
12. my ($depart_bloc,$fin_bloc)=(0,0);
13. my $numero_bloc = 1;
15. open (BLAST_FILE,"<blast.txt" ) or die ("Impossible de lire blast.txt\n" );
16. while(<BLAST_FILE> )
17. {
18. if(/Query: (\d+)\s+(.+)\s+(\d+)/) #Ajout de \s+ pour gerer s'il y a plus d'un espacement
19. {
20.  $depart_bloc=$1;  #Index de depart du bloc
21.  $query_seq=$2;    #Sequence Query
22.  $fin_bloc=$3;     #Index de fin du bloc
24. }
25. elsif(/Sbjct: \d+\s+(.+)/)
26. {
27.  $sbjct_seq=$1;   #Sequence Sbjct
28. }
30.         #Si les deux sequences "Query" et "Sbjct" ont ete trouvees, on a un nouveau bloc:
31. if((defined $query_seq) && (defined $sbjct_seq) && ($query_seq =~ m/\w/) && ($sbjct_seq =~ m/\w/))
32. {
33.                 #Separation des caracteres des sequences dans un tableau
34.  my @tab1 = split(//,$query_seq);
35.  my @tab2 = split(//,$sbjct_seq);
38.  my $r = $depart_bloc;
40.  # tableau : clé : AA   valeur : position
41.  my %positions_query;
42.  foreach my $aa ( @tab1){
43.   if ($aa ne 'X'){
44.    $positions_query{$aa} = $r;
45.   }
46.    $r ++;
47.  }
51.  my $s = $depart_bloc;
53.  # tableau : clé : AA   valeur : position
54.  my %positions_sbjct;
55.  foreach my $aa ( @tab2){
56.   if ($aa ne 'X'){
57.    $positions_sbjct{$aa} = $s;
58.   }
59.    $s ++;
60.  }
61.                
63.  # on vide les variables
64.  $query_seq = '';
65.  $sbjct_seq = '';
68. }
70. }

#!usr/bin/perl
use strict;
use warnings;
 
my $query_seq = 'DSVIAAMSKRGQDRLHHVIRILAEKGHVKELATAFYGNYTVQDLLDATHXXXXXXXXXXX';
my $sbjct_seq = 'EQAINALQRKSYQKLTRVVDILIESGKVPELVTHYFGNYSIQDLMEACFKLRKSFEKQGR';
my $q_start = 160;
my $s_start = 264;
my @q_pos = (20, 125, 133, 172, 185, 255);
my @s_pos = (20, 5, 133, 255, 276);
 
my $length = length($query_seq);
 
foreach my $l (@q_pos) {
    next if $l < $q_start;
    last if $l >= $q_start + $length; # ou $l > $q_end si on récupère $q_end dans le fichier
    my $c = substr($query_seq, $l - $q_start, 1); #On récupère le caractère a la position dans la chaine $query_seq
    my $d = substr($sbjct_seq, $l - $q_start, 1); #On récupère le caractère a la position dans la chaine $sbjct_seq
    next if ($c =~ m/[-X]/ or $d =~ m/[-X]/);
    my $k = $l - $q_start + $s_start;
    if (grep {$_ eq $k} @s_pos) {
    print "Found: positions ($l, $k) values ($c, $d) \n" ;
    }
}

1. #!/usr/bin/perl
3. use strict;
4. use warnings;
7. #Variables
8. my @positions=(24,48,54,92,137,235,275,324); #Liste des positions que tu souhaites verifier
9. my @positions2=(26,65,145,189);
10. my $query_seq;
11. my $sbjct_seq;
12. my ($depart_bloc,$fin_bloc)=(0,0);
13. my ($depart_bloc2,$fin_bloc2)=(0,0);
14. my $numero_bloc = 1;
16. open (BLAST_FILE,"<out.bl" ) or die ("Impossible de lire blast.txt\n" );
17. while(<BLAST_FILE> )
18. {
19. if(/Query: (\d+)\s+(.+)\s+(\d+)/) #Ajout de \s+ pour gerer s'il y a plus d'un espacement
20. {
21.  $depart_bloc=$1;  #Index de depart du bloc
22.  $query_seq=$2;    #Sequence Query
23.  $fin_bloc=$3;     #Index de fin du bloc
25. }
26. elsif(/Sbjct: \d+\s+(.+)/)
27. {
28.  $depart_bloc2=$1;
29.  print $sbjct_seq=$2;   #Sequence Sbjct
30. }
32.         #Si les deux sequences "Query" et "Sbjct" ont ete trouvees, on a un nouveau bloc:
33. if((defined $query_seq) && (defined $sbjct_seq) && ($query_seq =~ m/\w/) && ($sbjct_seq =~ m/\w/))
34. {
35.                 #Separation des caracteres des sequences dans un tableau
36.  my @tab1 = split(//,$query_seq);
37.  my @tab2 = split(//,$sbjct_seq);
39.  my $length = length(@tab1);
41.   my $r = $depart_bloc;
42.   my $s = $depart_bloc2;
44.  foreach my $l (@positions) {
45.        next if $l < $r ;
46.        last if $l >= $s  + $length; # ou $l > $q_end si on récupère $q_end dans le fichier
47.        my $c = substr($query_seq, $l - $r, 1); #On récupère le caractère a la position dans la chaine $query_seq
48.         my $d = substr($sbjct_seq, $l - $r, 1); #On récupère le caractère a la position dans la chaine $sbjct_seq
49.       next if ($c =~ m/[-X]/ or $d =~ m/[-X]/);
50.        my $k = $l - $r + $$s;
51.        if (grep {$_ eq $k} @positions2) {
52.         print "Found: positions ($l, $k) values ($c, $d) \n" ;
53.        }
55. }
57.  # on vide les variables
58.  $query_seq = '';
59.  $sbjct_seq = '';
62. }
64. }

#!/usr/bin/perl
use strict;
use warnings;
 
my $filename = "dnadata.txt";
open my $fh, "<$filename" or die "error opening $filename $!.\n";
my %Query = ( pattern => '^Query:\s(\d+)\s+(.+)\s(\d+)\s*$',
          start   => 0,
              end     => 0,
              line    => "" );
 
my %Sbjct = ( pattern => '^Sbjct:\s(\d+)\s+(.+)\s(\d+)\s*$',
          start   => 0,
              end     => 0,
              line    => "" );
 use constant {
        START       => 0,
        POSTQUERY   => 1,
        POSTSBJCT   => 2, };
my $state = START;
while (<$fh> ) {
  if (/$Query{pattern}/o) {
    if (($state == START) || ($state ==  POSTSBJCT)){
      $Query{start} = $1;
      $Query{end} = $3;
      $Query{line} = $2;
    }
    else {
 
    }
    $state = POSTQUERY;
  }
  if (/$Sbjct{pattern}/o) {
    if ($state ==  POSTQUERY){
      $Sbjct{start} = $1;
      $Sbjct{end} = $3;
      $Sbjct{line} = $2;
      #processBloc(\%Query, \%Sbjct);
    }
    else {
 
    }
    $state = POSTSBJCT;
  }
}
close $fh;

#!/usr/bin/perl
use strict;
use warnings;
 
my $filename = "dnadata.txt";
open my $fh, "<$filename" or die "error opening $filename $!.\n";
my %Query = ( pattern   => '^Query:\s(\d+)\s+(.+)\s(\d+)\s*$',
          start     => 0,
              end       => 0,
              line      => "",
          positions => [24,48,54,92,137,235,275,324],);
 
my %Sbjct = ( pattern => '^Sbjct:\s(\d+)\s+(.+)\s(\d+)\s*$',
          start   => 0,
              end     => 0,
              line    => "",
          positions => [26,65,145,189],);
 use constant {
        START       => 0,
        POSTQUERY   => 1,
        POSTSBJCT   => 2, };
my $state = START;
while (<$fh> ) {
  if (/$Query{pattern}/o) {
    if (($state == START) || ($state ==  POSTSBJCT)){
      $Query{start} = $1;
      $Query{end} = $3;
      $Query{line} = $2;
    }
    else {
 
    }
    $state = POSTQUERY;
  }
  if (/$Sbjct{pattern}/o) {
    if ($state ==  POSTQUERY){
      $Sbjct{start} = $1;
      $Sbjct{end} = $3;
      $Sbjct{line} = $2;
      processBloc(\%Query, \%Sbjct);
    }
    else {
 
    }
    $state = POSTSBJCT;
  }
}
close $fh;
 
 
sub processBloc {
  my ($Query, $Sbjct) = @_;
  foreach my $l (@{$Query->{positions}}) {
    next if ($l < $Query->{start});
    last if ($l > $Query->{end});;
    my $c = substr($Query->{line}, $l - $Query->{start}, 1);
    my $d = substr($Sbjct->{line}, $l - $Query->{start}, 1);
    next if ($c =~ m/[-X]/ or $d =~ m/[-X]/);
    my $k = $l - $Query->{start} + $Sbjct->{start};
    print "Testing: positions ($l, $k) values ($c, $d): " ;
    if (grep {$_ eq $k} @{$Sbjct->{positions}} ) {
      print "Found a match!\n" ;
    }
    else {
      print "no match.\n" ;
    }
  }
}

#!/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 = "dnadata.txt";
 
# 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" ;
    }
  }
}

# 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);

#!/usr/local/bin/perl
use strict;
use warnings;
 
process_cds("coco_cds" );
process_cds("aster_cds" );
 
open my $desc, '<', "RBH.txt";
while (my $ligne = <$desc> ) {
  my ($id1, $id2) = split(/\t/, $ligne1);
  system("formatdb -o -pT -i DB.pep" );
  system("fastacmd -d DB.pep -s $id1>cv" );
  system("fastacmd -d DB.pep -s $id2>ast" );
  system("bl2seq -i cv -j ast -p blastp -o out.bl -e 1.e-5" );
}
close $desc;
 
 
 
sub process_cds {
  my $filename = shift;
  open my $desc, '<', $filename;
  while (my $line = <$desc> ) {
    next if ($line =~ m/^\#/);
    chomp $line;
    my ( $id, $strand, $coord) = $line =~ m/[\w-]+\t([\w-]+)\t\d+\t([-+])\tORIGINAL JGI\t\d+\t[\#\w\.]+\t([,\d\.]+)/;
    my @exon = split (/,/, $coord);
    my @intron = ($coord =~ m/(\d+,\d+)/g);
    if ($strand eq '-') {
      @exon = reverse(@exon);
      @intron = reverse(@intron);
    }
 
    my $cds;
    my %hash;
    # 3777..3857,4046..4192,4443..4561,4940..5234,5406..5540,5734..5847,6009..6098,6421..6492
    #          324
    
    for my $i (0..$#intron) {
      my ($s, $e) = split(/,/, $intron[$i]);
      my $taille = abs($e-$s+1);
      my ($s2, $e2) = split(/\.\./, $exon[$i]);
      my $taille2 = abs($e2-$s2+1);
      $cds += $taille2;
      my $aa = int($cds/3);
      $hash{$id}{$aa}=$taille;
    }
  }
  close $desc;
}

1. error opening SCALAR(0x7df2a0) No such file or directory.

1. Warning: Unexpected Query at line 18

1. #!/usr/bin/perl
2.     use strict;
3.     use warnings;
4.     #use autodie qw(open close);   # open/close succeed or die
5.    
6.     # modifiable si le format du fichier change
7.     my $Query_string = '^Query:\s(\d+)\s+(.+)\s(\d+)\s*$';
8.     my $Sbjct_string = '^Sbjct:\s(\d+)\s+(.+)\s(\d+)\s*$';
9.     # peut être passé en parametre au script, etc
10.     my @Query_positions = (24,48,54,92,137,235,275,324);
11.     my @Sbjct_positions = (26,65,145,189);
12.     # fichier de données
13.     my $filename = "out.bl";
14.    
15.     # On fait tout dans une subroutine histoire d'avoir le tout bien modulaire
16.     # et les parametres importants comme parametres de la subroutine, ce qui
17.     # facilitera l'écriture avec passage des parametres sur la ligne de commande
18.     # du script (l'extension logique de ce script)
19.     processFile(\$filename, \$Query_string, \@Query_positions, \$Sbjct_string, \@Sbjct_positions);
20.    
21.     sub processFile {
22.      my ($filename, $Query_string, $Query_positions, $Sbjct_string, $Sbjct_positions) = @_;
23.      # creation des structures associées a une ligne utile
24.      my $Query = initStructure($Query_string, $Query_positions);
25.      my $Sbjct = initStructure($Sbjct_string, $Sbjct_positions);
26.    
27.     open my $fh, "<$$filename" or die "error opening $$filename $!.\n";
28.      my ($linenum, $bloc, $part) = (0, 0, 0);
29.      use constant {
30.        STATE_START  => 0,
31.        STATE_SCORE  => 1,
32.        STATE_QUERY  => 2,
33.        STATE_SBJCT  => 3,
34.      };
35.      my $state = STATE_START;
36.      while (<$fh> ) {
37.        ++$linenum;
38.        if (/^Score\s+=/) {
39.          ++$bloc;
40.          $part = 0;
41.          if (($state != STATE_START) && ($state != STATE_SBJCT)) {
42.         print "Warning: Unexpected Score at line $linenum\n";
43.          }
44.          $state = STATE_SCORE;
45.        }
46.        if (/${$Query->{pattern}}/o) {
47.          ++$part;
48.          adjustData($Query->{data}, $1, $2, $3);
49.          if (($state != STATE_SCORE) && ($state != STATE_SBJCT)) {
50.         print "Warning: Unexpected Query at line $linenum\n";
51.          }
52.          $state = STATE_QUERY;
53.        }
54.        if (/${$Sbjct->{pattern}}/o) {
55.          adjustData($Sbjct->{data}, $1, $2, $3);
56.          if ($state != STATE_QUERY) {
57.         ++$part;
58.         print "Warning: Unexpected Sbjct at line $linenum\n";
59.          }
60.          else {
61.         processBlocPart($bloc, $part, $Query, $Sbjct);
62.          }
63.          $state = STATE_SBJCT;
64.        }
65.      }
66.      close $fh;
67.      if ($state != STATE_SBJCT) {
68.        print "Warning: Unexpected end of file\n";
69.      }
70.     }
71.    
72.     # cree la structure associee a une ligne de donnees interessantes
73.     sub initStructure {
74.      my ($pattern, $position) = @_;
75.      my $hashref = {
76.              pattern   => $pattern,  #reference sur la chaine de pattern
77.              positions => $position, #reference sur l'array des positions
78.              data => {               #reference sur un hash des infos de la ligne
79.                   start => 0,
80.                   end   => 0,
81.                   line  => "",
82.                  },
83.             };
84.      return $hashref;
85.     }
86.    
87.     # remplit les champs d'un hash data passée par reference
88.     sub adjustData {
89.      my $dataref = shift;
90.      $dataref->{start} = shift;
91.      $dataref->{line}  = shift;
92.      $dataref->{end}   = shift;
93.     }
94.    
95.     # on a une portion de bloc, on regarde si on a des matches pour les positions cherchees
96.     sub processBlocPart {
97.      my ($bloc, $part, $Query, $Sbjct) = @_;
98.      foreach my $l (@{$Query->{positions}}) {
99.        next if ($l < $Query->{data}->{start});
100.        last if ($l > $Query->{data}->{end});
101.        my $c = substr($Query->{data}->{line}, $l - $Query->{data}->{start}, 1);
102.        my $d = substr($Sbjct->{data}->{line}, $l - $Query->{data}->{start}, 1);
103.        next if ($c =~ m/[-X]/ or $d =~ m/[-X]/);
104.        my $k = $l - $Query->{data}->{start} + $Sbjct->{data}->{start};
105.        print "Testing in bloc $bloc, part $part: positions ($l, $k) values ($c, $d): " ;
106.        if (grep {$_ eq $k} @{$Sbjct->{positions}} ) {
107.          print "Found a match!\n" ;
108.        } else {
109.          print "no match.\n" ;
110.        }
111.      }
112.     }

#!/usr/bin/perl
package dnadata;  #### ou un autre nom adapte ###
use strict;
use warnings;
#use autodie qw(open close);   # open/close succeed or die
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
 
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw(processFile);
$VERSION = '0.1';
 
########### change pas  a partir d'ici #############
 
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);
...................
    if (grep {$_ eq $k} @{$Sbjct->{positions}} ) {
      print "Found a match!\n" ;
    } else {
      print "no match.\n" ;
    }
  }
}
############ fin de ce qui ne changeait pas
 
1;
__END__

use dnadata; #avec les autres uses de ton programme (si tu as un autre nom de package que dnadata faut changer ici)
 
.........................
# valeurs qui viennes de ton programme principal ?
# 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*$';
# 
my @Query_positions = (24,48,54,92,137,235,275,324);
my @Sbjct_positions = (26,65,145,189);
# 
my $filename = "dnadata1.txt";
 
processFile(\$filename, \$Query_string, \@Query_positions, \$Sbjct_string, \@Sbjct_positions); # va appeler la fonction du module dnadata