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

(-)a/C4/Acquisition.pm (-21 / +13 lines)
Lines 22-27 use strict; Link Here
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;
(-)a/C4/Context.pm (-4 / +4 lines)
Lines 284-296 sub memcached { Link Here
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} ;
(-)a/C4/DBQ.pm (+65 lines)
Line 0 Link Here
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
(-)a/C4/DBQ/MySQL.pm (+78 lines)
Line 0 Link Here
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
(-)a/C4/DBQ/PostgreSQL.pm (+78 lines)
Line 0 Link Here
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
(-)a/C4/ImportExportFramework.pm (-26 / +16 lines)
Lines 266-277 sub _export_table_sql Link Here
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);
(-)a/C4/Installer/PerlDependencies.pm (+5 lines)
Lines 79-84 our $PERL_DEPS = { Link Here
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',
(-)a/t/DBQ.t (-1 / +67 lines)
Line 0 Link Here
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
);

Return to bug 7365