Swiss QR-Bill: Datenbankupgrade BankAccount
[kivitendo-erp.git] / 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