Browse Source

MT2116 : Addons to the CSV Export

Add encoding selection
Add authorised values handling
3.2.x
Matthias Meusburger 14 years ago
committed by Henri-Damien LAURENT
parent
commit
b40d4052b9
  1. 54
      C4/Koha.pm
  2. 34
      C4/Record.pm
  3. 1
      Makefile.PL
  4. 1
      about.pl
  5. 2
      basket/downloadcart.pl
  6. 4
      installer/data/mysql/kohastructure.sql
  7. 8
      installer/data/mysql/updatedatabase.pl
  8. 20
      koha-tmpl/intranet-tmpl/prog/en/modules/tools/csv-profiles.tmpl
  9. 2
      opac/opac-downloadcart.pl
  10. 2
      opac/opac-downloadshelf.pl
  11. 21
      tools/csv-profiles.pl
  12. 2
      virtualshelves/downloadshelf.pl

54
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

34
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)));
}
};

1
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,

1
about.pl

@ -130,6 +130,7 @@ Test::Harness
Test::More
Text::CSV
Text::CSV_XS
Text::CSV::Encoded
Text::Iconv
Text::Wrap
Time::HiRes

2
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;

4
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';

8
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)

20
koha-tmpl/intranet-tmpl/prog/en/modules/tools/csv-profiles.tmpl

@ -131,11 +131,20 @@ function reloadPage(p) {
</select>
<br /><br />
<label for="encoding">Encoding :</label>
<select name="encoding">
<!-- TMPL_LOOP NAME="encodings" -->
<option<!-- TMPL_IF EXPR="encoding eq 'utf8'" --> selected="selected" <!-- /TMPL_IF -->><!-- TMPL_VAR NAME="encoding" --></option>
<!-- /TMPL_LOOP -->
</select>
<br /><br />
<label for="profile_content">Profile marcfields :</label>
<textarea cols="50" rows="2" name="profile_content" id="profile_content"></textarea>
<p>You have to define which fields or subfields you want to export, separated by pipes.<br />
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.<br />
Example&nbsp;: Personal name=200|Entry element=210$a|300
Example&nbsp;: Personal name=200|Entry element=210$a|300|009
</p>
</fieldset>
<input type="hidden" name="action" value="create" />
@ -234,6 +243,15 @@ function reloadPage(p) {
</select>
<br /><br />
<label for="encoding">Encoding :</label>
<select name="encoding">
<!-- TMPL_LOOP NAME="encodings" -->
<option<!-- TMPL_IF EXPR="selected_encoding eq encoding" --> selected="selected" <!-- /TMPL_IF -->><!-- TMPL_VAR NAME="encoding" --></option>
<!-- /TMPL_LOOP -->
</select>
<br /><br />
<label for="modify_profile_content">Profile marcfields :</label>
<textarea cols="50" rows="2" name="profile_content" id="modify_profile_content"><!-- TMPL_VAR NAME="selected_profile_marcfields" --></textarea></li>

2
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;

2
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;
}

21
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]
);
}

2
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;
}

Loading…
Cancel
Save