lib/Bio/SeqIO/game.pm

   1 #
   2 # BioPerl module for Bio::SeqIO::game
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Sheldon McKay <mckays@cshl.edu>
   7 #
   8 # You may distribute this module under the same terms as perl itself
   9 #
  10
  11 # POD documentation - main docs before the code
  12
  13 =head1 NAME
  14
  15 Bio::SeqIO::game -- a class for parsing and writing game-XML
  16
  17 =head1 SYNOPSIS
  18
  19 This module is not used directly, use SeqIO.
  20
  21  use Bio::SeqIO;
  22
  23  my $in = Bio::SeqIO->new ( -file    => 'file.xml',
  24                             -format  =>  'game',
  25                             -verbose => 1 );
  26
  27  my $seq = $in->next_seq;
  28
  29 =head1 DESCRIPTION
  30
  31 Bio::SeqIO::game will parse game XML (version 1.2) or write game XML from
  32 a Bio::SeqI implementing object.  The XML is readable by the genome
  33 annotation editor 'Apollo' (www.gmod.org).  It is not backwards compatible
  34 with the previous version of game XML.  The XML format currently used by
  35 Apollo contains a single 'main' annotated sequence, so we will only get a
  36 single annotated sequence in the stream when parsing a game-XML record.
  37
  38 =head1 FEEDBACK
  39
  40 =head2 Mailing Lists
  41
  42 User feedback is an integral part of the evolution of this
  43 and other Bioperl modules. Send your comments and suggestions preferably
  44 to one of the Bioperl mailing lists.
  45
  46 Your participation is much appreciated.
  47
  48   bioperl-l@bioperl.org                  - General discussion
  49   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  50
  51 =head2 Support
  52
  53 Please direct usage questions or support issues to the mailing list:
  54
  55 I<bioperl-l@bioperl.org>
  56
  57 rather than to the module maintainer directly. Many experienced and
  58 reponsive experts will be able look at the problem and quickly
  59 address it. Please include a thorough description of the problem
  60 with code and data examples if at all possible.
  61
  62 =head2 Reporting Bugs
  63
  64 Report bugs to the Bioperl bug tracking system to help us keep track
  65 of the bugs and their resolution.
  66
  67 Bug reports can be submitted via the web:
  68
  69   https://github.com/bioperl/bioperl-live/issues
  70
  71 =head1 AUTHOR - Sheldon McKay
  72
  73 Email mckays@cshl.edu
  74
  75 =head1 APPENDIX
  76
  77 The rest of the documentation details each of the object
  78 methods. Internal methods are usually preceded with a _
  79
  80 =cut
  81
  82 package Bio::SeqIO::game;
  83
  84 use Bio::SeqIO::game::gameHandler;
  85 use Bio::SeqIO::game::gameWriter;
  86
  87 use base qw(Bio::SeqIO);
  88
  89 sub _initialize {
  90     my ($self, @args) = @_;
  91     $self->SUPER::_initialize(@args);
  92 }
  93
  94 =head2 next_seq
  95
  96  Title   : next_seq
  97  Usage   : my $seq = $seqio->next_seq;
  98  Function: get the main sequence object
  99  Returns : a Bio::Seq::RichSeq object
 100  Args    : none
 101
 102
 103 =cut
 104
 105 sub next_seq {
 106     my $self   = shift;
 107
 108     my $seq_l  = $self->_getseqs;
 109     my $annseq = shift @{$seq_l};
 110     my $seq    = $annseq->[0];
 111     my $feats  = $annseq->[1];
 112
 113     for ( @{$feats} ) {
 114         $seq->add_SeqFeature( $_ );
 115     }
 116
 117     return $seq;
 118 }
 119
 120 =head2 write_seq
 121
 122  Title   : write_seq
 123  Usage   : $seqio->write_seq($seq)
 124  Function: writes a sequence object as game XML
 125  Returns : nothing
 126  Args    : a Bio::SeqI compliant object
 127
 128 =cut
 129
 130 sub write_seq {
 131     my ($self, $seq) = @_;
 132     my $writer = Bio::SeqIO::game::gameWriter->new($seq);
 133     my $xml = $writer->write_to_game;
 134     $self->_print($xml);
 135 }
 136
 137 =head2 _getseqs
 138
 139  Title   : _getseqs
 140  Usage   : $self->_getseqs
 141  Function: An internal method to invoke the PerlSAX XML handler and get
 142            the sequence objects
 143  Returns : an reference to an array with sequence object and annotations
 144  Args    : none
 145
 146 =cut
 147
 148 sub _getseqs {
 149     my $self = shift;
 150     if ( defined $self->{seq_l} ) {
 151         return $self->{seq_l};
 152     }
 153     else {
 154         my $fh = $self->_fh;
 155         my $text = join '', <$fh>;
 156         $text || $self->throw("Input file is empty or does not exist");
 157         my $source = $text =~ /type>(source|origin|\bregion\b)<\/type/gm ? 1 : 0;
 158         my $handler = Bio::SeqIO::game::gameHandler->new;
 159         $handler->{has_source} = $source if $source;
 160         $handler->{verbose} = 1 if $self->verbose;
 161         my $parser  = XML::Parser::PerlSAX->new( Handler => $handler );
 162         my $game    = $parser->parse( $text );
 163         $self->{seq_l} = $game->load;
 164     }
 165 }
 166
 167 =head2 _hide_dna
 168
 169  Title   : _hide_dna
 170  Usage   : $seqio->_hide_dna
 171  Function: Hide the DNA for really huge sequences
 172  Returns : nothing
 173  Args    : none
 174
 175 =cut
 176
 177 sub _hide_dna {
 178     my $self = shift;
 179
 180     my $annseqs = $self->_getseqs;
 181
 182     for ( @{$annseqs} ) {
 183         my $seq = $_->[0];
 184         $seq->seq('');
 185     }
 186     return 0;
 187 }
 188
 189
 190 1;