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