[PATCH] C4::Table - A simple OO database abstraction layer.
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,@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,@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
Joe Atzberger a écrit :
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"});
Hi Joe, do we agree that it doesn't mean there will be those statements in Perl ? I think having all Perl in C4/*.pm is a good way. So, this C4::Table will be used in .pm. agreed ? -- Paul POULAIN http://www.biblibre.com Expert en Logiciels Libres pour l'info-doc NOUVEAU TELEPHONE : 04 91 81 35 08
Paul -- I think you mean all the SQL should be in C4, and yes I agree with that. C4::Table does not receive any SQL as arguments to select, insert or delete. I.E., it preserves the encapsulation of SQL inside C4/*. This would speed up development of features because a C4/NewFeature.pm module might not be necessary at all, or could focus on things special to NewFeature besides basic table operations. Once a table is added to the DB, C4::Table can access it, no new code necessary. And the other code will be more recognizable, using the same kind of $table->select({fieldname=>"value"}) statements. Would be nice to be able to use the same OO code accessing issues and old_issues, or any of the XX and old_XX tables, for example. --Joe On Tue, Nov 4, 2008 at 12:43 PM, Paul POULAIN <paul.poulain@free.fr> wrote:
Joe Atzberger a écrit :
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"});
Hi Joe,
do we agree that it doesn't mean there will be those statements in Perl ? I think having all Perl in C4/*.pm is a good way. So, this C4::Table will be used in .pm. agreed ?
-- Paul POULAIN http://www.biblibre.com Expert en Logiciels Libres pour l'info-doc NOUVEAU TELEPHONE : 04 91 81 35 08
Joe Atzberger a écrit :
Paul --
I think you mean all the SQL should be in C4, and yes I agree with that. C4::Table does not receive any SQL as arguments to select, insert or delete. I.E., it preserves the encapsulation of SQL inside C4/*.
This would speed up development of features because a C4/NewFeature.pm module might not be necessary at all, or could focus on things special to NewFeature besides basic table operations. Once a table is added to the DB, C4::Table can access it, no new code necessary.
And the other code will be more recognizable, using the same kind of $table->select({fieldname=>"value"}) statements. Would be nice to be able to use the same OO code accessing issues and old_issues, or any of the XX and old_XX tables, for example.
let me be more precise : do you agree that $table->select({fieldname => "value"}) is SQL somewhere : fieldname. If we change fieldname to newfieldname, with Koha as it's written now, you'll just have to dig C4 to find all occurrences of fieldname and update them. If you embeed $table->select... in a .pl, then that will be much more complex to maintain. + I really love to have a "high level" sub, that is fully DB independant (GetBorrowers(), GetBiblio()...) I'm not sure that what you answered me was the answer I was waiting for. I hope my concerne is now clear enough to be sure we are on the same way. Note : there are SQL statements in admin/ it's an historical reason : when I started to hack admin/script, I was a beginner at Perl. I'm not really proud of the code I wrote here, and, obviously, it should be rewritten. But as it works and nobody had time to do it... nobody did it. yet. -- Paul POULAIN http://www.biblibre.com Expert en Logiciels Libres pour l'info-doc NOUVEAU TELEPHONE : 04 91 81 35 08
On Wed, Nov 5, 2008 at 5:42 AM, Paul POULAIN <paul.poulain@free.fr> wrote:
Joe Atzberger a écrit :
Paul --
I think you mean all the SQL should be in C4, and yes I agree with that. C4::Table does not receive any SQL as arguments to select, insert or delete. I.E., it preserves the encapsulation of SQL inside C4/*.
This would speed up development of features because a C4/NewFeature.pm module might not be necessary at all, or could focus on things special to NewFeature besides basic table operations. Once a table is added to the DB, C4::Table can access it, no new code necessary.
And the other code will be more recognizable, using the same kind of $table->select({fieldname=>"value"}) statements. Would be nice to be able to use the same OO code accessing issues and old_issues, or any of the XX and old_XX tables, for example.
let me be more precise : do you agree that $table->select({fieldname => "value"}) is SQL somewhere : fieldname.
It is the table fieldname, yes. But that is not SQL. It would be the same as if you were querying some object unrelated to a DB table. If we change fieldname to newfieldname, with Koha as it's written now,
you'll just have to dig C4 to find all occurrences of fieldname and update them.
If you embeed $table->select... in a .pl, then that will be much more complex to maintain.
Not at all. The current approach that most frequently returns a reference to hashref (or reference to array of hashref) ALSO expects you to know the fieldnames in each script retrieving the data. This same argument style is already present in functions like ModMember. Perhaps it's useful to approach the question in reverse. Say you have one table and you to write a C4::Module to allow me to query that table. If all we ever needed was GetRowByPrimaryKey, it wouldn't be an issue. But we know we want to be able to search against any field. How would you do it? You could have: use C4::Module; my $row_a = GetRowByField1($field1); my $row_b = GetRowByField2($field2); my $row_c = GetRowByField3($field3); # ... and so on ... But that is obviously the least efficient and most duplicative approach. If you have n fields, you would need n different functions. It also fails if we want to specify matching against two fields. It should be no surprise that we don't solve that problem by making a whole bunch of specialized combo functions like: my $row_d = GetRowByField1xField3($field1, $field3); That would only make matters worse, requiring additional functions for every pairing of fields (equalling the sum 1 + 2 + 3 ... + n-1). Very silly indeed, since then we might want to specify 3, 4 or all n fields. So we do one big function: my $row_e = GetRow($field1, $field2, $field3 ... ); This is representative of the approach taken by parts of Koha. Although in most cases Koha doesn't implement it, we would need to have n argument slots for complete functionality. We then have the problem of expressing when we want the function to ignore an argument, and when we want to filter on a value like zero. And it starts to get ridiculous when you see calls like: GetRow(undef, undef, undef, 3, undef, 0, ""); Sometimes the argument order matches the order of fields in the table, and sometimes it doesn't. I think having to remember the numerical position of ALL n arguments is far worse than having to remember the names of just the fields you care about. In particular the problem of updating some fields in a record, without updating ALL of them brings us to Koha's most advanced argument style: ModRow({id=>$id, field1=>$field1}); # or GetRow({fieldname=>"value"}); But back to our hypothetical, say you were able to write the code to accept a hashref and return the correct rows from the table. It might look a bit like the code in C4::Tags. Paul, you seem to object to using the fieldnames as the keys in the hashref, but nothing else would be more sensible. There's no point to making me use a different label when the purpose really is to match against a specific table field. Certainly it is preferable to the old style of: my $member = GetMember($arg, 'cardnumber'); C4::Table is good enough to carp at me if I supply an unrecognized key. Passing hashref arguments is best practice<http://www.perl.com/pub/a/2006/02/23/advanced_subroutines.html>, afaict <http://safari.oreilly.com/0596001738/perlbp-CHP-16-SECT-4>, and allows clean conversion to OO style, where GetRow actually is more like a constructor: my $rowobj = C4::Module->new({fieldname=>"value"}); So imagining that you finish C4::Module and it works like we want... ok, good! After adding insert, modify and delete functions, you would still have to write similar new code for every new DB table added. C4::Table gives it to you in one place, with error checking and internal caching of structural data, for every existing Koha table and every Koha table that *could* exist, using (in preliminary form) less than 250 lines of code! I think that's about as many lines as we've now used in conversation about it, and I admit I probably should put a lot of this into the module as perldoc to make more apparent my motivation behind it. Hopefully that is more clear now, even if we may disagree about argument style. If you know a preferable alternative to hashref arguments, I would be glad to hear more about it. --Joe
Joe Atzberger wrote:
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"});
So what's it going to be for K3? C4::Table or DBIx::Class? -rickw -- _________________________________ Rick Welykochy || Praxis Services Tis the dream of each programmer before his life is done, To write three lines of APL and make the damn thing run.
DBIx::Class, in all likelihood, will be the real solution. As the author of C4::Table, I still think it is cool, easy to use and relatively tight, but it's unfinished, and there won't be a real need for it once we have DBIx::Class involved. --Joe On Thu, Nov 13, 2008 at 4:59 AM, Rick Welykochy <rick@praxis.com.au> wrote:
Joe Atzberger wrote:
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"});
So what's it going to be for K3?
C4::Table or DBIx::Class?
-rickw -- _________________________________ Rick Welykochy || Praxis Services
Tis the dream of each programmer before his life is done, To write three lines of APL and make the damn thing run.
participants (4)
-
Joe Atzberger -
Joe Atzberger -
Paul POULAIN -
Rick Welykochy