package Catalyst::Model::DBI;

use strict;
use base 'Catalyst::Model';
use NEXT;
use DBI;

our $VERSION = '0.20';

__PACKAGE__->mk_accessors( qw/_dbh _pid _tid/ );

=head1 NAME

Catalyst::Model::DBI - DBI Model Class

=head1 SYNOPSIS

	# use the helper
	create model DBI DBI dsn user password
	
	# lib/MyApp/Model/DBI.pm
	package MyApp::Model::DBI;
	
	use base 'Catalyst::Model::DBI';
	
	__PACKAGE__->config(
		dsn           => 'dbi:Pg:dbname=myapp',
		password      => '',
		user          => 'postgres',
		options       => { AutoCommit => 1 },
	);
	
	1;
	
	my $dbh = $c->model('DBI')->dbh;
	#do something with $dbh ...
	
=head1 DESCRIPTION

This is the C<DBI> model class.

=head1 METHODS

=over 4

=item new

Initializes DBI connection

=cut

sub new {
	my $self = shift;
	my ( $c ) = @_;
	$self = $self->NEXT::new( @_ );
	$self->{namespace}               ||= ref $self;
	$self->{additional_base_classes} ||= ();
	$self->{log} = $c->log;
	$self->{debug} = $c->debug;
	return $self;
}

=item $self->dbh

Returns the current database handle.

=cut

sub dbh {
	return shift->stay_connected;
}

=item $self->stay_connected

Returns a connected database handle.

=cut

sub stay_connected {
	my $self = shift;
	if ( $self->_dbh ) {
		if ( defined $self->_tid && $self->_tid != threads->tid ) {
			$self->_dbh( $self->connect );
      		} elsif ( $self->_pid != $$ ) {
			$self->_dbh->{InactiveDestroy} = 1;
			$self->_dbh( $self->connect );
		} elsif ( ! $self->connected ) {
			$self->_dbh( $self->connect );
		}
	} else {
		$self->_dbh( $self->connect );
	}
	return $self->_dbh;
}

=item $self->connected

Returns true if the database handle is active and pingable.

=cut

sub connected {
	my $self = shift;
	return unless $self->_dbh;
	return $self->_dbh->{Active} && $self->_dbh->ping;
}

=item $self->connect

Connects to the database and returns the handle.

=cut

sub connect {
	my $self = shift;
	my $dbh;
	eval {
		$dbh = DBI->connect(
			$self->{dsn},
			$self->{user},
			$self->{password},
			$self->{options}
		);
	};
	if ($@) { $self->{log}->debug( qq{Couldn't connect to the database "$@"} ) if $self->{debug} }
	else { $self->{log}->debug ( 'Connected to the database via dsn:' . $self->{dsn} ) if $self->{debug}; }
	$self->_pid( $$ );
	$self->_tid( threads->tid ) if $INC{'threads.pm'};
	return $dbh;
}

=item $self->disconnect

Executes rollback if AutoCommit is active,
disconnects and unsets the database handle.

=cut

sub disconnect {
	my $self = shift;
	if( $self->connected ) {
		$self->_dbh->rollback unless $self->_dbh->{AutoCommit};
		$self->_dbh->disconnect;
		$self->_dbh( undef );
	}
}

sub DESTROY {
	my $self = shift;
	$self->disconnect if (defined $self->_dbh);
}

=back

=head1 SEE ALSO

L<Catalyst>, L<DBI>

=head1 AUTHOR

Alex Pavlovic, C<alex.pavlovic@taskforce-1.com>

=head1 COPYRIGHT

This program is free software, you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;