#!/usr/bin/perl
package dnadata;
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';
 
 
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" ;
    }
  }
}
 
1;
__END__

#!/usr/bin/perl
use strict;
use warnings;
 
use dnadata;
 
# 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 = "dnadata1.txt";
 
processFile(\$filename, \$Query_string, \@Query_positions, \$Sbjct_string, \@Sbjct_positions);

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.     }

1. #!/usr/local/bin/perl
2.     use strict;
3.     use warnings;
4.  
5.     do_something("coco_cds" );
6.     do_something("aster_cds" );
7.    
8.     open my $desc, '<', "RBH.txt";
9.     while (my $ligne1 = <$desc> ) {
10.      my ($id1, $id2) = split(/\t/, $ligne1);
11.      system("formatdb -o -pT -i DB.pep" );
12.      system("fastacmd -d DB.pep -s $id1>cv" );
13.      system("fastacmd -d DB.pep -s $id2>ast" );
14.      system("bl2seq -i cv -j ast -p blastp -o out.bl -e 1.e-5" );
15.     }
16.     close $desc;
17.    
18.    
19.    
20.     sub do_something {
21.      my $filename = shift;
22.      open my $desc, '<', $filename;
23.      while (my $line = <$desc> ) {
24.        next if ($line =~ m/^\#/);
25.        chomp $line;
26.        my ( $id, $strand, $coord) = $line =~ m/[\w-]+\t([\w-]+)\t\d+\t([-+])\tORIGINAL JGI\t\d+\t[\#\w\.]+\t([,\d\.]+)/;
27.        my @exon = split (/,/, $coord);
28.        my @intron = ($coord =~ m/(\d+,\d+)/g);
29.        if ($strand eq '-') {
30.          @exon = reverse(@exon);
31.          @intron = reverse(@intron);
32.        }
33.    
34.        my $cds;
35.        my %hash;
36.        # 3777..3857,4046..4192,4443..4561,4940..5234,5406..5540,5734..5847,6009..6098,6421..6492
37.        #          324
38.      
39.        for my $i (0..$#intron) {
40.          my ($s, $e) = split(/,/, $intron[$i]);
41.          my $taille = abs($e-$s+1);
42.          my ($s2, $e2) = split(/\.\./, $exon[$i]);
43.          my $taille2 = abs($e2-$s2+1);
44.          $cds += $taille2;
45.          my $aa = int($cds/3);
46.          $hash{$id}{$aa}=$taille;
47.        }
48.      }
49.      close $desc;
50.     }