diff --git a/C4/Koha.pm b/C4/Koha.pm
index 31bd6784db..18af528a70 100644
--- a/C4/Koha.pm
+++ b/C4/Koha.pm
@@ -53,6 +53,7 @@ BEGIN {
&GetAuthorisedValues
&GetAuthorisedValueCategories
&GetKohaAuthorisedValues
+ &GetKohaAuthorisedValuesFromField
&GetAuthValCode
&GetNormalizedUPC
&GetNormalizedISBN
@@ -1064,6 +1065,30 @@ sub GetAuthValCode {
return $authvalcode;
}
+=head2 GetAuthValCodeFromField
+
+$authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
+
+C<$subfield> can be undefined
+
+=cut
+
+sub GetAuthValCodeFromField {
+ my ($field,$subfield,$fwcode) = @_;
+ my $dbh = C4::Context->dbh;
+ $fwcode='' unless $fwcode;
+ my $sth;
+ if (defined $subfield) {
+ $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
+ $sth->execute($field,$subfield,$fwcode);
+ } else {
+ $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
+ $sth->execute($field,$fwcode);
+ }
+ my ($authvalcode) = $sth->fetchrow_array;
+ return $authvalcode;
+}
+
=head2 GetAuthorisedValues
$authvalues = GetAuthorisedValues([$category], [$selected]);
@@ -1146,6 +1171,35 @@ sub GetKohaAuthorisedValues {
}
}
+=head2 GetKohaAuthorisedValuesFromField
+
+ Takes $field, $subfield $fwcode as parameters.
+ If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
+ $subfield can be undefined
+ Returns hashref of Code => description
+ Returns undef
+ if no authorised value category is defined for the given field and subfield
+
+=cut
+
+sub GetKohaAuthorisedValuesFromField {
+ my ($field, $subfield, $fwcode,$opac) = @_;
+ $fwcode='' unless $fwcode;
+ my %values;
+ my $dbh = C4::Context->dbh;
+ my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
+ if ($avcode) {
+ my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
+ $sth->execute($avcode);
+ while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
+ $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
+ }
+ return \%values;
+ } else {
+ return undef;
+ }
+}
+
=head2 display_marc_indicators
=over 4
diff --git a/C4/Record.pm b/C4/Record.pm
index 80f5c47bcb..7c3fcc5ebb 100644
--- a/C4/Record.pm
+++ b/C4/Record.pm
@@ -31,7 +31,8 @@ use XML::LibXSLT;
use XML::LibXML;
use C4::Biblio; #marc2bibtex
use C4::Csv; #marc2csv
-use Text::CSV; #marc2csv
+use C4::Koha; #marc2csv
+use Text::CSV::Encoded; #marc2csv
use vars qw($VERSION @ISA @EXPORT);
@@ -331,13 +332,13 @@ sub marc2endnote {
=over 4
-my ($csv) = marc2csv($record, $csvprofileid);
+my ($csv) = marc2csv($record, $csvprofileid, $header);
Returns a CSV scalar
=over 2
-C<$record> - a MARC::Record object
+C<$biblio> - a biblionumber
C<$csvprofileid> - the id of the CSV profile to use for the export (see export_format.export_format_id and the GetCsvProfiles function in C4::Csv)
@@ -351,12 +352,21 @@ C<$header> - true if the headers are to be printed (typically at first pass)
sub marc2csv {
- my ($record, $id, $header) = @_;
+ my ($biblio, $id, $header) = @_;
my $output;
- # Get the information about the csv profile
+ # Getting the record
+ my $record = GetMarcBiblio($biblio);
+
+ # Getting the framework
+ my $frameworkcode = GetFrameworkCode($biblio);
+
+ # Getting information about the csv profile
my $profile = GetCsvProfile($id);
+ # Getting output encoding
+ my $encoding = $profile->{encoding} || 'utf8';
+
# Getting separators
my $csvseparator = $profile->{csv_separator} || ',';
my $fieldseparator = $profile->{field_separator} || '#';
@@ -368,7 +378,8 @@ sub marc2csv {
if ($subfieldseparator eq '\t') { $subfieldseparator = "\t" }
# Init CSV
- my $csv = Text::CSV->new({ sep_char => $csvseparator });
+ my $csv = Text::CSV::Encoded->new({ sep_char => $csvseparator });
+ $csv = $csv->encoding_out($encoding) if ($encoding ne 'utf8');
# Getting the marcfields
my $marcfieldslist = $profile->{marcfields};
@@ -401,7 +412,6 @@ sub marc2csv {
if (exists $_->{header}) {
push @marcfieldsheaders, $_->{header};
} else {
-warn "else";
# If not, we get the matching tag name from koha
if (index($field, '$') > 0) {
my ($fieldtag, $subfieldtag) = split('\$', $field);
@@ -409,14 +419,12 @@ warn "else";
my $sth = $dbh->prepare($query);
$sth->execute($fieldtag, $subfieldtag);
my @results = $sth->fetchrow_array();
-warn "subfield $fieldtag, $subfieldtag";
push @marcfieldsheaders, $results[0];
} else {
my $query = "SELECT liblibrarian FROM marc_tag_structure WHERE tagfield=?";
my $sth = $dbh->prepare($query);
$sth->execute($field);
my @results = $sth->fetchrow_array();
-warn "field $results[0]";
push @marcfieldsheaders, $results[0];
}
}
@@ -441,14 +449,18 @@ warn "field $results[0]";
# We take every matching subfield
my @subfields = $field->subfield($subfieldtag);
foreach my $subfield (@subfields) {
- push @tmpfields, $subfield;
+
+ # Getting authorised value
+ my $authvalues = GetKohaAuthorisedValuesFromField($fieldtag, $subfieldtag, $frameworkcode, undef);
+ push @tmpfields, (defined $authvalues->{$subfield}) ? $authvalues->{$subfield} : $subfield;
}
}
push (@fieldstab, join($subfieldseparator, @tmpfields));
# Or a field
} else {
my @fields = ($record->field($marcfield));
- push (@fieldstab, join($fieldseparator, map($_->as_string(), @fields)));
+ my $authvalues = GetKohaAuthorisedValuesFromField($marcfield, undef, $frameworkcode, undef);
+ push (@fieldstab, join($fieldseparator, map((defined $authvalues->{$_->as_string}) ? $authvalues->{$_->as_string} : $_->as_string, @fields)));
}
};
diff --git a/Makefile.PL b/Makefile.PL
index a7cd3cf98c..584bbdbc64 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -606,6 +606,7 @@ WriteMakefile(
'Test::More' => 0.80,
'Text::CSV' => 0.01,
'Text::CSV_XS' => 0.32,
+ 'Text::CSV::Encoded' => 0.09,
'Text::Iconv' => 1.7,
'Text::Wrap' => 2005.082401,
'Time::HiRes' => 1.86,
diff --git a/about.pl b/about.pl
index 17316bf6f6..23012b59bc 100755
--- a/about.pl
+++ b/about.pl
@@ -130,6 +130,7 @@ Test::Harness
Test::More
Text::CSV
Text::CSV_XS
+Text::CSV::Encoded
Text::Iconv
Text::Wrap
Time::HiRes
diff --git a/basket/downloadcart.pl b/basket/downloadcart.pl
index 9733c116da..4be46dda28 100755
--- a/basket/downloadcart.pl
+++ b/basket/downloadcart.pl
@@ -68,7 +68,7 @@ if ($bib_list && $format) {
case "ris" { $output .= marc2ris($record); }
case "bibtex" { $output .= marc2bibtex($record, $biblio); }
# We're in the case of a csv profile (firstpass is used for headers printing) :
- case /^\d+$/ { $output .= marc2csv($record, $format, $firstpass); }
+ case /^\d+$/ { $output .= marc2csv($biblio, $format, $firstpass); }
}
$firstpass = 0;
diff --git a/installer/data/mysql/kohastructure.sql b/installer/data/mysql/kohastructure.sql
index 1697f85ff3..3045f13e49 100644
--- a/installer/data/mysql/kohastructure.sql
+++ b/installer/data/mysql/kohastructure.sql
@@ -755,6 +755,10 @@ CREATE TABLE `export_format` (
`profile` varchar(255) NOT NULL,
`description` mediumtext NOT NULL,
`marcfields` mediumtext NOT NULL,
+ `csv_separator` varchar(2) NOT NULL,
+ `field_separator` varchar(2) NOT NULL,
+ `subfield_separator` varchar(2) NOT NULL,
+ `encoding` varchar(255) NOT NULL,
PRIMARY KEY (`export_format_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COMMENT='Used for CSV export';
diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl
index 915570318d..f418f4c275 100755
--- a/installer/data/mysql/updatedatabase.pl
+++ b/installer/data/mysql/updatedatabase.pl
@@ -3369,6 +3369,14 @@ if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
SetVersion ($DBversion);
}
+$DBversion = "3.01.00.102";
+if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
+ $dbh->do(qq{
+ ALTER TABLE `export_format` ADD `encoding` VARCHAR(255) NOT NULL AFTER `subfield_separator`
+ });
+ print "Upgrade done (added encoding for csv export)\n";
+ SetVersion ($DBversion);
+}
=item DropAllForeignKeys($table)
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/csv-profiles.tmpl b/koha-tmpl/intranet-tmpl/prog/en/modules/tools/csv-profiles.tmpl
index c1b0ff924b..1b21c052e8 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/csv-profiles.tmpl
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/tools/csv-profiles.tmpl
@@ -130,12 +130,21 @@ function reloadPage(p) {
+
+
+
+
+
You have to define which fields or subfields you want to export, separated by pipes.
You can also use your own headers (instead of the ones from koha) by prefixing the field number with an header, followed by the equal sign.
- Example : Personal name=200|Entry element=210$a|300
+ Example : Personal name=200|Entry element=210$a|300|009
@@ -234,6 +243,15 @@ function reloadPage(p) {
+
+
+
+
+
diff --git a/opac/opac-downloadcart.pl b/opac/opac-downloadcart.pl
index fe80f3008c..241f879b4b 100755
--- a/opac/opac-downloadcart.pl
+++ b/opac/opac-downloadcart.pl
@@ -68,7 +68,7 @@ if ($bib_list && $format) {
case "ris" { $output .= marc2ris($record); }
case "bibtex" { $output .= marc2bibtex($record, $biblio); }
# We're in the case of a csv profile (firstpass is used for headers printing) :
- case /^\d+$/ { $output .= marc2csv($record, $format, $firstpass); }
+ case /^\d+$/ { $output .= marc2csv($biblio, $format, $firstpass); }
}
$firstpass = 0;
diff --git a/opac/opac-downloadshelf.pl b/opac/opac-downloadshelf.pl
index 976412b1de..a03a79bda5 100755
--- a/opac/opac-downloadshelf.pl
+++ b/opac/opac-downloadshelf.pl
@@ -69,7 +69,7 @@ if ($shelfid && $format) {
case "ris" { $output .= marc2ris($record); }
case "bibtex" { $output .= marc2bibtex($record, $biblionumber); }
# We're in the case of a csv profile (firstpass is used for headers printing) :
- case /^\d+$/ { $output .= marc2csv($record, $format, $firstpass); }
+ case /^\d+$/ { $output .= marc2csv($biblionumber, $format, $firstpass); }
}
$firstpass = 0;
}
diff --git a/tools/csv-profiles.pl b/tools/csv-profiles.pl
index 8ba84aee8d..15b90de586 100755
--- a/tools/csv-profiles.pl
+++ b/tools/csv-profiles.pl
@@ -36,6 +36,7 @@ This script allow the user to define a new profile for CSV export
use strict;
use Data::Dumper;
+use Encode;
use C4::Auth;
use C4::Context;
@@ -59,6 +60,10 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
}
);
+# Getting available encodings list
+my @encodings = Encode->encodings();
+my @encodings_loop = map{{encoding => $_}} @encodings;
+$template->param(encodings => \@encodings_loop);
my $profile_name = $input->param("profile_name");
my $profile_description = $input->param("profile_description");
@@ -66,6 +71,7 @@ my $profile_content = $input->param("profile_content");
my $csv_separator = $input->param("csv_separator");
my $field_separator = $input->param("field_separator");
my $subfield_separator = $input->param("subfield_separator");
+my $encoding = $input->param("encoding");
my $action = $input->param("action");
my $delete = $input->param("delete");
my $id = $input->param("id");
@@ -75,17 +81,16 @@ if ($profile_name && $profile_content && $action) {
my $rows;
if ($action eq "create") {
- my $query = "INSERT INTO export_format(export_format_id, profile, description, marcfields, csv_separator, field_separator, subfield_separator) VALUES (NULL, ?, ?, ?, ?, ?, ?)";
+ my $query = "INSERT INTO export_format(export_format_id, profile, description, marcfields, csv_separator, field_separator, subfield_separator, encoding) VALUES (NULL, ?, ?, ?, ?, ?, ?, ?)";
my $sth = $dbh->prepare($query);
- $rows = $sth->execute($profile_name, $profile_description, $profile_content, $csv_separator, $field_separator, $subfield_separator);
+ $rows = $sth->execute($profile_name, $profile_description, $profile_content, $csv_separator, $field_separator, $subfield_separator, $encoding);
}
if ($action eq "edit") {
- my $query = "UPDATE export_format SET description=?, marcfields=?, csv_separator=?, field_separator=?, subfield_separator=? WHERE export_format_id=? LIMIT 1";
+ my $query = "UPDATE export_format SET description=?, marcfields=?, csv_separator=?, field_separator=?, subfield_separator=?, encoding=? WHERE export_format_id=? LIMIT 1";
my $sth = $dbh->prepare($query);
- $rows = $sth->execute($profile_description, $profile_content, $csv_separator, $field_separator, $subfield_separator, $profile_name);
-warn "id $id";
+ $rows = $sth->execute($profile_description, $profile_content, $csv_separator, $field_separator, $subfield_separator, $encoding, $profile_name);
}
if ($action eq "delete") {
@@ -103,13 +108,12 @@ warn "id $id";
# If a profile has been selected for modification
if ($id) {
- my $query = "SELECT export_format_id, profile, description, marcfields, csv_separator, field_separator, subfield_separator FROM export_format WHERE export_format_id = ?";
+ my $query = "SELECT export_format_id, profile, description, marcfields, csv_separator, field_separator, subfield_separator, encoding FROM export_format WHERE export_format_id = ?";
my $sth;
$sth = $dbh->prepare($query);
$sth->execute($id);
my $selected_profile = $sth->fetchrow_arrayref();
- warn "value : " . $selected_profile->[4];
$template->param(
selected_profile_id => $selected_profile->[0],
selected_profile_name => $selected_profile->[1],
@@ -117,7 +121,8 @@ warn "id $id";
selected_profile_marcfields => $selected_profile->[3],
selected_csv_separator => $selected_profile->[4],
selected_field_separator => $selected_profile->[5],
- selected_subfield_separator => $selected_profile->[6]
+ selected_subfield_separator => $selected_profile->[6],
+ selected_encoding => $selected_profile->[7]
);
}
diff --git a/virtualshelves/downloadshelf.pl b/virtualshelves/downloadshelf.pl
index 03f3a5ce8d..f75d2d46f5 100755
--- a/virtualshelves/downloadshelf.pl
+++ b/virtualshelves/downloadshelf.pl
@@ -69,7 +69,7 @@ if ($shelfid && $format) {
case "ris" { $output .= marc2ris($record); }
case "bibtex" { $output .= marc2bibtex($record, $biblionumber); }
# We're in the case of a csv profile (firstpass is used for headers printing) :
- case /^\d+$/ { $output .= marc2csv($record, $format, $firstpass); }
+ case /^\d+$/ { $output .= marc2csv($biblionumber, $format, $firstpass); }
}
$firstpass = 0;
}