| ... | ... |
@@ -0,0 +1,63 @@ |
| 1 |
+package DBIx::Custom::Pool; |
|
| 2 |
+use Object::Simple -base; |
|
| 3 |
+use Carp 'croak'; |
|
| 4 |
+use Digest::MD5 'md5_hex'; |
|
| 5 |
+ |
|
| 6 |
+has count => 5; |
|
| 7 |
+ |
|
| 8 |
+sub prepare {
|
|
| 9 |
+ my ($self, $cb) = @_; |
|
| 10 |
+ |
|
| 11 |
+ my $count = $self->count; |
|
| 12 |
+ for (my $i = 0; $i < $count; $i++) {
|
|
| 13 |
+ my $dbi = $cb->(); |
|
| 14 |
+ |
|
| 15 |
+ my $id = $self->_id; |
|
| 16 |
+ |
|
| 17 |
+ $self->{_pool}{$id} = $dbi;
|
|
| 18 |
+ } |
|
| 19 |
+ return $self; |
|
| 20 |
+} |
|
| 21 |
+ |
|
| 22 |
+sub get {
|
|
| 23 |
+ my $self = shift; |
|
| 24 |
+ |
|
| 25 |
+ my @ids = keys %{$self->{_pool}};
|
|
| 26 |
+ croak "Pool is empty" unless @ids; |
|
| 27 |
+ my $id = $ids[0]; |
|
| 28 |
+ my $dbi = delete $self->{_pool}{$id};
|
|
| 29 |
+ $self->{_borrow}{$id} = 1;
|
|
| 30 |
+ $dbi->{_pool_id} = $id;
|
|
| 31 |
+ return $dbi; |
|
| 32 |
+} |
|
| 33 |
+ |
|
| 34 |
+sub back {
|
|
| 35 |
+ my ($self, $dbi) = @_; |
|
| 36 |
+ my $id = $dbi->{_pool_id};
|
|
| 37 |
+ return unless ref $dbi && defined $id; |
|
| 38 |
+ croak "This DBIx::Custom object is already returned back" |
|
| 39 |
+ if $self->{_pool}{$id};
|
|
| 40 |
+ delete $self->{_borrow}{$id};
|
|
| 41 |
+ $self->{_pool}{$id} = $dbi;
|
|
| 42 |
+ |
|
| 43 |
+ return $self; |
|
| 44 |
+} |
|
| 45 |
+ |
|
| 46 |
+sub _id {
|
|
| 47 |
+ my $self = shift; |
|
| 48 |
+ my $id; |
|
| 49 |
+ do { $id = md5_hex('c' . time . rand 999) }
|
|
| 50 |
+ while $self->{_pool}->{$id} || $self->{_borrow}->{$id};
|
|
| 51 |
+ return $id; |
|
| 52 |
+} |
|
| 53 |
+ |
|
| 54 |
+1; |
|
| 55 |
+ |
|
| 56 |
+=head1 NAME |
|
| 57 |
+ |
|
| 58 |
+DBIx::Custom::Pool |
|
| 59 |
+ |
|
| 60 |
+=head1 DESCRIPTION |
|
| 61 |
+ |
|
| 62 |
+DBI Pool. this module is very experimental. |
|
| 63 |
+ |
| ... | ... |
@@ -82,6 +82,12 @@ my $values_clause; |
| 82 | 82 |
my $assign_clause; |
| 83 | 83 |
my $reuse; |
| 84 | 84 |
my $affected; |
| 85 |
+my $dbi1; |
|
| 86 |
+my $dbi2; |
|
| 87 |
+my $dbi3; |
|
| 88 |
+my $dbi4; |
|
| 89 |
+my $dbi5; |
|
| 90 |
+my $pool; |
|
| 85 | 91 |
|
| 86 | 92 |
require MyDBI1; |
| 87 | 93 |
{
|
| ... | ... |
@@ -239,6 +245,33 @@ require MyDBI1; |
| 239 | 245 |
} |
| 240 | 246 |
} |
| 241 | 247 |
|
| 248 |
+test 'DBIx::Custom::Pool'; |
|
| 249 |
+use DBIx::Custom::Pool; |
|
| 250 |
+$dbi = DBIx::Custom->connect; |
|
| 251 |
+eval { $dbi->execute("drop table $table1") };
|
|
| 252 |
+$dbi->execute($create_table1); |
|
| 253 |
+$pool = DBIx::Custom::Pool->new; |
|
| 254 |
+$pool->count(3); |
|
| 255 |
+$pool->prepare(sub {
|
|
| 256 |
+ DBIx::Custom->connect; |
|
| 257 |
+}); |
|
| 258 |
+$dbi1 = $pool->get; |
|
| 259 |
+ok($dbi1); |
|
| 260 |
+$dbi2 = $pool->get; |
|
| 261 |
+ok($dbi1); |
|
| 262 |
+$dbi3 = $pool->get; |
|
| 263 |
+ok($dbi1); |
|
| 264 |
+eval {$pool->get};
|
|
| 265 |
+like($@, qr/empty/); |
|
| 266 |
+$pool->back($dbi1); |
|
| 267 |
+undef $dbi1; |
|
| 268 |
+$dbi1 = $pool->get; |
|
| 269 |
+ok($dbi1); |
|
| 270 |
+$pool->back($dbi1); |
|
| 271 |
+eval { $pool->back($dbi1) };
|
|
| 272 |
+like($@, qr/already/); |
|
| 273 |
+ |
|
| 274 |
+ |
|
| 242 | 275 |
test 'execute reuse option'; |
| 243 | 276 |
eval { $dbi->execute("drop table $table1") };
|
| 244 | 277 |
$dbi->execute($create_table1); |