File Coverage

blib/lib/DBIx/Counter.pm

Criterion	Covered	Total	%
statement	15	50	30.0
branch	0	10	0.0
condition	0	19	0.0
subroutine	5	15	33.3
pod	7	7	100.0
total	27	101	26.7

package DBIx::Counter;

use DBI;
use Carp qw(carp croak);
use strict;

require 5.004;

use overload (
               '++'     => \&inc,
               '--'     => \&dec,
               '""'     => \&value,
               fallback => 1,
             );

use vars qw( $VERSION $DSN $LOGIN $PASSWORD $TABLENAME );

$VERSION = '0.03';

sub new
{
    my $pkg         = shift;
    my $countername = shift or croak("No counter name supplied");
    unshift @_, 'initial' if @_ % 2;
    my %opts        = @_;

    my $self = {
                 countername => $countername,
                 dbh         => $opts{dbh},
                 dsn         => $opts{dsn}       || $DSN,
                 login       => $opts{login}     || $LOGIN,
                 password    => $opts{password}  || $PASSWORD,
                 tablename   => $opts{tablename} || $TABLENAME || 'counters',
                 initial     => $opts{initial}   || '0',
               };

    croak("Unable to connect to database: no valid connection handle or DSN supplied")
      unless $self->{dbh} or $self->{dsn};

    bless $self, $pkg;
    $self->_init;
    $self;
}

sub _init
{
    my $self = shift;

    # create counter record if not exists
    eval {
        my $dbh = $self->_db;
        my ($exists) = $dbh->selectrow_array( qq{select count(*) from $self->{tablename} where counter_id=?}, undef, $self->{countername} );
        unless ( $exists > 0 )
        {
            $dbh->do( qq{insert into $self->{tablename} (counter_id,value) values (?,?)}, undef, $self->{countername}, $self->{initial} );
        }
    } or croak "Error creating counter record: $@";
}

sub _db
{
    my $self = shift;

    return $self->{dbh}
      || DBI->connect_cached( $self->{dsn}, $self->{login}, $self->{password}, { PrintError => 0, RaiseError => 1 } );
}

sub _add
{
    my ( $self, $add ) = @_;
    my $dbh     = $self->_db;
    my $sth_set = $dbh->prepare_cached(qq{update $self->{tablename} set value=value+? where counter_id=?});
    $sth_set->execute( $add, $self->{countername} );
}

sub inc
{
    my $self = shift;
    $self->_add(1);
}

sub dec
{
    my $self = shift;
    $self->_add(-1);
}

sub value
{
    my $self    = shift;
    my $dbh     = $self->_db;
    my $sth_get = $dbh->prepare_cached(qq{select value from $self->{tablename} where counter_id=?});

    $sth_get->execute( $self->{countername} );
    my ($v) = $sth_get->fetchrow_array;
    $sth_get->finish;

    return $v;
}

sub lock   { 0 }
sub unlock { 0 }
sub locked { 0 }

1;

__END__