1package Biber::Entry; 2use v5.16; 3use strict; 4use warnings; 5 6use Biber::Utils; 7use Biber::Internals; 8use Biber::Constants; 9use Data::Dump qw( pp ); 10use Digest::MD5 qw( md5_hex ); 11use Log::Log4perl qw( :no_extra_logdie_message ); 12use List::Util qw( first ); 13use Storable qw( dclone ); 14 15my $logger = Log::Log4perl::get_logger('main'); 16 17=encoding utf-8 18 19=head1 NAME 20 21Biber::Entry 22 23=head2 new 24 25 Initialize a Biber::Entry object 26 27 There are three types of field possible in an entry: 28 29 * raw - These are direct copies of input fields with no processing performed on them. 30 Such fields are used for tool mode where we don't want to alter the fields as they 31 need to go back into the output as they are 32 * data - These are fields which derive directly from or are themselves fields in the 33 data souce. Things like YEAR, MONTH, DAY etc. are such fields which are derived from, 34 for example, the DATE field (which is itself a "raw" field). They are part of the 35 original data implicitly, derived from a "raw" field. 36 * other - These are fields, often meta-information like labelname, labelalpha etc. which are 37 more removed from the data fields. 38 39 The reason for this division is largely the entry cloning required for the related entry and 40 inheritance features. When we clone an entry or copy some fields from one entry to another 41 we generally don't want the "other" category as such derived meta-fields will often need 42 to be re-created or ignored so we need to know which are the actual "data" fields to copy/clone. 43 "raw" fields are important when we are writing bibtex format output (in tool mode for example) 44 since in such cases, we don't want to derive implicit fields like YEAR/MONTH from DATE. 45 46=cut 47 48sub new { 49 my $class = shift; 50 my $obj = shift; 51 my $self; 52 if (defined($obj) and ref($obj) eq 'HASH') { 53 $self = bless $obj, $class; 54 } 55 else { 56 $self = bless {}, $class; 57 } 58 return $self; 59} 60 61=head2 relclone 62 63 Recursively create related entry clones starting with an entry 64 65=cut 66 67sub relclone { 68 my $self = shift; 69 my $citekey = $self->get_field('citekey'); 70 my $secnum = $Biber::MASTER->get_current_section; 71 my $section = $Biber::MASTER->sections->get_section($secnum); 72 if (my $relkeys = $self->get_field('related')) { 73 $logger->debug("Found RELATED field in '$citekey' with contents " . join(',', @$relkeys)); 74 my @clonekeys; 75 foreach my $relkey (@$relkeys) { 76 # Resolve any alias 77 my $nrelkey = $section->get_citekey_alias($relkey) // $relkey; 78 $logger->debug("Resolved RELATED key alias '$relkey' to '$nrelkey'") if $relkey ne $nrelkey; 79 $relkey = $nrelkey; 80 $logger->debug("Looking at RELATED key '$relkey'"); 81 82 # Loop avoidance, in case we are back in an entry again in the guise of a clone 83 # We can record the related clone but don't create it again 84 if (my $ck = $section->get_keytorelclone($relkey)) { 85 $logger->debug("Found RELATED key '$relkey' already has clone '$ck'"); 86 push @clonekeys, $ck; 87 88 # Save graph information if requested 89 if (Biber::Config->getoption('output_format') eq 'dot') { 90 Biber::Config->set_graph('related', $ck, $relkey, $citekey); 91 } 92 } 93 else { 94 my $relentry = $section->bibentry($relkey); 95 my $clonekey = md5_hex($relkey); 96 push @clonekeys, $clonekey; 97 my $relclone = $relentry->clone($clonekey); 98 $logger->debug("Created new related clone for '$relkey' with clone key '$clonekey'"); 99 100 # Set related clone options 101 if (my $relopts = $self->get_field('relatedoptions')) { 102 process_entry_options($clonekey, $relopts); 103 $relclone->set_datafield('options', $relopts); 104 } 105 else { 106 process_entry_options($clonekey, [ 'skiplab', 'skipbiblist', 'uniquename=0', 'uniquelist=0' ]); 107 $relclone->set_datafield('options', [ 'dataonly' ]); 108 } 109 110 $section->bibentries->add_entry($clonekey, $relclone); 111 $section->keytorelclone($relkey, $clonekey); 112 113 # Save graph information if requested 114 if (Biber::Config->getoption('output_format') eq 'dot') { 115 Biber::Config->set_graph('related', $clonekey, $relkey, $citekey); 116 } 117 118 # recurse so we can do cascading related entries 119 $logger->debug("Recursing into RELATED entry '$clonekey'"); 120 $relclone->relclone; 121 } 122 } 123 # point to clone keys and add to citekeys 124 # We have to add the citekeys as we need these clones in the .bbl 125 # but the dataonly will cause biblatex not to print them in the bib 126 $section->add_citekeys(@clonekeys); 127 $self->set_datafield('related', [ @clonekeys ]); 128 } 129} 130 131=head2 clone 132 133 Clone a Biber::Entry object and return a copy 134 Accepts optionally a key for the copy 135 136=cut 137 138sub clone { 139 my $self = shift; 140 my $newkey = shift; 141 my $new = new Biber::Entry; 142 while (my ($k, $v) = each(%{$self->{datafields}})) { 143 $new->{datafields}{$k} = $v; 144 } 145 while (my ($k, $v) = each(%{$self->{rawfields}})) { 146 $new->{rawfields}{$k} = $v; 147 } 148 while (my ($k, $v) = each(%{$self->{origfields}})) { 149 $new->{origfields}{$k} = $v; 150 } 151 # Need to add entrytype and datatype 152 $new->{derivedfields}{entrytype} = $self->{derivedfields}{entrytype}; 153 $new->{derivedfields}{datatype} = $self->{derivedfields}{datatype}; 154 # put in key if specified 155 if ($newkey) { 156 $new->{derivedfields}{citekey} = $newkey; 157 } 158 # Record the key of the source of the clone in the clone. Useful for loop detection etc. 159 # in biblatex 160 $new->{derivedfields}{clonesourcekey} = $self->get_field('citekey'); 161 return $new; 162} 163 164=head2 notnull 165 166 Test for an empty object 167 168=cut 169 170sub notnull { 171 my $self = shift; 172 my @arr = keys %$self; 173 return $#arr > -1 ? 1 : 0; 174} 175 176=head2 set_labelname_info 177 178 Record the labelname information. This is special 179 meta-information so we have a seperate method for this 180 Takes a hash ref with the information. 181 182=cut 183 184sub set_labelname_info { 185 my $self = shift; 186 my $data = shift; 187 $self->{labelnameinfo} = $data; 188 return; 189} 190 191=head2 get_labelname_info 192 193 Retrieve the labelname information. This is special 194 meta-information so we have a seperate method for this 195 Returns a hash ref with the information. 196 197=cut 198 199sub get_labelname_info { 200 my $self = shift; 201 return $self->{labelnameinfo}; 202} 203 204=head2 set_labelnamefh_info 205 206 Record the fullhash labelname information. This is special 207 meta-information so we have a seperate method for this 208 Takes a hash ref with the information. 209 210=cut 211 212sub set_labelnamefh_info { 213 my $self = shift; 214 my $data = shift; 215 $self->{labelnamefhinfo} = $data; 216 return; 217} 218 219=head2 get_labelnamefh_info 220 221 Retrieve the fullhash labelname information. This is special 222 meta-information so we have a seperate method for this 223 Returns a hash ref with the information. 224 225=cut 226 227sub get_labelnamefh_info { 228 my $self = shift; 229 return $self->{labelnamefhinfo}; 230} 231 232=head2 set_labeltitle_info 233 234 Record the labeltitle information. This is special 235 meta-information so we have a seperate method for this 236 Takes a hash ref with the information. 237 238=cut 239 240sub set_labeltitle_info { 241 my $self = shift; 242 my $data = shift; 243 $self->{labeltitleinfo} = $data; 244 return; 245} 246 247=head2 get_labeltitle_info 248 249 Retrieve the labeltitle information. This is special 250 meta-information so we have a seperate method for this 251 Returns a hash ref with the information. 252 253=cut 254 255sub get_labeltitle_info { 256 my $self = shift; 257 return $self->{labeltitleinfo}; 258} 259 260 261=head2 set_labeldate_info 262 263 Record the labeldate information. This is special 264 meta-information so we have a seperate method for this 265 Takes a hash ref with the information. 266 267=cut 268 269sub set_labeldate_info { 270 my $self = shift; 271 my $data = shift; 272 $self->{labeldateinfo} = $data; 273 return; 274} 275 276=head2 get_labeldate_info 277 278 Retrieve the labeldate information. This is special 279 meta-information so we have a seperate method for this 280 Returns a hash ref with the information. 281 282=cut 283 284sub get_labeldate_info { 285 my $self = shift; 286 return $self->{labeldateinfo}; 287} 288 289 290=head2 set_field 291 292 Set a derived field for a Biber::Entry object, that is, a field 293 which was not an actual bibliography field 294 295=cut 296 297sub set_field { 298 my $self = shift; 299 my ($key, $val) = @_; 300 # All derived fields can be null 301 $self->{derivedfields}{$key} = $val; 302 return; 303} 304 305 306=head2 get_field 307 308 Get a field for a Biber::Entry object 309 Uses // as fields can be null (end dates etc). 310 311=cut 312 313sub get_field { 314 my $self = shift; 315 my $key = shift; 316 return undef unless $key; 317 return $self->{datafields}{$key} // 318 $self->{derivedfields}{$key} // 319 $self->{rawfields}{$key}; 320} 321 322 323=head2 set_datafield 324 325 Set a field which is in the .bib data file 326 327=cut 328 329sub set_datafield { 330 my $self = shift; 331 my ($key, $val) = @_; 332 $self->{datafields}{$key} = $val; 333 return; 334} 335 336 337 338=head2 set_rawfield 339 340 Save a copy of the raw field from the datasource 341 342=cut 343 344sub set_rawfield { 345 my $self = shift; 346 my ($key, $val) = @_; 347 $self->{rawfields}{$key} = $val; 348 return; 349} 350 351=head2 get_rawfield 352 353 Get a raw field 354 355=cut 356 357sub get_rawfield { 358 my $self = shift; 359 my $key = shift; 360 return $self->{rawfields}{$key}; 361} 362 363 364=head2 get_datafield 365 366 Get a field that was in the original data file 367 368=cut 369 370sub get_datafield { 371 my $self = shift; 372 my $key = shift; 373 return $self->{datafields}{$key}; 374} 375 376 377=head2 del_field 378 379 Delete a field in a Biber::Entry object 380 381=cut 382 383sub del_field { 384 my $self = shift; 385 my $key = shift; 386 delete $self->{datafields}{$key}; 387 delete $self->{derivedfields}{$key}; 388 delete $self->{rawfields}{$key}; 389 return; 390} 391 392=head2 del_datafield 393 394 Delete an original data source data field in a Biber::Entry object 395 396=cut 397 398sub del_datafield { 399 my $self = shift; 400 my $key = shift; 401 delete $self->{datafields}{$key}; 402 return; 403} 404 405 406=head2 field_exists 407 408 Check whether a field exists (even if null) 409 410=cut 411 412sub field_exists { 413 my $self = shift; 414 my $key = shift; 415 return (exists($self->{datafields}{$key}) || 416 exists($self->{derivedfields}{$key}) || 417 exists($self->{rawfields}{$key})) ? 1 : 0; 418} 419 420=head2 datafields 421 422 Returns a sorted array of the fields which came from the data source 423 424=cut 425 426sub datafields { 427 my $self = shift; 428 use locale; 429 return sort keys %{$self->{datafields}}; 430} 431 432=head2 rawfields 433 434 Returns a sorted array of the raw fields and contents 435 436=cut 437 438sub rawfields { 439 my $self = shift; 440 use locale; 441 return sort keys %{$self->{rawfields}}; 442} 443 444=head2 count_datafields 445 446 Returns the number of datafields 447 448=cut 449 450sub count_datafields { 451 my $self = shift; 452 return keys %{$self->{datafields}}; 453} 454 455 456=head2 fields 457 458 Returns a sorted array of all field names, including ones 459 added during processing which are not necessarily fields 460 which came from the data file 461 462=cut 463 464sub fields { 465 my $self = shift; 466 use locale; 467 my %keys = (%{$self->{derivedfields}}, %{$self->{datafields}}); 468 return sort keys %keys; 469} 470 471=head2 count_fields 472 473 Returns the number of fields 474 475=cut 476 477sub count_fields { 478 my $self = shift; 479 my %keys = (%{$self->{derivedfields}}, %{$self->{datafields}}); 480 return keys %keys; 481} 482 483 484=head2 has_keyword 485 486 Check if a Biber::Entry object has a particular keyword in 487 in the KEYWORDS field. 488 489=cut 490 491sub has_keyword { 492 no autovivification; 493 my $self = shift; 494 my $keyword = shift; 495 if (my $keywords = $self->{datafields}{keywords}) { 496 return (first {$_ eq $keyword} @$keywords) ? 1 : 0; 497 } 498 else { 499 return 0; 500 } 501 return undef; # shouldn't get here 502} 503 504 505 506=head2 add_warning 507 508 Append a warning to a Biber::Entry object 509 510=cut 511 512sub add_warning { 513 my $self = shift; 514 my $warning = shift; 515 push @{$self->{derivedfields}{warnings}}, $warning; 516 return; 517} 518 519 520=head2 set_inherit_from 521 522 Inherit fields from parent entry 523 524 $entry->set_inherit_from($parententry); 525 526 Takes a second Biber::Entry object as argument 527 Tailored for set inheritance which is a straight 1:1 inheritance, 528 excluding certain fields for backwards compatibility 529 530=cut 531 532sub set_inherit_from { 533 my $self = shift; 534 my $parent = shift; 535 536 # Data source fields 537 foreach my $field ($parent->datafields) { 538 next if $self->field_exists($field); # Don't overwrite existing fields 539 $self->set_datafield($field, $parent->get_field($field)); 540 } 541 # Datesplit is a special non datafield and needs to be inherited for any 542 # validation checks which may occur later 543 if (my $ds = $parent->get_field('datesplit')) { 544 $self->set_field('datesplit', $ds); 545 } 546 return; 547} 548 549=head2 resolve_xdata 550 551 Recursively resolve XDATA fields in an entry 552 553 $entry->resolve_xdata($xdata_entry); 554 555=cut 556 557sub resolve_xdata { 558 my ($self, $xdata) = @_; 559 my $secnum = $Biber::MASTER->get_current_section; 560 my $section = $Biber::MASTER->sections->get_section($secnum); 561 my $entry_key = $self->get_field('citekey'); 562 563 foreach my $xdatum (@$xdata) { 564 unless (my $xdatum_entry = $section->bibentry($xdatum)) { 565 biber_warn("Entry '$entry_key' references XDATA entry '$xdatum' which does not exist in section $secnum"); 566 next; 567 } 568 else { 569 # Skip xdata inheritance if we've already done it 570 # This will only ever be between two XDATA entrytypes since we 571 # always start at a non-XDATA entrytype, which we'll not look at again 572 # and recursion is always between XDATA entrytypes. 573 next if Biber::Config->get_inheritance('xdata', $xdatum, $entry_key); 574 575 # record the XDATA resolve between these entries to prevent loops 576 Biber::Config->set_inheritance('xdata', $xdatum, $entry_key); 577 578 # Detect XDATA loops 579 unless (Biber::Config->is_inheritance_path('xdata', $entry_key, $xdatum)) { 580 if (my $recurse_xdata = $xdatum_entry->get_field('xdata')) { # recurse 581 $xdatum_entry->resolve_xdata($recurse_xdata); 582 } 583 # For tool mode with bibtex output we need to copy the raw fields 584 if (Biber::Config->getoption('tool') and 585 Biber::Config->getoption('output_format') eq 'bibtex') { 586 foreach my $field ($xdatum_entry->rawfields()) { # set raw fields 587 next if $field eq 'ids'; # Never inherit aliases 588 $self->set_rawfield($field, $xdatum_entry->get_rawfield($field)); 589 $logger->debug("Setting field '$field' in entry '$entry_key' via XDATA"); 590 } 591 } 592 else { 593 foreach my $field ($xdatum_entry->datafields()) { # set fields 594 next if $field eq 'ids'; # Never inherit aliases 595 $self->set_datafield($field, $xdatum_entry->get_field($field)); 596 597 # Record graphing information if required 598 if (Biber::Config->getoption('output_format') eq 'dot') { 599 Biber::Config->set_graph('xdata', $xdatum_entry->get_field('citekey'), $entry_key, $field, $field); 600 } 601 $logger->debug("Setting field '$field' in entry '$entry_key' via XDATA"); 602 } 603 } 604 } 605 else { 606 biber_error("Circular XDATA inheritance between '$xdatum'<->'$entry_key'"); 607 } 608 } 609 } 610} 611 612=head2 inherit_from 613 614 Inherit fields from parent entry (as indicated by the crossref field) 615 616 $entry->inherit_from($parententry); 617 618 Takes a second Biber::Entry object as argument 619 Uses the crossref inheritance specifications from the .bcf 620 621=cut 622 623sub inherit_from { 624 my ($self, $parent) = @_; 625 626 my $secnum = $Biber::MASTER->get_current_section; 627 my $section = $Biber::MASTER->sections->get_section($secnum); 628 629 my $target_key = $self->get_field('citekey'); # target/child key 630 my $source_key = $parent->get_field('citekey'); # source/parent key 631 632 # record the inheritance between these entries to prevent loops and repeats. 633 Biber::Config->set_inheritance('crossref', $source_key, $target_key); 634 635 # Detect crossref loops 636 unless (Biber::Config->is_inheritance_path('crossref', $target_key, $source_key)) { 637 # cascading crossrefs 638 if (my $ppkey = $parent->get_field('crossref')) { 639 $parent->inherit_from($section->bibentry($ppkey)); 640 } 641 } 642 else { 643 biber_error("Circular inheritance between '$source_key'<->'$target_key'"); 644 } 645 646 my $type = $self->get_field('entrytype'); 647 my $parenttype = $parent->get_field('entrytype'); 648 my $inheritance = Biber::Config->getblxoption('inheritance'); 649 my %processed; 650 # get defaults 651 my $defaults = $inheritance->{defaults}; 652 # global defaults ... 653 my $inherit_all = $defaults->{inherit_all}; 654 my $override_target = $defaults->{override_target}; 655 # override with type_pair specific defaults if they exist ... 656 foreach my $type_pair (@{$defaults->{type_pair}}) { 657 if (($type_pair->{source} eq '*' or $type_pair->{source} eq $parenttype) and 658 ($type_pair->{target} eq '*' or $type_pair->{target} eq $type)) { 659 $inherit_all = $type_pair->{inherit_all} if $type_pair->{inherit_all}; 660 $override_target = $type_pair->{override_target} if $type_pair->{override_target}; 661 } 662 } 663 664 # First process any fields that have special treatment 665 foreach my $inherit (@{$inheritance->{inherit}}) { 666 # Match for this combination of entry and crossref parent? 667 foreach my $type_pair (@{$inherit->{type_pair}}) { 668 if (($type_pair->{source} eq '*' or $type_pair->{source} eq $parenttype) and 669 ($type_pair->{target} eq '*' or $type_pair->{target} eq $type)) { 670 foreach my $field (@{$inherit->{field}}) { 671 next unless $parent->field_exists($field->{source}); 672 $processed{$field->{source}} = 1; 673 # localise defaults according to field, if specified 674 my $field_override_target = $field->{override_target} // 'false'; 675 # Skip this field if requested 676 if ($field->{skip}) { 677 $processed{$field->{source}} = 1; 678 } 679 # Set the field if it doesn't exist or override is requested 680 elsif (not $self->field_exists($field->{target}) or 681 $field_override_target eq 'true') { 682 $logger->debug("Entry '$target_key' is inheriting field '" . 683 $field->{source}. 684 "' as '" . 685 $field->{target} . 686 "' from entry '$source_key'"); 687 # For tool mode with bibtex output we need to copy the raw fields 688 if (Biber::Config->getoption('tool') and 689 Biber::Config->getoption('output_format') eq 'bibtex') { 690 $self->set_rawfield($field->{target}, $parent->get_rawfield($field->{source})); 691 } 692 else { 693 $self->set_datafield($field->{target}, $parent->get_field($field->{source})); 694 } 695 # Record graphing information if required 696 if (Biber::Config->getoption('output_format') eq 'dot') { 697 Biber::Config->set_graph('crossref', $source_key, $target_key, $field->{source}, $field->{target}); 698 } 699 } 700 } 701 } 702 } 703 } 704 705 # Now process the rest of the (original data only) fields, if necessary 706 if ($inherit_all eq 'true') { 707 my @fields; 708 if (Biber::Config->getoption('tool')) { 709 @fields = $parent->rawfields; 710 } 711 else { 712 @fields = $parent->datafields; 713 } 714 foreach my $field (@fields) { 715 next if $processed{$field}; # Skip if we have already dealt with this field above 716 # Set the field if it doesn't exist or override is requested 717 if (not $self->field_exists($field) or $override_target eq 'true') { 718 $logger->debug("Entry '$target_key' is inheriting field '$field' from entry '$source_key'"); 719 # For tool mode with bibtex output we need to copy the raw fields 720 if (Biber::Config->getoption('tool') and 721 Biber::Config->getoption('output_format') eq 'bibtex') { 722 $self->set_rawfield($field, $parent->get_rawfield($field)); 723 } 724 else { 725 $self->set_datafield($field, $parent->get_field($field)); 726 } 727 728 # Record graphing information if required 729 if (Biber::Config->getoption('output_format') eq 'dot') { 730 Biber::Config->set_graph('crossref', $source_key, $target_key, $field, $field); 731 } 732 } 733 } 734 } 735 # Datesplit is a special non datafield and needs to be inherited for any 736 # validation checks which may occur later 737 if (my $ds = $parent->get_field('datesplit')) { 738 $self->set_field('datesplit', $ds); 739 } 740 741 return; 742} 743 744=head2 dump 745 746 Dump Biber::Entry object 747 748=cut 749 750sub dump { 751 my $self = shift; 752 return pp($self); 753} 754 7551; 756 757__END__ 758 759=head1 AUTHORS 760 761François Charette, C<< <firmicus at ankabut.net> >> 762Philip Kime C<< <philip at kime.org.uk> >> 763 764=head1 BUGS 765 766Please report any bugs or feature requests on our Github tracker at 767L<https://github.com/plk/biber/issues>. 768 769=head1 COPYRIGHT & LICENSE 770 771Copyright 2009-2015 François Charette and Philip Kime, all rights reserved. 772 773This module is free software. You can redistribute it and/or 774modify it under the terms of the Artistic License 2.0. 775 776This program is distributed in the hope that it will be useful, 777but without any warranty; without even the implied warranty of 778merchantability or fitness for a particular purpose. 779 780=cut 781