Koha/misc/cronjobs/create_koc_db.pl
Jonathan Druart 9d6d641d1f Bug 17600: Standardize our EXPORT_OK
On bug 17591 we discovered that there was something weird going on with
the way we export and use subroutines/modules.
This patch tries to standardize our EXPORT to use EXPORT_OK only.

That way we will need to explicitely define the subroutine we want to
use from a module.

This patch is a squashed version of:
Bug 17600: After export.pl
Bug 17600: After perlimport
Bug 17600: Manual changes
Bug 17600: Other manual changes after second perlimports run
Bug 17600: Fix tests

And a lot of other manual changes.

export.pl is a dirty script that can be found on bug 17600.

"perlimport" is:
git clone https://github.com/oalders/App-perlimports.git
cd App-perlimports/
cpanm --installdeps .
export PERL5LIB="$PERL5LIB:/kohadevbox/koha/App-perlimports/lib"
find . \( -name "*.pl" -o -name "*.pm" \) -exec perl App-perlimports/script/perlimports --inplace-edit --no-preserve-unused --filename {} \;

The ideas of this patch are to:
* use EXPORT_OK instead of EXPORT
* perltidy the EXPORT_OK list
* remove '&' before the subroutine names
* remove some uneeded use statements
* explicitely import the subroutines we need within the controllers or
modules

Note that the private subroutines (starting with _) should not be
exported (and not used from outside of the module except from tests).

EXPORT vs EXPORT_OK (from
https://www.thegeekstuff.com/2010/06/perl-exporter-examples/)
"""
Export allows to export the functions and variables of modules to user’s namespace using the standard import method. This way, we don’t need to create the objects for the modules to access it’s members.

@EXPORT and @EXPORT_OK are the two main variables used during export operation.

@EXPORT contains list of symbols (subroutines and variables) of the module to be exported into the caller namespace.

@EXPORT_OK does export of symbols on demand basis.
"""

If this patch caused a conflict with a patch you wrote prior to its
push:
* Make sure you are not reintroducing a "use" statement that has been
removed
* "$subroutine" is not exported by the C4::$MODULE module
means that you need to add the subroutine to the @EXPORT_OK list
* Bareword "$subroutine" not allowed while "strict subs"
means that you didn't imported the subroutine from the module:
  - use $MODULE qw( $subroutine list );
You can also use the fully qualified namespace: C4::$MODULE::$subroutine

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
2021-07-16 08:58:47 +02:00

458 lines
12 KiB
Perl
Executable file

#!/usr/bin/perl
# 2008 Kyle Hall <kyle.m.hall@gmail.com>
# 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 3 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, see <http://www.gnu.org/licenses>.
#
=head1 NAME
create_koc_db.pl - create a database file for the offline circulation tool
=head1 SYNOPSIS
create_koc_db.pl
Options:
-help brief help message
-man full documentation
=head1 OPTIONS
=over 8
=item B<--help>
Print a brief help message and exits.
=item B<--man>
Prints the manual page and exits.
=item B<--file>
The filename that we should use for the database file that we produce. Defaults to "borrowers.db"
=item B<--force>
Forcefully overwrite any existing db file. Defaults to false, so
program will terminate prematurely if the file already exists.
=item B<--sqlite2>
This option cause the output file to be an SQLite2 database.
This is the format that the original offline circ client
( the one written in PHP/Gtk, version < 1.0 ) requires.
=item B<--sqlite3>
This option cause the output file to be an SQLite3 database.
This is the format that the new offline circ client
( the one written in C++/Qt4, version >= 1.0 ) requires.
=back
=head1 DESCRIPTION
This script generates a sqlite database file full of patron and
holdings data that can be used by an offline circulation tool.
=head1 USAGE EXAMPLES
This program could be run from cron to occasionally refresh the
offline circulation database. For instance:
C<0 0 * * * create_koc_db.pl>
=head1 SEE ALSO
This program was originally created to interact with Kyle Hall's
offline circulation tool, which is available from
L<http://kylehall.info/index.php/projects/koha-tools/koha-offline-circulation/>,
but any similar tool could use the database that is produced.
=cut
use strict;
use warnings;
$|++;
use DBI;
use Getopt::Long qw( GetOptions );
use Pod::Usage qw( pod2usage );
use Koha::Script -cron;
use C4::Context;
use English qw(-no_match_vars);
my $verbose = 0;
my $help = 0;
my $man = 0;
my $filename = 'borrowers.db';
my $force = 0;
my $sqlite2 = 0;
my $sqlite3 = 0;
GetOptions(
'verbose' => \$verbose,
'help' => \$help,
'man' => \$man,
'file=s' => \$filename,
'force' => \$force,
'sqlite2' => \$sqlite2,
'sqlite3' => \$sqlite3,
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage( -verbose => 2 ) if $man;
my %wanted_borrowers_columns = map { $_ => 1 } qw/borrowernumber cardnumber surname firstname address city phone dateofbirth/;
my %wanted_issues_columns = map { $_ => 1 } qw/borrowernumber date_due itemcallnumber title itemtype/;
prepare_file_for_writing($filename)
or die "file: '$filename' already exists. Use --force to overwrite\n";
verify_dbd_sqlite();
## Create DB Connections
my $dbh_mysql = C4::Context->dbh;
my $dbh_sqlite;
if ( $sqlite2 ) {
$dbh_sqlite = DBI->connect( "dbi:SQLite2:dbname=$filename", "", "" );
} elsif ( $sqlite3 ) {
$dbh_sqlite = DBI->connect( "dbi:SQLite:dbname=$filename", "", "" );
}
$dbh_sqlite->{AutoCommit} = 0;
create_borrowers_table();
populate_borrowers_table();
create_issues_table();
populate_issues_table();
=head1 INTERNAL METHODS
=head2 verify_dbd_sqlite
Since DBD::SQLite is a new prerequisite and an optional one, let's
make sure we have a new enough version of it.
=cut
sub verify_dbd_sqlite {
if ( $sqlite2 ) {
eval { require DBD::SQLite2; };
if ( $EVAL_ERROR ) {
my $msg = <<'END_MESSAGE';
DBD::SQLite2 is required to generate offline circultion database files, but not found.
Please install the DBD::SQLite2 perl module. It is available from
http://search.cpan.org/dist/DBD-SQLite2/ or through the CPAN module.
END_MESSAGE
die $msg;
}
} elsif ( $sqlite3 ) {
eval { require DBD::SQLite; };
if ( $EVAL_ERROR ) {
my $msg = <<'END_MESSAGE';
DBD::SQLite3 is required to generate offline circultion database files, but not found.
Please install the DBD::SQLite3 perl module. It is available from
http://search.cpan.org/dist/DBD-SQLite3/ or through the CPAN module.
END_MESSAGE
die $msg;
}
} else {
die( "Error: execution requires either the option --sqlite2 or --sqlite3. Run with --help for details." );
}
}
=head2 prepare_file_for_writing
pass in the filename that we're considering using for the SQLite db.
returns true if we can use it.
returns false if we can't. For example, if it alredy exists and we
don't have --force or don't have permissions to unlink it.
=cut
sub prepare_file_for_writing {
my $filename = shift;
if ( -e $filename ) {
# this file exists. remove it if --force.
if ($force) {
return unlink $filename;
} else {
return;
}
}
return $filename;
}
=head2 create_borrowers_table
Create sqlite borrowers table to mirror the koha borrowers table structure
=cut
sub create_borrowers_table {
my %borrowers_info = get_columns_and_types_of_table( 'borrowers' );
my $sqlite_create_sql = "CREATE TABLE borrowers ( \n";
$sqlite_create_sql .= join(',', map{ $_ . ' ' . $borrowers_info{$_} }
grep { exists($wanted_borrowers_columns{$_}) } keys %borrowers_info);
$sqlite_create_sql .= " , \n total_fines decimal(28,6) "; ## Extra field to store the total fines for a borrower in.
$sqlite_create_sql .= " ) ";
my $return = $dbh_sqlite->do($sqlite_create_sql);
unless ( $return ) {
warn 'unable to create borrowers table: ' . $dbh_sqlite->errstr();
}
return $return;
}
=head2 populate_borrowers_table
Import the data from the koha.borrowers table into our sqlite table
=cut
sub populate_borrowers_table {
my @borrower_fields = grep { exists($wanted_borrowers_columns{$_}) } get_columns_of_table( 'borrowers' );
push @borrower_fields, 'total_fines';
my $sql = "INSERT INTO borrowers ( ";
$sql .= join( ',', @borrower_fields );
$sql .= " ) VALUES ( ";
$sql .= join( ',', map { '?' } @borrower_fields );
$sql .= " ) ";
my $sth_sqlite = $dbh_sqlite->prepare($sql);
my $sth_mysql = $dbh_mysql->prepare(<<'END_SQL');
SELECT borrowernumber,
cardnumber,
surname,
firstname,
address,
city,
phone,
dateofbirth,
sum( accountlines.amountoutstanding ) as total_fines
FROM borrowers
LEFT JOIN accountlines USING (borrowernumber)
GROUP BY borrowernumber;
END_SQL
my $fields_count = $sth_mysql->execute();
warn "preparing to insert $fields_count borrowers\n" if $verbose;
my $count;
while ( my $borrower = $sth_mysql->fetchrow_hashref ) {
$count++;
if ( $verbose ) {
print '.' unless ( $count % 10 );
print "$count\n" unless ( $count % 1000 );
}
$sth_sqlite->execute( @$borrower{ @borrower_fields } );
$sth_sqlite->finish();
$dbh_sqlite->commit() if ( 0 == $count % 1000 );
}
$dbh_sqlite->commit();
print "inserted $count borrowers\n" if $verbose;
# add_fines_to_borrowers_table();
}
=head2 add_fines_to_borrowers_table
Import the fines from koha.accountlines into the sqlite db
=cut
sub add_fines_to_borrowers_table {
print "preparing to update borrowers\n" if $verbose;
my $sth_mysql = $dbh_mysql->prepare(
"SELECT DISTINCT borrowernumber, SUM( amountoutstanding ) AS total_fines
FROM accountlines
GROUP BY borrowernumber"
);
$sth_mysql->execute();
my $count;
while ( my $result = $sth_mysql->fetchrow_hashref() ) {
$count++;
if ( $verbose ) {
print '.' unless ( $count % 10 );
print "$count\n" unless ( $count % 1000 );
}
my $borrowernumber = $result->{'borrowernumber'};
my $total_fines = $result->{'total_fines'};
# warn "Fines for Borrower # $borrowernumber are \$ $total_fines \n" if $verbose;
my $sql = "UPDATE borrowers SET total_fines = ? WHERE borrowernumber = ?";
my $sth_sqlite = $dbh_sqlite->prepare($sql);
$sth_sqlite->execute( $total_fines, $borrowernumber );
$sth_sqlite->finish();
}
print "updated $count borrowers\n" if ( $verbose && $count );
}
=head2 create_issue_table
Create sqlite issues table with minimal information needed from koha tables issues, items, biblio, biblioitems
=cut
sub create_issues_table {
my $fields = get_columns_for_issues_table();
my $sqlite_create_sql = "CREATE TABLE issues ( \n";
my $firstField = 1;
foreach my $key ( keys %$fields ) {
my $field = $key;
my $type = $fields->{$key};
if ($firstField) {
$sqlite_create_sql .= " $field $type ";
$firstField = 0;
} else {
$sqlite_create_sql .= ", \n $field $type ";
}
}
$sqlite_create_sql .= " ) ";
my $sth_sqlite = $dbh_sqlite->prepare($sqlite_create_sql);
$sth_sqlite->execute();
$sth_sqlite->finish();
}
=head2 populate_issues_table
Import open issues from the koha database
=cut
sub populate_issues_table {
print "preparing to populate ISSUES table\n" if $verbose;
my $sth_mysql = $dbh_mysql->prepare(
"SELECT issues.borrowernumber,
issues.date_due,
items.itemcallnumber,
biblio.title,
biblioitems.itemtype
FROM issues, items, biblioitems, biblio
WHERE issues.itemnumber = items.itemnumber
AND items.biblionumber = biblioitems.biblionumber
AND items.biblionumber = biblio.biblionumber
AND returndate IS NULL"
);
$sth_mysql->execute();
my $column_names = $sth_mysql->{'NAME'};
my $sql_sqlite = "INSERT INTO issues ( ";
$sql_sqlite .= join( ',', @$column_names );
$sql_sqlite .= " ) VALUES ( ";
$sql_sqlite .= join( ',', map { '?' } @$column_names );
$sql_sqlite .= " ) ";
warn "$sql_sqlite\n" if $verbose;
my $sth_sqlite = $dbh_sqlite->prepare($sql_sqlite);
my $count;
while ( my $result = $sth_mysql->fetchrow_hashref ) {
$count++;
if ( $verbose ) {
print '.' unless ( $count % 10 );
print "$count\n" unless ( $count % 1000 );
}
$sth_sqlite->execute( @$result{ @$column_names } );
$sth_sqlite->finish();
$dbh_sqlite->commit() if ( 0 == $count % 1000 );
}
$dbh_sqlite->commit();
print "inserted $count issues\n" if ( $verbose && $count );
}
=head2 get_columns_of_table
pass in the name of a database table.
returns list of column names in that table.
=cut
sub get_columns_of_table {
my $table_name = shift;
my %column_info = get_columns_and_types_of_table( $table_name );
my @columns = keys %column_info;
return @columns;
}
=head2 get_columns_and_types_of_table
pass in the name of a database table
returns a hash of column names to their types.
=cut
sub get_columns_and_types_of_table {
my $table_name = shift;
my $column_info = $dbh_mysql->selectall_arrayref( "SHOW COLUMNS FROM $table_name" );
my %columns = map{ $_->[0] => $_->[1] } @$column_info;
return %columns;
}
=head2 get_columns_for_issues_table
This sub returns a hashref where the keys are all the fields in the given tables, and the data is the field's type
=cut
sub get_columns_for_issues_table {
my @tables = ( 'issues', 'items', 'biblioitems', 'biblio' );
my %fields;
foreach my $table ( @tables ) {
my %table_info = get_columns_and_types_of_table( $table );
%fields = ( %fields, %table_info );
}
return { map { $_ => $fields{$_} } grep { exists($wanted_issues_columns{$_}) } keys %fields };
}
1;
__END__