File Coverage

blib/lib/DBIx/Cursor.pm

Criterion	Covered	Total	%
statement	12	180	6.6
branch	0	48	0.0
condition	0	21	0.0
subroutine	4	20	20.0
pod	15	15	100.0
total	31	284	10.9

########################################################################
#
#    Copyright (c) 2001,2002 by Tommi Mäkitalo
#
#    This package is free software; you can redistribute it
#    and/or modify it under the same terms as Perl itself.
#
########################################################################

package DBIx::Cursor;

use 5.6.0;
use strict;
use warnings;
use Carp;

our $VERSION = '0.14';

my %cache;

# ----------------------------------------------------------------------
sub new
{
  shift;
  my $self  = {};
  my $dbh   = shift;
  my $table = shift;
  my $pk    = \@_;

  # read names and types of columns
  unless ($cache{$table})
  {
    my $sth = $dbh->prepare("select * from $table where 0=1");
    $sth->execute or croak('error fetching columns');

    $self->{NAME}    = $sth->{NAME};
    $self->{TYPE}    = $sth->{TYPE};
    $self->{type}    = {};
    for (my $i = 0; $i < @{$self->{NAME}}; ++$i)
    {
      $self->{type}{$self->{NAME}[$i]} = $self->{TYPE}[$i];
    }

    # read primary-key if not given
    unless ($pk)
    {
      my @pk = $dbh->primary_key(undef, undef, $table);
      if (@pk)
      {
        $pk = \@pk;
      }
      else
      {
        croak ('primary key not known');
      }
    }

    $self->{pk}    = $pk;

    $cache{$table} = [$self->{NAME}, $self->{TYPE}, $self->{type}, $self->{pk}];
  }
  else
  {
    ($self->{NAME}, $self->{TYPE}, $self->{type}, $self->{pk}) = @{$cache{$table}};
  }

  # initialize values
  $self->{dbh}   = $dbh;
  $self->{table} = $table;

  # initialize data
  $self->{data}    = {};
  $self->{olddata} = {};

  # return value
  bless $self;
  return $self;
}

# ----------------------------------------------------------------------
sub DESTROY
{
  my $self = shift;
  $self->reset;
}

# ----------------------------------------------------------------------
sub dbh
{
  my $self = shift;
  return $self->{dbh};
}

# ----------------------------------------------------------------------
sub get_type
{
  my $self = shift;
  my $colname = shift;

  return $self->{type}{$colname} or croak ("column $colname not found");
}

# ----------------------------------------------------------------------
sub get_columns
{
  my $self = shift;
  return @{$self->{NAME}};
}

# ----------------------------------------------------------------------
sub read
{
  my $self = shift;
  my @values = @_;

  my @pk = @{$self->{pk}};

  croak ('invalid number of parameters') unless @values == @pk;

  my $dbh   = $self->{dbh};
  my $table = $self->{table};

  my $sth = $self->{sth_select};
  unless ($sth)
  {
    my $sql = "select * from $table where "
            . join(' and ', map { "$_ = ?" } @pk);

    $self->reset;
    $sth = $self->{sth_select} = $dbh->prepare($sql);
  }
  $sth->execute(@values);

  if ($self->{data} = $sth->fetchrow_hashref)
  {
    %{$self->{olddata}} = %{$self->{data}};
    return $self;
  }
  else
  {
    return undef;
  }
}

# ----------------------------------------------------------------------
sub set
{
  my $self = shift;
  my %newval = @_;

  while (my ($key, $value) = each (%newval) )
  {
    croak("column $key not found") unless $self->{type}{$key};
    $self->{data}{$key} = $value;
  }

  return $self;
}

# ----------------------------------------------------------------------
sub get
{
  my $self = shift;
  my @columns = @_;

  if (@columns)
  {
    if (wantarray)
    {
      return map { $self->{data}{$_} } @columns;
    }
    else
    {
      return $self->{data}{$columns[0]};
    }
  }
  elsif (wantarray)
  {
    return %{$self->{data}};
  }
  else
  {
    return $self->{data};
  }
}

# ----------------------------------------------------------------------
sub reset
{
  my $self = shift;

  $self->{data}    = {};
  $self->{olddata} = {};

  if ($self->{sth})
  {
    $self->{sth}->finish;
    $self->{sth} = undef;
  }

  return $self;
}

# ----------------------------------------------------------------------
sub where
{
  my $self = shift;

  $self->reset;
  $self->{where} = shift;
  $self->{values} = \@_;

  return $self;
}

# ----------------------------------------------------------------------
sub values
{
  my $self = shift;

  $self->reset;
  $self->{values} = \@_;

  return $self;
}

# ----------------------------------------------------------------------
sub fetch
{
  my $self = shift;

  unless ($self->{sth})
  {
    my $table = $self->{table};
    my $dbh   = $self->{dbh};
    my $sql   = "select * from $table";
    my $where = $self->{where};

    if ($where)
    {
      $sql .= ' where' if ($where !~ /^\s*(where)|(order\s+by)\s/i);
      $sql .= " $where";
    }

    my @values = @{$self->{values}} if $self->{values};
    $self->{sth} = $dbh->prepare($sql);
    $self->{sth}->execute(@values);
  }

  if ($self->{data} = $self->{sth}->fetchrow_hashref)
  {
    %{$self->{olddata}} = %{$self->{data}};
    return $self->get;
  }
  else
  {
    $self->reset;
    return undef;
  }
}

# ----------------------------------------------------------------------
sub update
{
  my $self = shift;

  my $data  = $self->{data};
  my $odata = $self->{olddata};
  my $table = $self->{table};
  my $dbh   = $self->{dbh};
  my $pk    = $self->{pk};

  # the columns to update are either given as parameter or
  # every not primary-key-column
  my @updatecols = @_ ? @_
                      : grep {                       # seach columns
                               my $col = $_;
                               # return every column not in primary-key
                               ! grep { $col eq $_ } @$pk
                             } @{$self->{NAME}};

  # check if update is needed
  my @cols;
  my @values;
  foreach my $col (@updatecols)
  {
    my $d = $data->{$col};
    my $o = $odata->{$col};
    next unless defined $d && !defined $o
       || !defined $d && defined $o
       || defined $d && defined $o && $o ne $d;
    push @cols, $col;
    push @values, $d;
  }

  return unless @cols;

  my $sql = "update $table set "
          . join(', ', map { "$_ = ?" } @cols )
          . ' where '
          . join(' and ', map { "$_ = ?" } @$pk);

  my @pkvalues = map { $odata->{$_} || $data->{$_} } @$pk;

  my $sth = $dbh->prepare($sql);
  my $ret = $sth->execute(@values, @pkvalues);
  %{$self->{olddata}} = %{$self->{data}};
  return $ret;
}

# ----------------------------------------------------------------------
sub insert
{
  my $self  = shift;
  my $table = $self->{table};
  my $dbh   = $self->{dbh};

  my $sth = $self->{sth_insert};
  unless ($sth)
  {
    my $sql = "insert into $table values ("
            . join(', ', ('?') x @{$self->{NAME}})
            . ')';

    $sth = $self->{sth_insert} = $dbh->prepare($sql);
  }

  my @values = map { $self->{data}{$_} } @{$self->{NAME}};

  return $sth->execute(@values);
}

# ----------------------------------------------------------------------
sub replace
{
  my $self = shift;
  return $self->update != 0 || $self->insert;
}

# ----------------------------------------------------------------------
sub delete
{
  my $self = shift;

  my $data  = $self->{data};
  my $table = $self->{table};
  my $dbh   = $self->{dbh};
  my $pk    = $self->{pk};

  my $sth = $self->{sth_delete};
  unless ($sth)
  {
    my $sql = "delete from $table where "
            . join(' and ', map { "$_ = ?" } @$pk);
    $sth = $self->{sth_delete} = $dbh->prepare($sql);
  }

  my @pkvalues = map { $data->{$_} } @$pk;

  $sth->execute(@pkvalues);
}

1;

__END__