branches/erry-devel/SrSv/MySQL/KeyValStub.pm

   1 #       This file is part of SurrealServices.
   2 #
   3 #       SurrealServices is free software; you can redistribute it and/or modify
   4 #       it under the terms of the GNU General Public License as published by
   5 #       the Free Software Foundation; either version 2 of the License, or
   6 #       (at your option) any later version.
   7 #
   8 #       SurrealServices is distributed in the hope that it will be useful,
   9 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #       GNU General Public License for more details.
  12 #
  13 #       You should have received a copy of the GNU General Public License
  14 #       along with SurrealServices; if not, write to the Free Software
  15 #       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16
  17 package SrSv::MySQL::KeyValStub;
  18
  19 use strict;
  20
  21 use Symbol 'delete_package';
  22
  23 use SrSv::MySQL '$dbh';
  24 use SrSv::Process::Init;
  25
  26 sub create_stub($$) {
  27         my ($get_sql, $set_sql) = @_;
  28
  29         my ($get, $set);
  30
  31         proc_init {
  32                 $get = $dbh->prepare($get_sql);
  33                 $set = $dbh->prepare($set_sql);
  34         };
  35
  36         return sub ($;$) {
  37                 my ($k, $v) = @_;
  38
  39                 if(defined($v)) {
  40                         $set->execute($v, $k); $set->finish;
  41                 } else {
  42                         $get->execute($k);
  43                         $v = $get->fetchrow_array;
  44                         $get->finish;
  45                 }
  46
  47                 return $v;
  48         };
  49 }
  50
  51 sub create_readonly_stub($) {
  52         my ($get_sql) = @_;
  53
  54         my ($get);
  55
  56         proc_init {
  57                 $get = $dbh->prepare($get_sql);
  58         };
  59
  60         return sub ($) {
  61                 my ($k) = @_;
  62
  63                 $get->execute($k);
  64                 my $v = $get->fetchrow_array;
  65                 $get->finish;
  66
  67                 return $v;
  68         };
  69 }
  70
  71 sub import {
  72         my (undef, $stubs) = @_;
  73
  74         my $callpkg = caller();
  75
  76         while(my ($name, $sql) = each %$stubs) {
  77                 no strict 'refs';
  78
  79                 my $stub;
  80
  81                 if(@$sql == 2) {
  82                         $stub = create_stub($sql->[0], $sql->[1]);
  83                 }
  84                 elsif(@$sql == 1) {
  85                         $stub = create_readonly_stub($sql->[0]);
  86                 }
  87                 else {
  88                         my ($package, $filename, $line) = caller();
  89                         die "Invalid use of ".__PACKAGE__." at $filename line $line\n";
  90                 }
  91
  92                 *{"$callpkg\::$name"} = $stub;
  93         }
  94 }
  95
  96 INIT {
  97         delete_package(__PACKAGE__);
  98 }
  99
 100 1;