view release on metacpan or  search on metacpan

lib/Dancer/Plugin/Database/Core.pm  view on Meta::CPAN

                    . " to enable UTF-8 support"
            );
            $settings->{dbi_params}{$param} = 1;
        }
    }

    # To support the database_error hook, use DBI's HandleError option
    $settings->{dbi_params}{HandleError} = sub {
        my ($error, $handle) = @_;
        $hook_exec->('database_error', $error, $handle);
    };

    my $dbh = DBI->connect($dsn,
        $settings->{username}, $settings->{password}, $settings->{dbi_params}
    );

    if (!$dbh) {
        $logger->(error => "Database connection failed - " . $DBI::errstr);
        $hook_exec->('database_connection_failed', $settings);
        return undef;
    } elsif (exists $settings->{on_connect_do}) {
        my $to_do = ref $settings->{on_connect_do} eq 'ARRAY'
            ?   $settings->{on_connect_do}
            : [ $settings->{on_connect_do} ];
        for (@$to_do) {
            $dbh->do($_) or
              $logger->(error => "Failed to perform on-connect command $_");
        }
    }

    $hook_exec->('database_connected', $dbh);

    # Indicate whether queries generated by quick_query() etc in
    # Dancer::Plugin::Database::Core::Handle should be logged or not; this seemed a
    # little dirty, but DBI's docs encourage it
    # ("You can stash private data into DBI handles via $h->{private_..._*}..")
    $dbh->{private_dancer_plugin_database} = {
        log_queries => $settings->{log_queries} || 0,
        logger      => $logger,
    };



    # Re-bless it as a Dancer::Plugin::Database::Core::Handle object, to provide nice
    # extra features (unless the config specifies a different class; if it does,
    # this should be a subclass of Dancer::Plugin::Database::Core::Handle in order to
    # extend the features provided by it, or a direct subclass of DBI::db (or
    # even DBI::db itself) to bypass the features provided by D::P::D::Handle)
    my $handle_class = 
        $settings->{handle_class} || 'Dancer::Plugin::Database::Core::Handle';
    my $package = $handle_class;
    $package =~ s{::}{/}g;
    $package .= '.pm';
    require $package;

    return bless($dbh => $handle_class);
}



# Check the connection is alive
sub _check_connection {
    my $dbh = shift;
    return unless $dbh;
    if ($dbh->{Active}) { 
        my $result = eval { $dbh->ping };

        return 0 if $@;

	    if (int($result)) {
            # DB driver itself claims all is OK, trust it:
            return 1;
        } else {
            # It was "0 but true", meaning the default DBI ping implementation
            # Implement our own basic check, by performing a real simple query.
            my $ok;
            eval {
                $ok = $dbh->do('select 1');
            };
            return $ok;
        }
    } else {
        return;
    }
}


=head1 AUTHOR

David Precious, C<< <davidp at preshweb.co.uk> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-dancer-plugin-database-core at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Dancer-Plugin-Database-Core>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Dancer::Plugin::Database::Core


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Dancer-Plugin-Database-Core>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Dancer-Plugin-Database-Core>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Dancer-Plugin-Database-Core>

=item * Search CPAN