Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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;
- =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
Add Comment
Please, Sign In to add comment