From e9511b8385f831cae25ae02a7e9f7472a6566479 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Delaune?= Date: Wed, 21 Mar 2012 15:57:15 +0100 Subject: [PATCH] Bug 7365: Add DBQ, a small module to generate DB specific SQL code --- C4/Acquisition.pm | 34 ++++++---------- C4/Context.pm | 8 ++-- C4/DBQ.pm | 65 +++++++++++++++++++++++++++++++ C4/DBQ/MySQL.pm | 78 ++++++++++++++++++++++++++++++++++++++ C4/DBQ/PostgreSQL.pm | 78 ++++++++++++++++++++++++++++++++++++++ C4/ImportExportFramework.pm | 42 ++++++++------------- C4/Installer/PerlDependencies.pm | 5 ++ t/DBQ.t | 67 ++++++++++++++++++++++++++++++++ 8 files changed, 326 insertions(+), 51 deletions(-) create mode 100644 C4/DBQ.pm create mode 100644 C4/DBQ/MySQL.pm create mode 100644 C4/DBQ/PostgreSQL.pm create mode 100755 t/DBQ.t diff --git a/C4/Acquisition.pm b/C4/Acquisition.pm index 0a96a02..5806cd1 100644 --- a/C4/Acquisition.pm +++ b/C4/Acquisition.pm @@ -22,6 +22,7 @@ use strict; use warnings; use Carp; use C4::Context; +use C4::DBQ; use C4::Debug; use C4::Dates qw(format_date format_date_in_iso); use MARC::Record; @@ -1476,27 +1477,18 @@ sub GetLateOrders { AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00') "; my $having = ""; - if ($dbdriver eq "mysql") { - $select .= " - aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity, - (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal, - DATEDIFF(CURDATE( ),closedate) AS latesince - "; - $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) "; - $having = " - HAVING quantity <> 0 - AND unitpricesupplier <> 0 - AND unitpricelib <> 0 - "; - } else { - # FIXME: account for IFNULL as above - $select .= " - aqorders.quantity AS quantity, - aqorders.quantity * aqorders.rrp AS subtotal, - (CURDATE - closedate) AS latesince - "; - $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) "; - } + my $dbq = C4::DBQ->dbq; + $select .= " + aqorders.quantity - " . $dbq->ifNull("aqorders.quantityreceived", "0") . " AS quantity, + (aqorders.quantity - " . $dbq->ifNull("aqorders.quantityreceived", "0") .") * aqorders.rrp AS subtotal, + (CAST(now() AS date) - closedate) AS latesince + "; + $from .= " AND (closedate <= " . $dbq->dateSub("CAST(now() AS date)", "?", "DAY") . ") "; + $having = " + HAVING quantity <> 0 + AND unitpricesupplier <> 0 + AND unitpricelib <> 0 + "; if (defined $supplierid) { $from .= ' AND aqbasket.booksellerid = ? '; push @query_params, $supplierid; diff --git a/C4/Context.pm b/C4/Context.pm index 0417c45..54ef1ec 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -284,13 +284,12 @@ sub memcached { # sub db_scheme2dbi { my $name = shift; - # for instance, we support only mysql, so don't care checking - return "mysql"; for ($name) { # FIXME - Should have other databases. if (/mysql/) { return("mysql"); } - if (/Postgres|Pg|PostgresSQL/) { return("Pg"); } - if (/oracle/) { return("Oracle"); } + elsif (/Postgres|Pg|pgsql|PostgresSQL/i) { return("Pg"); } + elsif (/oracle/) { return("Oracle"); } + else { return("mysql"); } } return undef; # Just in case } @@ -1103,6 +1102,7 @@ sub get_versions { { no warnings qw(exec); # suppress warnings if unable to find a program in $PATH $versions{mysqlVersion} = `mysql -V`; + $versions{psqlVersion} = `psql -V`; $versions{apacheVersion} = `httpd -v`; $versions{apacheVersion} = `httpd2 -v` unless $versions{apacheVersion} ; $versions{apacheVersion} = `apache2 -v` unless $versions{apacheVersion} ; diff --git a/C4/DBQ.pm b/C4/DBQ.pm new file mode 100644 index 0000000..dadea8c --- /dev/null +++ b/C4/DBQ.pm @@ -0,0 +1,65 @@ +package C4::DBQ; + +# Copyright 2012 BibLibre and Marc Balmer +# +# 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., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; +use C4::Context; +use vars qw(@ISA @EXPORT $state); + +@ISA = qw(Exporter); + +@EXPORT = qw( + &dbq +); + +$state = {}; + +sub dbq { + my ( $self, $dbtype ) = @_; + $dbtype //= C4::Context->config("db_scheme"); + if ( !$$state{"dbtype"} or $$state{"dbtype"} ne $dbtype ) { + if ( $dbtype eq "mysql" ) { + require C4::DBQ::MySQL; + $$state{"obj"} = C4::DBQ::MySQL->new(); + } + elsif ( $dbtype =~ /Postgres|Pg|PostgresSQL|pgsql/i ) { + require C4::DBQ::PostgreSQL; + $$state{"obj"} = C4::DBQ::PostgreSQL->new(); + } + else { + die "unsupported database type " . $dbtype; + } + $$state{"dbtype"} = $dbtype; + } + return $$state{"obj"}; +} + +1; +__END__ + +=head1 AUTHOR + +Koha Development Team + +Stephane Delaune + +Marc Balmer + +Christophe Croullebois + +=cut diff --git a/C4/DBQ/MySQL.pm b/C4/DBQ/MySQL.pm new file mode 100644 index 0000000..08e88ee --- /dev/null +++ b/C4/DBQ/MySQL.pm @@ -0,0 +1,78 @@ +package C4::DBQ::MySQL; + +# Copyright 2012 BibLibre and Marc Balmer +# +# 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., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; +use C4::Context; +use vars qw(@ISA @EXPORT); + +@ISA = qw(Exporter); + +@EXPORT = qw( + &new + &dateSub + &ifNull +); + +sub new { + my $class = shift; + my $self = {}; + bless $self, $class; + return $self; +} + +=head2 dateSub + +$value = $dbq->dateSub("2000-01-31", "1", "DAY") + +Subtract a time value (interval) from a date + +=cut + +sub dateSub { + my ( $self, $date, $interval, $unit ) = @_; + return "DATE_SUB($date, INTERVAL $interval $unit)"; +} + +=head2 ifNull + +$value = $dbq->ifNull($a, $b); + +Returns $a if not null, else return $b + +=cut + +sub ifNull { + my ( $self, $a, $b ) = @_; + return "IFNULL($a, $b)"; +} + +1; +__END__ + +=head1 AUTHOR + +Koha Development Team + +Stephane Delaune + +Marc Balmer + +Christophe Croullebois + +=cut diff --git a/C4/DBQ/PostgreSQL.pm b/C4/DBQ/PostgreSQL.pm new file mode 100644 index 0000000..c0a7592 --- /dev/null +++ b/C4/DBQ/PostgreSQL.pm @@ -0,0 +1,78 @@ +package C4::DBQ::PostgreSQL; + +# Copyright 2012 BibLibre and Marc Balmer +# +# 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., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; +use C4::Context; +use vars qw(@ISA @EXPORT); + +@ISA = qw(Exporter); + +@EXPORT = qw( + &new + &dateSub + &ifNull +); + +sub new { + my $class = shift; + my $self = {}; + bless $self, $class; + return $self; +} + +=head2 dateSub + +$value = $dbq->dateSub("2000-01-31", "1", "DAY") + +Subtract a time value (interval) from a date + +=cut + +sub dateSub { + my ( $self, $date, $interval, $unit ) = @_; + return "$date - interval '$interval $unit'"; +} + +=head2 ifNull + +$value = $dbq->ifNull($a, $b); + +Returns $a if not null, else return $b + +=cut + +sub ifNull { + my ( $self, $a, $b ) = @_; + return "COALESCE($a, $b)"; +} + +1; +__END__ + +=head1 AUTHOR + +Koha Development Team + +Stephane Delaune + +Marc Balmer + +Christophe Croullebois + +=cut diff --git a/C4/ImportExportFramework.pm b/C4/ImportExportFramework.pm index d85e64f..49e3683 100644 --- a/C4/ImportExportFramework.pm +++ b/C4/ImportExportFramework.pm @@ -266,12 +266,11 @@ sub _export_table_sql eval { # First row with the name of the columns - my $query = 'SHOW COLUMNS FROM ' . $table; - my $sth = $dbh->prepare($query); + my $sth = $dbh->column_info(undef, undef, $table, "%"); $sth->execute(); my @fields = (); while (my $hashRef = $sth->fetchrow_hashref) { - push @fields, $hashRef->{Field}; + push @fields, $hashRef->{COLUMN_NAME}; } my $fields = join(',', @fields); $$strSQL .= 'DELETE FROM ' . $table . ' WHERE frameworkcode=' . $dbh->quote($frameworkcode) . ';'; @@ -305,13 +304,12 @@ sub _export_table_csv eval { # First row with the name of the columns - my $query = 'SHOW COLUMNS FROM ' . $table; - my $sth = $dbh->prepare($query); + my $sth = $dbh->column_info(undef, undef, $table, "%"); $sth->execute(); my @fields = (); while (my $hashRef = $sth->fetchrow_hashref) { - $$strCSV .= '"' . $hashRef->{Field} . '",'; - push @fields, $hashRef->{Field}; + $$strCSV .= '"' . $hashRef->{COLUMN_NAME} . '",'; + push @fields, $hashRef->{COLUMN_NAME}; } chop $$strCSV; $$strCSV .= chr(10); @@ -361,19 +359,18 @@ sub _export_table_ods my $elementCell; my $elementData; # First row with the name of the columns - my $query = 'SHOW COLUMNS FROM ' . $table; - my $sth = $dbh->prepare($query); + my $sth = $dbh->column_info(undef, undef, $table, "%"); $sth->execute(); my @fields = (); while (my $hashRef = $sth->fetchrow_hashref) { $elementCell = $dom->createElement('table:table-cell'); $elementCell->setAttribute('office:value-type', 'string'); - $elementCell->setAttribute('office:value', $hashRef->{Field}); + $elementCell->setAttribute('office:value', $hashRef->{COLUMN_NAME}); $elementRow->appendChild($elementCell); $elementData = $dom->createElement('text:p'); $elementCell->appendChild($elementData); - $elementData->appendTextNode($hashRef->{Field}); - push @fields, {name => $hashRef->{Field}, type => ($hashRef->{Type} =~ /int/i)?'float':'string'}; + $elementData->appendTextNode($hashRef->{COLUMN_NAME}); + push @fields, {name => $hashRef->{COLUMN_NAME}, type => ($hashRef->{TYPE_NAME} =~ /int/i)?'float':'string'}; } # Populate rows with the data from mysql $query = 'SELECT * FROM ' . $table . ' WHERE frameworkcode=?'; @@ -426,8 +423,7 @@ sub _export_table_excel # First row with the name of the columns my $elementCell; my $elementData; - my $query = 'SHOW COLUMNS FROM ' . $table; - my $sth = $dbh->prepare($query); + my $sth = $dbh->column_info(undef, undef, $table, "%"); $sth->execute(); my @fields = (); while (my $hashRef = $sth->fetchrow_hashref) { @@ -437,8 +433,8 @@ sub _export_table_excel $elementData = $dom->createElement('ss:Data'); $elementData->setAttribute('ss:Type', 'String'); $elementCell->appendChild($elementData); - $elementData->appendTextNode($hashRef->{Field}); - push @fields, {name => $hashRef->{Field}, type => ($hashRef->{Type} =~ /int/i)?'Number':'String'}; + $elementData->appendTextNode($hashRef->{COLUMN_NAME}); + push @fields, {name => $hashRef->{COLUMN_NAME}, type => ($hashRef->{TYPE_NAME} =~ /int/i)?'Number':'String'}; } # Populate rows with the data from mysql $query = 'SELECT * FROM ' . $table . ' WHERE frameworkcode=?'; @@ -946,16 +942,11 @@ sub _check_validity_worksheet my $ret = 0; eval { - my $query = 'DESCRIBE ' . $table; - my $sth = $dbh->prepare($query); - $sth->execute(); - $sth->finish; - $query = 'SHOW COLUMNS FROM ' . $table; - $sth = $dbh->prepare($query); + my $sth = $dbh->column_info(undef, undef, $table, "%"); $sth->execute(); my $fields = {}; while (my $hashRef = $sth->fetchrow_hashref) { - $fields->{$hashRef->{Field}} = $hashRef->{Field}; + $fields->{$hashRef->{COLUMN_NAME}} = $hashRef->{COLUMN_NAME}; } my @fields; my $fieldsR; @@ -1004,11 +995,10 @@ sub _import_table if ($format eq 'csv') { my @fieldsName = (); eval { - my $query = 'SHOW COLUMNS FROM ' . $table; - my $sth = $dbh->prepare($query); + my $sth = $dbh->column_info(undef, undef, $table, "%"); $sth->execute(); while (my $hashRef = $sth->fetchrow_hashref) { - push @fieldsName, $hashRef->{Field}; + push @fieldsName, $hashRef->{COLUMN_NAME}; } }; $ok = _import_table_csv($dbh, $table, $frameworkcode, $dom, $PKArray, \%fields2Delete, \@fieldsName); diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index 0a888a8..212e5b3 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/C4/Installer/PerlDependencies.pm @@ -79,6 +79,11 @@ our $PERL_DEPS = { 'required' => '1', 'min_ver' => '4.004' }, + 'DBD::Pg' => { + 'usage' => 'Core', + 'required' => '1', + 'min_ver' => '2.19.2' + }, 'XML::LibXML' => { 'usage' => 'Core', 'required' => '1', diff --git a/t/DBQ.t b/t/DBQ.t new file mode 100755 index 0000000..f37b6a6 --- /dev/null +++ b/t/DBQ.t @@ -0,0 +1,67 @@ +#!/usr/bin/perl +# +# This Koha test module is a stub! +# Add more tests here!!! + +use Modern::Perl; +use Data::Dumper; +use Test::More tests => 6; + +BEGIN { + use_ok('C4::DBQ'); +} + +#check if all files in C4/DBQ/ have the same sub's names +my $dirname = C4::Context->intranetdir . "/C4/DBQ/"; +my %sublists; +opendir my ($dh), $dirname or die "Couldn't open dir '$dirname': $!"; +my @files = readdir $dh; +foreach my $file (@files) { + my @sublist = (); + my $stringlist = ""; + + open my $f, '<', $dirname . $file; + while ( my $line = <$f> ) { + if ( $line =~ /^(\s*)sub(\s*)([^{|\s]+)(\s*){/ ) { + push( @sublist, $3 ); + } + } + close $f; + my @sortlist = sort( { $a cmp $b } @sublist ); + foreach my $subname (@sortlist) { + $stringlist .= "$subname|"; + } + $sublists{$stringlist} = 1 if $stringlist; + + #print $file; +} +closedir $dh; +my $countdiffsubs = 0; +foreach my $sublists ( keys(%sublists) ) { + $countdiffsubs++; +} +is( $countdiffsubs, '1', "check sub's list into C4/DBQ/ files" ); + +#check each sub +my $mysql = C4::DBQ->dbq('mysql'); +my $pgsql = C4::DBQ->dbq('pgsql'); +is( + $mysql->dateSub("2000-01-31", "1", "DAY"), + "DATE_SUB(2000-01-31, INTERVAL 1 DAY)", + "check C4::DBQ::MySQL->dateSub" +); +is( + $pgsql->dateSub("2000-01-31", "1", "DAY"), + "2000-01-31 - interval '1 DAY'", + "check C4::DBQ::PostgreSQL->dateSub" +); +is( + $mysql->ifNull("a", "b"), + "IFNULL(a, b)", + "check C4::DBQ::MySQL->ifNull" +); +is( + $pgsql->ifNull("a", "b"), + "COALESCE(a, b)", + "check C4::DBQ::PostgreSQL->ifNull" +); -- 1.7.5.4