Index: ArtworkCache.pm
===================================================================
--- ArtworkCache.pm	(revision 33670)
+++ ArtworkCache.pm	(working copy)
@@ -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,50 +15,33 @@
 	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 ) = @_;
-	
-	$self->{root} = $root;
-}
+package Slim::Utils::DbArtworkCache;
+
+use base 'Slim::Utils::DbCache';
+use File::Spec::Functions qw(catfile);
 
-sub wipe {
+sub new {
 	my $self = shift;
+	my $root  = 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)
 	# 32-bit mtime
@@ -83,16 +61,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 +70,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 +86,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 +101,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;
Index: Cache.pm
===================================================================
--- Cache.pm	(revision 33670)
+++ Cache.pm	(working copy)
@@ -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,26 +40,23 @@
 
 =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';
+use constant DEFAULT_EXPIRES_TIME => 60 * 60;
+use constant PURGE_INTERVAL       => 60 * 60 * 8;  # interval between purge cycles
+use constant PURGE_RETRY          => 60 * 60;      # retry time if players are on
+use constant PURGE_NEXT           => 30;           # purge next namespace
 
-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 DEFAULT_NAMESPACE    => 'filecache';
+use constant DEFAULT_VERSION      => 1;
 
 # hash of caches which we have created by namespace
 my %caches = ();
@@ -72,13 +69,14 @@
 
 my $startUpPurge = 1; # Flag for purging at startup
 
-my $log = logger('server');
+my $log = logger('server.cache');
 
 # 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 +100,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 +116,6 @@
 	}
 }
 
-
 sub init {
 	my $class = shift;
 
@@ -137,7 +134,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 +142,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,11 +158,10 @@
 		return $caches{$namespace};
 	}
 
-	my $cache = Cache::FileCache->new( {
+	my $cache = Slim::Utils::DbCache->new( {
 		namespace          => $namespace,
-		default_expires_in => $DEFAULT_EXPIRES_TIME,
-		cache_root         => ($nameSpaceRoot{$namespace} || preferences('server')->get('cachedir')),
-		directory_umask    => umask(),
+		default_expires_in => DEFAULT_EXPIRES_TIME,
+		root               => ($nameSpaceRoot{$namespace} || preferences('server')->get('cachedir')),
 	} );
 	
 	my $self = bless {
@@ -179,7 +175,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 +192,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 +211,7 @@
 			if ($client->power()) {
 				unshift @thisCycle, $namespace;
 				$namespace = undef;
-				$interval = $PURGE_RETRY;
+				$interval = PURGE_RETRY;
 				last;
 			}
 		}
@@ -223,45 +219,32 @@
 
 	unless ($interval) {
 		if (@thisCycle) {
-			$interval = $startUpPurge ? 0.1 : $PURGE_NEXT;
+			$interval = $startUpPurge ? 0.1 : PURGE_NEXT;
 		} else {
-			$interval = $PURGE_INTERVAL;
-			$startUpPurge = 0;
+			$interval = PURGE_INTERVAL;
 			push @thisCycle, @eachCycle;
+			
+			# always run one purging task at startup
+			$namespace ||= shift @thisCycle if $startUpPurge;
+			$startUpPurge = 0;
 		}
 	}
 	
-	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->purge;
 			
-			$cache->set('Slim::Utils::Cache-purgetime', $start, 'never');
-			$now = Time::HiRes::time();
+			$cache->set('Slim::Utils::Cache-purgetime', $start, time());
+
+			$now = time();
 			if ( main::INFOLOG && $log->is_info ) {
 				$log->info(sprintf("Cache purge: $namespace - %f sec", $now - $start));
 			}
Index: DbCache.pm
===================================================================
--- DbCache.pm	(revision 0)
+++ DbCache.pm	(revision 0)
@@ -0,0 +1,253 @@
+package Slim::Utils::DbCache;
+
+# Lightweight, efficient, and fast file cache for artwork.
+#
+# This class is roughly 9x faster for get, and 12x faster for set than using Cache::FileCache
+# which imposes too much overhead for our artwork needs.  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);
+
+sub new {
+	my ( $self, $args ) = @_;
+
+	if ( !defined $args->{root} ) {
+		require Slim::Utils::Prefs;
+		$args->{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' );
+	}
+	
+	$args->{default_expires_in} ||= 60 * 60;
+	
+	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;
+	
+	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;