Author: mherger
Date: Thu Nov 10 07:17:53 2011
New Revision: 33683
URL: http://svn.slimdevices.com/slim?rev=33683&view=rev
Log:
Bug: 17734
Description: rewrite cache to use a db instead of the file system
Added:
7.7/trunk/server/Slim/Utils/DbCache.pm
Modified:
7.7/trunk/server/Slim/Utils/ArtworkCache.pm
7.7/trunk/server/Slim/Utils/Cache.pm
Modified: 7.7/trunk/server/Slim/Utils/ArtworkCache.pm
URL: http://svn.slimdevices.com/slim/7.7/trunk/server/Slim/Utils/ArtworkCache.pm?rev=33683&r1=33682&r2=33683&view=diff
==============================================================================
--- 7.7/trunk/server/Slim/Utils/ArtworkCache.pm (original)
+++ 7.7/trunk/server/Slim/Utils/ArtworkCache.pm Thu Nov 10 07:17:53 2011
@@ -8,11 +8,6 @@
use strict;
-use DBD::SQLite;
-use Digest::MD5 ();
-use File::Spec::Functions qw(catfile);
-use Time::HiRes ();
-
my $singleton;
sub new {
@@ -20,49 +15,45 @@
my $root = shift;
if ( !$singleton ) {
- if ( !defined $root ) {
- require Slim::Utils::Prefs;
- $root = Slim::Utils::Prefs::preferences('server')->get('librarycachedir');
-
- # Update root value if librarycachedir changes
- Slim::Utils::Prefs::preferences('server')->setChange( sub {
- $singleton->wipe;
- $singleton->setRoot( $_[1] );
- $singleton->_init_db;
- }, 'librarycachedir' );
- }
-
- $singleton = bless { root => $root }, $class;
+ $singleton = Slim::Utils::DbArtworkCache->new($root);
}
return $singleton;
}
-sub getRoot {
- return shift->{root};
-}
+1;
-sub setRoot {
- my ( $self, $root ) = @_;
+package Slim::Utils::DbArtworkCache;
+
+use base 'Slim::Utils::DbCache';
+use File::Spec::Functions qw(catfile);
+
+sub new {
+ my $self = shift;
+ my $root = shift;
+
+ if ( !defined $root ) {
+ require Slim::Utils::Prefs;
+ # the artwork cache needs to be in the same place as the library data for TinyLMS
+ $root = Slim::Utils::Prefs::preferences('server')->get('librarycachedir');
+
+ # Update root value if librarycachedir changes
+ Slim::Utils::Prefs::preferences('server')->setChange( sub {
+ $self->wipe;
+ $self->setRoot( $_[1] );
+ $self->_init_db;
+ }, 'librarycachedir' );
+ }
- $self->{root} = $root;
-}
-
-sub wipe {
- my $self = shift;
-
- if ( $self->{dbh} ) {
- $self->{dbh}->do('DELETE FROM cache'); # truncate
- $self->_close_db;
- }
+ return $self->SUPER::new({
+ namespace => 'artwork',
+ noexpiry => 1,
+ root => $root
+ });
}
sub set {
my ( $self, $key, $data ) = @_;
-
- if ( !$self->{dbh} ) {
- $self->_init_db;
- }
# packed data is stored as follows:
# 3 bytes type (jpg/png/gif)
@@ -83,16 +74,7 @@
# Prepend the packed header to the original data
substr $$ref, 0, 0, $packed;
- # Get a 60-bit unsigned int from MD5 (SQLite uses 64-bit signed ints for the key)
- # Have to concat 2 values here so it works on a 32-bit machine
- my $md5 = Digest::MD5::md5_hex($key);
- my $id = hex( substr($md5, 0, 8) ) . hex( substr($md5, 8, 7) );
-
- # Insert or replace the value
- my $set = $self->{set_sth};
- $set->bind_param( 1, $id );
- $set->bind_param( 2, $$ref, DBI::SQL_BLOB );
- $set->execute;
+ $self->SUPER::set($key, $$ref);
# Remove the packed header
substr $$ref, 0, length($packed), '';
@@ -101,19 +83,7 @@
sub get {
my ( $self, $key ) = @_;
- if ( !$self->{dbh} ) {
- $self->_init_db;
- }
-
- # Get a 60-bit unsigned int from MD5 (SQLite uses 64-bit signed ints for the key)
- # Have to concat 2 values here so it works on a 32-bit machine
- my $md5 = Digest::MD5::md5_hex($key);
- my $id = hex( substr($md5, 0, 8) ) . hex( substr($md5, 8, 7) );
-
- my $get = $self->{get_sth};
- $get->execute($id);
-
- my ($buf) = $get->fetchrow_array;
+ my $buf = $self->SUPER::get($key);
return unless defined $buf;
@@ -129,30 +99,11 @@
};
}
-sub pragma {
- my ( $self, $pragma ) = @_;
-
- my $dbh = $self->{dbh} || $self->_init_db;
-
- $dbh->do("PRAGMA $pragma");
-
- if ( $pragma =~ /locking_mode/ ) {
- # if changing the locking_mode we need to run a statement to change the lock
- $dbh->do('SELECT 1 FROM cache LIMIT 1');
- }
-}
-
-sub close {
- my $self = shift;
-
- $self->_close_db;
-}
-
sub _init_db {
- my $self = shift;
+ my $self = shift;
my $retry = shift;
- my $dbfile = catfile( $self->{root}, 'artwork.db' );
+ my $dbfile = $self->_get_dbfile;
my $oldDBfile = catfile( $self->{root}, 'ArtworkCache.db' );
if (!-f $dbfile && -r $oldDBfile) {
@@ -163,58 +114,7 @@
}
}
- my $dbh;
-
- eval {
- $dbh = DBI->connect( "dbi:SQLite:dbname=$dbfile", '', '', {
- AutoCommit => 1,
- PrintError => 0,
- RaiseError => 1,
- sqlite_use_immediate_transaction => 1,
- } );
-
- $dbh->do('PRAGMA synchronous = OFF');
- $dbh->do('PRAGMA journal_mode = WAL');
- $dbh->do('PRAGMA wal_autocheckpoint = 200');
-
- # Create the table, note that using an integer primary key
- # is much faster than any other kind of key, such as a char
- # because it doesn't have to create an index
- $dbh->do('CREATE TABLE IF NOT EXISTS cache (k INTEGER PRIMARY KEY, v BLOB)');
- };
-
- if ( $@ ) {
- if ( $retry ) {
- # Give up after 2 tries
- die "Unable to read/create $dbfile\n";
- }
-
- # Something was wrong with the database, delete it and try again
- $self->wipe;
-
- return $self->_init_db(1);
- }
-
- # Prepare statements we need
- $self->{set_sth} = $dbh->prepare('INSERT OR REPLACE INTO cache (k, v) VALUES (?, ?)');
- $self->{get_sth} = $dbh->prepare('SELECT v FROM cache WHERE k = ?');
-
- $self->{dbh} = $dbh;
-
- return $dbh;
-}
-
-sub _close_db {
- my $self = shift;
-
- if ( $self->{dbh} ) {
- $self->{set_sth}->finish;
- $self->{get_sth}->finish;
-
- $self->{dbh}->disconnect;
-
- delete $self->{$_} for qw(set_sth get_sth dbh);
- }
+ return $self->SUPER::_init_db($retry);
}
1;
Modified: 7.7/trunk/server/Slim/Utils/Cache.pm
URL: http://svn.slimdevices.com/slim/7.7/trunk/server/Slim/Utils/Cache.pm?rev=33683&r1=33682&r2=33683&view=diff
==============================================================================
--- 7.7/trunk/server/Slim/Utils/Cache.pm (original)
+++ 7.7/trunk/server/Slim/Utils/Cache.pm Thu Nov 10 07:17:53 2011
@@ -24,7 +24,7 @@
=head1 DESCRIPTION
-A simple cache for arbitrary data using L<Cache::FileCache>.
+A simple cache for arbitrary data using SQLite, providing an interface similar to Cache::Cache
=head1 METHODS
@@ -40,32 +40,25 @@
=head1 SEE ALSO
-L<Cache::Cache> and L<Cache::FileCache>.
+L<Cache::Cache>.
=cut
use strict;
-use Cache::FileCache ();
-
+use Slim::Utils::DbCache;
use Slim::Utils::Log;
-use Slim::Utils::Misc;
use Slim::Utils::Prefs;
-my $DEFAULT_EXPIRES_TIME = '1 hour';
-
-my $PURGE_INTERVAL = 60 * 60 * 24; # interval between purge cycles
-my $PURGE_RETRY = 60 * 60; # retry time if players are on
-my $PURGE_NEXT = 30; # purge next namespace
-
-my $defaultNameSpace = 'FileCache';
-my $defaultVersion = 1;
+use constant PURGE_INTERVAL => 3600 * 8; # interval between purge cycles
+use constant PURGE_RETRY => 3600; # retry time if players are on
+use constant PURGE_NEXT => 30; # purge next namespace
+
+use constant DEFAULT_NAMESPACE => 'cache';
+use constant DEFAULT_VERSION => 1;
# hash of caches which we have created by namespace
my %caches = ();
-
-# hash of roots to use for caches
-my %nameSpaceRoot;
my @thisCycle = (); # namespaces to be purged this purge cycle
my @eachCycle = (); # namespaces to be purged every PURGE_INTERVAL
@@ -77,8 +70,9 @@
# create proxy methods
{
my @methods = qw(
- get set get_object set_object
- clear purge remove size
+ get set
+ # get_object set_object size
+ clear purge remove
);
no strict 'refs';
@@ -102,7 +96,7 @@
# "If value is less than 60*60*24*30 (30 days), time is assumed to be
# relative from the present. If larger, it's considered an absolute Unix time."
- if ( $expire > 2592000 ) {
+ if ( $expire < 2592000 ) {
$expire += time();
}
}
@@ -118,7 +112,6 @@
}
}
-
sub init {
my $class = shift;
@@ -137,7 +130,7 @@
sub new {
my $class = shift;
- my $namespace = shift || $defaultNameSpace;
+ my $namespace = shift || DEFAULT_NAMESPACE;
# return existing instance if exists for this namespace
return $caches{$namespace} if $caches{$namespace};
@@ -145,8 +138,8 @@
# otherwise create new cache object taking acount of additional params
my ($version, $noPeriodicPurge);
- if ($namespace eq $defaultNameSpace) {
- $version = $defaultVersion;
+ if ($namespace eq DEFAULT_NAMESPACE) {
+ $version = DEFAULT_VERSION;
} else {
$version = shift || 0;
$noPeriodicPurge = shift;
@@ -161,12 +154,20 @@
return $caches{$namespace};
}
- my $cache = Cache::FileCache->new( {
- namespace => $namespace,
- default_expires_in => $DEFAULT_EXPIRES_TIME,
- cache_root => ($nameSpaceRoot{$namespace} || preferences('server')->get('cachedir')),
- directory_umask => umask(),
+ my $prefs = preferences('server');
+
+ my $cache = Slim::Utils::DbCache->new( {
+ namespace => $namespace,
} );
+
+ # Increase cache size when using dbhighmem, and reduce it to 300K otherwise
+ if ( $prefs->get('dbhighmem') ) {
+ $cache->pragma('cache_size = 20000');
+ $cache->pragma('temp_store = MEMORY');
+ }
+ else {
+ $cache->pragma('cache_size = 300');
+ }
my $self = bless {
_cache => $cache,
@@ -179,7 +180,7 @@
main::INFOLOG && $log->info("Version changed for cache: $namespace - clearing out old entries");
$self->clear();
- $self->set('Slim::Utils::Cache-version', $version, 'never');
+ $self->set('Slim::Utils::Cache-version', $version, -1);
}
@@ -196,12 +197,12 @@
# NB Purging is expensive and blocks the server
#
# namespaces with $noPeriodicPurge set are only purged at server startup
- # others are purged at max once per $PURGE_INTERVAL.
+ # others are purged at max once per PURGE_INTERVAL.
#
# To allow disks to spin down, each namespace is purged within a short period
- # and then no purging is done for $PURGE_INTERVAL
+ # and then no purging is done for PURGE_INTERVAL
#
- # After the startup purge, if any players are on it reschedules in $PURGE_RETRY
+ # After the startup purge, if any players are on it reschedules in PURGE_RETRY
my $namespace; # namespace to purge this call
my $interval; # interval to next call
@@ -215,7 +216,7 @@
if ($client->power()) {
unshift @thisCycle, $namespace;
$namespace = undef;
- $interval = $PURGE_RETRY;
+ $interval = PURGE_RETRY;
last;
}
}
@@ -223,45 +224,31 @@
unless ($interval) {
if (@thisCycle) {
- $interval = $startUpPurge ? 0.1 : $PURGE_NEXT;
+ $interval = $startUpPurge ? 0.1 : PURGE_NEXT;
} else {
- $interval = $PURGE_INTERVAL;
+ $interval = PURGE_INTERVAL;
+ push @thisCycle, @eachCycle;
+
+ # always run one purging task at startup
+ $namespace ||= shift @thisCycle if $startUpPurge;
$startUpPurge = 0;
- push @thisCycle, @eachCycle;
}
}
- my $now = Time::HiRes::time();
+ my $now = time();
if ($namespace && $caches{$namespace}) {
my $cache = $caches{$namespace};
my $lastpurge = $cache->get('Slim::Utils::Cache-purgetime');
- unless ($lastpurge && ($now - $lastpurge) < $PURGE_INTERVAL) {
+ unless ($lastpurge && ($now - $lastpurge) < PURGE_INTERVAL) {
my $start = $now;
- if ( !main::ISWINDOWS && !Slim::Utils::OSDetect::isSqueezeOS() ) {
- # Fork a child to purge the cache, as it's a slow operation
- if ( my $pid = fork ) {
- # parent
- }
- else {
- # child
- $cache->purge;
-
- # Skip END processing
- $main::daemon = 1;
-
- exit;
- }
- }
- else {
- $cache->purge;
- }
-
- $cache->set('Slim::Utils::Cache-purgetime', $start, 'never');
- $now = Time::HiRes::time();
+ $cache->purge;
+
+ $cache->set('Slim::Utils::Cache-purgetime', $start, '-1');
+ $now = time();
if ( main::INFOLOG && $log->is_info ) {
$log->info(sprintf("Cache purge: $namespace - %f sec", $now - $start));
}
Added: 7.7/trunk/server/Slim/Utils/DbCache.pm
URL: http://svn.slimdevices.com/slim/7.7/trunk/server/Slim/Utils/DbCache.pm?rev=33683&view=auto
==============================================================================
--- 7.7/trunk/server/Slim/Utils/DbCache.pm (added)
+++ 7.7/trunk/server/Slim/Utils/DbCache.pm Thu Nov 10 07:17:53 2011
@@ -1,0 +1,257 @@
+package Slim::Utils::DbCache;
+
+# Lightweight, efficient, and fast cache
+#
+# This class is roughly 9x faster for get, and 12x faster for set than using Cache::FileCache.
+# Using a SQLite database also makes it much faster to remove the cache.
+
+use strict;
+
+use Cache::BaseCache;
+use DBD::SQLite;
+use Digest::MD5 ();
+use File::Spec::Functions qw(catfile);
+use Storable qw(freeze thaw);
+
+use constant DEFAULT_EXPIRES_TIME => 60 * 60;
+
+sub new {
+ my ( $self, $args ) = @_;
+
+ return unless $args->{namespace};
+
+ if ( !defined $args->{root} ) {
+ require Slim::Utils::Prefs;
+ $args->{root} = Slim::Utils::Prefs::preferences('server')->get('cachedir');
+
+ # Update root value if librarycachedir changes
+ Slim::Utils::Prefs::preferences('server')->setChange( sub {
+ $self->wipe;
+ $self->setRoot( $_[1] );
+ $self->_init_db;
+ }, 'cachedir' );
+ }
+
+ $args->{default_expires_in} ||= DEFAULT_EXPIRES_TIME;
+
+ return bless $args, $self;
+}
+
+sub getRoot {
+ return shift->{root};
+}
+
+sub setRoot {
+ my ( $self, $root ) = @_;
+
+ $self->{root} = $root;
+}
+
+sub wipe {
+ my $self = shift;
+
+ if ( $self->{dbh} ) {
+ $self->{dbh}->do('DELETE FROM cache'); # truncate
+ $self->_close_db;
+ }
+}
+*clear = \&wipe;
+
+sub set {
+ my ( $self, $key, $data, $expiry ) = @_;
+
+ if ( !$self->{dbh} ) {
+ $self->_init_db;
+ }
+
+ $expiry = defined $expiry ? _canonicalize_expiration_time($expiry) : $self->{default_expires_in};
+
+ my $id = _key($key);
+
+ if (ref $data) {
+ $data = freeze( $data );
+ }
+
+ # Insert or replace the value
+ my $set = $self->{set_sth};
+ $set->bind_param( 1, $id );
+ $set->bind_param( 2, $data, DBI::SQL_BLOB );
+ $set->bind_param( 3, $expiry ) unless $self->{noexpiry};
+ $set->execute;
+}
+
+sub get {
+ my ( $self, $key ) = @_;
+
+ if ( !$self->{dbh} ) {
+ $self->_init_db;
+ }
+
+ my $id = _key($key);
+
+ my $get = $self->{get_sth};
+ $get->execute($id);
+
+ my ($data, $expiry) = $get->fetchrow_array;
+
+ if ($expiry && !$self->{noexpiry} && $expiry >= 0 && $expiry < time()) {
+ $data = undef;
+# $self->{delete_sth}->execute($id);
+ }
+
+ eval {
+ $data = thaw($data);
+ } if $data;
+
+ return $data;
+}
+
+sub remove {
+ my ( $self, $key ) = @_;
+
+ if ( !$self->{dbh} ) {
+ $self->_init_db;
+ }
+
+ my $id = _key($key);
+ $self->{delete_sth}->execute($id);
+}
+
+sub purge {
+ my ( $self ) = @_;
+
+ my $dbh = $self->{dbh} || $self->_init_db;
+
+ $dbh->do('DELETE FROM cache WHERE t >= 0 AND t < ' . time());
+}
+
+sub _key {
+ my ( $key ) = @_;
+
+ # Get a 60-bit unsigned int from MD5 (SQLite uses 64-bit signed ints for the key)
+ # Have to concat 2 values here so it works on a 32-bit machine
+ my $md5 = Digest::MD5::md5_hex($key);
+ return hex( substr($md5, 0, 8) ) . hex( substr($md5, 8, 7) );
+}
+
+sub pragma {
+ my ( $self, $pragma ) = @_;
+
+ my $dbh = $self->{dbh} || $self->_init_db;
+
+ $dbh->do("PRAGMA $pragma");
+
+ if ( $pragma =~ /locking_mode/ ) {
+ # if changing the locking_mode we need to run a statement to change the lock
+ $dbh->do('SELECT 1 FROM cache LIMIT 1');
+ }
+}
+
+sub close {
+ my $self = shift;
+
+ $self->_close_db;
+}
+
+sub _canonicalize_expiration_time {
+ my ( $expiry ) = @_;
+
+ if ( $expiry && $expiry !~ /^[\-]*\d+$/ ) {
+ #Slim::Utils::Log::logBacktrace($expiry);
+
+ # Not a number, need to canonicalize it
+ $expiry = Cache::BaseCache::Canonicalize_Expiration_Time($expiry);
+ }
+
+ # "If value is less than 60*60*24*30 (30 days), time is assumed to be
+ # relative from the present. If larger, it's considered an absolute Unix time."
+ if ( $expiry < 2592000 ) {
+ $expiry += time();
+ }
+
+ return $expiry;
+}
+
+
+sub _get_dbfile {
+ my $self = shift;
+
+ # XXX - namespace should not be longer than 8 characters on Windows, as it was causing DB corruption
+ return catfile( $self->{root}, $self->{namespace} . '.db' );
+}
+
+sub _init_db {
+ my $self = shift;
+ my $retry = shift;
+
+ my $dbfile = $self->_get_dbfile;
+
+ my $dbh;
+
+ eval {
+ $dbh = DBI->connect( "dbi:SQLite:dbname=$dbfile", '', '', {
+ AutoCommit => 1,
+ PrintError => 0,
+ RaiseError => 1,
+ sqlite_use_immediate_transaction => 1,
+ } );
+
+ $dbh->do('PRAGMA synchronous = OFF');
+ $dbh->do('PRAGMA journal_mode = WAL');
+ $dbh->do('PRAGMA wal_autocheckpoint = 200');
+
+ # Create the table, note that using an integer primary key
+ # is much faster than any other kind of key, such as a char
+ # because it doesn't have to create an index
+ if ($self->{noexpiry}) {
+ $dbh->do('CREATE TABLE IF NOT EXISTS cache (k INTEGER PRIMARY KEY, v BLOB)');
+ }
+ else {
+ $dbh->do('CREATE TABLE IF NOT EXISTS cache (k INTEGER PRIMARY KEY, v BLOB, t INTEGER)');
+ $dbh->do('CREATE INDEX IF NOT EXISTS expiry ON cache (t)');
+ }
+ };
+
+ if ( $@ ) {
+ if ( $retry ) {
+ # Give up after 2 tries
+ die "Unable to read/create $dbfile\n";
+ }
+
+ # Something was wrong with the database, delete it and try again
+ $self->wipe;
+
+ return $self->_init_db(1);
+ }
+
+ # Prepare statements we need
+ if ($self->{noexpiry}) {
+ $self->{set_sth} = $dbh->prepare('INSERT OR REPLACE INTO cache (k, v) VALUES (?, ?)');
+ $self->{get_sth} = $dbh->prepare('SELECT v FROM cache WHERE k = ?');
+ }
+ else {
+ $self->{set_sth} = $dbh->prepare('INSERT OR REPLACE INTO cache (k, v, t) VALUES (?, ?, ?)');
+ $self->{get_sth} = $dbh->prepare('SELECT v, t FROM cache WHERE k = ?');
+ }
+ $self->{delete_sth} = $dbh->prepare('DELETE FROM cache WHERE k = ?');
+
+ $self->{dbh} = $dbh;
+
+ return $dbh;
+}
+
+sub _close_db {
+ my $self = shift;
+
+ if ( $self->{dbh} ) {
+ $self->{set_sth}->finish;
+ $self->{get_sth}->finish;
+ $self->{delete_sth}->finish;
+
+ $self->{dbh}->disconnect;
+
+ delete $self->{$_} for qw(set_sth get_sth dbh);
+ }
+}
+
+1;
lmpx.com only provides a reader for public news (NNTP) servers. It is not
affiliated with the servers or forums shown here and is not responsible for
the content of articles, which is written by their respective authors.