From 9b277c57641b8afb56dac83a0ec9995d032b8d13 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 Signed-off-by: Marc Balmer --- C4/Context.pm | 8 ++-- C4/DBQ.pm | 65 ++++++++++++++++++++++++++++++++++++++ C4/DBQ/MySQL.pm | 64 +++++++++++++++++++++++++++++++++++++ C4/DBQ/PostgreSQL.pm | 65 ++++++++++++++++++++++++++++++++++++++ C4/ImportExportFramework.pm | 29 +++++++--------- C4/Installer/PerlDependencies.pm | 5 +++ t/DBQ.t | 58 +++++++++++++++++++++++++++++++++ 7 files changed, 274 insertions(+), 20 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/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..d0ce697 --- /dev/null +++ b/C4/DBQ/MySQL.pm @@ -0,0 +1,64 @@ +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 + &tableColumns +); + +sub new { + my $class = shift; + my $self = {}; + bless $self, $class; + return $self; +} + +=head2 tableColumns + +$value = $sql->tableColumns($tablename); + +Returns a string containing request to get a table's columns + +=cut + +sub tableColumns { + my ( $self, $table ) = @_; + return "SHOW COLUMNS FROM $table"; +} + +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..46300e4 --- /dev/null +++ b/C4/DBQ/PostgreSQL.pm @@ -0,0 +1,65 @@ +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 + &tableColumns +); + +sub new { + my $class = shift; + my $self = {}; + bless $self, $class; + return $self; +} + +=head2 tableColumns + +$value = $sql->tableColumns($tablename); + +Returns a string containing request to get a table's columns + +=cut + +sub tableColumns { + my ( $self, $table ) = @_; + return +"SELECT column_name as \"Field\", data_type as \"Type\" FROM information_schema.columns WHERE table_name ='$table'"; +} + +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..c69b5c5 100644 --- a/C4/ImportExportFramework.pm +++ b/C4/ImportExportFramework.pm @@ -25,6 +25,7 @@ use Digest::MD5 qw(md5_base64); use POSIX qw(strftime); use C4::Context; +use C4::DBQ; use C4::Debug; @@ -266,8 +267,8 @@ 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 $dbq = C4::DBQ->dbq; + my $sth = $dbh->prepare($dbq->tableColumns($table)); $sth->execute(); my @fields = (); while (my $hashRef = $sth->fetchrow_hashref) { @@ -305,8 +306,8 @@ 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 $dbq = C4::DBQ->dbq; + my $sth = $dbh->prepare($dbq->tableColumns($table)); $sth->execute(); my @fields = (); while (my $hashRef = $sth->fetchrow_hashref) { @@ -361,8 +362,8 @@ 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 $dbq = C4::DBQ->dbq; + my $sth = $dbh->prepare($dbq->tableColumns($table)); $sth->execute(); my @fields = (); while (my $hashRef = $sth->fetchrow_hashref) { @@ -426,8 +427,8 @@ 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 $dbq = C4::DBQ->dbq; + my $sth = $dbh->prepare($dbq->tableColumns($table)); $sth->execute(); my @fields = (); while (my $hashRef = $sth->fetchrow_hashref) { @@ -946,12 +947,8 @@ 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 $dbq = C4::DBQ->dbq; + my $sth = $dbh->prepare($dbq->tableColumns($table)); $sth->execute(); my $fields = {}; while (my $hashRef = $sth->fetchrow_hashref) { @@ -1004,8 +1001,8 @@ sub _import_table if ($format eq 'csv') { my @fieldsName = (); eval { - my $query = 'SHOW COLUMNS FROM ' . $table; - my $sth = $dbh->prepare($query); + my $dbq = C4::DBQ->dbq; + my $sth = $dbh->prepare($dbq->tableColumns($table)); $sth->execute(); while (my $hashRef = $sth->fetchrow_hashref) { push @fieldsName, $hashRef->{Field}; 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..f65ef2c --- /dev/null +++ b/t/DBQ.t @@ -0,0 +1,58 @@ +#!/usr/bin/perl +# +# This Koha test module is a stub! +# Add more tests here!!! + +use Modern::Perl; +use Data::Dumper; +use Test::More tests => 4; + +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->tableColumns("foo"), + "SHOW COLUMNS FROM foo", + "check C4::DBQ::MySQL->tableColumns" +); +is( + $pgsql->tableColumns("foo"), +"SELECT column_name as \"Field\", data_type as \"Type\" FROM information_schema.columns WHERE table_name ='foo'", + "check C4::DBQ::PostgreSQL->tableColumns" +); + -- 1.7.2.5