SL/DBConnect/Cache.pm

   1 package SL::DBConnect::Cache;
   2
   3 use strict;
   4 use List::MoreUtils qw(apply);
   5
   6 my %cache;
   7
   8 sub get {
   9   my ($package, @args) = @_;
  10
  11   my $dbh = $cache{ _args2str(@args) };
  12
  13   if (!$dbh->{Active}) {
  14     delete $cache{ _args2str(@args) };
  15     $dbh = undef;
  16   }
  17
  18   return $dbh;
  19 }
  20
  21 sub store {
  22   my ($package, $dbh, @args) = @_;
  23
  24   $cache{ _args2str(@args) } = $dbh;
  25 }
  26
  27 sub reset {
  28   my ($package, @args) = @_;
  29
  30   my $dbh = $cache{ _args2str(@args) };
  31
  32   return unless $dbh;
  33
  34   $dbh->rollback;
  35   $dbh;
  36 }
  37
  38 sub clear {
  39   %cache = ();
  40 }
  41
  42 sub _args2str {
  43   my (@args) = @_;
  44
  45   my ($dbconnect, $dbuser, $dbpasswd, $options, $initial_sql) = @_;
  46   $dbconnect //= '';
  47   $dbuser    //= '';
  48   $dbpasswd  //= '';
  49   $options   //= {};
  50   my $options_str =
  51     join ';', apply { s/([;\\])/\\$1/g }  # no collisions if anything contains ;
  52     map { $_ => $options->{$_} }
  53     sort keys %$options;                  # deterministic order
  54
  55   join ';', apply { $_ //= ''; s/([;\\])/\\$1/g } $dbconnect, $dbuser, $dbpasswd, $options_str, $initial_sql;
  56 }
  57
  58 1;
  59
  60 __END__
  61
  62 =encoding utf-8
  63
  64 =head1 NAME
  65
  66 SL::DBConnect::Cache - cached database handle pool
  67
  68 =head1 SYNOPSIS
  69
  70   use SL::DBConnect::Cache;
  71
  72   my $dbh = SL::DBConnect::Cache->get(@args);
  73   SL::DBConnect::Cache->store($dbh, @args);
  74
  75   # reset a cached handle
  76   SL::DBConnect::Cache->reset($dbh);
  77
  78   # close a cached handle and forget it
  79   SL::DBConnect::Cache->close($dbh);
  80
  81   SL::DBConnect::Cache->clear($dbh);
  82
  83
  84 =head1 DESCRIPTION
  85
  86 Implements a managed cache for DB connection handles.
  87
  88 The same would be possible with C<< DBI->connect_cached >>, but in that case,
  89 we would have no control over the cache.
  90
  91 =head1 METHODS
  92
  93 =over 4
  94
  95 =item * C<get ARGS>
  96
  97 Retrieve a connection specified by C<ARGS>.
  98
  99 =item * C<store DBH ARGS>
 100
 101 Store a connection specified by C<ARGS>.
 102
 103 =item * C<reset ARGS>
 104
 105 Rollback the connection specified by C<ARGS>.
 106
 107 =item * C<clear>
 108
 109 Empties the cache. If handles are not referenced otherwise, they will get
 110 dropped and closed.
 111
 112 =back
 113
 114 =head1 BUGS
 115
 116 None yet :)
 117
 118 =head1 AUTHOR
 119
 120 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 121
 122 =cut