Create a gist now

Instantly share code, notes, and snippets.

package Connector;
use strict;
use warnings;
use Carp;
use Data::Util qw/is_array_ref/;
use List::Util qw/shuffle/;
use Log::Minimal;
use Scope::Container;
use DBIx::Connector;
use Data::MessagePack;
sub connect {
my $class = shift;
if ( is_array_ref($_[0]) ) {
my @dsn = @_;
my $connector;
my $dsn_key = build_dsn_key(@dsn);
my $dbh = lookup_container($dsn_key);
return $dbh if $dbh;
for my $s_dsn ( shuffle(@dsn) ) {
eval {
($dbh, $connector) = $class->connect(@$s_dsn);
};
infof($@) if $@;
last if ( $dbh );
}
if ( $dbh ) {
save_container($dsn_key, $connector);
return wantarray ? ( $dbh, $connector ) : $dbh;
}
croak("couldnt connect all DB, " .
join(",", map { $_->[0] } @dsn));
}
my @dsn = @_;
my $dsn_key = build_dsn_key(\@dsn);
my $dbh = lookup_container($dsn_key);
return $dbh if $dbh;
my $connector = DBIx::Connector->new(@dsn);
$dbh = $connector->dbh;
save_container($dsn_key, $connector);
return wantarray ? ( $dbh, $connector ) : $dbh;
}
sub build_dsn_key {
my @dsn = @_;
@dsn = sort { $a->[0] cmp $b->[0] } @dsn;
Data::MessagePack->pack(\@dsn);
}
sub lookup_container {
my $key = shift;
my $connector = scope_container("pickless:dbix:connector:".$key);
return if !$connector;
my $dbh;
eval {
$dbh = $connector->_dbh;
};
return if $@;
return $dbh;
}
sub save_container {
my $key = shift;
scope_container("pickless:dbix:connector:".$key, shift);
}
1;
__END__
=head1 NAME
connector - DBI connection cache with Scope::Container
=head1 SYNOPSIS
use Scope::Container;
use Connector;
my $container = start_scope_container();
{
my $dbh = Connector->connect("dbi:mysql:mydb","user","password",{RaiseError=>1});
my $dbh2 = Connector->connect(
["dbi:mysql:mydb;host=srv1","user","password",{RaiseError=>1}],
["dbi:mysql:mydb;host=srv2","user","password",{RaiseError=>1}],
["dbi:mysql:mydb;host=srv3","user","password",{RaiseError=>1}],
);
}
{
#return from cache
my $dbh = Connector->connect("dbi:mysql:mydb","user","password",{RaiseError=>1});
my $dbh2 = Connector->connect(
["dbi:mysql:mydb;host=srv1","user","password",{RaiseError=>1}],
["dbi:mysql:mydb;host=srv2","user","password",{RaiseError=>1}],
["dbi:mysql:mydb;host=srv3","user","password",{RaiseError=>1}],
);
}
# clear DB connection cache if $container scope out
=head1 DESCRIPTION
DBI connection cache with Scope::Container
=head1 AUTHOR
Masahiro Nagano E<lt>kazeburo {at} gmail.comE<gt>
=head1 SEE ALSO
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment