From 523735ef6b97944dcbbb882704702028c7373c0e Mon Sep 17 00:00:00 2001 From: Matthias Meusburger Date: Tue, 26 Jan 2010 14:52:36 +0100 Subject: [PATCH] MT2116 : Addons to the CSV Export Add encoding selection Add authorised values handling --- C4/Koha.pm | 54 +++++++++++ C4/Record.pm | 34 ++++--- Makefile.PL | 1 + about.pl | 1 + basket/downloadcart.pl | 90 +++++++++++++++++++ installer/data/mysql/kohastructure.sql | 4 + installer/data/mysql/updatedatabase.pl | 8 ++ .../prog/en/modules/tools/csv-profiles.tmpl | 20 ++++- opac/opac-downloadcart.pl | 2 +- opac/opac-downloadshelf.pl | 2 +- tools/csv-profiles.pl | 21 +++-- virtualshelves/downloadshelf.pl | 90 +++++++++++++++++++ 12 files changed, 305 insertions(+), 22 deletions(-) create mode 100755 basket/downloadcart.pl create mode 100755 virtualshelves/downloadshelf.pl diff --git a/C4/Koha.pm b/C4/Koha.pm index 3589010b0f..dc10a6e5d7 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -51,6 +51,7 @@ BEGIN { &GetAuthorisedValues &GetAuthorisedValueCategories &GetKohaAuthorisedValues + &GetKohaAuthorisedValuesFromField &GetAuthValCode &GetNormalizedUPC &GetNormalizedISBN @@ -991,6 +992,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]); @@ -1067,6 +1092,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 4300f9a532..1e00a7b629 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 c5131cd83c..06a38263f7 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -594,6 +594,7 @@ WriteMakefile( 'Test::More' => 0.62, '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 4a554adccf..75635a694c 100755 --- a/about.pl +++ b/about.pl @@ -124,6 +124,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 new file mode 100755 index 0000000000..4be46dda28 --- /dev/null +++ b/basket/downloadcart.pl @@ -0,0 +1,90 @@ +#!/usr/bin/perl + +# Copyright 2009 BibLibre +# +# 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 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., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use warnings; + +use CGI; +use Encode qw(encode); +use Switch; + +use C4::Auth; +use C4::Biblio; +use C4::Items; +use C4::Output; +use C4::VirtualShelves; +use C4::Record; +use C4::Ris; +use C4::Csv; +use utf8; +use open qw( :std :utf8); +my $query = new CGI; + +my ( $template, $borrowernumber, $cookie ) = get_template_and_user ( + { + template_name => "basket/downloadcart.tmpl", + query => $query, + type => "intranet", + authnotrequired => 0, + flagsrequired => { borrow => 1 }, + } +); + +my $bib_list = $query->param('bib_list'); +my $format = $query->param('format'); +my $dbh = C4::Context->dbh; + +if ($bib_list && $format) { + + my @bibs = split( /\//, $bib_list ); + + my $marcflavour = C4::Context->preference('marcflavour'); + my $output; + + # retrieve biblios from shelf + my $firstpass = 1; + foreach my $biblio (@bibs) { + + my $record = GetMarcBiblio($biblio); + + switch ($format) { + case "iso2709" { $output .= $record->as_usmarc(); } + 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($biblio, $format, $firstpass); } + } + $firstpass = 0; + + } + + # If it was a CSV export we change the format after the export so the file extension is fine + $format = "csv" if ($format =~ m/^\d+$/); + + print $query->header( + -type => 'application/octet-stream', + -'Content-Transfer-Encoding' => 'binary', + -attachment=>"cart.$format"); + print $output; + +} else { + $template->param(csv_profiles => GetCsvProfilesLoop()); + $template->param(bib_list => $bib_list); + output_html_with_http_headers $query, $cookie, $template->output; +} diff --git a/installer/data/mysql/kohastructure.sql b/installer/data/mysql/kohastructure.sql index 37d0cb03ab..2b62abfda2 100644 --- a/installer/data/mysql/kohastructure.sql +++ b/installer/data/mysql/kohastructure.sql @@ -977,6 +977,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 310438fca6..218ee450a2 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/installer/data/mysql/updatedatabase.pl @@ -2986,6 +2986,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 2d50bdcb8a..9d61b7f55c 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 @@ -84,12 +84,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

@@ -151,6 +160,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 new file mode 100755 index 0000000000..f75d2d46f5 --- /dev/null +++ b/virtualshelves/downloadshelf.pl @@ -0,0 +1,90 @@ +#!/usr/bin/perl + +# Copyright 2009 BibLibre +# +# 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 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., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use warnings; + +use CGI; +use Encode qw(encode); +use Switch; + +use C4::Auth; +use C4::Biblio; +use C4::Items; +use C4::Output; +use C4::VirtualShelves; +use C4::Record; +use C4::Ris; +use C4::Csv; +use utf8; +use open qw( :std :utf8); +my $query = new CGI; + +my ( $template, $borrowernumber, $cookie ) = get_template_and_user ( + { + template_name => "virtualshelves/downloadshelf.tmpl", + query => $query, + type => "intranet", + authnotrequired => 0, + flagsrequired => { catalogue => 1 }, + } +); + +my $shelfid = $query->param('shelfid'); +my $format = $query->param('format'); +my $dbh = C4::Context->dbh; + +if ($shelfid && $format) { + + my @shelf = GetShelf($shelfid); + my ($items, $totitems) = GetShelfContents($shelfid); + my $marcflavour = C4::Context->preference('marcflavour'); + my $output; + + # retrieve biblios from shelf + my $firstpass = 1; + foreach my $biblio (@$items) { + my $biblionumber = $biblio->{biblionumber}; + + my $record = GetMarcBiblio($biblionumber); + + switch ($format) { + case "iso2709" { $output .= $record->as_usmarc(); } + 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($biblionumber, $format, $firstpass); } + } + $firstpass = 0; + } + + # If it was a CSV export we change the format after the export so the file extension is fine + $format = "csv" if ($format =~ m/^\d+$/); + + print $query->header( + -type => 'application/octet-stream', + -'Content-Transfer-Encoding' => 'binary', + -attachment=>"shelf.$format"); + print $output; + +} else { + $template->param(csv_profiles => GetCsvProfilesLoop()); + $template->param(shelfid => $shelfid); + output_html_with_http_headers $query, $cookie, $template->output; +} -- 2.39.5