File Coverage

blib/lib/DBIx/SQLite/Simple/Table.pm

Criterion	Covered	Total	%
statement	199	220	90.4
branch	37	56	66.0
condition			n/a
subroutine	31	35	88.5
pod	13	13	100.0
total	280	324	86.4

#
# $Id: Table.pm,v 1.25 2007-01-27 13:35:02 gomor Exp $
#

package DBIx::SQLite::Simple::Table;
use strict;
use warnings;
use Carp;

require Class::Gomor::Array;
our @ISA = qw(Class::Gomor::Array);

our @AS = qw(
   dbo
);
__PACKAGE__->cgBuildIndices;
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

require DBIx::SQLite::Simple;

# XXX: do all SQL request with prepare/execute

=head1 NAME

DBIx::SQLite::Simple::Table - superclass only used to handle SQL tables

=head1 SYNOPSIS

   # Example of a table with a primary key

   package TPub;

   require DBIx::SQLite::Simple::Table;
   our @ISA = qw(DBIx::SQLite::Simple::Table);

   our @AS = qw(
      idPub
      pub
   );
   __PACKAGE__->cgBuildIndices;
   __PACKAGE__->cgBuildAccessorsScalar(\@AS);

   # 'our $Id' and 'our @Fields' are named Id and Fields for a good
   # reason, so do not name these variables by another name.
   our $Id     = $AS[0];
   our @Fields = @AS[1..$#AS];

   1;

   # Example of a table with no key at all

   package TBeer;

   require DBIx::SQLite::Simple::Table;
   our @ISA = qw(DBIx::SQLite::Simple::Table);

   our @AS = qw(
      beer
      country
   );
   __PACKAGE__->cgBuildIndices;
   __PACKAGE__->cgBuildAccessorsScalar(\@AS);

   our @Fields = @AS;

   1;

   # Now, we have two tables, we can play with the database

   package main;

   require DBIx::SQLite::Simple;
   my $db = DBIx::SQLite::Simple->new(db => 'sqlite.db');

   # Create to object to play with the two tables
   my $tPub = TPub->new;
   my $tBeer = TBeer->new;

   # Create tables
   $tPub->create  unless $tPub->exists;
   $tBeer->create unless $tBeer->exists;

   # Create some entries
   my @pubEntries;
   push @pubEntries, TPub->new(pub => $_) for (qw(corner friends));

   my @beerEntries;
   push @beerEntries, TBeer->new(beer => $_, country => 'BE')
      for (qw(grim leffe bud));

   # Now insert those entries;
   $tPub->insert(\@pubEntries);
   $tBeer->insert(\@beerEntries);

   # Get friends pub
   my $friends = $tPub->select(pub => 'friends');

   # Lookup id
   my $id = $tPub->lookupId(pub => 'friends');

   # Lookup string
   my $str = $tPub->lookupString('pub', idPub => $id);

   # Add a beer from 'chez moi'
   my $dremmwel = TBeer->new(beer => 'Dremmwel', country => '?');
   $tBeer->insert([ $dremmwel ]);

   $tPub->commit;
   $tBeer->commit;

   # Update Dremmwel
   my $dremmwelOld = $dremmwel->cgClone;
   $dremmwel->country('BZH');
   $tBeer->update([ $dremmwel ], $dremmwelOld);
   $tBeer->commit;

   # Delete all pubs
   $tPub->delete(\@pubEntries);

=head1 ATTRIBUTES

=over 4

=item B

Stores a DBIx::SQLite::Simple object.

=back

=head1 METHODS

=over 4

=item B

Object creator. Will return an object used to access corresponding SQL table. You can pass an optional parameter: dbo. By default, it uses the global variable $DBIx::SQLite::Simple::Dbo.

=cut

sub new {
   my $self = shift->SUPER::new(@_);

   $self->dbo($DBIx::SQLite::Simple::Dbo)
      unless $self->dbo;

   $self;
}

sub __toObj {
   my $self = shift;
   my ($fields, $aref) = @_;

   my $class = ref($self);

   my @obj = ();
   for my $h (@$aref) {
      my %values = map { $_ => $h->{$_} } @$fields;
      push @obj, $class->new(%values);
   }
   \@obj;
}

sub _carp { shift; carp("@{[(caller(0))[3]]}: ".shift()."\n"); undef }

sub _create {
   my $self = shift;
   my ($fields, $noKey) = @_;

   my ($table) = ref($self) =~ /^(?:.*::)?(.*)/;

   my $query = 'CREATE TABLE '. $table. '(';
   if ($noKey) {
      $query .= $fields->[0]. ', ';
   }
   else {
      $query .= $fields->[0]. ' INTEGER PRIMARY KEY, ';
   }
   shift(@$fields);
   $query .= $_. ', ' for @$fields;
   $query =~ s/, $/)/;

   $self->dbo->_dbh->do($query);

   return $self->_carp('_create: do: query['.$query.']: '.
                       $self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   1;
}

=item B

Just a convenient method to commit pending changes to the whole database.

=cut

sub commit { shift->dbo->commit }

sub _exists {
   my $self = shift;

   my ($table) = ref($self) =~ /^(?:.*::)?(.*)/;

   $self->dbo->_dbh->do('SELECT * FROM '. $table);
   $self->dbo->_dbh->err ? undef : 1;
}

sub _delete {
   my $self = shift;
   my ($fields, $values) = @_;

   my ($table) = ref($self) =~ /^(?:.*::)?(.*)/;

   my $query = 'DELETE FROM '. $table. ' WHERE ';
   $query .= $_. '=? AND ' for @$fields;
   $query =~ s/ AND $//;
   my $sth = $self->dbo->_dbh->prepare($query);

   return $self->_carp('_delete: prepare: query['.$query.']: '.
                       $self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   for my $obj (@$values) {
      my @fields;
      push @fields, $obj->$_ for @$fields;
      $sth->execute(@fields);

      return $self->_carp('_delete: execute: '.$self->dbo->_dbh->errstr)
         if $self->dbo->_dbh->err;
   }
   $sth->finish;

   1;
}

sub _update {
   my $self = shift;
   my ($fields, $id, $values, $where) = @_;

   my ($table) = ref($self) =~ /^(?:.*::)?(.*)/;

   my $query = 'UPDATE '. $table. ' SET ';
   $query .= $_. '=?, ' for @$fields;
   $query =~ s/, $/ WHERE /;
   if ($id) {
      $query .= $id. '=?';
   }
   else {
      $query .= $_. '=? AND ' for @$fields;
      $query =~ s/ AND $//;
   }
   my $sth = $self->dbo->_dbh->prepare($query);

   return $self->_carp('_update: prepare: query['.$query.']: '.
                       $self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   for my $obj (@$values) {
      my @fields;
      push @fields, $obj->$_ for @$fields;
      $id ? do { push @fields, $obj->$id               }
          : do { push @fields, $where->$_ for @$fields };
      $sth->execute(@fields);

      return $self->_carp('_update: execute: '.$self->dbo->_dbh->errstr)
         if $self->dbo->_dbh->err;
   }
   $sth->finish;

   1;
}

sub _insert {
   my $self = shift;
   my ($fields, $values) = @_;

   my ($table) = ref($self) =~ /^(?:.*::)?(.*)/;

   my $query = 'INSERT INTO '. $table. '(';
   $query .= $_. ', ' for @$fields;
   $query =~ s/, $/) VALUES (/;
   $query .= ('?, ' x scalar @$fields);
   $query =~ s/, $/)/;
   my $sth = $self->dbo->_dbh->prepare($query);

   return $self->_carp('_insert: prepare: query['.$query.']: '.
                       $self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   for my $obj (@$values) {
      my @fields;
      push @fields, $obj->$_ for @$fields;
      $sth->execute(@fields);

      return $self->_carp('_insert: execute: '.$self->dbo->_dbh->errstr)
         if $self->dbo->_dbh->err;
   }
   $sth->finish;

   1;
}

sub _select {
   my $self = shift;
   my (%fields) = @_;

   my ($table) = ref($self) =~ /^(?:.*::)?(.*)/;

   my $query = 'SELECT * FROM '. $table. ' WHERE ';
   if (%fields) {
      do { $query .= $_. '=? AND ' } for keys %fields;
      $query =~ s/ AND $//;
   }
   else {
      $query =~ s/ WHERE $//;
   }

   my $sth = $self->dbo->_dbh->prepare($query);

   return $self->_carp('_select: prepare: query['.$query.']: '.
                       $self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   %fields
      ? $sth->execute(values %fields)
      : $sth->execute;

   return $self->_carp('_select: execute: '.$self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   my $res = $sth->fetchall_arrayref({});

   return $self->_carp('_select: fetchall_arrayref: '.$self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   $sth->finish;

   $self->can('_toObj')
      ? return $self->_toObj($res)
      : return $res->[0];
}

sub _lookupId {
   my $self = shift;
   my ($id, %fields) = @_;

   my ($table) = ref($self) =~ /^(?:.*::)?(.*)/;

   my $query = 'SELECT '. $id. ' FROM '. $table. ' WHERE ';
   do { $query .= $_. '=? AND ' } for keys %fields;
   $query =~ s/ AND $//;

   my $sth = $self->dbo->_dbh->prepare($query);

   return $self->_carp('_lookupId: prepare: query['.$query.']: '.
                       $self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   $sth->execute(values %fields);

   return $self->_carp('_lookupId: execute: '.$self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   my @res = $sth->fetchrow_array;

   return $self->_carp('_lookupId: fetchrow_array: '.$self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   $sth->finish;

   $res[0];
}

sub _lookupString {
   my $self = shift;
   my ($string, %fields) = @_;

   my ($table) = ref($self) =~ /^(?:.*::)?(.*)/;

   my $query = 'SELECT '. $string. ' FROM '. $table. ' WHERE ';
   do { $query .= $_. '=? AND ' } for keys %fields;
   $query =~ s/ AND $//;

   my $sth = $self->dbo->_dbh->prepare($query);

   return $self->_carp('_lookupString: prepare: query['.$query.']: '.
                       $self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   $sth->execute(values %fields);

   return $self->_carp('_lookupString: execute: '.$self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   my @res = $sth->fetchrow_array;

   return $self->_carp('_lookupString: fetchrow_array: '.
                       $self->dbo->_dbh->errstr)
      if $self->dbo->_dbh->err;

   $sth->finish;

   $res[0];
}

# XXX: _lookupObject to return a list of objects

sub _toObj  {
   my $self = shift;

   no strict 'refs';
   my $id     = ${ref($self). '::Id'};
   my @fields = @{ref($self). '::Fields'};

   $id ? return $self->__toObj([ $id, @fields ], @_)
       : return $self->__toObj(\@fields, @_);
}

=item B

Method to create the table.

=cut

sub create {
   my $self = shift;

   no strict 'refs';
   my $id     = ${ref($self). '::Id'};
   my @fields = @{ref($self). '::Fields'};

   $id ? return $self->_create([ $id, @fields ], @_)
       : return $self->_create(\@fields, 1, @_);
}

=item B

Method to verify existence of a table.

=cut

sub exists { shift->_exists(@_) }

=item B

If called without parameters, returns the whole content as an arrayref. If called with a hash as argument containing some table fields with values, it plays as multiple where clauses (return result as an arrayref also). See SYNOPSIS.

=cut

sub select { shift->_select(@_) }

=item B

This method returns a reference to an array with each array indice set to the corresponding table object id.

=cut

sub selectById {
   my $self = shift;

   no strict 'refs';
   my $id = ${ref($self). '::Id'};

   my $sorted;
   $sorted->[$_->$id] = $_ for @{$self->select(@_)};
   $sorted;
}

=item B

Method used to generate a unique key, using to store and retrieve a database element quickly. By default, the key is the first field in the table schema (excluding the id field). It is user responsibility to override this method to use an appropriate key.

=cut

sub getKey {
   my $self = shift;

   no strict 'refs';
   my @fields = @{ref($self). '::Fields'};
   my $key = $fields[0];

   $self->$key;
}

=item B

Method used to cache a table content. It uses B to store the object into a reference to a hash. You access a cached element by calling B on an object.

=cut

sub selectByKey {
   my $self = shift;
   my %cache = map { $_->getKey => $_ } @{$self->select(@_)};
   \%cache;
}

=item B($arrayref)

Deletes all entries specified in the arrayref (they are all objects of type DBIx::SQLite::Simple::Table).

=cut

sub delete {
   my $self = shift;

   no strict 'refs';
   my @fields = @{ref($self). '::Fields'};

   $self->_delete(\@fields, @_);
}

=item B($arrayref)

Insert all entries specified in the arrayref (they are all objects of type DBIx
::SQLite::Simple::Table).

=cut

sub insert {
   my $self = shift;

   no strict 'refs';
   my $id     = ${ref($self). '::Id'};
   my @fields = @{ref($self). '::Fields'};

   $id ? return $self->_insert([ $id, @fields ], @_)
       : return $self->_insert(\@fields, @_);
}

=item B($arrayref)

Will update elements specified within the arrayref (they are all objects of type DBIx::SQLite::Simple::Table). If an additionnal argument is passed, it will act as a where clause. See SYNOPSIS.

=cut

sub update {
   my $self = shift;

   no strict 'refs';
   my $id     = ${ref($self). '::Id'};
   my @fields = @{ref($self). '::Fields'};

   $id ? return $self->_update([ $id, @fields ], $id, @_)
       : return $self->_update(\@fields, undef, @_);
}

=item B(%hash)

Returns the the id if the specified field/value hash.

=cut

sub lookupId {
   my $self = shift;

   no strict 'refs';
   my $id = ${ref($self). '::Id'};

   $self->_lookupId($id, @_);
}

=item B($field, field2 => value)

Returns the content of the specified field. See SYNOPSIS.

=cut

sub lookupString { shift->_lookupString(@_)  }

=back

=head1 AUTHOR

Patrice EGomoRE Auffret

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2015, Patrice EGomoRE Auffret

You may distribute this module under the terms of the Artistic license.
See LICENSE.Artistic file in the source distribution archive.

=cut

1;