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