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