File Coverage

blib/lib/Bio/Tools/EUtilities/Link/LinkSet.pm

Criterion	Covered	Total	%
statement	122	172	70.9
branch	37	58	63.7
condition	9	18	50.0
subroutine	23	35	65.7
pod	22	22	100.0
total	213	305	69.8

package Bio::Tools::EUtilities::Link::LinkSet;
$Bio::Tools::EUtilities::Link::LinkSet::VERSION = '1.76';
use utf8;
use strict;
use warnings;
use base qw(Bio::Root::Root Bio::Tools::EUtilities::HistoryI);
use Bio::Tools::EUtilities::Link::UrlLink;
use Bio::Tools::EUtilities::Info::LinkInfo;

# ABSTRACT: Class for EUtils LinkSets.
# AUTHOR:   Chris Fields
# OWNER:    2006-2013 Chris Fields
# LICENSE:  Perl_5


sub new {
    my ($class,@args) = @_;
    my $self = $class->SUPER::new(@args);
    my ($type) = $self->_rearrange([qw(DATATYPE)],@args);
    $type ||= 'linkset';
    $self->eutil('elink');
    $self->datatype($type);
    return $self;
}


sub get_ids {
    my $self = shift;
    unless ($self->{'_sorted_id'}) {
        @{$self->{'_sorted_id'}} =
            sort {
                $self->{'_id'}->{$a}->[0] <=>
                $self->{'_id'}->{$b}->[0]
            } keys %{$self->{'_id'}};
    }
    return @{$self->{'_sorted_id'}};
}


sub get_database {
    return ($_[0]->get_databases)[0];
}


sub get_db {
    return shift->get_database;
}


sub get_dbto {
    return shift->get_database;
}


sub get_databases {
    my $self = shift;
    my %tmp;
    my @dbs = sort map {$_->get_database}
        grep {!$tmp{$_->get_database}++} ($self->get_LinkInfo);
    unshift @dbs, $self->{'_dbto'} if $self->{'_dbto'} && !$tmp{$self->{'_dbto'}}++;
    return @dbs;
}


sub get_dbs {
    return shift->get_databases;
}


sub get_dbfrom { return shift->{'_dbfrom'} }


sub get_link_names {
    my ($self) = shift;
    my %tmps;
    my @lns;
    if ($self->{'_linkname'}) {
        push @lns, $self->{'_linkname'};
        $tmps{$self->{'_linkname'}}++;
    }
    push @lns, map {$_->get_link_name} $self->get_LinkInfo;
    return @lns;
}


sub get_link_name {
    return ($_[0]->get_link_names)[0];
}


sub get_submitted_ids {
    my $self = shift;
    my $datatype = $self->datatype;
    if ($datatype eq 'idcheck' || $datatype eq 'urllink') {
        return $self->get_ids;
    } elsif ($self->{'_submitted_ids'}) {
        return @{$self->{'_submitted_ids'}};
    } else {
        return ();
    }
}


sub has_scores {
    my $self = shift;
    return exists $self->{'_has_scores'} ? 1 : 0;
}


sub get_scores {
    my $self = shift;
    # do we want to cache this or generate only when needed?  Likely won't be
    # called more than once...
    return unless $self->has_scores;
    my %scores = map {$_ => $self->{'_id'}->{$_}->[1]} keys %{$self->{'_id'}};
    return %scores;
}


sub get_score_by_id {
    my ($self, $id) = @_;
    ($id && exists $self->{'_id'}->{$id}) ? return $self->{'_id'}->{$id}->[1] :
        return;
}


sub has_linkout {
    my $self = shift;
    if (exists $self->{'_haslinkout'}) {
        return $self->{'_haslinkout'} eq 'Y' ? 1 : 0;
    } else  {
        return (grep {$_ eq 'LinkOut'} $self->get_databases) ? 1 : 0;
    }
}


sub has_neighbor {
    my $self = shift;
    if (exists $self->{'_hasneighbor'}) {
        return $self->{'_hasneighbor'} eq 'Y' ? 1 : 0;
    } else {
        return 0;
    }
}


sub next_UrlLink {
    my $self = shift;
    unless ($self->{"_urllinks_it"}) {
        my @ul = $self->get_UrlLinks;
        $self->{"_urllinks_it"} = sub {return shift @ul}
    }
    $self->{'_urllinks_it'}->();
}


sub get_UrlLinks {
    my $self = shift;
    return ref $self->{'_urllinks'} ? @{ $self->{'_urllinks'} } : return;
}


sub next_LinkInfo {
    my $self = shift;
    unless ($self->{"_linkinfo_it"}) {
        my @li = $self->get_LinkInfo;
        $self->{"_linkinfo_it"} = sub {return shift @li}
    }
    $self->{'_linkinfo_it'}->();
}


sub get_LinkInfo {
    my $self = shift;
    return ref $self->{'_linkinfo'} ? @{ $self->{'_linkinfo'} } : return ();
}


{
    my %VALID_DATA = ('linkinfo' => 'linkinfo',
                      'linkinfos' => 'linkinfo',
                      'urllinks' => 'urllinks');

    sub rewind {
        my ($self, $arg) = @_;
        $arg ||= 'all';
        if (exists $VALID_DATA{$arg}) {
            delete $self->{'_'.$arg.'_it'};
        } elsif ($arg eq 'all') {
            delete $self->{'_'.$_.'_it'} for values %VALID_DATA;
        }
    }
}

# private methods and handlers

{
    my %DATA_HANDLER = (
        'IdList' => \&_add_submitted_ids,
        'Id'     => \&_add_retrieved_ids,
        'LinkInfo' => \&_add_linkinfo,
        'Link'   => \&_add_retrieved_ids,
        'ObjUrl' => \&_add_objurls,
        );

sub _add_data {
    my ($self, $data) = @_;
    for my $key (qw(IdList Link Id ObjUrl LinkInfo)) {
        next if !exists $data->{$key};
        my $handler = $DATA_HANDLER{$key};
        $self->$handler($data);
        delete $data->{$key};
    }
    # map the rest
    if ($self->datatype eq 'idcheck' && exists $data->{content}) {
        %{$self->{'_id'} } = ($data->{content} => [1]);
        delete $data->{content}
    }
    map {$self->{'_'.lc $_} = $data->{$_}} keys %$data;
}

}

sub _add_submitted_ids {
    my ($self, $data) = @_;
    if (exists $data->{IdList}->{Id}) {
        @{$self->{'_submitted_ids'}} = @{$data->{IdList}->{Id}} ;
    }
}

sub _add_retrieved_ids {
    my ($self, $data) = @_;
    # map all IDs to deal with possible scores
    # ID => {'count' = POSITION, 'score' => SCORE}
    if (exists $data->{Link}) {
        my $ct = 0;
        for my $link (@{$data->{Link}}) {
            if (exists $link->{Score}) {
                $self->{'_has_scores'}++;
                $self->{'_id'}->{$link->{Id}->[0]} = [ $ct++,$link->{Score}];
            } else {
                $self->{'_id'}->{$link->{Id}->[0]} = [ $ct++ ];
            }
        }
    }
    elsif (exists $data->{Id}) { # urls
        %{$self->{'_id'} } = ($data->{Id}->[0] => [1]);
    }
}

sub _add_objurls {
    my ($self, $data) = @_;
    for my $urldata (@{$data->{ObjUrl}}) {
        $urldata->{dbfrom} = $data->{DbFrom} if exists $data->{DbFrom};
        my $obj = Bio::Tools::EUtilities::Link::UrlLink->new(-eutil => 'elink',
                                                             -datatype => 'urldata',
                                                             -verbose => $self->verbose
                                                             );
        $obj->_add_data($urldata);
        push @{$self->{'_urllinks'}}, $obj;
    }
}

sub _add_linkinfo {
    my ($self, $data) = @_;
    for my $linkinfo (@{$data->{LinkInfo}}) {
        $linkinfo->{dbfrom} = $data->{DbFrom} if exists $data->{DbFrom};
        my $obj = Bio::Tools::EUtilities::Info::LinkInfo->new(-eutil => 'elink',
                                                             -datatype => 'linkinfo',
                                                             -verbose => $self->verbose
                                                             );
        $obj->_add_data($linkinfo);
        push @{$self->{'_linkinfo'}}, $obj;
    }
}


sub to_string {
    my $self = shift;
    my $level = shift || 0;
    my $pad = 20 - $level;
    #        order     method                    name
    my %tags = (1 => ['get_databases'         => 'DB'],
                2 => ['get_ids'               => 'ID'],
                3 => ['get_link_names'        => 'Link Names'],
                5 => ['get_submitted_ids'     => 'Submitted IDs'],
                6 => ['has_scores'            => 'Scores?'],
                7 => ['has_linkout'           => 'LinkOut?'],
                8 => ['has_neighbor'          => 'DB Neighbors?'],
                9 => ['get_webenv'            => 'WebEnv'],
                10 => ['get_query_key'        => 'Key'],
                );
    my $string;
    for my $tag (sort {$a <=> $b} keys %tags) {
        my ($m, $nm) = (@{$tags{$tag}}[0..1]);
        # using this awkward little construct to deal with both lists and scalars
        my @content = grep {defined $_} $self->$m();
        next unless @content;
        $string .= $self->_text_wrap(
                 sprintf("%-*s%-*s:",$level, '',$pad, $nm,),
                 ' ' x ($pad).':',
                 join(', ',@content))."\n";
    }
    while (my $li = $self->next_LinkInfo) {
        $string .= $li->to_string(4);
    }
    while (my $ui = $self->next_UrlLink) {
        $string .= $ui->to_string(4);
    }
    if ($self->has_scores) {
        $string .= "Scores:\n";
        my %scores = $self->get_scores;
        $string .= sprintf("%-*s%-*s%s\n",
            $level + 4, '',
            $pad - 4, 'ID', 'Score'
            );
        for my $id ($self->get_ids) {
            $string .= sprintf("%-*s%-*s%s\n",
                $level + 4, '',
                $pad - 4, $id, $scores{$id}
                );
        }
    }
    $string .= "\n";
    return $string;
}

1;

__END__