Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/SeqIO/pir.pm @ 0:1f6dce3d34e0
Uploaded
| author | mahtabm |
|---|---|
| date | Thu, 11 Apr 2013 02:01:53 -0400 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:1f6dce3d34e0 |
|---|---|
| 1 # $Id: pir.pm,v 1.18 2002/10/25 16:23:16 jason Exp $ | |
| 2 # | |
| 3 # BioPerl module for Bio::SeqIO::PIR | |
| 4 # | |
| 5 # Cared for by Aaron Mackey <amackey@virginia.edu> | |
| 6 # | |
| 7 # Copyright Aaron Mackey | |
| 8 # | |
| 9 # You may distribute this module under the same terms as perl itself | |
| 10 # | |
| 11 # _history | |
| 12 # October 18, 1999 Largely rewritten by Lincoln Stein | |
| 13 | |
| 14 # POD documentation - main docs before the code | |
| 15 | |
| 16 =head1 NAME | |
| 17 | |
| 18 Bio::SeqIO::pir - PIR sequence input/output stream | |
| 19 | |
| 20 =head1 SYNOPSIS | |
| 21 | |
| 22 Do not use this module directly. Use it via the Bio::SeqIO class. | |
| 23 | |
| 24 =head1 DESCRIPTION | |
| 25 | |
| 26 This object can transform Bio::Seq objects to and from pir flat | |
| 27 file databases. | |
| 28 | |
| 29 Note: This does not completely preserve the PIR format - quality | |
| 30 information about sequence is currently discarded since bioperl | |
| 31 does not have a mechanism for handling these encodings in sequence | |
| 32 data. | |
| 33 | |
| 34 =head1 FEEDBACK | |
| 35 | |
| 36 =head2 Mailing Lists | |
| 37 | |
| 38 User feedback is an integral part of the evolution of this and other | |
| 39 Bioperl modules. Send your comments and suggestions preferably to one | |
| 40 of the Bioperl mailing lists. Your participation is much appreciated. | |
| 41 | |
| 42 bioperl-l@bioperl.org - General discussion | |
| 43 http://www.bioperl.org/MailList.shtml - About the mailing lists | |
| 44 | |
| 45 =head2 Reporting Bugs | |
| 46 | |
| 47 Report bugs to the Bioperl bug tracking system to help us keep track | |
| 48 the bugs and their resolution. | |
| 49 Bug reports can be submitted via email or the web: | |
| 50 | |
| 51 bioperl-bugs@bio.perl.org | |
| 52 http://bugzilla.bioperl.org/ | |
| 53 | |
| 54 =head1 AUTHORS | |
| 55 | |
| 56 Aaron Mackey E<lt>amackey@virginia.eduE<gt> | |
| 57 Lincoln Stein E<lt>lstein@cshl.orgE<gt> | |
| 58 Jason Stajich E<lt>jason@bioperl.orgE<gt> | |
| 59 | |
| 60 =head1 APPENDIX | |
| 61 | |
| 62 The rest of the documentation details each of the object | |
| 63 methods. Internal methods are usually preceded with a _ | |
| 64 | |
| 65 =cut | |
| 66 | |
| 67 # Let the code begin... | |
| 68 | |
| 69 package Bio::SeqIO::pir; | |
| 70 use vars qw(@ISA); | |
| 71 use strict; | |
| 72 | |
| 73 use Bio::SeqIO; | |
| 74 use Bio::Seq::SeqFactory; | |
| 75 | |
| 76 @ISA = qw(Bio::SeqIO); | |
| 77 | |
| 78 sub _initialize { | |
| 79 my($self,@args) = @_; | |
| 80 $self->SUPER::_initialize(@args); | |
| 81 if( ! defined $self->sequence_factory ) { | |
| 82 $self->sequence_factory(new Bio::Seq::SeqFactory | |
| 83 (-verbose => $self->verbose(), | |
| 84 -type => 'Bio::Seq')); | |
| 85 } | |
| 86 } | |
| 87 | |
| 88 =head2 next_seq | |
| 89 | |
| 90 Title : next_seq | |
| 91 Usage : $seq = $stream->next_seq() | |
| 92 Function: returns the next sequence in the stream | |
| 93 Returns : Bio::Seq object | |
| 94 Args : NONE | |
| 95 | |
| 96 =cut | |
| 97 | |
| 98 sub next_seq { | |
| 99 my ($self) = @_; | |
| 100 local $/ = "\n>"; | |
| 101 return unless my $line = $self->_readline; | |
| 102 if( $line eq '>' ) { # handle the very first one having no comment | |
| 103 return unless $line = $self->_readline; | |
| 104 } | |
| 105 my ($top, $desc,$seq) = ( $line =~ /^(.+?)\n(.+?)\n([^>]*)/s ) or | |
| 106 $self->throw("Cannot parse entry PIR entry [$line]"); | |
| 107 | |
| 108 | |
| 109 my ( $type,$id ) = ( $top =~ /^>?([PF])1;(\S+)\s*$/ ) or | |
| 110 $self->throw("PIR stream read attempted without leading '>P1;' [ $line ]"); | |
| 111 | |
| 112 # P - indicates complete protein | |
| 113 # F - indicates protein fragment | |
| 114 # not sure how to stuff these into a Bio object | |
| 115 # suitable for writing out. | |
| 116 $seq =~ s/\*//g; | |
| 117 $seq =~ s/[\(\)\.\/\=\,]//g; | |
| 118 $seq =~ s/\s+//g; # get rid of whitespace | |
| 119 | |
| 120 my ($alphabet) = ('protein'); | |
| 121 # TODO - not processing SFS data | |
| 122 return $self->sequence_factory->create | |
| 123 (-seq => $seq, | |
| 124 -primary_id => $id, | |
| 125 -id => $type. '1;' . $id, | |
| 126 -desc => $desc, | |
| 127 -alphabet => $alphabet | |
| 128 ); | |
| 129 } | |
| 130 | |
| 131 =head2 write_seq | |
| 132 | |
| 133 Title : write_seq | |
| 134 Usage : $stream->write_seq(@seq) | |
| 135 Function: writes the $seq object into the stream | |
| 136 Returns : 1 for success and 0 for error | |
| 137 Args : Array of Bio::PrimarySeqI objects | |
| 138 | |
| 139 | |
| 140 =cut | |
| 141 | |
| 142 sub write_seq { | |
| 143 my ($self, @seq) = @_; | |
| 144 for my $seq (@seq) { | |
| 145 $self->throw("Did not provide a valid Bio::PrimarySeqI object") | |
| 146 unless defined $seq && ref($seq) && $seq->isa('Bio::PrimarySeqI'); | |
| 147 my $str = $seq->seq(); | |
| 148 return unless $self->_print(">".$seq->id(), | |
| 149 "\n", $seq->desc(), "\n", | |
| 150 $str, "*\n"); | |
| 151 } | |
| 152 | |
| 153 $self->flush if $self->_flush_on_write && defined $self->_fh; | |
| 154 return 1; | |
| 155 } | |
| 156 | |
| 157 1; |
