[libcatmandu-marc-perl] 70/208: buffer lines before sending to IO::Handle, especially for IO::String that uses string appending
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:36 UTC 2017
This is an automated email from the git hooks/post-receive script.
js pushed a commit to annotated tag upstream/1.19
in repository libcatmandu-marc-perl.
commit d99a18ce0a488f4826b4ad4d71a35185e3d23e74
Author: Nicolas Franck <nicolas.franck at ugent.be>
Date: Wed Dec 14 15:16:11 2016 +0100
buffer lines before sending to IO::Handle, especially for IO::String that uses string appending
---
lib/Catmandu/Exporter/MARC/XML.pm | 52 ++++++++++++++++++++-------------------
1 file changed, 27 insertions(+), 25 deletions(-)
diff --git a/lib/Catmandu/Exporter/MARC/XML.pm b/lib/Catmandu/Exporter/MARC/XML.pm
index 6589681..15c054d 100644
--- a/lib/Catmandu/Exporter/MARC/XML.pm
+++ b/lib/Catmandu/Exporter/MARC/XML.pm
@@ -5,7 +5,7 @@ use Moo;
our $VERSION = '1.03';
-with 'Catmandu::Exporter', 'Catmandu::Exporter::MARC::Base';
+with 'Catmandu::Exporter', 'Catmandu::Exporter::MARC::Base', 'Catmandu::Buffer';
has record => (is => 'ro' , default => sub { 'record'});
has record_format => (is => 'ro' , default => sub { 'raw'} );
@@ -15,14 +15,13 @@ has xml_declaration => (is => 'ro' , default => sub { 1 });
has pretty => (is => 'rw' , default => sub { 0 });
has _n => (is => 'rw' , default => sub { 0 });
-sub _print {
+sub _line {
my ($self, $indent, $line) = @_;
if ($self->pretty) {
- $self->fh->print(" " x $indent);
- $self->fh->print($line);
- $self->fh->print("\n");
+ my $pre = " " x $indent;
+ $self->buffer_add( $pre.$line."\n" );
} else {
- $self->fh->print($line);
+ $self->buffer_add( $line );
}
}
@@ -31,34 +30,34 @@ sub add {
if ($self->_n == 0) {
if ($self->xml_declaration) {
- $self->fh->print(Catmandu::Util::xml_declaration);
+ $self->buffer_add( Catmandu::Util::xml_declaration );
}
if ($self->collection) {
- $self->_print(0,'<marc:collection xmlns:marc="http://www.loc.gov/MARC21/slim">');
+ $self->_line(0,'<marc:collection xmlns:marc="http://www.loc.gov/MARC21/slim">');
}
$self->_n(1);
}
-
+
my $indent = $self->collection ? 1 : 0;
- if ($self->record_format eq 'MARC-in-JSON') {
+ if ($self->record_format eq 'MARC-in-JSON') {
$data = $self->_json_to_raw($data);
}
if ($self->collection) {
- $self->_print($indent,'<marc:record>');
+ $self->_line($indent,'<marc:record>');
}
else {
- $self->_print($indent,'<marc:record xmlns:marc="http://www.loc.gov/MARC21/slim">');
+ $self->_line($indent,'<marc:record xmlns:marc="http://www.loc.gov/MARC21/slim">');
}
- my $record = $data->{$self->record};
+ my $record = $data->{$self->record};
for my $field (@$record) {
my ($tag, $ind1, $ind2, @data) = @$field;
-
+
$ind1 = ' ' unless defined $ind1;
$ind2 = ' ' unless defined $ind2;
@@ -68,30 +67,33 @@ sub add {
next if @data == 0;
if ($tag eq 'LDR') {
- $self->_print($indent+1,'<marc:leader>' . xml_escape($data[1]) . '</marc:leader>');
+ $self->_line($indent+1,'<marc:leader>' . xml_escape($data[1]) . '</marc:leader>');
}
elsif ($tag =~ /^00/) {
- $self->_print($indent+1,'<marc:controlfield tag="' . xml_escape($tag) . '">' . xml_escape($data[1]) . '</marc:controlfield>');
+ $self->_line($indent+1,'<marc:controlfield tag="' . xml_escape($tag) . '">' . xml_escape($data[1]) . '</marc:controlfield>');
}
else {
- $self->_print($indent+1,'<marc:datafield tag="' . xml_escape($tag) . '" ind1="' . $ind1 . '" ind2="' . $ind2 . '">');
+ $self->_line($indent+1,'<marc:datafield tag="' . xml_escape($tag) . '" ind1="' . $ind1 . '" ind2="' . $ind2 . '">');
while (@data) {
my ($code, $val) = splice(@data, 0, 2);
next unless $code =~ /[A-Za-z0-9]/;
- $self->_print($indent+2,'<marc:subfield code="' . $code . '">' . xml_escape($val) . '</marc:subfield>');
+ $self->_line($indent+2,'<marc:subfield code="' . $code . '">' . xml_escape($val) . '</marc:subfield>');
}
- $self->_print($indent+1,'</marc:datafield>');
+ $self->_line($indent+1,'</marc:datafield>');
}
}
- $self->_print($indent,'</marc:record>');
+ $self->_line($indent,'</marc:record>');
+
+ $self->fh->print( join('', @{ $self->buffer } ) );
+ $self->clear_buffer;
}
sub commit {
my ($self) = @_;
if($self->collection){
- $self->_print(0,'</marc:collection>');
+ $self->fh->print('</marc:collection>');
}
$self->fh->flush;
@@ -106,7 +108,7 @@ Catmandu::Exporter::MARC::XML - Exporter for MARC records to MARCXML
=head1 SYNOPSIS
- # From the command line
+ # From the command line
$ catmandu convert MARC to MARC --type XML < /foo/data.mrc
# From Perl
@@ -137,9 +139,9 @@ used to write to a callback function.
Write the output to an L<IO::Handle>. If not specified,
L<Catmandu::Util::io|Catmandu::Util/IO-functions> is used to create the output
handle from the C<file> argument or by using STDOUT.
-
+
=item fix
-
+
An ARRAY of one or more fixes or file scripts to be applied to exported items.
=item record
@@ -150,7 +152,7 @@ the key containing the marc record (default: 'record')
Optionally set to 'MARC-in-JSON' when the input format is in MARC-in-JSON
-=item collection
+=item collection
add a marc:collection header when true (default: true)
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-marc-perl.git
More information about the Pkg-perl-cvs-commits
mailing list