Permalink
Browse files

added eg/

  • Loading branch information...
1 parent 64369fc commit f98ead0a971037d105b12011422129fd13df72ac @kazeburo committed Nov 4, 2010
Showing with 130 additions and 0 deletions.
  1. +130 −0 eg/Connector.pm
View
@@ -0,0 +1,130 @@
+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

0 comments on commit f98ead0

Please sign in to comment.