[Koha-devel] [PATCH] C4::Table - A simple OO database abstraction layer.
Joe Atzberger
joe.atzberger at liblime.com
Mon Nov 3 21:07:19 CET 2008
The purpose of Table is to provide all the basic functionality that
is reimplemented multiple times throughout Koha for each DB table.
This code is considered experimental and does not yet supplant any
production code. Please examine and test, like:
use C4::Table;
my $table = C4::Table->new("borrowers");
my $set = $table->select({surname=>"Smith", sort=>"branchcode,firstname"});
The argument style to select is similar to functions in C4::Tags using a hashref.
The return from select is a reference to array of hashrefs, like fetchall_arrayref({}).
The full database row is represented, like "SELECT(*)".
---
C4/Table.pm | 216 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
t/other/README | 5 ++
t/other/Table.t | 103 ++++++++++++++++++++++++++
3 files changed, 324 insertions(+), 0 deletions(-)
create mode 100644 C4/Table.pm
create mode 100644 t/other/README
create mode 100644 t/other/Table.t
diff --git a/C4/Table.pm b/C4/Table.pm
new file mode 100644
index 0000000..0b7737b
--- /dev/null
+++ b/C4/Table.pm
@@ -0,0 +1,216 @@
+package C4::Table;
+# Copyright 2008 LibLime
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use warnings;
+use Carp;
+
+use C4::Context;
+use C4::Debug;
+use Data::Dumper;
+
+use vars qw($VERSION);
+use vars qw(@tables $default);
+
+BEGIN {
+ $VERSION = 0.02; # experimental!
+ if ($debug) {
+ require Data::Dumper;
+ import Data::Dumper qw(:DEFAULT);
+ }
+}
+
+$default = {
+ tablename => undef,
+ columns => undef, # = fetchall_arrayref({}) from SHOW COLUMNS
+ fields => undef, # = ref to array of ALL field names
+ key_fields => undef, # = hashref of just the keys (field_name => keytype)
+};
+### Don't confuse the data structure here with the return values of similarly named functions
+
+sub new {
+ my ($class) = shift or croak "Bad call to " . __PACKAGE__ . " constructor new";
+ my $type = ref($class) || $class;
+ my $self = {};
+ foreach (keys %$default) {
+ $self->{$_} = $default->{$_};
+ }
+ $debug and warn "new " . __PACKAGE__ ;
+ bless $self, $type;
+ return $self->_init(@_);
+}
+
+sub fields { # returns array
+ my $self = shift or return undef;
+ defined ($self->{fields}) and return @{$self->{fields}};
+ my @fields = map {$_->{Field}} @{$self->columns};
+ $self->{fields} = \@fields;
+ return @fields;
+}
+sub key_fields { # returns hash
+ my $self = shift or return undef;
+ defined ($self->{key_fields}) and return %{$self->{key_fields}};
+ my @keys = grep {$_->{Key}} @{$self->columns};
+ my %map = ();
+ foreach (@keys) {
+ $map{$_->{Field}} = $_->{Key};
+ }
+ $self->{key_fields} =\%map;
+ return %map;
+}
+
+sub _columns_init {
+ my $self = shift or return undef;
+ $self->{tablename} or croak "No tablename set for " . __PACKAGE__ . " object";
+ my $sth = C4::Context->dbh->prepare("SHOW COLUMNS FROM " . $self->{tablename});
+ $sth->execute;
+ $self->{columns} = $sth->fetchall_arrayref({});
+ return $self;
+}
+sub columns { # returns reference to array of hashref, i.e. [{},{},{}...]
+ my $self = shift or return undef;
+ defined ($self->{columns}) or $self->_columns_init;
+ return $self->{columns};
+}
+
+sub _init {
+ my $self = shift or return undef;
+ unless ($self->{tablename} = shift) {
+ croak "Missing tablename argument in _init for " . __PACKAGE__ ;
+ return undef;
+ }
+ $self->_columns_init;
+ ($debug > 1) and print STDERR __PACKAGE__ . " : " . Dumper($self);
+ return $self;
+}
+
+sub delete ($$;$) {
+ die "delete not implemented yet";
+ my $self = shift or return undef;
+ my $hash = shift || {};
+}
+
+sub parse_args ($$$) { # returns $sql_fragment, @args
+ my $self = shift or croak "Bad call to method parse_args";
+ my $op = shift or croak "Bad call to method parse_args";
+ my $hash = shift || {};
+ my @ok_fields = $self->fields;
+ my $wheres;
+ my $limit = "";
+ my $order = "";
+ my @exe_args = ();
+ push @ok_fields, 'limit', 'sort'; # push the limit! :)
+ foreach my $key (keys %$hash) {
+ $debug and print STDERR "$op arg. '$key' = ", $hash->{$key}, "\n";
+ unless (length $key) {
+ carp "Empty argument key to $op: ignoring!";
+ next;
+ }
+ unless (1 == scalar grep {/^ $key $/x} @ok_fields) {
+ carp "$op received unreconized argument key '$key'.";
+ next;
+ }
+ if ($key eq 'limit') {
+ my $val = $hash->{$key};
+ unless ($val =~ /^(\d+,)?\d+$/) {
+ carp "Non-nuerical limit value '$val' ignored!";
+ next;
+ }
+ $limit = " LIMIT $val\n";
+ } elsif ($key eq 'sort') {
+ unless ($op eq 'select') {
+ carp 'Unexpected "sort" in arguments to non-SELECT parse_args: ignoring';
+ next;
+ }
+ foreach my $by (split /\s*\,\s*/, $hash->{$key}) {
+ my $sign;
+ $by =~ s/^([-+])// and $sign = $1;
+ unless (grep /^($by)$/, $self->fields) {
+ carp "Illegal sort order '$by'";
+ next;
+ }
+ if ($order) {
+ $order .= ", ";
+ } else {
+ $order = " ORDER BY ";
+ }
+ $order .= $by . " " . ((!$sign) ? '' : $sign eq '-' ? 'DESC' : $sign eq '+' ? 'ASC' : '') . "\n";
+ }
+ } else {
+ my $whereval = $hash->{$key};
+ my $op = ($whereval =~ s/^(>=|<=)// or
+ $whereval =~ s/^(>|=|<)// ) ? $1 : '=';
+ $wheres .= ($wheres) ? " AND $key $op ?\n" : " WHERE $key $op ?\n";
+ push @exe_args, $whereval;
+ }
+ }
+ ($order) and $wheres .= " $order";
+ ($limit) and $wheres .= " $limit";
+ $debug and print STDERR "$op WHERE(_LIMIT): $wheres\n";
+ return $wheres, @exe_args;
+}
+
+sub insert ($$) {
+ my $self = shift or croak "Bad call to method insert";
+ my ($sql_tail, at exe_args) = $self->parse_args('insert', shift);
+ my $query = "SELECT * FROM $self->{tablename} " . ($sql_tail||'');
+ $debug and print STDERR "insert query:\n $query\n",
+ "insert query args: ", join(',', @exe_args), "\n";
+ my $sth = C4::Context->dbh->prepare($query) or carp "dbh->prepare failed";
+ if (@exe_args) {
+ $sth->execute(@exe_args);
+ } else {
+ $sth->execute;
+ }
+ return $sth->fetchall_arrayref({});
+}
+
+sub select {
+ my $self = shift or croak "Bad call to method select";
+ my ($sql_tail, at exe_args) = $self->parse_args('select', shift);
+ my $query = "SELECT * FROM $self->{tablename} " . ($sql_tail||'');
+ $debug and print STDERR "select query:\n $query\n",
+ "select query args: ", join(',', @exe_args), "\n";
+ my $sth = C4::Context->dbh->prepare($query);
+ if (@exe_args) {
+ $sth->execute(@exe_args);
+ } else {
+ $sth->execute;
+ }
+ return $sth->fetchall_arrayref({});
+}
+
+1;
+__END__
+
+=head1 C4::Table - A DBI for any and all tables.
+
+This class is intended to stand in for all the basic methods (select, insert, update, delete) that are re-implemented
+everywhere.
+
+=head1 SYNOPSIS
+
+my $table = C4::Table->new('borrowers');
+my $set = $table->select({surname=>'Smith', sort=>'branchcode,firstname'});
+
+my $all_branches = C4::Table->new('branches')->select({sort=>'branchname'});
+
+=head1 TODO More documentation
+
+=head1 AUTHOR
+
+Joe Atzberger - atz AT liblime.com
diff --git a/t/other/README b/t/other/README
new file mode 100644
index 0000000..9e44dab
--- /dev/null
+++ b/t/other/README
@@ -0,0 +1,5 @@
+This directory is for optional and experimental tests that do not get run by
+"make test" from the t/ directory.
+
+Some of these tests may have additional module dependencies to demonstrate the
+difference between alternative implementations.
diff --git a/t/other/Table.t b/t/other/Table.t
new file mode 100644
index 0000000..670c13e
--- /dev/null
+++ b/t/other/Table.t
@@ -0,0 +1,103 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+use Test::More tests => 11;
+
+BEGIN {
+ use FindBin;
+ use lib $FindBin::Bin;
+ use_ok('C4::Table');
+}
+
+sub print_results ($;$) {
+ my $rows = shift;
+ my $max = (@_ ? shift : undef);
+ my $i = 0;
+ foreach my $row (@$rows) {
+ my @keys = sort keys %$row;
+ unless ($i++) {
+ diag(join "\t", @keys);
+ diag(join "\t", map {'-' x $_} map {length} @keys);
+ }
+ if ($max and $i > $max) {
+ diag(" ... ERROR: TOO MANY ROWS ... ");
+ return 0;
+ }
+ print "# " . (join "\t", map {$row->{$_}||''} @keys), "\n";
+ # NOT
+ # diag (join "\t", map {$row->{$_}||''} @keys);
+ # because Test::Builder cannot handle Unicode/utf8 strings
+ # like "Žukauskaitė"
+ }
+}
+sub field_we_want ($) {
+ my $x = shift;
+ return ($x eq 'surname' or $x eq 'borrowernumber' or $x eq 'cardnumber' or $x eq 'firstname' or
+ $x eq 'branchcode' or $x eq 'userid' or $x eq 'categorycode') ? 1 : 0;
+}
+
+binmode STDOUT, ':utf8';
+binmode STDERR, ':utf8';
+diag("843 LCC 1000001149 PT Simona Žukauskaitė szukaus06");
+my %tables;
+my @tablenames = (qw(branches borrowers));
+
+my $columns;
+foreach my $tname (@tablenames) {
+ ok($tables{$tname} = C4::Table->new($tname), "C4::Table->new('$tname')");
+}
+# construct all up front to test object independence from CLASS
+
+foreach my $tname (@tablenames) {
+ ok($columns = $tables{$tname}->columns, "\$$tname" . '->columns');
+ diag(sprintf "$tname table has %2d columns:", scalar(@$columns));
+ my $maxwidth = 0;
+ foreach(map {length($_->{Field})} @$columns) {
+ ($_ > $maxwidth) and $maxwidth = $_;
+ }
+ # diag("widest field name is $maxwidth characters");
+ foreach(@$columns) {
+ my $padding = $maxwidth-length($_->{Field});
+ diag(sprintf "\t$tname.%s %" . $padding . "s %s", $_->{Field}, '', $_->{Type});
+ }
+ diag(sprintf "END $tname table (%2d columns)", scalar(@$columns));
+ print "#\n";
+}
+
+foreach my $tname (qw(branches)) {
+ my $select;
+ ok($select = $tables{$tname}->select({sort=>"+branchcode"}), "\$$tname" . '->select({sort=>"+branchcode"})');
+ diag(scalar(@$select) . " $tname retrieved, sorted by branchcode ASCENDING:");
+ print_results($select);
+ ok($select = $tables{$tname}->select({sort=>"-branchcode"}), "\$$tname" . '->select({sort=>"-branchcode"})');
+ diag(scalar(@$select) . " $tname retrieved, sorted by branchcode DESCENDING:");
+ print_results($select);
+}
+foreach my $tname (qw(borrowers)) {
+ my ($select, $count);
+ ok($select = $tables{$tname}->select({sort=>"+surname", limit=>5}), "\$$tname" . '->select({sort=>"+surname", limit=>5})');
+ diag(scalar(@$select) . " $tname retrieved, sorted by surname ASCENDING, limit 5:");
+ ok($count = scalar(@$select) <= 5, "limit=>5 returned " . scalar(@$select) . " items");
+ foreach my $row (@$select) {
+ foreach (keys %$row) {field_we_want($_) or delete $row->{$_};}
+ # make the display more managable. note: you wouldn't want to do this (select * then purge) in production code
+ }
+ print_results($select, 5);
+ ok($select = $tables{$tname}->select({sort=>"-surname", limit=>5}), "\$$tname" . '->select({sort=>"-surname", limit=>5})');
+ diag(scalar(@$select) . " $tname retrieved, sorted by surname DESCENDING, limit 5:");
+ ok($count = scalar(@$select) <= 5, "limit=>5 returned " . scalar(@$select) . " items");
+ foreach my $row (@$select) {
+ foreach (keys %$row) {field_we_want($_) or delete $row->{$_};}
+ # make the display more managable. note: you wouldn't want to do this (select * then purge) in production code
+ }
+ print_results($select, 5);
+}
+
+#############################
+diag "done.\n";
+exit;
+#############################
+
--
1.5.5.GIT
More information about the Koha-devel
mailing list