use warnings;
use XML::LibXML;
use XML::LibXML::XPathContext;
-use Digest::MD5 qw();
-use POSIX qw(strftime);
+use Digest::MD5;
+use POSIX qw( strftime );
+use Text::CSV_XS;
+use List::MoreUtils qw( indexes );
use C4::Context;
-use C4::Debug;
-
-
-use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use Koha::Logger;
+our (@ISA, @EXPORT_OK);
BEGIN {
require Exporter;
@ISA = qw(Exporter);
- @EXPORT = qw(
- &ExportFramework
- &ImportFramework
- &createODS
+ @EXPORT_OK = qw(
+ ExportFramework
+ ImportFramework
+ createODS
);
}
}
};
if ($@) {
- $debug and warn "Error ExportFramework $@\n";
+ Koha::Logger->get->warn("Error ExportFramework $@");
return 0;
}
}
$$strCSV .= chr(10);
};
if ($@) {
- $debug and warn "Error _export_table_csv $@\n";
+ Koha::Logger->get->warn("Error _export_table_csv $@");
return 0;
}
return 1;
}
};
if ($@) {
- $debug and warn "Error _export_table_ods $@\n";
+ Koha::Logger->get->warn("Error _export_table_ods $@");
return 0;
}
return 1;
}
};
if ($@) {
- $debug and warn "Error _export_table_excel $@\n";
+ Koha::Logger->get->warn("Error _export_table_excel $@");
return 0;
}
return 1;
}
};
if ($@) {
- $debug and warn "Error createODS $@\n";
+ Koha::Logger->get->warn("Error createODS $@");
} else {
# create ods file from tempdir directory
eval {
}
}
} else {
- $debug and warn "Error ImportFramework couldn't create dom\n";
+ Koha::Logger->get->warn("Error ImportFramework couldn't create dom");
}
};
if ($@) {
- $debug and warn "Error ImportFramework $@\n";
+ Koha::Logger->get->warn("Error ImportFramework $@");
} else {
if ($extension eq 'csv') {
close($dom) if ($dom);
}
unlink ($filename) if ($deleteFilename); # remove temporary file
} else {
- $debug and warn "Error ImportFramework no conex to database or not readeable $filename\n";
+ Koha::Logger->get->warn("Error ImportFramework no conex to database or not readeable $filename");
}
if ($deleteFilename && $tempdir && -d $tempdir && -w $tempdir) {
eval {
$sth->execute((@$dataFields, @$dataFields));
};
if ($@) {
- $debug and warn "Error _processRows_Table $@\n";
+ Koha::Logger->get->warn("Error _processRow_DB $@");
} else {
$ok = 1;
}
my ($dataFields, $dataFieldsR) = _getDataFields($frameworkcode, $nodeR, \@fields, $format);
if (scalar(@fields) == scalar(@$dataFieldsR)) {
$ok = _processRow_DB($dbh, $table, $fields, $dataStr, $updateStr, $dataFieldsR, $dataFields, $PKArray, \@fieldsPK, $fields2Delete);
+ } else {
+ warn "$j don't match number of fields " . scalar(@fields) . ' vs ' . scalar(@$dataFieldsR) . "($dataStr)";
}
}
$j++;
my $numFields = @$fields;
my $fieldsNameRead = 0;
my @arrData;
- my ($fieldsStr, $dataStr, $updateStr);
+ my ($fieldsStr, $dataStr, $updateStr, @empty_indexes);
my @fieldsPK = @$PKArray;
shift @fieldsPK;
my $ok = 0;
- my $numRow = 0;
my $pos = 0;
- while (<$dom>) {
- $row = $_;
- # Check whether the line has an unfinished field, i.e., a field with CR/LF in its data
- if ($row =~ /,"[^"]*[\r\n]+$/ || $row =~ /^[^"]+[\r\n]+$/) {
- $row =~ s/[\r\n]+$//;
- $partialRow .= $row;
- next;
- }
- if ($partialRow) {
- $row = $partialRow . $row;
- $partialRow = '';
- }
- # Line OK, process it
- if ($row =~ /(?:".*?",?)+/) {
- @arrData = split('","', $row);
- $arrData[0] = substr($arrData[0], 1) if ($arrData[0] =~ /^"/);
- $arrData[$#arrData] =~ s/[\r\n]+$//;
- chop $arrData[$#arrData] if ($arrData[$#arrData] =~ /"$/);
- if (@arrData) {
- if ($arrData[0] eq '#-#' && $arrData[$#arrData] eq '#-#') {
- # Change of table with separators #-#
- return 1;
- } elsif ($fieldsNameRead && $arrData[0] eq 'tagfield') {
- # Change of table because we begin with field name with former field names read
- seek($dom, $pos, 0);
- return 1;
- }
- 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]} = $_;
- }
- $j++
+ my $csv = Text::CSV_XS->new ({ binary => 1 });
+ while ( my $row = $csv->getline($dom) ) {
+ my @fields = @$row;
+ @arrData = @fields;
+ next if scalar @arrData == grep { $_ eq '' } @arrData; # Emtpy lines
+ #$arrData[0] = substr($arrData[0], 1) if ($arrData[0] =~ /^"/);
+ #$arrData[$#arrData] =~ s/[\r\n]+$//;
+ #chop $arrData[$#arrData] if ($arrData[$#arrData] =~ /"$/);
+ if (@arrData) {
+ if ($arrData[0] eq '#-#' && $arrData[$#arrData] eq '#-#') {
+ # Change of table with separators #-#
+ return 1;
+ } elsif ($fieldsNameRead && $arrData[0] eq 'tagfield') {
+ # Change of table because we begin with field name with former field names read
+ seek($dom, $pos, 0);
+ return 1;
+ }
+ if (!$fieldsNameRead) {
+ # New table, we read the field names
+ $fieldsNameRead = 1;
+ $fields = [@arrData];
+ my $non_empty_fields = [ grep { $_ ne '' } @$fields ];
+ @empty_indexes = indexes { $_ eq '' } @$fields;
+ $fieldsStr = join(',', @$non_empty_fields);
+ $dataStr = '';
+ map { $dataStr .= '?,';} @$non_empty_fields;
+ chop($dataStr) if ($dataStr);
+ $updateStr = '';
+ map { $updateStr .= $_ . '=?,';} @$non_empty_fields;
+ chop($updateStr) if ($updateStr);
+ } else {
+ # Read data
+ my $j = 0;
+ my %dataFields = ();
+ my @values;
+ for my $value (@arrData) {
+ if ( grep { $_ == $j } @empty_indexes ) {
+ # empty field
+ } elsif ($fields->[$j] eq 'frameworkcode' && $value ne $frameworkcode) {
+ $dataFields{$fields->[$j]} = $frameworkcode;
+ push @values, $frameworkcode;
+ } elsif ($fields->[$j] eq 'isurl' && defined $value && $value eq q{}) {
+ $dataFields{$fields->[$j]} = undef;
+ push @values, undef;
+ } else {
+ $dataFields{$fields->[$j]} = $value;
+ push @values, $value;
}
- $ok = _processRow_DB($dbh, $table, $fieldsStr, $dataStr, $updateStr, \@arrData, \%dataFields, $PKArray, \@fieldsPK, $fields2Delete);
+ $j++
}
- $pos = tell($dom);
+ $ok = _processRow_DB($dbh, $table, $fieldsStr, $dataStr, $updateStr, \@values, \%dataFields, $PKArray, \@fieldsPK, $fields2Delete);
}
- @arrData = ();
+ $pos = tell($dom);
}
- $numRow++;
+ @arrData = ();
}
return $ok;
}#_import_table_csv
my $nodeR = $nodes[0]->firstChild;
return _processRows_Table($dbh, $frameworkcode, $nodeR, $table, $PKArray, 'ods', $fields2Delete);
} else {
- $debug and warn "Error _import_table_ods there's not worksheet for $table\n";
+ Koha::Logger->get->warn("Error _import_table_ods there's not worksheet for $table");
}
return 0;
}#_import_table_ods
}
}
} else {
- $debug and warn "Error _import_table_excel there's not worksheet for $table\n";
+ Koha::Logger->get->warn("Error _import_table_excel there's not worksheet for $table");
}
return 0;
}#_import_table_excel
if ($format && $format eq 'ods') {
($data, $repeated) = _getDataNodeODS($node2) if ($repeated <= 0);
$repeated--;
- $ok = 1 if (defined($data));
+ $ok = 1;
} else {
if ($node2->nodeType == 1 && $node2->nodeName =~ /(?:ss:)?Cell/) {
my @nodes3 = $node2->getElementsByTagNameNS('urn:schemas-microsoft-com:office:spreadsheet', 'Data');
}
}
if ($ok) {
+ $data //= '';
$data = '' if ($data eq '#');
- $data = $frameworkcode if ($fields->[$i] eq 'frameworkcode');
+ if ( $fields->[$i] eq 'frameworkcode' ) {
+ $data = $frameworkcode;
+ }
+ elsif ( $fields->[$i] eq 'isurl' ) {
+ $data = undef if defined $data && $data eq q{};
+ }
$dataFields->{$fields->[$i]} = $data;
push @dataFieldsA, $data;
$i++;
projects / koha-ffzg.git / blobdiff