#Copyright (c) 2010 Joachim Bargsten <code at bargsten dot org>. All rights reserved.
package Bio::Gonzales::IDMapIO;
use warnings;
use strict;
use Carp;
use 5.010;
use parent qw/Bio::Root::Root/;
use YAML qw/freeze thaw/;
use Data::Dumper;
our $VERSION = '0.0547'; # VERSION
our $MAP_PREFIX = 's';
our $IDLENGTH = 9;
=head1 NAME
Bio::Gonzales::IDMapIO - remap ids of 'objects', should be used in IO-classes, like Bio::SeqIO
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 METHODS
=cut
sub _initialize_idmapio {
my ( $self, @args ) = @_;
$self->SUPER::_initialize(@args);
my ( $fh, $file, $prefix, $id_length, $start_idx, $cache )
= $self->_rearrange( [qw(map_fh map_file map_prefix map_id_length map_start_idx map_cache)], @args );
$self->{'_map_id_len'} = $IDLENGTH;
$self->_map_id_len($id_length);
$self->map_prefix( $prefix // $MAP_PREFIX );
$self->map_reset_id;
$self->map_reset_cache;
$self->{'_mapidx'} = $start_idx - 1
if ( defined $start_idx );
$self->{'_cache'} = $cache
if ( defined $cache );
if ( $fh || $file ) {
$self->{'_map_io'} = Bio::Root::IO->new;
$self->{'_map_io'}->_initialize_io( -fh => $fh, -file => $file );
$self->_cache_from_io( $self->{'_map_io'} ) if ( $self->{'_map_io'}->mode eq 'r' && !defined($cache) );
}
}
=head2 $io->map_reset_id
=cut
sub map_reset_id {
my ($self) = @_;
$self->{'_mapidx'} = -1;
}
=head2 $io->map_reset_cache
=cut
sub map_reset_cache {
my ($self) = @_;
$self->{'_cache'} = {};
}
=head2 $io->map_add
=cut
sub map_add {
my ( $self, $real_id, $desc ) = @_;
$self->{'_mapidx'}++;
$self->map_add_custom( $self->map_id_current, $real_id, $desc );
$self->warn("map id exceeds id length")
if ( length( $self->map_prefix . $self->{'_mapidx'} ) > $self->_map_id_len );
return $self->map_id_current;
}
=head2 $io->map_add_custom
=cut
sub map_add_custom {
my ( $self, $map_id, $real_id, $desc ) = @_;
$self->throw("Did not provide a valid custom map id for proper mapping")
unless defined $map_id;
$self->throw("Did not provide a valid id for proper mapping")
unless defined $real_id;
$desc //= '';
$self->{'_cache'}->{$map_id} = { real_id => $real_id, desc => $desc };
return $map_id;
}
=head2 $io->map_write
=cut
sub map_write {
my ( $self, @args ) = @_;
my $map_io;
if ( $self->{'_map_io'} ) {
$map_io = $self->{'_map_io'};
} elsif ( @args > 0 ) {
$map_io = Bio::Root::IO->new;
$map_io->_initialize_io(@args);
} else {
$self->throw("no io args in constructor and no io args in function args");
}
$map_io->_print( freeze( $self->{_cache} ) );
$map_io->close();
}
=head2 $io->map_id_current
=cut
sub map_id_current {
my ($self) = @_;
return $self->{'_map_prefix'}
. sprintf( "%0." . ( $self->_map_id_len - $self->_map_prefix_len ) . "d", $self->{'_mapidx'} );
}
=head2 $io->map_lookup_id
=cut
sub map_lookup_id {
my ( $self, $map_id ) = @_;
return $self->{'_cache'}->{$map_id};
}
=head2 $io->map_prefix
=cut
sub map_prefix {
my ( $self, $value ) = @_;
if ( defined $value ) {
$self->throw("map prefix starts with >") if ( $value =~ /^>/ );
$self->throw("map prefix too long") if ( length($value) > $self->_map_id_len - 1 );
$self->{'_map_prefix'} = $value;
}
return $self->{'_map_prefix'};
}
sub _map_id_len {
my ( $self, $len ) = @_;
return $self->{'_map_id_len'} unless ( defined($len) );
$self->throw("map id shorterd than prefix")
if ( exists( $self->{'_map_prefix'} ) && $len < length( $self->{'_map_prefix'} ) );
$self->{'_map_id_len'} = $len;
return $len;
}
sub _map_prefix_len {
my ($self) = @_;
return length( $self->{'_map_prefix'} );
}
=head2 $io->map_idx($new_index_value)
set the index value (00001 in S00001)
=cut
sub map_idx {
my ( $self, $idx ) = @_;
$self->{'_mapidx'} = $idx
if ( defined $idx );
return $idx;
}
=head2 $io->map
return the map
=cut
sub map {
my ($self) = @_;
return $self->{'_cache'};
}
=head2 $io->map_read
read the map from a file
=cut
sub map_read {
my ( $self, @args ) = @_;
$self->throw("no io args in function args")
unless ( @args > 0 );
my $map_io = Bio::Root::IO->new;
$map_io->_initialize_io(@args);
$self->{'_map_io'} = $map_io;
$self->_cache_from_io($map_io);
}
sub _cache_from_io {
my ( $self, $map_io ) = @_;
my $yaml_string = '';
while ( my $l = $map_io->_readline ) {
$yaml_string .= $l;
}
$self->{'_cache'} = thaw($yaml_string);
}
1;
__END__
=head1 SEE ALSO
=head1 AUTHOR
jw bargsten, C<< <joachim.bargsten at wur.nl> >>
=cut