merge in changes from bioperl-live into Bio-FeatureIO

lib/Bio/FeatureIO.pm

@@ -50,8 +50,7 @@ can be used on many levels:
 both the data parsed and 
 
 Bio::FeatureIO is a handler module for the formats in the FeatureIO set (eg,
-Bio::FeatureIO::GFF). It is the officially sanctioned way of getting at the
-format objects, which most people should use.
+Bio::FeatureIO::GFF).
 
 The Bio::FeatureIO system can be thought of like biological file handles. They
 are attached to filehandles with smart formatting rules (eg, GFF format, or BED
@@ -244,7 +243,7 @@ Report bugs to the Bioperl bug tracking system to help us keep track
 the bugs and their resolution.  Bug reports can be submitted via the
 web:
 
-  http://bugzilla.open-bio.org/
+  https://redmine.open-bio.org/projects/bioperl/
 
 =head1 AUTHOR - Allen Day
 
@@ -390,6 +389,18 @@ sub fh {
     return $s;
 }
 
+=head2 format
+
+ Title   : format
+ Usage   : $format = $stream->format()
+ Function: Get the feature format
+ Returns : feature format
+ Args    : none
+
+=cut
+
+# format() method inherited from Bio::Root::IO
+
 =head2 next_feature
 
  Title   : next_feature
@@ -552,4 +563,3 @@ sub PRINT {
 
 __END__
 
-

lib/Bio/FeatureIO/bed.pm

@@ -1,4 +1,3 @@
-
 =pod
 
 =head1 NAME
@@ -52,7 +51,7 @@ Report bugs to the Bioperl bug tracking system to help us keep track
 of the bugs and their resolution. Bug reports can be submitted via
 the web:
 
-  http://bugzilla.open-bio.org/
+  https://redmine.open-bio.org/projects/bioperl/
 
 =head1 AUTHOR - Allen Day
 

lib/Bio/FeatureIO/gff.pm

@@ -196,11 +196,7 @@ sub next_feature_group {
 
 sub next_seq() {
     my $self = shift;
-    return unless $self->fasta_mode;
-    #first time next_seq has been called.  initialize Bio::SeqIO instance
-    if(!$self->seqio){
-        $self->seqio( Bio::SeqIO->new(-format => 'fasta', -fh => $self->_fh()) );
-    }
+    return undef unless $self->fasta_mode();
     return $self->seqio->next_seq();
 }
 
@@ -281,7 +277,6 @@ sub _gff3_lowlevel_hashref {
             ( $parent_id ? ( Parent => [ $parent_id ] ) : () ),
           },
     };
-
 }
 
 ################################################################################
@@ -308,22 +303,27 @@ sub fasta_mode {
 =head2 seqio()
 
  Usage   : $obj->seqio($newval)
- Function: get/set a Bio::SeqIO instance for handling the GFF3 ##FASTA section.
-           Returns undef before the ##FASTA section of the GFF3 stream has been
-           reached.
- Returns : value of seqio (a scalar) or undef
+ Function: get/set a Bio::SeqIO instance to handle the GFF3 ##FASTA section.
+ Returns : a Bio::SeqIO object or undef
  Args    : on set, new value (a scalar or undef, optional)
 
 =cut
 
 sub seqio {
-    my($self,$val) = @_;
-    $self->{'seqio'} = $val if defined($val);
-    return $self->{'seqio'};
+  my($self,$val) = @_;
+  if (defined $val) {
+    $self->{'seqio'} = $val;
+  } else {
+    # Cannot get seqio before we've reached the ##FASTA section
+    return undef unless $self->fasta_mode();
+    if (not defined $self->{'seqio'}) {
+      # Initialize Bio::SeqIO instance
+      $self->{'seqio'} = Bio::SeqIO->new(-format => 'fasta', -fh => $self->_fh());
+    }
+  }
+  return $self->{'seqio'};
 }
 
-# TODO: reimplement to call the handler's set parameters (getter only)
-
 =head2 sequence_region()
 
  Usage   :
@@ -517,8 +517,15 @@ Bio::SeqFeature::Annotated object.
 #        $values =~ s/^["']//;
 #        $values =~ s/["']$//; #' terminate the quote for emacs
 #  
-#        my @values = map{uri_unescape($_)} split ',', $values;
-#  
+#        my @values;
+#        if ($key eq 'Target') {
+#            #dont unescape Target values
+#            @values = split ',', $values;
+#        }
+#        else {
+#            @values = map{uri_unescape($_)} split ',', $values
+#        }
+
 #       #minor hack to allow for multiple instances of the same tag
 #        if ($attr{$key}) {
 #          my @tmparray = @{$attr{$key}};
@@ -974,7 +981,7 @@ Refactored from the original work by:
 =head1 CONTRIBUTORS
 
  Steffen Grossmann, <grossman@molgen.mpg.de>
- Scott Cain, <cain@cshl.edu>
+ Scott Cain, <scain@cpan.org>
  Rob Edwards <rob@salmonella.org>
 
 =head1 APPENDIX

lib/Bio/FeatureIO/gtf.pm

@@ -51,7 +51,7 @@ Report bugs to the Bioperl bug tracking system to help us keep track
 of the bugs and their resolution. Bug reports can be submitted via
 the web:
 
-  http://bugzilla.open-bio.org/
+  https://redmine.open-bio.org/projects/bioperl/
 
 =head1 AUTHOR - Allen Day
 

lib/Bio/FeatureIO/interpro.pm

@@ -42,7 +42,7 @@ Report bugs to the Bioperl bug tracking system to help us keep track
 of the bugs and their resolution. Bug reports can be submitted via
 the web:
 
-  http://bugzilla.open-bio.org/
+  https://redmine.open-bio.org/projects/bioperl/
 
 =head1 AUTHOR - Allen Day
 

lib/Bio/FeatureIO/ptt.pm

@@ -1,4 +1,3 @@
-
 =pod
 
 =head1 NAME
@@ -94,7 +93,7 @@ Report bugs to the Bioperl bug tracking system to help us keep track
 of the bugs and their resolution. Bug reports can be submitted via
 the web:
 
-  http://bugzilla.open-bio.org/
+  https://redmine.open-bio.org/projects/bioperl/
 
 =head1 AUTHOR - Torsten Seemann
 
@@ -210,19 +209,45 @@ sub next_dataset {
     }
 }
 
-=head2 write_feature (NOT IMPLEMENTED)
+=head2 write_feature
 
  Title   : write_feature
  Usage   : $io->write_feature($feature)
- Function: write a Bio::SeqFeatureI object in PTT format
+ Function: write a Bio::SeqFeature object in PTT format with no header
  Example : 
- Args    : Bio::SeqFeatureI object
+ Args    : Bio::SeqFeature object
  Returns : 
 
 =cut
 
 sub write_feature {
-    shift->throw_not_implemented;
+  my($self,$feat) = @_;
+
+  # Example, with header:
+  # Location  Strand  Length  PID Gene  Synonym Code  COG Product
+  # 190..255  + 21  16763391  thrL  STM0001 - - thr operon leader peptide
+
+  $self->throw("Only Bio::SeqFeature::Generic or Bio::SeqFeature::Annotated objects are writeable") 
+  unless ( $feat->isa('Bio::SeqFeature::Generic') || $feat->isa('Bio::SeqFeature::Annotated') );
+
+  # Default
+  my ($len,$pid,$gene,$synonym,$code,$cog,$product) = qw(- - - - - - -);
+
+  my $start = $feat->start;
+  my $end   = $feat->end;
+  my $loc   = "$start..$end";
+
+  my $strand = $feat->strand == 1 ? '+' : '-';
+
+  $len = int(($end - $start)/3);
+
+  $product = join ' ',$feat->get_tag_values("product")     if ($feat->has_tag("product"));
+  $pid     = join ' ',$feat->get_tag_values("protein_id")  if ($feat->has_tag("protein_id"));
+  $code    = join ' ',$feat->get_tag_values("codon_start") if ($feat->has_tag("codon_start"));
+
+  $self->_print(join("\t",($loc,$strand,$len,$pid,$gene,$synonym,$code,$cog,$product)) . "\n");
+
+  $self->write_feature($_) foreach $feat->get_SeqFeatures();
 }
 
 =head2 description

lib/Bio/FeatureIO/vecscreen_simple.pm

@@ -58,7 +58,7 @@ Report bugs to the Bioperl bug tracking system to help us keep track
 of the bugs and their resolution. Bug reports can be submitted via
 the web:
 
- http://bugzilla.open-bio.org/
+ https://redmine.open-bio.org/projects/bioperl/
 
 =head1 AUTHOR - Robert Buels