view release on metacpan or  search on metacpan

lib/DBIx/DWIW.pm  view on Meta::CPAN

                $dbh = DBI->connect($dsn, $User, $Password, { PrintError => 0 });
                Time::HiRes::alarm(0);
            };
            if ($@ eq "alarm\n")
            {
                if (my $routine = $self->can("ConnectTimeoutHook")) {
                    $routine->($self);
                }

                my $timeout = $self->{CONNECT_TIMEOUT};
                undef $self; # this fires the DESTROY, which sets $@, so must
                             # do before setting $@ below.

                $@ = "connection timeout ($timeout sec passed)";
                return ();
            }
        }
        else
        {
            $dbh = DBI->connect($dsn, $User, $Password, { PrintError => 0 });
        }

        if (not ref $dbh)
        {
            if (not $DBI::errstr and $@)
            {
                ##
                ## Must be a problem with loading DBD or something --
                ## a *perl* problem as opposed to a network/credential
                ## problem. If we clear $Retry now, we'll ensure to drop
                ## into the die 'else' clause below.
                ##
                $Retry = 0;
            }

            if ($Retry
                and
                ($DBI::errstr =~ m/can\'t connect/i
                 or
                 $DBI::errstr =~ m/Too many connections/i
                 or
                 $DBI::errstr =~ m/Lost connection to MySQL server/i)
                and
                $self->RetryWait($DBI::errstr))
            {
                $done = 0; ## Heh.
            }
            else
            {
                my $ERROR = ($DBI::errstr || $@ || "internal error");

                ##
                ## If DBI::ProxyServer is being used and the target mmysql
                ## server refuses the connection (wrong password, trying to
                ## access a db that they've not been given permission for,
                ## etc.) DBI::ProxyServer just reports "Unexpected EOF from
                ## server". Let's give the user a hint as to what that
                ## might mean.
                ##
                if ($ERROR =~ m/^Cannot log in to DBI::ProxyServer: Unexpected EOF from server/) {
                    $ERROR =    "Cannot log in via DBI::ProxyServer: Unexpected EOF from server (check user's MySQL credentials and privileges)";
                }
                if (not $NoAbort) {
                    die $ERROR;
                }
                elsif (not $Quiet) {
                    warn $ERROR;
                }

                $@ = $ERROR;
                $self->_OperationFailed();

                undef $self; # This fires the DESTROY, which sets $@.
                $@ = $ERROR; # Just in case the DESTROY did set $@.
                return ();
            }
        }
        else
        {
            eval { $dbh->{AutoCommit} = 1};
            $dbh->{mysql_auto_reconnect} = 1;
            $done = 1;  ## it worked!
        }
    } ## end while not done

    ##
    ## We got through....
    ##
    $self->_OperationSuccessful();
    $self->{DBH} = $dbh;

    ##
    ## Save this one if it's not to be unique.
    ##
    if (not $Unique)
    {
        $CurrentConnections{$self->{UNIQUE_KEY}} = $self;
    }

    return $self;
}

*new = \&Connect;

=item Dump()

Dump the internal configuration to stdout.  This is mainly useful for
debugging DBIx::DWIW.  You probably don't need to call it unless you
know what you're doing. :-)

=cut

sub Dump
{
    my $self = shift;

    ## Trivial dumping of key/value pairs.
    for my $key (sort keys %$self)
    {
        print "$key: $self->{$key}\n" unless not defined $self->{$key};
    }