Attachment #116891 for bug #27569

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




use XML::LibXML::XPathContext;
use Digest::MD5 qw();
use POSIX qw(strftime);
use Text::CSV_XS;
use List::MoreUtils qw(indexes);

use C4::Context;
use C4::Debug;

    my $numFields = @$fields;
    my $fieldsNameRead = 0;
    my @arrData;
    my ($fieldsStr, $dataStr, $updateStr, @empty_indexes);
    my @fieldsPK = @$PKArray;
    shift @fieldsPK;
    my $ok = 0;
    my $numRow = 0;
    my $pos = 0;
    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;
                    } else {
                        $dataFields{$fields->[$j]} = $value;
                        push @values, $value;
                            $dataFields{$fields->[$j]} = $frameworkcode;
                            $arrData[$j] = $frameworkcode;
                        } else {
                            $dataFields{$fields->[$j]} = $_;
                        }
                        $j++
                    }
                    $j++
                }
                $ok = _processRow_DB($dbh, $table, $fieldsStr, $dataStr, $updateStr, \@values, \%dataFields, $PKArray, \@fieldsPK, $fields2Delete);
            }
            $pos = tell($dom);
        }
        @arrData = ();
    }
    return $ok;
}#_import_table_csv
- 

Return to bug 27569

Lines 23-28 use XML::LibXML; Link Here

(-)a/C4/ImportExportFramework.pm (-57 / +51 lines)
23	use XML::LibXML::XPathContext;	23	use XML::LibXML::XPathContext;
24	use Digest::MD5 qw();	24	use Digest::MD5 qw();
25	use POSIX qw(strftime);	25	use POSIX qw(strftime);
		26	use Text::CSV_XS;
		27	use List::MoreUtils qw(indexes);
26		28
27	use C4::Context;	29	use C4::Context;
28	use C4::Debug;	30	use C4::Debug;
Lines 927-996 sub _import_table_csv Link Here
927	my $numFields = @$fields;	929	my $numFields = @$fields;
928	my $fieldsNameRead = 0;	930	my $fieldsNameRead = 0;
929	my @arrData;	931	my @arrData;
930	my ($fieldsStr, $dataStr, $updateStr);	932	my ($fieldsStr, $dataStr, $updateStr, @empty_indexes);
931	my @fieldsPK = @$PKArray;	933	my @fieldsPK = @$PKArray;
932	shift @fieldsPK;	934	shift @fieldsPK;
933	my $ok = 0;	935	my $ok = 0;
934	my $numRow = 0;
935	my $pos = 0;	936	my $pos = 0;
936	while (<$dom>) {	937	my $csv = Text::CSV_XS->new ({ binary => 1 });
937	$row = $_;	938	while ( my $row = $csv->getline($dom) ) {
938	# Check whether the line has an unfinished field, i.e., a field with CR/LF in its data	939	my @fields = @$row;
939	if ($row =~ /,"[^"]*[\r\n]+$/ \|\| $row =~ /^[^"]+[\r\n]+$/) {	940	@arrData = @fields;
940	$row =~ s/[\r\n]+$//;	941	next if scalar @arrData == grep { $_ eq '' } @arrData; # Emtpy lines
941	$partialRow .= $row;	942	#$arrData[0] = substr($arrData[0], 1) if ($arrData[0] =~ /^"/);
942	next;	943	#$arrData[$#arrData] =~ s/[\r\n]+$//;
943	}	944	#chop $arrData[$#arrData] if ($arrData[$#arrData] =~ /"$/);
944	if ($partialRow) {	945	if (@arrData) {
945	$row = $partialRow . $row;	946	if ($arrData[0] eq '#-#' && $arrData[$#arrData] eq '#-#') {
946	$partialRow = '';	947	# Change of table with separators #-#
947	}	948	return 1;
948	# Line OK, process it	949	} elsif ($fieldsNameRead && $arrData[0] eq 'tagfield') {
949	if ($row =~ /(?:".*?",?)+/) {	950	# Change of table because we begin with field name with former field names read
950	@arrData = split('","', $row);	951	seek($dom, $pos, 0);
951	$arrData[0] = substr($arrData[0], 1) if ($arrData[0] =~ /^"/);	952	return 1;
952	$arrData[$#arrData] =~ s/[\r\n]+$//;	953	}
953	chop $arrData[$#arrData] if ($arrData[$#arrData] =~ /"$/);	954	if (!$fieldsNameRead) {
954	if (@arrData) {	955	# New table, we read the field names
955	if ($arrData[0] eq '#-#' && $arrData[$#arrData] eq '#-#') {	956	$fieldsNameRead = 1;
956	# Change of table with separators #-#	957	$fields = [@arrData];
957	return 1;	958	my $non_empty_fields = [ grep { $_ ne '' } @$fields ];
958	} elsif ($fieldsNameRead && $arrData[0] eq 'tagfield') {	959	@empty_indexes = indexes { $_ eq '' } @$fields;
959	# Change of table because we begin with field name with former field names read	960	$fieldsStr = join(',', @$non_empty_fields);
960	seek($dom, $pos, 0);	961	$dataStr = '';
961	return 1;	962	map { $dataStr .= '?,';} @$non_empty_fields;
962	}	963	chop($dataStr) if ($dataStr);
963	if (!$fieldsNameRead) {	964	$updateStr = '';
964	# New table, we read the field names	965	map { $updateStr .= $_ . '=?,';} @$non_empty_fields;
965	$fieldsNameRead = 1;	966	chop($updateStr) if ($updateStr);
966	$fields = [@arrData];	967	} else {
967	$fieldsStr = join(',', @$fields);	968	# Read data
968	$dataStr = '';	969	my $j = 0;
969	map { $dataStr .= '?,';} @$fields;	970	my %dataFields = ();
970	chop($dataStr) if ($dataStr);	971	my @values;
971	$updateStr = '';	972	for my $value (@arrData) {
972	map { $updateStr .= $_ . '=?,';} @$fields;	973	if ( grep { $_ == $j } @empty_indexes ) {
973	chop($updateStr) if ($updateStr);	974	# empty field
974	} else {	975	} elsif ($fields->[$j] eq 'frameworkcode' && $value ne $frameworkcode) {
975	# Read data	976	$dataFields{$fields->[$j]} = $frameworkcode;
976	my $j = 0;	977	push @values, $frameworkcode;
977	my %dataFields = ();	978	} else {
978	for (@arrData) {	979	$dataFields{$fields->[$j]} = $value;
979	if ($fields->[$j] eq 'frameworkcode' && $_ ne $frameworkcode) {	980	push @values, $value;
980	$dataFields{$fields->[$j]} = $frameworkcode;
981	$arrData[$j] = $frameworkcode;
982	} else {
983	$dataFields{$fields->[$j]} = $_;
984	}
985	$j++
986	}	981	}
987	$ok = _processRow_DB($dbh, $table, $fieldsStr, $dataStr, $updateStr, \@arrData, \%dataFields, $PKArray, \@fieldsPK, $fields2Delete);	982	$j++
988	}	983	}
989	$pos = tell($dom);	984	$ok = _processRow_DB($dbh, $table, $fieldsStr, $dataStr, $updateStr, \@values, \%dataFields, $PKArray, \@fieldsPK, $fields2Delete);
990	}	985	}
991	@arrData = ();	986	$pos = tell($dom);
992	}	987	}
993	$numRow++;	988	@arrData = ();
994	}	989	}
995	return $ok;	990	return $ok;
996	}#_import_table_csv	991	}#_import_table_csv
997	-