1package Biber::Output::biblatexml;
2use v5.16;
3use strict;
4use warnings;
5use base 'Biber::Output::base';
6
7use Biber;
8use Biber::Config;
9use Biber::Constants;
10use Biber::Utils;
11use List::AllUtils qw( :all );
12use Encode;
13use IO::File;
14use Log::Log4perl qw( :no_extra_logdie_message );
15use Text::Wrap;
16use XML::Writer;
17use Unicode::Normalize;
18$Text::Wrap::columns = 80;
19my $logger = Log::Log4perl::get_logger('main');
20
21=encoding utf-8
22
23=head1 NAME
24
25Biber::Output::biblatexml - class for biblatexml output of tool mode
26
27=cut
28
29
30=head2 new
31
32    Initialize a Biber::Output::biblatexml object
33
34=cut
35
36sub new {
37  my $class = shift;
38  my $obj = shift;
39  my $self;
40  if (defined($obj) and ref($obj) eq 'HASH') {
41    $self = bless $obj, $class;
42  }
43  else {
44    $self = bless {}, $class;
45  }
46
47  return $self;
48}
49
50
51=head2 set_output_target_file
52
53    Set the output target file of a Biber::Output::biblatexml object
54    A convenience around set_output_target so we can keep track of the
55    filename
56
57=cut
58
59sub set_output_target_file {
60  my $self = shift;
61  my $toolfile = shift;
62
63  $self->{output_target_file} = $toolfile;
64  my $bltxml = 'http://biblatex-biber.sourceforge.net/biblatexml';
65  $self->{xml_prefix} = $bltxml;
66
67  my $of = IO::File->new($toolfile, '>:encoding(UTF-8)');
68  $of->autoflush;# Needed for running tests to string refs
69
70  my $xml = XML::Writer->new(OUTPUT      => $of,
71                             DATA_MODE   => 1,
72                             DATA_INDENT => Biber::Config->getoption('output_indent'),
73                             NAMESPACES  => 1,
74                             PREFIX_MAP  => {$bltxml => 'bltx'});
75  $xml->xmlDecl("UTF-8");
76  $xml->comment("Auto-generated by Biber::Output::biblatexml");
77  $xml->startTag([$self->{xml_prefix}, 'entries']);
78  $self->set_output_target($xml);
79}
80
81=head2 set_output_entry
82
83  Set the output for an entry
84
85=cut
86
87sub set_output_entry {
88  my $self = shift;
89  my $be = shift; # Biber::Entry object
90  my $bee = $be->get_field('entrytype');
91  my $section = shift; # Section object the entry occurs in
92  my $dm = shift; # Data Model object
93  my $secnum = $section->number;
94  my $key = $be->get_field('citekey');
95  my $xml = $self->{output_target};
96  my $xml_prefix = $self->{xml_prefix};
97
98  $xml->startTag([$xml_prefix, 'entry'], id => NFC($key), entrytype => NFC($bee));
99
100  # Id field
101  if (my $ids = $be->get_field('ids')) {
102    $xml->startTag([$xml_prefix, 'id']);
103    foreach my $id (@$ids) {
104      $xml->dataElement([$xml_prefix, 'item'], NFC($id));
105    }
106  $xml->endTag;
107  }
108
109  # If CROSSREF and XDATA have been resolved, don't output them
110  # We can't use the usual skipout test for fields not to be output
111  # as this only refers to .bbl output and not to biblatexml output since this
112  # latter is not really a "processed" output, it is supposed to be something
113  # which could be again used as input and so we don't want to resolve/skip
114  # fields like DATE etc.
115  unless (Biber::Config->getoption('output_resolve')) {
116    if (my $xdata = $be->get_field('xdata')) {
117      $xml->startTag([$xml_prefix, 'xdata']);
118      foreach my $xd (@$xdata) {
119        $xml->dataElement([$xml_prefix, 'item'], NFC($xd));
120      }
121      $xml->endTag();
122    }
123    if (my $crossref = $be->get_field('crossref')) {
124      $xml->dataElement([$xml_prefix, 'crossref'], NFC($crossref));
125    }
126  }
127
128  # Output name fields
129  foreach my $namefield (@{$dm->get_fields_of_type('list', 'name')}) {
130
131    # Name loop
132    if (my $nf = $be->get_field($namefield)) {
133
134      my @attrs;
135
136      # Did we have "and others" in the data?
137      if ( $nf->get_morenames ) {
138        push @attrs, (morenames => 1);
139      }
140      $xml->startTag([$xml_prefix, $namefield], @attrs);
141
142      foreach my $n (@{$nf->names}) {
143        $n->name_to_biblatexml($xml, $self);
144      }
145      $xml->endTag();           # Names
146    }
147  }
148
149  # Output list fields
150  foreach my $listfield (@{$dm->get_fields_of_fieldtype('list')}) {
151    next if $dm->field_is_datatype('name', $listfield); # name is a special list
152
153    # List loop
154    if (my $lf = $be->get_field($listfield)) {
155
156      my @attrs;
157      # Did we have a "more" list?
158      if (lc($lf->[-1]) eq Biber::Config->getoption('others_string') ) {
159        push @attrs, (morelist => 1);
160        pop @$lf;               # remove the last element in the array
161      }
162
163      $xml->startTag([$xml_prefix, $listfield], @attrs);
164
165      # List loop
166      foreach my $f (@$lf) {
167        $xml->dataElement([$xml_prefix, 'item'], NFC($f));
168      }
169      $xml->endTag();           # List
170    }
171  }
172
173  # Standard fields
174  foreach my $field (sort @{$dm->get_fields_of_type('field', 'entrykey')},
175                     @{$dm->get_fields_of_type('field', 'key')},
176                     @{$dm->get_fields_of_type('field', 'literal')},
177                     @{$dm->get_fields_of_type('field', 'code')},
178                     @{$dm->get_fields_of_type('field', 'integer')},
179                     @{$dm->get_fields_of_type('field', 'verbatim')},
180                     @{$dm->get_fields_of_type('field', 'uri')}) {
181    next if $dm->get_fieldformat($field) eq 'xsv';
182    if ( ($dm->field_is_nullok($field) and
183          $be->field_exists($field)) or
184         $be->get_field($field) ) {
185
186      if (my $f = $be->get_field($field)) {
187
188        my @attrs;
189        $xml->dataElement([$xml_prefix, $field], NFC($f), @attrs);
190      }
191    }
192  }
193
194  # xsv fields
195  foreach my $xsvf (@{$dm->get_fields_of_type('field', 'xsv')}) {
196    next if $xsvf eq 'ids'; # IDS is special
197    next if $xsvf eq 'xdata'; # XDATA is special
198
199    if (my $f = $be->get_field($xsvf)) {
200      $xml->dataElement([$xml_prefix, $xsvf], NFC(join(',',@$f)));
201    }
202  }
203
204  # Range fields
205  foreach my $rfield (@{$dm->get_fields_of_datatype('range')}) {
206    if ( my $rf = $be->get_field($rfield) ) {
207      # range fields are an array ref of two-element array refs [range_start, range_end]
208      # range_end can be be empty for open-ended range or undef
209      $xml->startTag([$xml_prefix, $rfield]);
210      $xml->startTag([$xml_prefix, 'list']);
211
212      foreach my $f (@$rf) {
213        $xml->startTag([$xml_prefix, 'item']);
214        if (defined($f->[1])) {
215          $xml->dataElement([$xml_prefix, 'start'], NFC($f->[0]));
216          $xml->dataElement([$xml_prefix, 'end'], NFC($f->[1]));
217        }
218        else {
219          $xml->characters(NFC($f->[0]));
220        }
221        $xml->endTag();# item
222      }
223      $xml->endTag();# list
224      $xml->endTag();# range
225    }
226  }
227
228  # Date fields
229  my %dinfo;
230  foreach my $dfield (@{$dm->get_fields_of_datatype('datepart')}) {
231    if ( my $df = $be->get_field($dfield) ) {
232      # There are some assumptions here about field names which is not nice but
233      # they are part of the default biblatex data model which is unlikely to be
234      # changed by users
235      if ($dfield =~ /^(url|orig|event)?(end)?(.+)$/) {
236        my $dt = $1 || 'MAIN'; # Normal data has no qualifier prefix like "url" etc.
237        if ($2) {
238          $dinfo{$dt}{end}{$3} = $df;
239        }
240        else {
241          $dinfo{$dt}{begin}{$3} = $df; # beginning of ranges have no qualifier like "end"
242        }
243      }
244    }
245  }
246
247  foreach my $dp (keys %dinfo) {
248    if ($dp eq 'MAIN') {
249      $xml->startTag([$xml_prefix, 'date']);
250    }
251    else {
252      $xml->startTag([$xml_prefix, 'date'], datetype => $dp);
253    }
254
255    my @s;
256    my @e;
257
258    push @s, $dinfo{$dp}{begin}{year} if exists($dinfo{$dp}{begin}{year});
259    push @s, $dinfo{$dp}{begin}{month} if exists($dinfo{$dp}{begin}{month});
260    push @s, $dinfo{$dp}{begin}{day} if exists($dinfo{$dp}{begin}{day});
261
262    push @e, $dinfo{$dp}{end}{year} if exists($dinfo{$dp}{end}{year});
263    push @e, $dinfo{$dp}{end}{month} if exists($dinfo{$dp}{end}{month});
264    push @e, $dinfo{$dp}{end}{day} if exists($dinfo{$dp}{end}{day});
265
266    my $end = join('-', @e);
267
268    # date range
269    if ($end or $dm->field_is_nullok("${dp}enddate")) {
270      $xml->dataElement([$xml_prefix, 'start'], NFC(join('-', @s)));
271      $xml->dataElement([$xml_prefix, 'end'], NFC(join('-', @e)));
272
273    }
274    else { # simple date
275      $xml->characters(NFC(join('-', @s)));
276    }
277    $xml->endTag();# date
278  }
279
280  $xml->endTag();
281
282  return;
283}
284
285
286=head2 output
287
288    Tool output method
289
290=cut
291
292sub output {
293  my $self = shift;
294  my $data = $self->{output_data};
295  my $xml = $self->{output_target};
296  my $target_string = "Target"; # Default
297  if ($self->{output_target_file}) {
298    $target_string = $self->{output_target_file};
299  }
300
301  $logger->debug('Preparing final output using class ' . __PACKAGE__ . '...');
302  $logger->debug("Writing entries in tool mode");
303  $xml->endTag();
304  $xml->end();
305
306  $logger->info("Output to $target_string");
307  return;
308}
309
310=head2 create_output_section
311
312    Create the output from the sections data and push it into the
313    output object.
314
315=cut
316
317sub create_output_section {
318  my $self = shift;
319  my $secnum = $Biber::MASTER->get_current_section;
320  my $section = $Biber::MASTER->sections->get_section($secnum);
321
322
323  # We rely on the order of this array for the order of the .bbl
324  foreach my $k ($section->get_citekeys) {
325    # Regular entry
326    my $be = $section->bibentry($k) or biber_error("Cannot find entry with key '$k' to output");
327    $self->set_output_entry($be, $section, Biber::Config->get_dm);
328  }
329
330  # Make sure the output object knows about the output section
331  $self->set_output_section($secnum, $section);
332
333  return;
334}
335
336
3371;
338
339__END__
340
341=head1 AUTHORS
342
343François Charette, C<< <firmicus at ankabut.net> >>
344Philip Kime C<< <philip at kime.org.uk> >>
345
346=head1 BUGS
347
348Please report any bugs or feature requests on our Github tracker at
349L<https://github.com/plk/biber/issues>.
350
351=head1 COPYRIGHT & LICENSE
352
353Copyright 2009-2015 François Charette and Philip Kime, all rights reserved.
354
355This module is free software.  You can redistribute it and/or
356modify it under the terms of the Artistic License 2.0.
357
358This program is distributed in the hope that it will be useful,
359but without any warranty; without even the implied warranty of
360merchantability or fitness for a particular purpose.
361
362=cut
363