#
# 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 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.
+# 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.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
use strict;
use warnings;
use XML::LibXML;
use XML::LibXML::XPathContext;
-use Digest::MD5 qw(md5_base64);
+use Digest::MD5 qw();
use POSIX qw(strftime);
use C4::Context;
use C4::Debug;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
BEGIN {
- $VERSION = 3.03; # set version for version checking
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
}
}
- if (_export_table('marc_tag_structure', $dbh, ($mode eq 'csv' || $mode eq 'sql')?$xmlStrRef:$dom, ($mode eq 'ods')?$elementSS:$root, $frameworkcode, $mode)) {
- if (_export_table('marc_subfield_structure', $dbh, ($mode eq 'csv' || $mode eq 'sql')?$xmlStrRef:$dom, ($mode eq 'ods')?$elementSS:$root, $frameworkcode, $mode)) {
+ if (_export_table('marc_tag_structure', $dbh, ($mode eq 'csv')?$xmlStrRef:$dom, ($mode eq 'ods')?$elementSS:$root, $frameworkcode, $mode)) {
+ if (_export_table('marc_subfield_structure', $dbh, ($mode eq 'csv')?$xmlStrRef:$dom, ($mode eq 'ods')?$elementSS:$root, $frameworkcode, $mode)) {
$$xmlStrRef = $dom->toString(1) if ($mode eq 'ods' || $mode eq 'excel');
return 1;
}
my ($table, $dbh, $dom, $root, $frameworkcode, $mode) = @_;
if ($mode eq 'csv') {
_export_table_csv($table, $dbh, $dom, $root, $frameworkcode);
- } elsif ($mode eq 'sql') {
- _export_table_sql($table, $dbh, $dom, $root, $frameworkcode);
} elsif ($mode eq 'ods') {
_export_table_ods($table, $dbh, $dom, $root, $frameworkcode);
} else {
}
}
-
-# Export the mysql table to an sql file
-sub _export_table_sql
-{
- my ($table, $dbh, $strSQL, $root, $frameworkcode) = @_;
-
- eval {
- # First row with the name of the columns
- my $query = 'SHOW COLUMNS FROM ' . $table;
- my $sth = $dbh->prepare($query);
- $sth->execute();
- my @fields = ();
- while (my $hashRef = $sth->fetchrow_hashref) {
- push @fields, $hashRef->{Field};
- }
- my $fields = join(',', @fields);
- $$strSQL .= 'DELETE FROM ' . $table . ' WHERE frameworkcode=' . $dbh->quote($frameworkcode) . ';';
- $$strSQL .= chr(10);
- # Populate rows with the data from mysql
- $query = 'SELECT * FROM ' . $table . ' WHERE frameworkcode=?';
- $sth = $dbh->prepare($query);
- $sth->execute($frameworkcode);
- while (my $hashRef = $sth->fetchrow_hashref) {
- $$strSQL .= 'INSERT INTO ' . $table . ' (' . $fields . ') VALUES (';
- for (@fields) {
- $$strSQL .= $dbh->quote($hashRef->{$_}) . ',';
- }
- chop $$strSQL;
- $$strSQL .= ');' . chr(10);
- }
- $$strSQL .= chr(10) . chr(10);
- };
- if ($@) {
- $debug and warn "Error _export_table_sql $@\n";
- return 0;
- }
- return 1;
-}#_export_table_sql
-
-
# Export the mysql table to an csv file
sub _export_table_csv
{
$sth->execute($frameworkcode);
my $data;
while (my $hashRef = $sth->fetchrow_hashref) {
- for (@fields) {
- $hashRef->{$_} =~ s/[\r\n]//g;
- $$strCSV .= '"' . $hashRef->{$_} . '",';
+ for my $field (@fields) {
+ my $value = $hashRef->{$field} // q||;
+ $value =~ s/[\r\n]//g;
+ $$strCSV .= '"' . $value . '",';
}
chop $$strCSV;
$$strCSV .= chr(10);
$data = $hashRef->{$_->{name}};
if ($_->{type} eq 'float' && !defined($data)) {
$data = '0';
+ } elsif ($_->{type} eq 'string' && !defined($data)) {
+ $data = q{};
} elsif ($_->{type} eq 'string' && (!$data && $data ne '0')) {
$data = '#';
}
$data = $hashRef->{$_->{name}};
if ($_->{type} eq 'Number' && !defined($data)) {
$data = '0';
+ } elsif ($_->{type} eq 'String' && !defined($data)) {
+ $data = q{};
} elsif ($_->{type} eq 'String' && (!$data && $data ne '0')) {
$data = '#';
}
mkdir $tempdir;
};
if ($@) {
- return undef;
+ return;
} else {
return $tempdir;
}
$tempdir = _createTmpDir($tmp);
}
if ($tempdir) {
+ my $fh;
# populate tempdir directory with the ods elements
eval {
- if (open(OUT, "> $tempdir/content.xml")) {
- print OUT $strContent;
- close(OUT);
+ if (open($fh, '>', "$tempdir/content.xml")) {
+ print {$fh} $strContent;
+ close($fh);
}
- if (open(OUT, "> $tempdir/mimetype")) {
- print OUT 'application/vnd.oasis.opendocument.spreadsheet';
- close(OUT);
+ if (open($fh, '>', "$tempdir/mimetype")) {
+ print {$fh} 'application/vnd.oasis.opendocument.spreadsheet';
+ close($fh);
}
- if (open(OUT, "> $tempdir/meta.xml")) {
- print OUT _getMeta($lang);
- close(OUT);
+ if (open($fh, '>', "$tempdir/meta.xml")) {
+ print {$fh} _getMeta($lang);
+ close($fh);
}
- if (open(OUT, "> $tempdir/styles.xml")) {
- print OUT ODS_STYLES_STR;
- close(OUT);
+ if (open($fh, '>', "$tempdir/styles.xml")) {
+ print {$fh} ODS_STYLES_STR;
+ close($fh);
}
- if (open(OUT, "> $tempdir/settings.xml")) {
- print OUT ODS_SETTINGS_STR;
- close(OUT);
+ if (open($fh, '>', "$tempdir/settings.xml")) {
+ print {$fh} ODS_SETTINGS_STR;
+ close($fh);
}
mkdir($tempdir.'/META-INF/');
mkdir($tempdir.'/Configurations2/');
mkdir($tempdir.'/Configurations2/menubar/');
mkdir($tempdir.'/Configurations2/progressbar/');
mkdir($tempdir.'/Configurations2/toolbar/');
- if (open(OUT, "> $tempdir/META-INF/manifest.xml")) {
- print OUT ODS_MANIFEST_STR;
- close(OUT);
+
+ if (open($fh, '>', "$tempdir/META-INF/manifest.xml")) {
+ print {$fh} ODS_MANIFEST_STR;
+ close($fh);
}
};
if ($@) {
my $ok = 0;
# read ods file and return as a string
if (-f "$tempdir/new.ods") {
- if (open (MYFILE, "$tempdir/new.ods")) {
- binmode MYFILE;
+ if (open ($fh, '<', "$tempdir/new.ods")) {
+ binmode $fh;
my $buffer;
- while (read (MYFILE, $buffer, 65536)) {
+ while (read ($fh, $buffer, 65536)) {
$$strODSRef .= $buffer;
}
- close(MYFILE);
+ close($fh);
$ok = 1;
}
}
my $dbh = C4::Context->dbh;
if (-r $filename && $dbh) {
my $extension = '';
- if ($filename =~ /\.(csv|ods|xml|sql)$/i) {
+ if ($filename =~ /\.(csv|ods|xml)$/i) {
$extension = lc($1);
} else {
unlink ($filename) if ($deleteFilename); # remove temporary file
open($dom, '<', $filename);
}
if ($dom) {
- # For sql we execute the line
- if ($extension eq 'sql') {
- _parseSQLLine($dbh, $dom, $frameworkcode);
- $ok = 0;
- } else {
- # Process both tables
- my $numDeleted = 0;
- my $numDeletedAux = 0;
- if (($numDeletedAux = _import_table($dbh, 'marc_tag_structure', $frameworkcode, $dom, ['frameworkcode', 'tagfield'], $extension)) >= 0) {
+ # Process both tables
+ my $numDeleted = 0;
+ my $numDeletedAux = 0;
+ if (($numDeletedAux = _import_table($dbh, 'marc_tag_structure', $frameworkcode, $dom, ['frameworkcode', 'tagfield'], $extension)) >= 0) {
+ $numDeleted += $numDeletedAux if ($numDeletedAux > 0);
+ if (($numDeletedAux = _import_table($dbh, 'marc_subfield_structure', $frameworkcode, $dom, ['frameworkcode', 'tagfield', 'tagsubfield'], $extension)) >= 0) {
$numDeleted += $numDeletedAux if ($numDeletedAux > 0);
- if (($numDeletedAux = _import_table($dbh, 'marc_subfield_structure', $frameworkcode, $dom, ['frameworkcode', 'tagfield', 'tagsubfield'], $extension)) >= 0) {
- $numDeleted += $numDeletedAux if ($numDeletedAux > 0);
- $ok = ($numDeleted > 0)?$numDeleted:0;
- }
+ $ok = ($numDeleted > 0)?$numDeleted:0;
}
}
} else {
if ($@) {
$debug and warn "Error ImportFramework $@\n";
} else {
- if ($extension eq 'sql' || $extension eq 'csv') {
+ if ($extension eq 'csv') {
close($dom) if ($dom);
}
}
return $ok;
}#ImportFramework
-
-# Parse the sql statement to see if the frameworkcode is correct
-# We're checking only the delete and insert SQL commands generated in the export process
-sub _parseSQLLine
-{
- my ($dbh, $dom, $frameworkcode) = @_;
-
- my $parser;
- eval {
- require SQL::Statement;
- $parser = SQL::Parser->new('AnyData');
- $parser->{RaiseError}=1;
- $parser->{PrintError}=0;
- };
- my $literalEscape = (C4::Context->config("db_scheme") eq 'mysql')?'\\':'\'';
- my $line;
- my $numLines = 0;
- while (<$dom>) {
- s/[\r\n]+$//;
- $line = $_;
- # we don't want to execute any sql statement, only the ones dealing with frameworks
- next unless ($line =~ /^\s*(?i:DELETE\s+FROM|INSERT\s+INTO)\s+(?:marc_tag_structure|marc_subfield_structure)/);
- $numLines++;
- # We check if the frameworkcode is the same, if not we change it
- unless ($line =~ /'$frameworkcode'/) {
- my $error = 0;
- if ($parser) {
- eval {
- $line = substr($line, 0 ,-1) if ($line =~ /;$/);
- my $stmt = SQL::Statement->new($line, $parser);
- my $where = $stmt->where();
- if ($where && $where->op() eq '=' && $line =~ /^\s*DELETE/) {
- $line =~ s/frameworkcode='.*?'/frameworkcode='$frameworkcode';/ unless ($_ =~ /frameworkcode='$frameworkcode'/);
- } else {
- my @arrFields;
- my @arrValues;
- my $table;
- # Due to lacking of backward compatibility
- if ($parser->VERSION < 1.30) {
- $table = lc($stmt->tables(0)->name());
- @arrFields = map{lc($_->name)} $stmt->columns;
- @arrValues = $stmt->row_values();
- } else {
- $table = $stmt->tables(0)->name();
- @arrValues = $stmt->row_values(0);
- my @aux = $stmt->column_defs();
- for (@{$aux[0]}) {
- push @arrFields, $_->{value};
- }
- }
- if (scalar(@arrFields) == scalar(@arrValues)) {
- my $j = 0;
- my $modified = 0;
- for (@arrFields) {
- if ($_ eq 'frameworkcode' && $arrValues[$j] ne $frameworkcode) {
- $arrValues[$j] = $dbh->quote($frameworkcode);
- $modified = 1;
- } else {
- $arrValues[$j] = $dbh->quote($arrValues[$j]);
- }
- $j++;
- }
- $line = 'INSERT INTO ' . $table . ' (' . join(',', @arrFields) . ') VALUES (' . join(',', @arrValues) . ');' if ($modified);
- }
- }
- };
- $error = 1 if ($@);
- } else {
- $error = 1;
- }
- if ($error) {
- $line .= ';' unless ($line =~ /;$/);
- if ($line =~ /^\s*DELETE/) {
- $line =~ s/frameworkcode='.*?'/frameworkcode='$frameworkcode'/ unless ($_ =~ /frameworkcode='$frameworkcode'/);
- } elsif ($line =~ /^\s*INSERT\s+INTO\s+(.*?)\s+\((.*?frameworkcode.*?)\)\s+VALUES\s+\((.+)\)\s*;\s*$/) {
- my $table = $1;
- my $fields = $2;
- my $values = $3;
- my @arrFields = split(/\s*,\s*/, $fields);
- my @arrValues;
- if ($values) {
- _parseSQLInsertValues($values, $literalEscape, \@arrValues);
- }
- if (scalar(@arrFields) == scalar(@arrValues)) {
- my $modified = 0;
- for (my $i=0; $i < @arrFields; $i++) {
- if ($arrFields[$i] eq 'frameworkcode' && $arrValues[$i]->{value} ne $frameworkcode) {
- $arrValues[$i]->{value} = $dbh->quote($frameworkcode);
- $modified = 1;
- } elsif ($arrValues[$i]->{literal}) {
- $arrValues[$i]->{value} = $dbh->quote($arrValues[$i]->{value});
- }
- }
- if ($modified) {
- $line = "INSERT INTO $table ($fields) VALUES (" . join(',', map {$_->{value}} @arrValues) . ');';
- }
- }
- }
- }
- }
- eval {
- $dbh->do($line);
- };
- }
-}#_parseSQLLine
-
-
-# Simple sub to get the values from the insert sentence
-sub _parseSQLInsertValues
-{
- my ($values, $literalEscape, $arrValues) = @_;
-
- my ($posBegin, $posLiteral, $currentPos, $lengthValues, $currentChar);
- $lengthValues = length($values);
- $currentPos = 0;
- while ($currentPos < $lengthValues) {
- $currentChar = substr($values, $currentPos++, 1);
- next if ($currentChar =~ /^\s$/);
- next if ($posBegin && $currentChar !~ /^[,']$/);
- unless ($posBegin) {
- if ($currentChar eq '\'') {
- $posBegin = $currentPos;
- $posLiteral = $posBegin;
- } else {
- $posBegin = $currentPos -1;
- }
- } else {
- if ($currentChar eq ',') {
- unless ($posLiteral) {
- push @$arrValues, {literal => 0, value => substr($values, $posBegin, $currentPos -(1 + $posBegin))};
- $posBegin = undef;
- }
- } elsif ($currentChar eq '\'' && $posLiteral) {
- next if ($literalEscape eq '\\' && substr($values, $currentPos -2, 1) eq $literalEscape);
- if ($literalEscape eq '\'' && substr($values, $currentPos, 1) eq $literalEscape) {
- $currentPos++;
- next;
- }
- push @$arrValues, {literal => 1 , value => substr($values, $posBegin, $currentPos -( 1 + $posBegin))};
- $currentPos++ if (substr($values, $currentPos, 1) eq ',');
- $posBegin = undef;
- $posLiteral = undef;
- } # We shouldn't get to here if the sql sentence is correct
- }
- }
- push @$arrValues, {literal => ($posLiteral)?1:0, value => substr($values, $posBegin, $currentPos - $posBegin)} if ($posBegin);
-}#_parseSQLInsertValues
-
-
# Open (uncompress) ods file and return the content.xml file
sub _openODS
{
seek($dom, $pos, 0);
return 1;
}
- if (scalar(@$fields) == scalar(@arrData)) {
- if (!$fieldsNameRead) {
- # New table, we read the field names
- $fieldsNameRead = 1;
- for (my $i=0; $i < @arrData; $i++) {
- if ($arrData[$i] ne $fields->[$i]) {
- $fieldsNameRead = 0;
- last;
- }
- }
- if ($fieldsNameRead) {
- $fieldsStr = join(',', @$fields);
- $dataStr = '';
- map { $dataStr .= '?,';} @$fields;
- chop($dataStr) if ($dataStr);
- $updateStr = '';
- map { $updateStr .= $_ . '=?,';} @$fields;
- chop($updateStr) if ($updateStr);
- }
- } else {
- # Read data
- my $j = 0;
- my %dataFields = ();
- for (@arrData) {
- if ($fields->[$j] eq 'frameworkcode' && $_ ne $frameworkcode) {
- $dataFields{$fields->[$j]} = $frameworkcode;
- $arrData[$j] = $frameworkcode;
- } else {
- $dataFields{$fields->[$j]} = $_;
- }
- $j++
+ if (!$fieldsNameRead) {
+ # New table, we read the field names
+ $fieldsNameRead = 1;
+ $fields = [@arrData];
+ $fieldsStr = join(',', @$fields);
+ $dataStr = '';
+ map { $dataStr .= '?,';} @$fields;
+ chop($dataStr) if ($dataStr);
+ $updateStr = '';
+ map { $updateStr .= $_ . '=?,';} @$fields;
+ chop($updateStr) if ($updateStr);
+ } else {
+ # Read data
+ my $j = 0;
+ my %dataFields = ();
+ for (@arrData) {
+ if ($fields->[$j] eq 'frameworkcode' && $_ ne $frameworkcode) {
+ $dataFields{$fields->[$j]} = $frameworkcode;
+ $arrData[$j] = $frameworkcode;
+ } else {
+ $dataFields{$fields->[$j]} = $_;
}
- $ok = _processRow_DB($dbh, $db_scheme, $table, $fieldsStr, $dataStr, $updateStr, \@arrData, \%dataFields, $PKArray, \@fieldsPK, $fields2Delete);
+ $j++
}
+ $ok = _processRow_DB($dbh, $db_scheme, $table, $fieldsStr, $dataStr, $updateStr, \@arrData, \%dataFields, $PKArray, \@fieldsPK, $fields2Delete);
}
$pos = tell($dom);
}