Code cleanup. Remove unused module.
Patch by kareila.
diffs (298 lines):
diff -r 276a9e18856e -r c65fc2c8f8f5 cgi-bin/LJ/Cache.pm
--- a/cgi-bin/LJ/Cache.pm Wed Jun 02 10:50:41 2010 +0800
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,294 +0,0 @@
-#!/usr/bin/perl
-# This code was forked from the LiveJournal project owned and operated
-# by Live Journal, Inc. The code has been modified and expanded by
-# Dreamwidth Studios, LLC.
-#
-# LJ::Cache class
-# See perldoc documentation at the end of this file.
-#
-# -------------------------------------------------------------------------
-#
-# This package is released under the LGPL (GNU Library General Public License)
-#
-# A copy of the license has been included with the software as LGPL.txt.
-# If not, the license is available at:
-# http://www.gnu.org/copyleft/library.txt
-#
-# -------------------------------------------------------------------------
-#
-
-package LJ::Cache;
-
-use strict;
-use fields qw(items size tail head bytes maxsize maxbytes);
-
-use vars qw($VERSION);
-use constant PREVKEY => 0;
-use constant VALUE => 1;
-use constant NEXTKEY => 2;
-use constant BYTES => 3;
-use constant INSTIME => 4;
-use constant FLAGS => 5; # caller-defined metadata
-
-$VERSION = '1.0';
-
-sub new {
- my ($class, $args) = @_;
- my $self = fields::new($class);
-
- $self->init($args);
- return $self;
-}
-
-sub walk_items {
- my LJ::Cache $self = shift;
- my $code = shift;
-
- my $iter = $self->{'head'};
- while ($iter) {
- my $it = $self->{'items'}->{$iter};
- $code->($iter, $it->[BYTES], $it->[INSTIME]);
- $iter = $it->[NEXTKEY];
- }
-}
-
-sub init {
- my LJ::Cache $self = shift;
- my $args = shift;
-
- $self->{'head'} = 0;
- $self->{'tail'} = 0;
- $self->{'items'} = {}; # key -> arrayref, indexed by constants above
- $self->{'size'} = 0;
- $self->{'bytes'} = 0;
- $self->{'maxsize'} = $args->{'maxsize'}+0;
- $self->{'maxbytes'} = $args->{'maxbytes'}+0;
-}
-
-sub get_item_count {
- my LJ::Cache $self = shift;
- $self->{'size'};
-}
-
-sub get_byte_count {
- my LJ::Cache $self = shift;
- $self->{'bytes'};
-}
-
-sub get_max_age {
- my LJ::Cache $self = shift;
- return undef unless $self->{'tail'};
- return $self->{'items'}->{$self->{'tail'}}->[INSTIME];
-}
-
-sub validate_list
-{
- my ($self, $source) = @_;
- print "Validate list: $self->{'size'} (max: $self->{'maxsize'})\n";
-
- my $count = 1;
- if ($self->{'size'} && ! defined $self->{'head'}) {
- die "$source: no head pointer\n";
- }
- if ($self->{'size'} && ! defined $self->{'tail'}) {
- die "$source: no tail pointer\n";
- }
- if ($self->{'size'}) {
- print " head: $self->{'head'}\n";
- print " tail: $self->{'tail'}\n";
- }
-
- my $iter = $self->{'head'};
- my $last = undef;
- while ($count <= $self->{'size'}) {
- if (! defined $iter) {
- die "$source: undefined iterator\n";
- }
- my $item = $self->{'items'}->{$iter};
- unless (defined $item) {
- die "$source: item '$iter' isn't in items\n";
- }
- my $prevtext = $item->[PREVKEY] || "--";
- my $nexttext = $item->[NEXTKEY] || "--";
- print " #$count ($iter): [$prevtext, $item->[VALUE], $nexttext]\n";
- if ($count == 1 && defined($item->[0])) {
- die "$source: Head element shouldn't have previous pointer!\n";
- }
- if ($count == $self->{'size'} && defined($item->[NEXTKEY])) {
- die "$source: Last element shouldn't have next pointer!\n";
- }
- if (defined $last && ! defined $item->[PREVKEY]) {
- die "$source: defined \$last but not defined previous pointer.\n";
- }
- if (! defined $last && defined $item->[PREVKEY]) {
- die "$source: not defined \$last but previous pointer defined.\n";
- }
- if (defined $item->[PREVKEY] && defined $last && $item->[PREVKEY] ne
$last)
- {
- die "$source: Previous pointer is wrong.\n";
- }
-
- $last = $iter;
- $iter = defined $item->[NEXTKEY] ? $item->[NEXTKEY] : undef;
- $count++;
- }
-}
-
-sub drop_tail
-{
- my LJ::Cache $self = shift;
-
- ## who's going to die?
- my $to_die = $self->{'tail'};
-
- ## set the tail to the item before the one dying.
- $self->{'tail'} = $self->{'items'}->{$to_die}->[PREVKEY];
-
- ## adjust the forward pointer on the tail to be undef
- if (defined $self->{'tail'}) {
- undef $self->{'items'}->{$self->{'tail'}}->[NEXTKEY];
- }
-
- ## kill the item
- my $bytes = $self->{'items'}->{$to_die}->[BYTES];
- delete $self->{'items'}->{$to_die};
-
- ## shrink the overall size
- $self->{'size'}--;
- $self->{'bytes'} -= $bytes;
-}
-
-sub print_list {
- my LJ::Cache $self = shift;
-
- print "Size: $self->{'size'} (max: $self->{'maxsize'})\n";
-
- my $count = 1;
- my $iter = $self->{'head'};
- while (defined $iter) { #$count <= $self->{'size'}) {
- my $item = $self->{'items'}->{$iter};
- print "$count: $iter = $item->[VALUE]\n";
- $iter = $item->[NEXTKEY];
- $count++;
- }
-}
-
-sub get {
- my LJ::Cache $self = shift;
- my ($key, $out_flags) = @_;
-
- if (exists $self->{'items'}->{$key})
- {
- my $item = $self->{'items'}->{$key};
-
- # promote this to the head
- unless ($self->{'head'} eq $key)
- {
- if ($self->{'tail'} eq $key) {
- $self->{'tail'} = $item->[PREVKEY];
- }
- # remove this element from the linked list.
- my $next = $item->[NEXTKEY];
- my $prev = $item->[PREVKEY];
- if (defined $next) { $self->{'items'}->{$next}->[PREVKEY] = $prev; }
- if (defined $prev) { $self->{'items'}->{$prev}->[NEXTKEY] = $next; }
-
- # make current head point backwards to this item
- $self->{'items'}->{$self->{'head'}}->[PREVKEY] = $key;
-
- # make this item point forwards to current head, and backwards
nowhere
- $item->[NEXTKEY] = $self->{'head'};
- undef $item->[PREVKEY];
-
- # make this the new head
- $self->{'head'} = $key;
- }
-
- $$out_flags = $item->[FLAGS] if $out_flags;
- return $item->[VALUE];
- }
- return undef;
-}
-
-# bytes is optional
-sub set {
- my LJ::Cache $self = shift;
- my ($key, $value, $bytes, $flags) = @_;
-
- $self->drop_tail() while ($self->{'maxsize'} &&
- $self->{'size'} >= $self->{'maxsize'} &&
- ! exists $self->{'items'}->{$key}) ||
- ($self->{'maxbytes'} && $self->{'size'} &&
- $self->{'bytes'} + $bytes >=
$self->{'maxbytes'} &&
- ! exists $self->{'items'}->{$key});
-
-
- if (exists $self->{'items'}->{$key}) {
- # update the value
- my $it = $self->{'items'}->{$key};
- $it->[VALUE] = $value;
- my $bytedelta = $bytes - $it->[BYTES];
- $self->{'bytes'} += $bytedelta;
- $it->[BYTES] = $bytes;
- $it->[FLAGS] = $flags;
- } else {
- # stick it at the end, for now
- my $it = $self->{'items'}->{$key} = [];
- $it->[PREVKEY] = undef;
- $it->[NEXTKEY] = undef;
- $it->[VALUE] = $value;
- $it->[BYTES] = $bytes;
- $it->[INSTIME] = time();
- $it->[FLAGS] = $flags;
- if ($self->{'size'}) {
- $self->{'items'}->{$self->{'tail'}}->[NEXTKEY] = $key;
- $self->{'items'}->{$key}->[PREVKEY] = $self->{'tail'};
- } else {
- $self->{'head'} = $key;
- }
- $self->{'tail'} = $key;
- $self->{'size'}++;
- $self->{'bytes'} += $bytes;
- }
-
- # this will promote it to the top:
- $self->get($key);
-}
-
-1;
-__END__
-
-=head1 NAME
-
-LJ::Cache - LRU Cache
-
-=head1 SYNOPSIS
-
- use LJ::Cache;
- my $cache = new LJ::Cache { 'maxsize' => 20 };
- my $value = $cache->get($key);
- unless (defined $value) {
- $val = "load some value";
- $cache->set($key, $value);
- }
-
-=head1 DESCRIPTION
-
-This class implements an LRU dictionary cache. The two operations on it
-are get() and set(), both of which promote the key being referenced to
-the "top" of the cache, so it will stay alive longest.
-
-When the cache is full and and a new item needs to be added, the oldest
-one is thrown away.
-
-You should be able to regenerate the data at any time, if get()
-returns undef.
-
-This class is useful for caching information from a slower data source
-while also keeping a bound on memory usage.
-
-=head1 AUTHOR
-
-Brad Fitzpatrick, [email protected]
-
-=cut
_______________________________________________
dw-changelog mailing list
[email protected]
http://lists.dwscoalition.org/mailman/listinfo/dw-changelog
