← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/Matrix/PSM/IO/transfac.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Matrix/PSM/IO/transfac.pm
1
1
#---------------------------------------------------------
2
 
# $Id: transfac.pm,v 1.6 2003/12/18 18:59:24 skirov Exp $
 
2
# $Id: transfac.pm,v 1.14.4.3 2006/10/02 23:10:22 sendu Exp $
3
3
 
4
4
=head1 NAME
5
5
 
6
 
Bio::Matrix::PSM::transfac - PSM transfac parser
 
6
Bio::Matrix::PSM::IO::transfac - PSM transfac parser
7
7
 
8
8
=head1 SYNOPSIS
9
9
 
21
21
Bioperl modules. Send your comments and suggestions preferably to one
22
22
of the Bioperl mailing lists.  Your participation is much appreciated.
23
23
 
24
 
  bioperl-l@bioperl.org                 - General discussion
25
 
  http://bio.perl.org/MailList.html     - About the mailing lists
 
24
  bioperl-l@bioperl.org                  - General discussion
 
25
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
26
26
 
27
27
=head2 Reporting Bugs
28
28
 
29
29
Report bugs to the Bioperl bug tracking system to help us keep track
30
 
 the bugs and their resolution.
31
 
 Bug reports can be submitted via email or the web:
 
30
the bugs and their resolution.  Bug reports can be submitted via the
 
31
web:
32
32
 
33
 
  bioperl-bugs@bio.perl.org
34
 
  http://bugzilla.bioperl.org/
 
33
  http://bugzilla.open-bio.org/
35
34
 
36
35
=head1 AUTHOR - Stefan Kirov
37
36
 
45
44
# Let the code begin...
46
45
package Bio::Matrix::PSM::IO::transfac;
47
46
use Bio::Matrix::PSM::Psm;
48
 
use Bio::Matrix::PSM::IO;
49
 
use Bio::Matrix::PSM::PsmHeader;
50
47
use Bio::Root::Root;
51
 
use vars qw(@ISA);
 
48
use Bio::Annotation::Reference;
 
49
use Bio::Annotation::Comment;
 
50
use Bio::Annotation::DBLink;
52
51
use strict;
53
52
 
54
 
@ISA=qw(Bio::Matrix::PSM::PsmHeader Bio::Root::Root Bio::Matrix::PSM::IO);
 
53
use base qw(Bio::Matrix::PSM::PsmHeader Bio::Matrix::PSM::IO);
55
54
 
56
55
=head2 new
57
56
 
76
75
    do {
77
76
        $line=$self->_readline;
78
77
        chomp $line;
79
 
        push @{$self->{unstructured}},$line if (length($line)>2); } until ($line =~ /^\/\//) || (!defined($line)); #Unstructured header
 
78
        push @{$self->{unstructured}},$line if (length($line)>2); } until ($line =~ m{^//}) || (!defined($line)); #Unstructured header
80
79
    $self->_initialize;
81
80
    return $self;
82
81
}
83
 
   
 
82
 
84
83
 
85
84
=head2 next_psm
86
85
 
97
96
sub next_psm {
98
97
    my $self=shift;
99
98
    my $line;
100
 
    return undef if ($self->{end});
101
 
    my (@a,@c,@g,@t, $id, $tr1, $accn, $bf, $sites);
 
99
    return if ($self->{end});
 
100
    my (@a,@c,@g,@t, $id, $tr1, @refs,$accn, $bf, $sites);
102
101
    my $i=0;
103
102
    while (defined( $line=$self->_readline)) {
104
103
        chomp($line);
113
112
    }
114
113
    if (!(defined($id) && defined($accn))) {
115
114
        $self->{end}=1;
116
 
        return undef;
 
115
        return;
117
116
    }
118
117
    while (defined( $line=$self->_readline)) {  #How many sites?
119
118
        if ($line=~/^BA\s/) {
120
119
            my ($tr1,$ba)=split(/\s{2}/,$line);
121
120
            ($sites)=split(/\s/,$ba);
122
 
            last;
123
121
        }
124
 
        last if ($line=~/^\/\//);
 
122
   if ($line=~/^RN/) { #Adding a reference as Bio::Annotation object (self)
 
123
    # not interested in RN line itself, since has only transfac-specific
 
124
    # reference id? - no push back of line
 
125
    my $ref=_parse_ref($self);
 
126
    push @refs,$ref
 
127
  }
 
128
        last if ($line=~m{^//});
125
129
    }
126
130
    # We have the frequencies, let's create a SiteMatrix object
127
131
    my %matrix = &_make_matrix($self,\@a,\@c,\@g,\@t,$id, $accn);
128
132
    $matrix{-sites}=$sites if ($sites);
129
133
    $matrix{-width}=@a;
130
134
    my $psm=new Bio::Matrix::PSM::Psm(%matrix);
 
135
    foreach my $ref (@refs) { $psm->add_Annotation('reference',$ref); }
131
136
    return $psm;
132
137
}
133
138
 
202
207
    return (-pA=>\@fa,-pC=>\@fc,-pG=>\@fg,-pT=>\@ft, -id=>$id, -accession_number=>$accn)
203
208
    }
204
209
 
 
210
sub _parse_ref {
 
211
my $self=shift;
 
212
my ($authors,$title,$loc,@refs,$tr,$db,$dbid);
 
213
    while (my $refline=$self->_readline) { #Poorely designed, should go through an array with fields
 
214
      chomp $refline;
 
215
      my ($field,$arg)=split(/\s+/,$refline,2);
 
216
      last if ($field=~/XX/);
 
217
      $field.=' ';
 
218
      REF: {
 
219
          if ($field=~/RX/) {  #DB Reference
 
220
              $refline=~s/[;\.]//g;
 
221
              ($tr, $db, $dbid)=split(/\s+/,$refline);
 
222
              last REF;
 
223
          }
 
224
         if ($field=~/RT/) {   #Title
 
225
            $title .= $arg;
 
226
            last REF;
 
227
          }
 
228
          if ($field=~/RA/) {  #Author
 
229
            $authors .= $arg;
 
230
            last REF;
 
231
          }
 
232
          if ($field=~/RL/) {  #Journal
 
233
            $loc .= $arg;
 
234
            last REF;
 
235
          }
 
236
        }
 
237
     }
 
238
     my $reference=new Bio::Annotation::Reference (-authors=>$authors, -title=>$title,
 
239
                                                    -location=>$loc);
 
240
     if ($db eq 'MEDLINE') {
 
241
        # does it ever equal medline?
 
242
        $reference->medline($dbid);
 
243
     }
 
244
     elsif ($dbid) {
 
245
        $reference->pubmed($dbid);
 
246
     }
 
247
     return $reference;
 
248
}
205
249
 
206
250
sub DESTROY {
207
251
    my $self=shift;