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         $sc = OpenSRF::Utils::SettingsClient->new;
  17
  18         my $dbfile = $sc->config_value( apps => persist => app_settings => 'dbfile');
  19         unless ($dbfile) {
  20                 throw OpenSRF::EX::PANIC ("Can't find my dbfile for SQLite!");
  21         }
  22
  23         my $init_dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","");
  24         $init_dbh->{AutoCommit} = 1;
  25         $init_dbh->{RaiseError} = 0;
  26
  27         $init_dbh->do( <<"      SQL" );
  28                 CREATE TABLE storage (
  29                         id      INTEGER PRIMARY KEY,
  30                         name_id INTEGER,
  31                         value   TEXT
  32                 );
  33         SQL
  34
  35         $init_dbh->do( <<"      SQL" );
  36                 CREATE TABLE store_name (
  37                         id      INTEGER PRIMARY KEY,
  38                         name    TEXT UNIQUE
  39                 );
  40         SQL
  41
  42 }
  43
  44 sub child_init {
  45         $sc = OpenSRF::Utils::SettingsClient->new;
  46
  47         my $dbfile = $sc->config_value( apps => persist => app_settings => 'dbfile');
  48         unless ($dbfile) {
  49                 throw OpenSRF::EX::PANIC ("Can't find my dbfile for SQLite!");
  50         }
  51
  52         $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","");
  53         $dbh->{AutoCommit} = 1;
  54         $dbh->{RaiseError} = 0;
  55
  56 }
  57
  58 sub create_store {
  59         my $self = shift;
  60         my $client = shift;
  61
  62         my $name = shift || '';
  63
  64
  65         my $continue = 0;
  66         try {
  67                 _get_name_id($name);
  68
  69         } catch Error with {
  70                 $continue++;
  71         };
  72
  73         throw OpenSRF::EX::WARN ("Duplicate key:  object name [$name] already exists!  " . $dbh->errstr)
  74                 unless ($continue);
  75
  76         my $sth = $dbh->prepare("INSERT INTO store_name (name) VALUES (?);");
  77         $sth->execute($name);
  78         $sth->finish;
  79
  80         unless ($name) {
  81                 my $last_id = $dbh->last_insert_id(undef, undef, 'store_name', 'id');
  82                 $name = 'AUTOGENERATED!!'.$last_id;
  83                 $dbh->do("UPDATE store_name SET name = '$name' WHERE id = '$last_id';");
  84         }
  85
  86         return $name;
  87 }
  88 __PACKAGE__->register_method(
  89         api_name => 'opensrf.persist.slot.create',
  90         method => 'create_store',
  91         argc => 2,
  92 );
  93
  94
  95
  96 sub add_item {
  97         my $self = shift;
  98         my $client = shift;
  99
 100         my $name = shift or do {
 101                 throw OpenSRF::EX::WARN ("No name specified!");
 102         };
 103         my $value = shift || '';
 104
 105         my $name_id = _get_name_id($name);
 106
 107         if ($self->api_name =~ /object/) {
 108                 $dbh->do('DELETE FROM storage WHERE name_id = ?;', {}, $name_id);
 109         }
 110
 111         $dbh->do('INSERT INTO storage (name_id,value) VALUES (?,?);', {}, $name_id, JSON->perl2JSON($value));
 112
 113         return 0 if ($dbh->err);
 114         return $name;
 115 }
 116 __PACKAGE__->register_method(
 117         api_name => 'opensrf.persist.object.set',
 118         method => 'add_item',
 119         argc => 2,
 120 );
 121 __PACKAGE__->register_method(
 122         api_name => 'opensrf.persist.queue.push',
 123         method => 'add_item',
 124         argc => 2,
 125 );
 126 __PACKAGE__->register_method(
 127         api_name => 'opensrf.persist.stack.push',
 128         method => 'add_item',
 129         argc => 2,
 130 );
 131
 132 sub _get_name_id {
 133         my $name = shift or do {
 134                 throw OpenSRF::EX::WARN ("No queue name specified!");
 135         };
 136
 137
 138         my $name_id = $dbh->selectrow_arrayref("SELECT id FROM store_name WHERE name = ?;", {}, $name);
 139
 140         if (!ref($name_id) || !defined($name_id->[0])) {
 141                 throw OpenSRF::EX::WARN ("Object name [$name] does not exist!");
 142         }
 143
 144         return $name_id->[0];
 145 }
 146
 147 sub destroy_store {
 148         my $self = shift;
 149         my $client = shift;
 150
 151         my $name = shift;
 152
 153         my $name_id = _get_name_id($name);
 154
 155         $dbh->do("DELETE FROM storage WHERE name_id = ?;", {}, $name_id);
 156         $dbh->do("DELETE FROM store_name WHERE id = ?;", {}, $name_id);
 157
 158 }
 159 __PACKAGE__->register_method(
 160         api_name => 'opensrf.persist.slot.destroy',
 161         method => 'destroy_store',
 162         argc => 1,
 163 );
 164
 165 sub _flush_by_name {
 166         my $name = shift;
 167         if ($name =~ /^AUTOGENERATED!!/) {
 168                 my $name_id = _get_name_id($name);
 169                 my $count = $dbh->selectrow_arrayref("SELECT COUNT(*) FROM storage WHERE name_id = ?;", {}, $name_id);
 170                 if (!ref($count) || $$count[0] == 0) {
 171                         $dbh->do("DELETE FROM store_name WHERE name = ?;", {}, $name);
 172                 }
 173         }
 174 }
 175
 176 sub pop_queue {
 177         my $self = shift;
 178         my $client = shift;
 179
 180         my $name = shift or do {
 181                 throw OpenSRF::EX::WARN ("No queue name specified!");
 182         };
 183         my $name_id = _get_name_id($name);
 184
 185         my $value = $dbh->selectrow_arrayref('SELECT id, value FROM storage WHERE name_id = ? ORDER BY id ASC LIMIT 1;', {}, $name_id);
 186         $dbh->do('DELETE FROM storage WHERE id = ?;',{}, $value->[0]) unless ($self->api_name =~ /peek$/);
 187
 188         _flush_by_name($name);
 189
 190         return JSON->JSON2perl( $value->[1] );
 191 }
 192 __PACKAGE__->register_method(
 193         api_name => 'opensrf.persist.queue.peek',
 194         method => 'pop_queue',
 195         argc => 1,
 196 );
 197 __PACKAGE__->register_method(
 198         api_name => 'opensrf.persist.queue.pop',
 199         method => 'pop_queue',
 200         argc => 1,
 201 );
 202
 203
 204 sub store_size {
 205         my $self = shift;
 206         my $client = shift;
 207
 208         my $name = shift or do {
 209                 throw OpenSRF::EX::WARN ("No queue name specified!");
 210         };
 211         my $name_id = _get_name_id($name);
 212
 213         my $value = $dbh->selectrow_arrayref('SELECT SUM(LENGTH(value)) FROM storage WHERE name_id = ?;', {}, $name_id);
 214
 215         return JSON->JSON2perl( $value->[0] );
 216 }
 217 __PACKAGE__->register_method(
 218         api_name => 'opensrf.persist.queue.size',
 219         method => 'shift_stack',
 220         argc => 1,
 221 );
 222 __PACKAGE__->register_method(
 223         api_name => 'opensrf.persist.stack.size',
 224         method => 'shift_stack',
 225         argc => 1,
 226 );
 227 __PACKAGE__->register_method(
 228         api_name => 'opensrf.persist.object.size',
 229         method => 'shift_stack',
 230         argc => 1,
 231 );
 232
 233 sub store_depth {
 234         my $self = shift;
 235         my $client = shift;
 236
 237         my $name = shift or do {
 238                 throw OpenSRF::EX::WARN ("No queue name specified!");
 239         };
 240         my $name_id = _get_name_id($name);
 241
 242         my $value = $dbh->selectrow_arrayref('SELECT COUNT(*) FROM storage WHERE name_id = ?;', {}, $name_id);
 243
 244         return JSON->JSON2perl( $value->[0] );
 245 }
 246 __PACKAGE__->register_method(
 247         api_name => 'opensrf.persist.queue.length',
 248         method => 'shift_stack',
 249         argc => 1,
 250 );
 251 __PACKAGE__->register_method(
 252         api_name => 'opensrf.persist.stack.depth',
 253         method => 'shift_stack',
 254         argc => 1,
 255 );
 256
 257 sub shift_stack {
 258         my $self = shift;
 259         my $client = shift;
 260
 261         my $name = shift or do {
 262                 throw OpenSRF::EX::WARN ("No queue name specified!");
 263         };
 264         my $name_id = _get_name_id($name);
 265
 266         my $value = $dbh->selectrow_arrayref('SELECT id, value FROM storage WHERE name_id = ? ORDER BY id DESC LIMIT 1;', {}, $name_id);
 267         $dbh->do('DELETE FROM storage WHERE id = ?;',{}, $value->[0]) unless ($self->api_name =~ /peek$/);
 268
 269         _flush_by_name($name);
 270
 271         return JSON->JSON2perl( $value->[1] );
 272 }
 273 __PACKAGE__->register_method(
 274         api_name => 'opensrf.persist.stack.peek',
 275         method => 'shift_stack',
 276         argc => 1,
 277 );
 278 __PACKAGE__->register_method(
 279         api_name => 'opensrf.persist.stack.pop',
 280         method => 'shift_stack',
 281         argc => 1,
 282 );
 283
 284 sub get_object {
 285         my $self = shift;
 286         my $client = shift;
 287
 288         my $name = shift or do {
 289                 throw OpenSRF::EX::WARN ("No object name specified!");
 290         };
 291
 292         my $name_id = _get_name_id($name);
 293
 294         my $value = $dbh->selectrow_arrayref('SELECT name_id, value FROM storage WHERE name_id = ? ORDER BY id DESC LIMIT 1;', {}, $name_id);
 295         $dbh->do('DELETE FROM storage WHERE name_id = ?',{}, $value->[0]) unless ($self->api_name =~ /peek$/);
 296
 297         _flush_by_name($name);
 298
 299         return JSON->JSON2perl( $value->[1] );
 300 }
 301 __PACKAGE__->register_method(
 302         api_name => 'opensrf.persist.object.peek',
 303         method => 'shift_stack',
 304         argc => 1,
 305 );
 306 __PACKAGE__->register_method(
 307         api_name => 'opensrf.persist.object.get',
 308         method => 'shift_stack',
 309         argc => 1,
 310 );
 311
 312 1;