Koha/Persistant.pm

   1 package Koha::Persistant;
   2
   3 # Copyright (c) 2012 Dobrica Pavlinusic
   4 # This file is part of Koha.
   5 #
   6 # Koha is free software; you can redistribute it and/or modify it under the
   7 # terms of the GNU General Public License as published by the Free Software
   8 # Foundation; either version 2 of the License, or (at your option) any later
   9 # version.
  10 #
  11 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  12 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License along with
  16 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  17 # Suite 330, Boston, MA  02111-1307 USA
  18
  19 use strict;
  20 use warnings;
  21
  22 use C4::Context;
  23
  24 use Data::Dump qw(dump);
  25
  26 use base 'Exporter';
  27 use version; our $VERSION = qv('1.0.0');
  28
  29 our @EXPORT = (
  30     qw( sql_cache authorized_value )
  31 );
  32
  33 =head1 Persistant
  34
  35 Koha::Persistant - make data objects in Koha persistant
  36
  37 =head1 DESCRIPTION
  38
  39 Koha needs nice centralized way to cache data for plack
  40
  41 Name of this module was choosen to be non-conflicting with possible
  42 future C<Koha::Cache>
  43
  44 =cut
  45
  46 =head2 sql_cache
  47
  48   $row = sql_cache($sql, $value1 [, $value2, ... ]);
  49
  50 Takes C<SELECT col1,col2 FROM table WHERE value1 = ? AND value2 = ?>
  51 SQL query and cache result returning cached row.
  52
  53   -- key: name-of-key
  54
  55 Syntax inside SQL query will override default cache key generation
  56 which is simple normalization of SQL strings.
  57
  58 =cut
  59
  60 sub DESTROY {
  61         warn "## Koha::Persistent::DESTROY";
  62 }
  63
  64 our $_sql_cache;
  65 our $stats;
  66
  67 sub _sql_cache {
  68         my $sql = shift;
  69         my @var = @_;
  70
  71         my $key = $sql;
  72         $key =~ s/\s\s+/ /gs;
  73         $key = $1 if $key =~ s/^.*\s*--\s*key:\s*(.+)//;
  74         my $full = join(' ', $key, @var);
  75         # FIXME make multi-dimensional hash out of this?
  76
  77         if ( exists $_sql_cache->{$full} ) {
  78                 warn "### _sql_cache HIT $key\n";
  79                 $stats->{$key}->[0]++;
  80                 return $_sql_cache->{$full};
  81         }
  82         warn "### _sql_cache MISS $key\n";
  83         $stats->{$key}->[1]++;
  84         my $dbh = C4::Context->dbh;
  85         my $sth = $dbh->prepare( $sql );
  86         $sth->execute( @var );
  87         my $v = $sth->fetchrow_hashref;
  88         $_sql_cache->{$key} = $v;
  89         warn "# row $key = ",dump($v);
  90         return $v;
  91 }
  92
  93 =head2 autorhised_value
  94
  95   my $row = authorised_value( category => $category, $value );
  96
  97 =cut
  98
  99 sub authorised_value {
 100         shift if $_[0] eq 'category';
 101         my ( $category, $value ) = @_;
 102         my $row = _sql_cache("SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ? -- key:autorhised_value", $category, $value);
 103         warn dump $row;
 104         return $row;
 105 }
 106
 107 1;