The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# BioPerl module for Bio::Community::IO::Driver::gaas
#
# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Copyright 2011-2014 Florent Angly <florent.angly@gmail.com>
#
# You may distribute this module under the same terms as perl itself


=head1 NAME

Bio::Community::IO::Driver::gaas - Driver to read and write files in the GAAS format

=head1 SYNOPSIS

   my $in = Bio::Community::IO->new( -file => 'gaas_communities.txt', -format => 'gaas' );

   # See Bio::Community::IO for more information

=head1 DESCRIPTION

This Bio::Community::IO::Driver::gaas driver reads and writes files in the format
generated by GAAS (http://sourceforge.net/projects/gaas/). GAAS creates one such
file per community. Here is an example:

  # tax_name	tax_id	rel_abund
  Streptococcus pyogenes phage 315.1	198538	0.791035649011735
  Goatpox virus Pellor	376852	0.196094208626593
  Lumpy skin disease virus NI-2490	376849	0.0128701423616715

For each Bio::Community::Member $member generated from a GAAS file, $member->id()
contains the content of the tax_id field, while $member->desc() reflects the
tax_name field.

Note that GAAS format does not include counts for the community members but
relative abundances only. Thus, the get_members_count() method of the
Bio::Community objects generated using this driver is a relative abundance
(a decimal number) instead of the usual integers used for counts.

=head1 CONSTRUCTOR

See L<Bio::Community::IO>.

=head1 AUTHOR

Florent Angly L<florent.angly@gmail.com>

=head1 SUPPORT AND BUGS

User feedback is an integral part of the evolution of this and other Bioperl
modules. Please direct usage questions or support issues to the mailing list, 
L<bioperl-l@bioperl.org>, rather than to the module maintainer directly. Many
experienced and reponsive experts will be able look at the problem and quickly 
address it. Please include a thorough description of the problem with code and
data examples if at all possible.

If you have found a bug, please report it on the BioPerl bug tracking system
to help us keep track the bugs and their resolution:
L<https://redmine.open-bio.org/projects/bioperl/>

=head1 COPYRIGHT

Copyright 2011-2014 by Florent Angly <florent.angly@gmail.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.1 or,
at your option, any later version of Perl 5 you may have available.

=cut


package Bio::Community::IO::Driver::gaas;

use Moose;
use namespace::autoclean;
use Method::Signatures;
use Bio::Community::Member;

extends 'Bio::Community::IO';
with 'Bio::Community::Role::IO';


our $multiple_communities    =  0;         # the format supports one community per file
our $explicit_ids            =  1;         # IDs are explicitly recorded
our $default_sort_members    =  -1;        # sorted by decreasing abundance
our $default_abundance_type  = 'fraction'; # fractional number between 0 and 1
our $default_missing_string  =  0;         # empty members get a '0'


has '_count' => (
   is => 'rw',
   isa => 'PositiveInt',
   required => 0,
   init_arg => undef,
   default => 0,
   lazy => 1,
);


method next_member () {
   # Read next line
   my $line;
   do {
      $line = $self->_readline;
      if (not defined $line) {
         return undef;
      }
   } while ( ($line =~ m/^#/) || ($line =~ m/^\s*$/) ); # skip comment and empty lines

   # Parse and validate the line 
   chomp $line;
   my ($name, $taxid, $rel_ab) = split "\t", $line;

   if ( (not defined $name  ) ||
        (not defined $taxid ) ||
        (not defined $rel_ab) ) {
      $self->throw("Error: The following line does not follow the GAAS format.\n-->$line<--\n");
   }

   my $member = Bio::Community::Member->new( -id => $taxid, -desc => $name );
   $self->_attach_taxon($member, $taxid, 0);
   ### TODO:handle things differently if GAAS did not use a taxonomy file??
   $self->_attach_weights($member);

   # Note that a relative abundance is returned, not a count
   return $member, $rel_ab;
}


method _next_community_init () {
   my $count = $self->_count;
   $count++;
   if ($count <= 1) {
      $self->_count($count);
      return ''; # name of community
   } else {
      return undef;
   }
}


method _next_community_finish () {
   return 1;
}


method _next_metacommunity_init () {
   my $name = ''; # no provision for metacommunity name in this format
   return $name;
}


method _next_metacommunity_finish () {
   return 1;
}


method write_member (Bio::Community::Member $member, Count $count) {
   my $line = $member->desc."\t".$member->id."\t".$count."\n";
   $self->_print( $line );
   return 1;
}


method _write_community_init (Bio::Community $community) {
   return 1;
}


method _write_headers () {
   my $header_line = "# tax_name\ttax_id\trel_abund\n";
   # But it could also be "# seq_name\tseq_id\trel_abund\n";
   $self->_print( $header_line );
}


method _write_community_finish (Bio::Community $community) {
   return 1;
}


method _write_metacommunity_init (Bio::Community::Meta $meta) {
   # Write first column header
   $self->_write_headers;
   return 1;
}


method _write_metacommunity_finish (Bio::Community::Meta $meta) {
   return 1;
}



__PACKAGE__->meta->make_immutable;

1;