src/perlmods/OpenSRF/Application/Persist.pm

   1 package OpenSRF::Application::Persist;
   2 use base qw/OpenSRF::Application/;
   3 use OpenSRF::Application;
   4
   5 use OpenSRF::Utils::SettingsClient;
   6 use OpenSRF::EX qw/:try/;
   7 use OpenSRF::Utils::Logger;
   8 use JSON;
   9 use DBI;
  10
  11 use vars qw/$dbh $sc $log/;
  12
  13 sub initialize {
  14         $log = 'OpenSRF::Utils::Logger';
  15 }
  16
  17 sub child_init {
  18         $sc = OpenSRF::Utils::SettingsClient->new;
  19
  20         my $dbfile = $sc->config_value( apps => persist => app_settings => 'dbfile');
  21         unless ($dbfile) {
  22                 throw OpenSRF::EX::PANIC ("Can't find my dbfile for SQLite!");
  23         }
  24
  25         $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","");
  26         $dbh->{AutoCommit} = 1;
  27         $dbh->{RaiseError} = 1;
  28
  29         eval {
  30                 $dbh->do( <<"           SQL" );
  31                         CREATE TABLE storage (
  32                                 id      INT PRIMARY KEY,
  33                                 name_id INT,
  34                                 value   TEXT
  35                         );
  36                 SQL
  37
  38                 $dbh->do( <<"           SQL" );
  39                         CREATE TABLE store_name (
  40                                 id      INT PRIMARY KEY,
  41                                 name    TEXT UNIQUE
  42                         );
  43                 SQL
  44         };
  45 }
  46
  47 sub create_store {
  48         my $self = shift;
  49         my $client = shift;
  50
  51         my $name = shift || '';
  52
  53         eval {
  54                 my $sth = $dbh->prepare("INSERT INTO store_name (name) VALUES (?)");
  55                 $sth->execute($name);
  56                 $sth->finish;
  57         };
  58         if ($@) {
  59                 throw OpenSRF::EX::WARN ("Duplicate key:  object name [$name] already exists!  " . $dbh->errstr);
  60         }
  61
  62         unless ($name) {
  63                 my $last_id = $dbh->last_insert_id();
  64                 $name = 'AUTOGENERATED!!'.$last_id;
  65                 $dbh->do("UPDATE store_name SET name = '$name' WHERE id = '$last_id';");
  66         }
  67
  68         return $name;
  69 }
  70 __PACKAGE__->register_method(
  71         api_name => 'opensrf.persist.slot.create',
  72         method => 'create_store',
  73         argc => 2,
  74 );
  75
  76
  77
  78 sub add_item {
  79         my $self = shift;
  80         my $client = shift;
  81
  82         my $name = shift or throw OpenSRF::EX::WARN ("No queue name specified!");
  83         my $value = shift || '';
  84
  85         my $name_id = _get_name_id($name);
  86
  87         if ($self->api_name =~ /object/) {
  88                 $dbh->do('DELETE FROM storage WHERE name_id = ?', {}, $name_id);
  89         }
  90
  91         $dbh->do('INSERT INTO storage (name_id,value) VALUES (?,?);', {}, $name_id, JSON->perl2JSON($value));
  92
  93         return 0 if ($dbh->err);
  94         return $name;
  95 }
  96 __PACKAGE__->register_method(
  97         api_name => 'opensrf.persist.object.set',
  98         method => 'add_item',
  99         argc => 2,
 100 );
 101 __PACKAGE__->register_method(
 102         api_name => 'opensrf.persist.queue.push',
 103         method => 'add_item',
 104         argc => 2,
 105 );
 106 __PACKAGE__->register_method(
 107         api_name => 'opensrf.persist.stack.push',
 108         method => 'add_item',
 109         argc => 2,
 110 );
 111
 112 sub _get_name_id {
 113         my $name = shift or throw OpenSRF::EX::WARN ("No queue name specified!");
 114
 115         my $name_id = $dbh->selectcol_arrayref("SELECT id FROM store_name WHERE name = ?", {}, $name)->[0];
 116
 117         unless ($name_id) {
 118                 throw OpenSRF::EX::WARN ("Object name [$name] does not exist!");
 119         }
 120
 121         return $name_id;
 122 }
 123
 124 sub destroy_store {
 125         my $self = shift;
 126         my $client = shift;
 127
 128         my $name = shift;
 129
 130         my $name_id = _get_name_id($name);
 131
 132         $dbh->do("DELETE FROM storage WHERE name_id = ?", {}, $name_id);
 133         $dbh->do("DELETE FROM store_name WHERE id = ?", {}, $name_id);
 134 }
 135 __PACKAGE__->register_method(
 136         api_name => 'opensrf.persist.slot.destroy',
 137         method => 'destroy_store',
 138         argc => 1,
 139 );
 140
 141 sub _flush_by_name {
 142         my $name = shift;
 143         if ($name =~ /^AUTOGENERATED!!/) {
 144                 my $count = $dbh->selectrow_arrayref("SELECT COUNT(*) FROM storage WHERE name = ?", {}, $name);
 145                 if (!ref($count) || $$count[0] == 0) {
 146                         $dbh->do("DELETE FROM store_name WHERE name = ?", {}, $name);
 147                 }
 148         }
 149 }
 150
 151 sub pop_queue {
 152         my $self = shift;
 153         my $client = shift;
 154
 155         my $name = shift or throw OpenSRF::EX::WARN ("No queue name specified!");
 156         my $name_id = _get_name_id($name);
 157
 158         my $value = $dbh->selectrow_arrayref('SELECT id, value FROM storage WHERE name_id = ? ORDER BY id ASC LIMIT 1', {}, $name_id);
 159         $dbh->do('DELETE FROM storage WHERE id = ?',{}, $value->[0]);
 160
 161         _flush_by_name($name);
 162         return JSON->JSON2perl( $value->[1] );
 163 }
 164 __PACKAGE__->register_method(
 165         api_name => 'opensrf.persist.queue.pop',
 166         method => 'pop_queue',
 167         argc => 1,
 168 );
 169
 170
 171 sub shift_stack {
 172         my $self = shift;
 173         my $client = shift;
 174
 175         my $name = shift or throw OpenSRF::EX::WARN ("No queue name specified!");
 176         my $name_id = _get_name_id($name);
 177
 178         my $value = $dbh->selectrow_arrayref('SELECT id, value FROM storage WHERE name_id = ? ORDER BY id DESC LIMIT 1', {}, $name_id);
 179         $dbh->do('DELETE FROM storage WHERE id = ?',{}, $value->[0]);
 180
 181         _flush_by_name($name);
 182         return JSON->JSON2perl( $value->[1] );
 183 }
 184 __PACKAGE__->register_method(
 185         api_name => 'opensrf.persist.stack.pop',
 186         method => 'shift_stack',
 187         argc => 1,
 188 );
 189
 190 sub get_object {
 191         my $self = shift;
 192         my $client = shift;
 193
 194         my $name = shift or throw OpenSRF::EX::WARN ("No queue name specified!");
 195         my $name_id = _get_name_id($name);
 196
 197         my $value = $dbh->selectrow_arrayref('SELECT name_id, value FROM storage WHERE name_id = ? ORDER BY id DESC LIMIT 1', {}, $name_id);
 198         $dbh->do('DELETE FROM storage WHERE name_id = ?',{}, $value->[0]);
 199
 200         _flush_by_name($name);
 201         return JSON->JSON2perl( $value->[1] );
 202 }
 203 __PACKAGE__->register_method(
 204         api_name => 'opensrf.persist.object.get',
 205         method => 'shift_stack',
 206         argc => 1,
 207 );
 208
 209 1;