added .create_expirable interface. accepts a Utils style interval, and sweeps at...

git-svn-id: svn://svn.open-ils.org/OpenSRF/trunk@102 9efc2488-bf62-4759-914b-345cdb29e865

diff --git a/src/perlmods/OpenSRF/Application/Persist.pm b/src/perlmods/OpenSRF/Application/Persist.pm
index cc4c092..aca73d9 100644 (file)
--- a/src/perlmods/OpenSRF/Application/Persist.pm
+++ b/src/perlmods/OpenSRF/Application/Persist.pm
@@ -4,11 +4,12 @@ use OpenSRF::Application;
 
 use OpenSRF::Utils::SettingsClient;
 use OpenSRF::EX qw/:try/;
+use OpenSRF::Utils qw/:common/;
 use OpenSRF::Utils::Logger;
 use JSON;
 use DBI;
 
-use vars qw/$dbh $sc $log/;
+use vars qw/$dbh $log $default_expire_time/;
 
 sub initialize {
        $log = 'OpenSRF::Utils::Logger';
@@ -39,10 +40,21 @@ sub initialize {
                );
        SQL
 
+       $init_dbh->do( <<"      SQL" );
+               CREATE TABLE store_expire (
+                       id              INTEGER PRIMARY KEY,
+                       atime           INTEGER,
+                       expire_interval INTEGER
+               );
+       SQL
+
 }
 
 sub child_init {
-       $sc = OpenSRF::Utils::SettingsClient->new;
+       my $sc = OpenSRF::Utils::SettingsClient->new;
+
+       $default_expire_time = $sc->config_value( apps => persist => app_settings => 'default_expire_time' );
+       $default_expire_time ||= 300;
 
        my $dbfile = $sc->config_value( apps => persist => app_settings => 'dbfile');
        unless ($dbfile) {
@@ -88,10 +100,58 @@ sub create_store {
 __PACKAGE__->register_method(
        api_name => 'opensrf.persist.slot.create',
        method => 'create_store',
+       argc => 1,
+);
+
+
+sub create_expirable_store {
+       my $self = shift;
+       my $client = shift;
+       my $name = shift || do { throw OpenSRF::EX::InvalidArg ("Expirable slots must be given a name!") };
+       my $time = shift || $default_expire_time;
+
+       try {
+               __PACKAGE__->method_lookup( 'opensrf.persist.slot.create' )->run( $name );
+       } catch Error with {
+               my $e = shift;
+               if ($e->message =~ /^Duplicate key/o) {
+                       throw $e;
+               }
+       };
+
+       my $name_id = _get_name_id($name);
+       my $atime = time;
+       my $etime = interval_to_seconds($time);
+
+       $dbh->do('INSERT INTO store_expire (id, atime, expire_interval) VALUES (?,?,?);',{},$name_id,$atime,$etime);
+
+       return $name;
+}
+__PACKAGE__->register_method(
+       api_name => 'opensrf.persist.slot.create_expirable',
+       method => 'create_expirable_store',
        argc => 2,
 );
 
+sub _update_expire_atime {
+       my $id = shift;
+       $dbh->do('UPDATE store_expire SET atime = ? WHERE id = ?', {}, time(), $id);
+}
+
+sub _sweep_expired_slots {
+       return if (shift());
+
+       my @expired_slots = $dbh->selectcol_arrayref(<<"        SQL", {}, time() );
+               SELECT id FROM store_expire WHERE (atime + expire_interval) <= ?;
+       SQL
+
+       return unless (@expired_slots);
 
+       $dbh->do('DELETE FROM storage WHERE name_id IN ('.join(',', map { '?' } @expired_slots).');', {}, @expired_slots);
+       for my $id (@expired_slots) {
+               _flush_by_name(_get_id_name($id), 1);
+       }
+}
 
 sub add_item {
        my $self = shift;
@@ -129,16 +189,31 @@ __PACKAGE__->register_method(
        argc => 2,
 );
 
+sub _get_id_name {
+       my $name = shift or do {
+               throw OpenSRF::EX::WARN ("No slot id specified!");
+       };
+
+
+       my $name_id = $dbh->selectcol_arrayref("SELECT name FROM store_name WHERE id = ?;", {}, $name);
+
+       if (!ref($name_id) || !defined($name_id->[0])) {
+               throw OpenSRF::EX::WARN ("Slot id [$name] does not exist!");
+       }
+
+       return $name_id->[0];
+}
+
 sub _get_name_id {
        my $name = shift or do {
-               throw OpenSRF::EX::WARN ("No queue name specified!");
+               throw OpenSRF::EX::WARN ("No slot name specified!");
        };
 
 
-       my $name_id = $dbh->selectrow_arrayref("SELECT id FROM store_name WHERE name = ?;", {}, $name);
+       my $name_id = $dbh->selectcol_arrayref("SELECT id FROM store_name WHERE name = ?;", {}, $name);
 
        if (!ref($name_id) || !defined($name_id->[0])) {
-               throw OpenSRF::EX::WARN ("Object name [$name] does not exist!");
+               throw OpenSRF::EX::WARN ("Slot name [$name] does not exist!");
        }
 
        return $name_id->[0];
@@ -153,7 +228,7 @@ sub destroy_store {
        my $name_id = _get_name_id($name);
 
        $dbh->do("DELETE FROM storage WHERE name_id = ?;", {}, $name_id);
-       $dbh->do("DELETE FROM store_name WHERE id = ?;", {}, $name_id);
+       _flush_by_name($name);
 
 }
 __PACKAGE__->register_method(
@@ -164,9 +239,13 @@ __PACKAGE__->register_method(
 
 sub _flush_by_name {
        my $name = shift;
+       my $no_sweep = shift;
+
+       _sweep_expired_slots() unless ($no_sweep);
+       
        if ($name =~ /^AUTOGENERATED!!/) {
                my $name_id = _get_name_id($name);
-               my $count = $dbh->selectrow_arrayref("SELECT COUNT(*) FROM storage WHERE name_id = ?;", {}, $name_id);
+               my $count = $dbh->selectcol_arrayref("SELECT COUNT(*) FROM storage WHERE name_id = ?;", {}, $name_id);
                if (!ref($count) || $$count[0] == 0) {
                        $dbh->do("DELETE FROM store_name WHERE name = ?;", {}, $name);
                }
@@ -242,7 +321,7 @@ sub store_size {
        };
        my $name_id = _get_name_id($name);
 
-       my $value = $dbh->selectrow_arrayref('SELECT SUM(LENGTH(value)) FROM storage WHERE name_id = ?;', {}, $name_id);
+       my $value = $dbh->selectcol_arrayref('SELECT SUM(LENGTH(value)) FROM storage WHERE name_id = ?;', {}, $name_id);
 
        return JSON->JSON2perl( $value->[0] );
 }
@@ -271,7 +350,7 @@ sub store_depth {
        };
        my $name_id = _get_name_id($name);
 
-       my $value = $dbh->selectrow_arrayref('SELECT COUNT(*) FROM storage WHERE name_id = ?;', {}, $name_id);
+       my $value = $dbh->selectcol_arrayref('SELECT COUNT(*) FROM storage WHERE name_id = ?;', {}, $name_id);
 
        return JSON->JSON2perl( $value->[0] );
 }