view release on metacpan or  search on metacpan

lib/Bio/EnsEMBL/Utils/Cache.pm  view on Meta::CPAN

}

sub NEXTKEY {
    my($self, $lastkey) = @_;
    shift @{$self->{'keys'}};
}

sub DESTROY {
    my($self) = @_;

    # if debugging, snapshot cache before clearing
    if($self->{dbg}) {
	if($self->{hit} || $self->{miss}) {
	    $self->{hit_ratio} = 
		sprintf("%4.3f", $self->{hit} / ($self->{hit} + $self->{miss})); 
	}
	$self->print($self->pretty_self());
	if($self->{dbg} > 1) {
	    $self->print($self->pretty_chains());
	}
    }
    
    $self->print("DESTROYING") if $self->{dbg} > 1;
    $self->CLEAR();
    
    1;
}

####PERL##LRU##TIE##CACHE##PERL##LRU##TIE##CACHE##PERL##LRU##TIE##CACHE
## Helper Routines
####PERL##LRU##TIE##CACHE##PERL##LRU##TIE##CACHE##PERL##LRU##TIE##CACHE

# we use scalar_refs for the data for speed
sub create_node {
    my($self, $key, $value, $length) = @_;
    (defined($$key) && defined($$value)) 
      || die("need more localized data than $$key and $$value");
    
    # max_size always defined when max_bytes is
    if (($self->{max_size})) {
	$length = defined $length ? $length : &_get_data_length($key, $value)
    } else {
	$length = 0;
    }
    
    # ORDER SPECIFIC, see top for NODE ARRAY STRUCT
    my $node = [ $$key, $$value, $length ];
}

sub _get_data_length {
    my($key, $value) = @_;
    my $length = 0;
    my %refs;

    my @data = ($$key, $$value);
    while(my $elem = shift @data) {
	next if $refs{$elem};
	$refs{$elem} = 1;
	if(ref $elem && $elem =~ /(SCALAR|HASH|ARRAY)/) {
	    my $type = $1;
	    $length += $REF_SIZE; # guess, 16 bytes per ref, probably more
	    if (($type eq 'SCALAR')) {
		$length += length($$elem);
	    } elsif (($type eq 'HASH')) {
		while (my($k,$v) = each %$elem) {
		    for my $kv($k,$v) {
			if ((ref $kv)) {
			    push(@data, $kv);
			} else {
			    $length += length($kv);
			}
		    }
		}
	    } elsif (($type eq 'ARRAY')) {
		for my $val (@$elem){
		    if ((ref $val)) {
			push(@data, $val);
		    } else {
			$length += length($val);
		    }
		}
	    }
	} else {
	    $length += length($elem);
	}
    }

    $length;
}

sub insert {
    my($self, $new_node) = @_;
    
    $new_node->[$AFTER] = 0;
    $new_node->[$BEFORE] = $self->{tail};
    $self->print("insert() [$new_node->[$KEY], $new_node->[$VALUE]]") if ($self->{dbg} > 1);
    
    $self->{nodes}{$new_node->[$KEY]} = $new_node;

    # current sizes
    $self->{count}++;
    $self->{bytes} += $new_node->[$BYTES] + $STRUCT_SIZE;

    if($self->{tail}) {
	$self->{tail}[$AFTER] = $new_node;
    } else {
	$self->{head} = $new_node;
    }
    $self->{tail} = $new_node;

    ## if we are too big now, remove head
    while(($self->{max_count} && ($self->{count} > $self->{max_count})) ||
	  ($self->{max_bytes} && ($self->{bytes} > $self->{max_bytes}))) 
    {
	if($self->{dbg} > 1) {
	    $self->print("current/max: ".
			 "bytes ($self->{bytes}/$self->{max_bytes}) ".
			 "count ($self->{count}/$self->{max_count}) "
			 );
	}
	my $old_node = $self->delete($self->{head}[$KEY]);