Attachment #8534 for bug #7365

View | Details | Raw Unified | Return to bug 7365
Collapse All | Expand All




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;

        AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
    ";
    my $having = "";
    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
    ";
    } 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)) ";
    }
    if (defined $supplierid) {
        $from .= ' AND aqbasket.booksellerid = ? ';
        push @query_params, $supplierid;




# 
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"); }
        elsif (/Postgres|Pg|pgsql|PostgresSQL/i) { return("Pg"); }
        elsif (/oracle/) { return("Oracle"); }
        else { return("mysql"); }
    }
    return undef;         # Just in case
}

    {
        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} ;




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 <http://koha-community.org/>

Stephane Delaune <stephane.delaune at biblibre dot com>

Marc Balmer <marc at msys dot ch>

Christophe Croullebois <christophe.croullebois at biblibre dot com>

=cut




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 <http://koha-community.org/>

Stephane Delaune <stephane.delaune at biblibre dot com>

Marc Balmer <marc at msys dot ch>

Christophe Croullebois <christophe.croullebois at biblibre dot com>

=cut




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 <http://koha-community.org/>

Stephane Delaune <stephane.delaune at biblibre dot com>

Marc Balmer <marc at msys dot ch>

Christophe Croullebois <christophe.croullebois at biblibre dot com>

=cut





    eval {
        # First row with the name of the columns
        my $sth = $dbh->column_info(undef, undef, $table, "%");
        my $sth = $dbh->prepare($query);
        $sth->execute();
        my @fields = ();
        while (my $hashRef = $sth->fetchrow_hashref) {
            push @fields, $hashRef->{COLUMN_NAME};
        }
        my $fields = join(',', @fields);
        $$strSQL .= 'DELETE FROM ' . $table . ' WHERE frameworkcode=' . $dbh->quote($frameworkcode) . ';';


    eval {
        # First row with the name of the columns
        my $sth = $dbh->column_info(undef, undef, $table, "%");
        my $sth = $dbh->prepare($query);
        $sth->execute();
        my @fields = ();
        while (my $hashRef = $sth->fetchrow_hashref) {
            $$strCSV .= '"' . $hashRef->{COLUMN_NAME} . '",';
            push @fields, $hashRef->{COLUMN_NAME};
        }
        chop $$strCSV;
        $$strCSV .= chr(10);

        my $elementCell;
        my $elementData;
        # First row with the name of the columns
        my $sth = $dbh->column_info(undef, undef, $table, "%");
        my $sth = $dbh->prepare($query);
        $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->{COLUMN_NAME});
            $elementRow->appendChild($elementCell);
            $elementData = $dom->createElement('text:p');
            $elementCell->appendChild($elementData);
            $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=?';

        # First row with the name of the columns
        my $elementCell;
        my $elementData;
        my $sth = $dbh->column_info(undef, undef, $table, "%");
        my $sth = $dbh->prepare($query);
        $sth->execute();
        my @fields = ();
        while (my $hashRef = $sth->fetchrow_hashref) {

            $elementData = $dom->createElement('ss:Data');
            $elementData->setAttribute('ss:Type', 'String');
            $elementCell->appendChild($elementData);
            $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=?';


    my $ret = 0;
    eval {
        my $sth = $dbh->column_info(undef, undef, $table, "%");
        my $sth = $dbh->prepare($query);
        $sth->execute();
        $sth->finish;
        $query = 'SHOW COLUMNS FROM ' . $table;
        $sth = $dbh->prepare($query);
        $sth->execute();
        my $fields = {};
        while (my $hashRef = $sth->fetchrow_hashref) {
            $fields->{$hashRef->{COLUMN_NAME}} = $hashRef->{COLUMN_NAME};
        }
        my @fields;
        my $fieldsR;

    if ($format eq 'csv') {
        my @fieldsName = ();
        eval {
            my $sth = $dbh->column_info(undef, undef, $table, "%");
            my $sth = $dbh->prepare($query);
            $sth->execute();
            while (my $hashRef = $sth->fetchrow_hashref) {
                push @fieldsName, $hashRef->{COLUMN_NAME};
            }
        };
        $ok = _import_table_csv($dbh, $table, $frameworkcode, $dom, $PKArray, \%fields2Delete, \@fieldsName);

Lines 79-84 our $PERL_DEPS = { Link Here

(-)a/C4/Installer/PerlDependencies.pm (+5 lines)
79	'required' => '1',	79	'required' => '1',
80	'min_ver' => '4.004'	80	'min_ver' => '4.004'
81	},	81	},
		82	'DBD::Pg' => {
		83	'usage' => 'Core',
		84	'required' => '1',
		85	'min_ver' => '2.19.2'
		86	},
82	'XML::LibXML' => {	87	'XML::LibXML' => {
83	'usage' => 'Core',	88	'usage' => 'Core',
84	'required' => '1',	89	'required' => '1',




#!/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"
);

Return to bug 7365

Lines 22-27 use strict; Link Here

(-)a/C4/Acquisition.pm (-21 / +13 lines)
22	use warnings;	22	use warnings;
23	use Carp;	23	use Carp;
24	use C4::Context;	24	use C4::Context;
		25	use C4::DBQ;
25	use C4::Debug;	26	use C4::Debug;
26	use C4::Dates qw(format_date format_date_in_iso);	27	use C4::Dates qw(format_date format_date_in_iso);
27	use MARC::Record;	28	use MARC::Record;
Lines 1476-1502 sub GetLateOrders { Link Here
1476	AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')	1477	AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1477	";	1478	";
1478	my $having = "";	1479	my $having = "";
1479	if ($dbdriver eq "mysql") {	1480	my $dbq = C4::DBQ->dbq;
1480	$select .= "	1481	$select .= "
1481	aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,	1482	aqorders.quantity - " . $dbq->ifNull("aqorders.quantityreceived", "0") . " AS quantity,
1482	(aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,	1483	(aqorders.quantity - " . $dbq->ifNull("aqorders.quantityreceived", "0") .") * aqorders.rrp AS subtotal,
1483	DATEDIFF(CURDATE( ),closedate) AS latesince	1484	(CAST(now() AS date) - closedate) AS latesince
1484	";	1485	";
1485	$from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";	1486	$from .= " AND (closedate <= " . $dbq->dateSub("CAST(now() AS date)", "?", "DAY") . ") ";
1486	$having = "	1487	$having = "
1487	HAVING quantity <> 0	1488	HAVING quantity <> 0
1488	AND unitpricesupplier <> 0	1489	AND unitpricesupplier <> 0
1489	AND unitpricelib <> 0	1490	AND unitpricelib <> 0
1490	";	1491	";
1491	} else {
1492	# FIXME: account for IFNULL as above
1493	$select .= "
1494	aqorders.quantity AS quantity,
1495	aqorders.quantity * aqorders.rrp AS subtotal,
1496	(CURDATE - closedate) AS latesince
1497	";
1498	$from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1499	}
1500	if (defined $supplierid) {	1492	if (defined $supplierid) {
1501	$from .= ' AND aqbasket.booksellerid = ? ';	1493	$from .= ' AND aqbasket.booksellerid = ? ';
1502	push @query_params, $supplierid;	1494	push @query_params, $supplierid;

Lines 284-296 sub memcached { Link Here

(-)a/C4/Context.pm (-4 / +4 lines)
284	#	284	#
285	sub db_scheme2dbi {	285	sub db_scheme2dbi {
286	my $name = shift;	286	my $name = shift;
287	# for instance, we support only mysql, so don't care checking
288	return "mysql";
289	for ($name) {	287	for ($name) {
290	# FIXME - Should have other databases.	288	# FIXME - Should have other databases.
291	if (/mysql/) { return("mysql"); }	289	if (/mysql/) { return("mysql"); }
292	if (/Postgres\|Pg\|PostgresSQL/) { return("Pg"); }	290	elsif (/Postgres\|Pg\|pgsql\|PostgresSQL/i) { return("Pg"); }
293	if (/oracle/) { return("Oracle"); }	291	elsif (/oracle/) { return("Oracle"); }
		292	else { return("mysql"); }
294	}	293	}
295	return undef; # Just in case	294	return undef; # Just in case
296	}	295	}
Lines 1103-1108 sub get_versions { Link Here
1103	{	1102	{
1104	no warnings qw(exec); # suppress warnings if unable to find a program in $PATH	1103	no warnings qw(exec); # suppress warnings if unable to find a program in $PATH
1105	$versions{mysqlVersion} = `mysql -V`;	1104	$versions{mysqlVersion} = `mysql -V`;
		1105	$versions{psqlVersion} = `psql -V`;
1106	$versions{apacheVersion} = `httpd -v`;	1106	$versions{apacheVersion} = `httpd -v`;
1107	$versions{apacheVersion} = `httpd2 -v` unless $versions{apacheVersion} ;	1107	$versions{apacheVersion} = `httpd2 -v` unless $versions{apacheVersion} ;
1108	$versions{apacheVersion} = `apache2 -v` unless $versions{apacheVersion} ;	1108	$versions{apacheVersion} = `apache2 -v` unless $versions{apacheVersion} ;

Lines 266-277 sub _export_table_sql Link Here

(-)a/C4/ImportExportFramework.pm (-26 / +16 lines)
266		266
267	eval {	267	eval {
268	# First row with the name of the columns	268	# First row with the name of the columns
269	my $query = 'SHOW COLUMNS FROM ' . $table;	269	my $sth = $dbh->column_info(undef, undef, $table, "%");
270	my $sth = $dbh->prepare($query);
271	$sth->execute();	270	$sth->execute();
272	my @fields = ();	271	my @fields = ();
273	while (my $hashRef = $sth->fetchrow_hashref) {	272	while (my $hashRef = $sth->fetchrow_hashref) {
274	push @fields, $hashRef->{Field};	273	push @fields, $hashRef->{COLUMN_NAME};
275	}	274	}
276	my $fields = join(',', @fields);	275	my $fields = join(',', @fields);
277	$$strSQL .= 'DELETE FROM ' . $table . ' WHERE frameworkcode=' . $dbh->quote($frameworkcode) . ';';	276	$$strSQL .= 'DELETE FROM ' . $table . ' WHERE frameworkcode=' . $dbh->quote($frameworkcode) . ';';
Lines 305-317 sub _export_table_csv Link Here
305		304
306	eval {	305	eval {
307	# First row with the name of the columns	306	# First row with the name of the columns
308	my $query = 'SHOW COLUMNS FROM ' . $table;	307	my $sth = $dbh->column_info(undef, undef, $table, "%");
309	my $sth = $dbh->prepare($query);
310	$sth->execute();	308	$sth->execute();
311	my @fields = ();	309	my @fields = ();
312	while (my $hashRef = $sth->fetchrow_hashref) {	310	while (my $hashRef = $sth->fetchrow_hashref) {
313	$$strCSV .= '"' . $hashRef->{Field} . '",';	311	$$strCSV .= '"' . $hashRef->{COLUMN_NAME} . '",';
314	push @fields, $hashRef->{Field};	312	push @fields, $hashRef->{COLUMN_NAME};
315	}	313	}
316	chop $$strCSV;	314	chop $$strCSV;
317	$$strCSV .= chr(10);	315	$$strCSV .= chr(10);
Lines 361-379 sub _export_table_ods Link Here
361	my $elementCell;	359	my $elementCell;
362	my $elementData;	360	my $elementData;
363	# First row with the name of the columns	361	# First row with the name of the columns
364	my $query = 'SHOW COLUMNS FROM ' . $table;	362	my $sth = $dbh->column_info(undef, undef, $table, "%");
365	my $sth = $dbh->prepare($query);
366	$sth->execute();	363	$sth->execute();
367	my @fields = ();	364	my @fields = ();
368	while (my $hashRef = $sth->fetchrow_hashref) {	365	while (my $hashRef = $sth->fetchrow_hashref) {
369	$elementCell = $dom->createElement('table:table-cell');	366	$elementCell = $dom->createElement('table:table-cell');
370	$elementCell->setAttribute('office:value-type', 'string');	367	$elementCell->setAttribute('office:value-type', 'string');
371	$elementCell->setAttribute('office:value', $hashRef->{Field});	368	$elementCell->setAttribute('office:value', $hashRef->{COLUMN_NAME});
372	$elementRow->appendChild($elementCell);	369	$elementRow->appendChild($elementCell);
373	$elementData = $dom->createElement('text:p');	370	$elementData = $dom->createElement('text:p');
374	$elementCell->appendChild($elementData);	371	$elementCell->appendChild($elementData);
375	$elementData->appendTextNode($hashRef->{Field});	372	$elementData->appendTextNode($hashRef->{COLUMN_NAME});
376	push @fields, {name => $hashRef->{Field}, type => ($hashRef->{Type} =~ /int/i)?'float':'string'};	373	push @fields, {name => $hashRef->{COLUMN_NAME}, type => ($hashRef->{TYPE_NAME} =~ /int/i)?'float':'string'};
377	}	374	}
378	# Populate rows with the data from mysql	375	# Populate rows with the data from mysql
379	$query = 'SELECT * FROM ' . $table . ' WHERE frameworkcode=?';	376	$query = 'SELECT * FROM ' . $table . ' WHERE frameworkcode=?';
Lines 426-433 sub _export_table_excel Link Here
426	# First row with the name of the columns	423	# First row with the name of the columns
427	my $elementCell;	424	my $elementCell;
428	my $elementData;	425	my $elementData;
429	my $query = 'SHOW COLUMNS FROM ' . $table;	426	my $sth = $dbh->column_info(undef, undef, $table, "%");
430	my $sth = $dbh->prepare($query);
431	$sth->execute();	427	$sth->execute();
432	my @fields = ();	428	my @fields = ();
433	while (my $hashRef = $sth->fetchrow_hashref) {	429	while (my $hashRef = $sth->fetchrow_hashref) {
Lines 437-444 sub _export_table_excel Link Here
437	$elementData = $dom->createElement('ss:Data');	433	$elementData = $dom->createElement('ss:Data');
438	$elementData->setAttribute('ss:Type', 'String');	434	$elementData->setAttribute('ss:Type', 'String');
439	$elementCell->appendChild($elementData);	435	$elementCell->appendChild($elementData);
440	$elementData->appendTextNode($hashRef->{Field});	436	$elementData->appendTextNode($hashRef->{COLUMN_NAME});
441	push @fields, {name => $hashRef->{Field}, type => ($hashRef->{Type} =~ /int/i)?'Number':'String'};	437	push @fields, {name => $hashRef->{COLUMN_NAME}, type => ($hashRef->{TYPE_NAME} =~ /int/i)?'Number':'String'};
442	}	438	}
443	# Populate rows with the data from mysql	439	# Populate rows with the data from mysql
444	$query = 'SELECT * FROM ' . $table . ' WHERE frameworkcode=?';	440	$query = 'SELECT * FROM ' . $table . ' WHERE frameworkcode=?';
Lines 946-961 sub _check_validity_worksheet Link Here
946		942
947	my $ret = 0;	943	my $ret = 0;
948	eval {	944	eval {
949	my $query = 'DESCRIBE ' . $table;	945	my $sth = $dbh->column_info(undef, undef, $table, "%");
950	my $sth = $dbh->prepare($query);
951	$sth->execute();
952	$sth->finish;
953	$query = 'SHOW COLUMNS FROM ' . $table;
954	$sth = $dbh->prepare($query);
955	$sth->execute();	946	$sth->execute();
956	my $fields = {};	947	my $fields = {};
957	while (my $hashRef = $sth->fetchrow_hashref) {	948	while (my $hashRef = $sth->fetchrow_hashref) {
958	$fields->{$hashRef->{Field}} = $hashRef->{Field};	949	$fields->{$hashRef->{COLUMN_NAME}} = $hashRef->{COLUMN_NAME};
959	}	950	}
960	my @fields;	951	my @fields;
961	my $fieldsR;	952	my $fieldsR;
Lines 1004-1014 sub _import_table Link Here
1004	if ($format eq 'csv') {	995	if ($format eq 'csv') {
1005	my @fieldsName = ();	996	my @fieldsName = ();
1006	eval {	997	eval {
1007	my $query = 'SHOW COLUMNS FROM ' . $table;	998	my $sth = $dbh->column_info(undef, undef, $table, "%");
1008	my $sth = $dbh->prepare($query);
1009	$sth->execute();	999	$sth->execute();
1010	while (my $hashRef = $sth->fetchrow_hashref) {	1000	while (my $hashRef = $sth->fetchrow_hashref) {
1011	push @fieldsName, $hashRef->{Field};	1001	push @fieldsName, $hashRef->{COLUMN_NAME};
1012	}	1002	}
1013	};	1003	};
1014	$ok = _import_table_csv($dbh, $table, $frameworkcode, $dom, $PKArray, \%fields2Delete, \@fieldsName);	1004	$ok = _import_table_csv($dbh, $table, $frameworkcode, $dom, $PKArray, \%fields2Delete, \@fieldsName);

Line 0 Link Here

(-)a/C4/DBQ.pm (+65 lines)
		1	package C4::DBQ;
		2
		3	# Copyright 2012 BibLibre and Marc Balmer
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 2 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use Modern::Perl;
		21	use C4::Context;
		22	use vars qw(@ISA @EXPORT $state);
		23
		24	@ISA = qw(Exporter);
		25
		26	@EXPORT = qw(
		27	&dbq
		28	);
		29
		30	$state = {};
		31
		32	sub dbq {
		33	my ( $self, $dbtype ) = @_;
		34	$dbtype //= C4::Context->config("db_scheme");
		35	if ( !$$state{"dbtype"} or $$state{"dbtype"} ne $dbtype ) {
		36	if ( $dbtype eq "mysql" ) {
		37	require C4::DBQ::MySQL;
		38	$$state{"obj"} = C4::DBQ::MySQL->new();
		39	}
		40	elsif ( $dbtype =~ /Postgres\|Pg\|PostgresSQL\|pgsql/i ) {
		41	require C4::DBQ::PostgreSQL;
		42	$$state{"obj"} = C4::DBQ::PostgreSQL->new();
		43	}
		44	else {
		45	die "unsupported database type " . $dbtype;
		46	}
		47	$$state{"dbtype"} = $dbtype;
		48	}
		49	return $$state{"obj"};
		50	}
		51
		52	1;
		53	__END__
		54
		55	=head1 AUTHOR
		56
		57	Koha Development Team <http://koha-community.org/>
		58
		59	Stephane Delaune <stephane.delaune at biblibre dot com>
		60
		61	Marc Balmer <marc at msys dot ch>
		62
		63	Christophe Croullebois <christophe.croullebois at biblibre dot com>
		64
65	=cut

Line 0 Link Here

(-)a/C4/DBQ/MySQL.pm (+78 lines)
		1	package C4::DBQ::MySQL;
		2
		3	# Copyright 2012 BibLibre and Marc Balmer
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 2 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use Modern::Perl;
		21	use C4::Context;
		22	use vars qw(@ISA @EXPORT);
		23
		24	@ISA = qw(Exporter);
		25
		26	@EXPORT = qw(
		27	&new
		28	&dateSub
		29	&ifNull
		30	);
		31
		32	sub new {
		33	my $class = shift;
		34	my $self = {};
		35	bless $self, $class;
		36	return $self;
		37	}
		38
		39	=head2 dateSub
		40
		41	$value = $dbq->dateSub("2000-01-31", "1", "DAY")
		42
		43	Subtract a time value (interval) from a date
		44
		45	=cut
		46
		47	sub dateSub {
		48	my ( $self, $date, $interval, $unit ) = @_;
		49	return "DATE_SUB($date, INTERVAL $interval $unit)";
		50	}
		51
		52	=head2 ifNull
		53
		54	$value = $dbq->ifNull($a, $b);
		55
		56	Returns $a if not null, else return $b
		57
		58	=cut
		59
		60	sub ifNull {
		61	my ( $self, $a, $b ) = @_;
		62	return "IFNULL($a, $b)";
		63	}
		64
65	1;
66	__END__
67
68	=head1 AUTHOR
69
70	Koha Development Team <http://koha-community.org/>
71
72	Stephane Delaune <stephane.delaune at biblibre dot com>
73
74	Marc Balmer <marc at msys dot ch>
75
76	Christophe Croullebois <christophe.croullebois at biblibre dot com>
77
78	=cut

Line 0 Link Here

(-)a/C4/DBQ/PostgreSQL.pm (+78 lines)
		1	package C4::DBQ::PostgreSQL;
		2
		3	# Copyright 2012 BibLibre and Marc Balmer
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 2 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use Modern::Perl;
		21	use C4::Context;
		22	use vars qw(@ISA @EXPORT);
		23
		24	@ISA = qw(Exporter);
		25
		26	@EXPORT = qw(
		27	&new
		28	&dateSub
		29	&ifNull
		30	);
		31
		32	sub new {
		33	my $class = shift;
		34	my $self = {};
		35	bless $self, $class;
		36	return $self;
		37	}
		38
		39	=head2 dateSub
		40
		41	$value = $dbq->dateSub("2000-01-31", "1", "DAY")
		42
		43	Subtract a time value (interval) from a date
		44
		45	=cut
		46
		47	sub dateSub {
		48	my ( $self, $date, $interval, $unit ) = @_;
		49	return "$date - interval '$interval $unit'";
		50	}
		51
		52	=head2 ifNull
		53
		54	$value = $dbq->ifNull($a, $b);
		55
		56	Returns $a if not null, else return $b
		57
		58	=cut
		59
		60	sub ifNull {
		61	my ( $self, $a, $b ) = @_;
		62	return "COALESCE($a, $b)";
		63	}
		64
65	1;
66	__END__
67
68	=head1 AUTHOR
69
70	Koha Development Team <http://koha-community.org/>
71
72	Stephane Delaune <stephane.delaune at biblibre dot com>
73
74	Marc Balmer <marc at msys dot ch>
75
76	Christophe Croullebois <christophe.croullebois at biblibre dot com>
77
78	=cut

Line 0 Link Here

(-)a/t/DBQ.t (-1 / +67 lines)
0	-	1	#!/usr/bin/perl
		2	#
		3	# This Koha test module is a stub!
		4	# Add more tests here!!!
		5
		6	use Modern::Perl;
		7	use Data::Dumper;
		8	use Test::More tests => 6;
		9
		10	BEGIN {
		11	use_ok('C4::DBQ');
		12	}
		13
		14	#check if all files in C4/DBQ/ have the same sub's names
		15	my $dirname = C4::Context->intranetdir . "/C4/DBQ/";
		16	my %sublists;
		17	opendir my ($dh), $dirname or die "Couldn't open dir '$dirname': $!";
		18	my @files = readdir $dh;
		19	foreach my $file (@files) {
		20	my @sublist = ();
		21	my $stringlist = "";
		22
		23	open my $f, '<', $dirname . $file;
		24	while ( my $line = <$f> ) {
		25	if ( $line =~ /^(\s)sub(\s)([^{\|\s]+)(\s*){/ ) {
		26	push( @sublist, $3 );
		27	}
		28	}
		29	close $f;
		30	my @sortlist = sort( { $a cmp $b } @sublist );
		31	foreach my $subname (@sortlist) {
		32	$stringlist .= "$subname\|";
		33	}
		34	$sublists{$stringlist} = 1 if $stringlist;
		35
		36	#print $file;
		37	}
		38	closedir $dh;
		39	my $countdiffsubs = 0;
		40	foreach my $sublists ( keys(%sublists) ) {
		41	$countdiffsubs++;
		42	}
		43	is( $countdiffsubs, '1', "check sub's list into C4/DBQ/ files" );
		44
		45	#check each sub
		46	my $mysql = C4::DBQ->dbq('mysql');
		47	my $pgsql = C4::DBQ->dbq('pgsql');
		48	is(
		49	$mysql->dateSub("2000-01-31", "1", "DAY"),
		50	"DATE_SUB(2000-01-31, INTERVAL 1 DAY)",
		51	"check C4::DBQ::MySQL->dateSub"
		52	);
		53	is(
		54	$pgsql->dateSub("2000-01-31", "1", "DAY"),
		55	"2000-01-31 - interval '1 DAY'",
		56	"check C4::DBQ::PostgreSQL->dateSub"
		57	);
		58	is(
		59	$mysql->ifNull("a", "b"),
		60	"IFNULL(a, b)",
		61	"check C4::DBQ::MySQL->ifNull"
		62	);
		63	is(
		64	$pgsql->ifNull("a", "b"),
		65	"COALESCE(a, b)",
66	"check C4::DBQ::PostgreSQL->ifNull"
67	);