File Coverage

GO/ObjCache.pm

Criterion	Covered	Total	%
statement	33	85	38.8
branch	1	10	10.0
condition	1	3	33.3
subroutine	12	18	66.6
pod	2	7	28.5
total	49	123	39.8

# $Id: ObjCache.pm,v 1.3 2005/05/20 18:46:57 cmungall Exp $
#
# This GO module is maintained by Chris Mungall
#
# see also - http://www.geneontology.org
#          - http://www.godatabase.org/dev
#
# You may distribute this module under the same terms as perl itself

package GO::ObjCache;

=head1 NAME

  GO::ObjCache;

=head1 DESCRIPTION

This is a kind of L - you should not need to use this
method directly

=cut

use Carp;
use strict;
use Exporter;
use GO::Utils qw(rearrange);
#use strict;
use FileHandle;
use Exporter;
use vars qw(@ISA);
use strict;

use base qw(GO::Model::Graph GO::ObjFactory);

sub _valid_params {
    return qw(dbh);
}

sub _initialize {
    my $self = shift;
    $self->SUPER::_initialize(@_);
}

sub apph {
    my $self = shift;
    $self->{apph} = shift if @_;
    return $self->{apph} || $self;
}

sub n_deep_associations {
    my $self = shift;
    my $acc = shift;
    $self->extend_down([$acc]);   # make sure all terms loaded
    $self->SUPER::n_deep_associations($acc);
}

sub deep_association_list {
    my $self = shift;
    my $acc = shift;
    $self->extend_down([$acc]);   # make sure all terms loaded
    $self->SUPER::deep_association_list($acc);
}

#------

sub extend_graph_by_acc {
    my $self = shift;
    my $graph = shift;
    my $acc = shift;
    my $depth = shift;

    my $term = $self->get_term($acc);
    $self->extend_up($graph, [$acc]);
    $self->extend_down($graph, [$acc], $depth);

}

sub extend_up {
    my $self = shift;
    my $graph = shift;
    my @accs = @{shift || []};
    my $i=0;
    while ($i < scalar(@accs)) {
	my $acc = $accs[$i];
	$i++;
	my $term = $self->get_term($acc);
	$graph->add_term($term);
	my $parent_rels = $self->get_parent_relationships($acc);
	foreach my $rel (@$parent_rels) {
	    $graph->add_relationship($rel);
	    if (!(grep {$_ == $rel->acc1} @accs)) {
		# only put new accs in
		push(@accs, $rel->acc1);
	    }
	}
    } @accs;
}

sub extend_down {
    my $self = shift;
    my $graph = shift;
    my @accs = @{shift || []};
    my $max_depth = shift;

    my $i=0;
    while ($i < scalar(@accs)) {
	printf STDERR
	  "======== %d %d %s\n",
	  $i,
	  $#accs,
	  join(", ", @accs);
	my $acc = $accs[$i];
	$i++;
	my $term = $self->get_term($acc);
	$graph->add_term($term);
	my $child_rels = $self->get_child_relationships($acc);
	foreach my $rel (@$child_rels) {
	    $graph->add_relationship($rel);
	    if (!(grep {$_ == $rel->acc2} @accs)) {
		# only put new accs in
		push(@accs, $rel->acc2);
	    }
	}
    } @accs;

}

sub get_deep_product_count { 0 }

1;