view release on metacpan or  search on metacpan

lib/Bio/Community/IO.pm  view on Meta::CPAN

   lazy => 1,
);


# Overriding new... Is there a better alternative?

func new ($class, @args) {
   my $real_class = Scalar::Util::blessed($class) || $class;

   # These all come from the same base, Moose::Object, so this is fine
   my $params = $real_class->BUILDARGS(@args);
   my $format = delete $params->{'-format'};
   if (not defined $format) {
      # Try to guess format
      my $guesser = Bio::Community::IO::FormatGuesser->new();
      if ($params->{'-file'}) {
         $guesser->file( $params->{'-file'} );
      } elsif ($params->{'-fh'}) {
         $guesser->fh( $params->{'-fh'} );
      }
      $format = $guesser->guess;
   }
   if (not defined $format) {
      $real_class->throw("Could not automatically detect input format.");
   }

   # Use the real driver class here
   $real_class = __PACKAGE__.'::Driver::'.$format;
   Module::Runtime::use_module($real_class);
   $class->throw("Module $real_class does not implement a community IO stream")
       unless $real_class->does('Bio::Community::Role::IO');

   $params = $real_class->BUILDARGS(%$params);
   my $self = Class::MOP::Class->initialize($real_class)->new_object($params);

   return $self;
}


method BUILD ($args) {
   # Start IOs
   $self->_initialize_io(%$args);
   return 1;
}


=head2 next_member

 Usage   : my ($member, $count) = $in->next_member;
 Function: Get the next member from the community and its abundance. This
           function is implemented by the Bio::Community::IO::Driver used to
           parse the given file format.
 Args    : None
 Returns : An array containing:
             A Bio::Community::Member object (or undef)
             A positive number (or undef)

=cut

method next_member () {
   $self->throw_not_implemented;
}


=head2 next_community

 Usage   : my $community = $in->next_community;
 Function: Get the next community. Note that communities without members are
           skipped.
 Args    : None
 Returns : A Bio::Community object
             or
           undef if there were no communities left

=cut

method next_community () {
   my $community;

   if (not defined $self->_meta) {
      $self->_next_metacommunity_init( );
      $self->_meta(Bio::Community::Meta->new);
   }

   while ( 1 ) { # Skip communities with no members

      # Initialize driver for next community and set community name
      my $name = $self->_next_community_init;

      # All communities have been read
      last if not defined $name;

      # Create a new community object
      $community = Bio::Community->new( -name => $name );

      # Reinitialize queue
      my $count_queue = {};
      my $member_queue = $self->_member_queue;

      # Populate the community with members
      while ( my ($member, $count) = $self->next_member() ) {

         # All members have been read
         last if not defined $member;

         # Skip members without proper weights for now
         if (exists $member_queue->{$member->id}) {
            $count_queue->{$member->id} = $count;
            next;
         }

         # Add this member to the community
         $community->add_member($member, $count);
      }
      $self->_count_queue( $count_queue );

      # Process member queue now
      if (scalar keys %$count_queue > 0) {
         $self->_process_member_queue($community);
      }

      $self->_next_community_finish;

      if ( ($community->get_richness > 0) || (not $self->skip_empty_communities) ) {
         last;
      } else {
         $community = undef;
      }

   }
   # Community is undef if all communities have been seen
   return $community;
}


method _next_community_init () {
   # Driver-side method to initialize new community and return its name
   $self->throw_not_implemented;
}


method _next_community_finish () {
   # Driver-side method to finalize a community
   $self->throw_not_implemented;
}


=head2 next_metacommunity

 Usage   : my $meta = $in->next_metacommunity;
 Function: Get the next metacommunity. It may contain one or several communities
           depending on the format of the file read,
 Args    : None
 Returns : A Bio::Community::Meta object
             or
           undef after the metacommunity has been read

=cut

method next_metacommunity () {
   my $meta;
   if (not defined $self->_meta) {
      $meta = Bio::Community::Meta->new();
      my $name = $self->_next_metacommunity_init;
      if (defined $name) {
         $meta->name($name);
      }
      $self->_meta($meta);
      while (my $community = $self->next_community) {
         $self->_meta->add_communities([$community]);
      }
      # _next_metacommunity_finish will happen before close()
   }
   return $meta;
}


method _next_metacommunity_init () {
   # Driver-side method to initialize new metacommunity and return its name
   $self->throw_not_implemented;
}


method _next_metacommunity_finish () {
   # Driver-side method to finalize reading a metacommunity
   $self->throw_not_implemented;
}


=head2 write_member

 Usage   : $out->write_member($member, $abundance);
 Function: Write the next member from the community and its count or relative
           abundance. This function is implemented by a Bio::Community::IO::Driver
           specific to the given file format.
 Args    : A Bio::Community::Member object
           A positive number
 Returns : 1 for success

=cut

method write_member (Bio::Community::Member $member, Count $count) {
   $self->throw_not_implemented;
}


=head2 write_community

 Usage   : $out->write_community($community);
 Function: Write the next community.
 Args    : A Bio::Community object
 Returns : 1 for success

=cut

method write_community (Bio::Community $community) {
   if (not defined $self->_meta) {
      my $meta = Bio::Community::Meta->new;
      $self->_write_metacommunity_init($meta);
      $self->_meta($meta);
   }

   # Write community but skip empty ones if desired
   if ( ($community->get_richness > 0) || (not $self->skip_empty_communities) ) {   
      $self->_write_community_init($community);
      if (not defined $self->_meta->get_community_by_name($community->name)) {
         $self->_meta->add_communities([$community]);
      }
      my $sort_members = $self->sort_members;
      if ($sort_members == 1) {
         my $rank = $community->get_richness;
         while ( my $member = $community->get_member_by_rank($rank) ) {
            $self->_process_member($member, $community);
            $rank--;
            last if $rank == 0;
         }
      } elsif ($sort_members == -1) {
         my $rank = 1;
         while ( my $member = $community->get_member_by_rank($rank) ) {
            $self->_process_member($member, $community);
            $rank++;
         }
      } elsif ($sort_members == 0) {
         while ( my $member = $community->next_member('_write_community_ite') ) {
            $self->_process_member($member, $community);
         }
      } else {
         $self->throw("$sort_members is not a valid sort value.\n");
      }
      $self->_write_community_finish($community);
   }

   if ( ($self->_meta->get_communities_count > 1) && (not $self->multiple_communities) ) {
      $self->throw('Format '.$self->format.' only supports writing one community per file');
   }

   return 1;
}


method _write_community_init (Bio::Community $community) {
   # Driver-side method to initialize writing a community
   $self->throw_not_implemented;
}


method _write_community_finish (Bio::Community $community) {
   # Driver-side method to finalize writing a community
   $self->throw_not_implemented;
}


=head2 write_metacommunity

 Usage   : $out->write_metacommunity($meta);
 Function: Write a metacommunity.
 Args    : A Bio::Community::Meta object
 Returns : 1 for success

=cut

method write_metacommunity (Bio::Community::Meta $meta) {
   if (not defined $self->_meta) {
      $self->_meta($meta);
      $self->_write_metacommunity_init($meta);
      while (my $community = $meta->next_community) {
         $self->write_community($community);
      }
      # _write_metacommunity_finish will happen before close()
   } else {
      $self->throw('Can write only one metacommunity');
   }
   return 1;
}


method _write_metacommunity_init (Bio::Community::Meta $meta) {
   # Driver-side method to initialize writing a metacommunity
   $self->throw_not_implemented;
}


method _write_metacommunity_finish (Bio::Community::Meta $meta) {
   # Driver-side method to finalize writing a metacommunity
   $self->throw_not_implemented;
}


before 'close' => sub {
   my $self = shift;
   if ($self->mode eq 'r') {
      $self->_next_metacommunity_finish();
   } else {
      # Finish preparing the metacommunity for writing
      $self->_write_metacommunity_finish($self->_meta);
      # For objects consuming Bio::Community::Role::Table, write the table now
      if (does_role($self, 'Bio::Community::Role::Table')) {
         $self->_write_table unless $self->_was_written;
      }
   }
   return 1;
};


#method _process_member (Bio::Community::Member $member, Bio::Community $community) {
method _process_member ($member, $community) {
   my $ab_value;
   my $ab_type = $self->abundance_type;
   if ($ab_type eq 'count') {
      $ab_value = $community->get_count($member);
   } elsif ($ab_type eq 'absolute') {
      $ab_value = $community->get_abs_ab($member);
   } elsif ($ab_type eq 'percentage') {
      $ab_value = $community->get_rel_ab($member);
   } elsif ($ab_type eq 'fraction') {
      $ab_value = $community->get_rel_ab($member) / 100;
   } else {
      $self->throw("$ab_value is not a valid abundance type.\n");
   }
   $self->write_member($member, $ab_value);
   return 1;
}


=head2 skip_empty_communities

 Usage   : $in->skip_empty_communities;
 Function: Get or set whether empty communities (with no members) should be
           read/written or skipped.
 Args    : 0 or 1
 Returns : 0 or 1

=cut

has 'skip_empty_communities' => (
   is => 'rw',
   isa => 'Bool',
   required => 0,
   lazy => 1,
   default => 0,
   init_arg => '-skip_empty_communities',
);


=head2 sort_members