diff options
Diffstat (limited to 'Master/texmf-dist/source/bibtex/biber/lib/Biber.pm')
-rw-r--r-- | Master/texmf-dist/source/bibtex/biber/lib/Biber.pm | 2178 |
1 files changed, 0 insertions, 2178 deletions
diff --git a/Master/texmf-dist/source/bibtex/biber/lib/Biber.pm b/Master/texmf-dist/source/bibtex/biber/lib/Biber.pm deleted file mode 100644 index d15b8034c57..00000000000 --- a/Master/texmf-dist/source/bibtex/biber/lib/Biber.pm +++ /dev/null @@ -1,2178 +0,0 @@ -package Biber; -use strict; -use warnings; -#use feature 'unicode_strings'; -use Carp; -use Encode; -use File::Copy; -use File::Spec; -use IO::File; -use IPC::Cmd qw( can_run run ); -use POSIX qw( locale_h ); # for sorting with built-in "sort" -use Cwd qw( abs_path ); -use Biber::Config; -use Biber::Constants; -use List::Util qw( first ); -use Digest::MD5 qw( md5_hex ); -use Biber::Internals; -use Biber::Entries; -use Biber::Entry; -use Biber::Entry::Name; -use Biber::Sections; -use Biber::Section; -use Biber::Section::List; -use Biber::Structure; -use Biber::Utils; -use Storable qw( dclone ); -use Log::Log4perl qw( :no_extra_logdie_message ); -use base 'Biber::Internals'; -use Config::General qw( ParseConfig ); -use Data::Dump; -use Data::Compare; -use Text::BibTeX qw(:macrosubs); - -=encoding utf-8 - -=head1 NAME - -Biber - main module for biber, a bibtex replacement for users of biblatex - -=cut - -our $VERSION = '0.8'; -our $BETA_VERSION = 0; # Is this a beta version? - -my $logger = Log::Log4perl::get_logger('main'); - - -=head1 SYNOPSIS - - use Biber; - - my $biber = Biber->new(); - $biber->parse_ctrlfile("example.bcf"); - $biber->prepare; - -=cut - -=head1 METHODS - -=head2 new - - Initialize the Biber object, optionally passing named options as arguments. - -=cut - -sub new { - my ($class, %opts) = @_; - my $self = bless {}, $class; - - # Set up config object from config file and defaults - if (defined $opts{configfile}) { - Biber::Config->_initopts( $opts{configfile} ); - } else { - Biber::Config->_initopts(undef, $opts{noconf}); - } - # Command-line overrides everything else - if (%opts) { - foreach (keys %opts) { - Biber::Config->setcmdlineoption($_, $opts{$_}); - } - } - - return $self; -} - -=head2 biber_warn - - Wrapper around various warnings bits and pieces - Logs a warning, increments warning count in Biber object and add warning to - the list of .bbl warnings to add - -=cut - -sub biber_warn { - my $self = shift; - my $entry = shift; - my $warning = shift; - $logger->warn($warning); - $entry->add_warning($warning); - $self->{warnings}++; - return; -} - - -=head2 sections - - my $sections= $biber->sections - - Returns a Biber::Sections object describing the bibliography sections - -=cut - -sub sections { - my $self = shift; - return $self->{sections}; -} - - -=head2 set_output_obj - - Sets the object used to output final results - Must be a subclass of Biber::Output::Base - -=cut - -sub set_output_obj { - my $self = shift; - my $obj = shift; - croak('Output object must be subclass of Biber::Output::Base!') unless $obj->isa('Biber::Output::Base'); - $self->{output_obj} = $obj; - return; -} - - -=head2 get_preamble - - Returns the current preamble as an array ref - -=cut - -sub get_preamble { - my $self = shift; - return $self->{preamble}; -} - - -=head2 get_output_obj - - Returns the object used to output final results - -=cut - -sub get_output_obj { - my $self = shift; - return $self->{output_obj}; -} - -=head2 set_current_section - - Sets the current section number that we are working on to a section number - -=cut - -sub set_current_section { - my $self = shift; - my $secnum = shift; - $self->{current_section} = $secnum; - return; -} - -=head2 get_current_section - - Gets the current section number that we are working on - -=cut - -sub get_current_section { - my $self = shift; - return $self->{current_section}; -} - -=head2 parse_ctrlfile - - This method reads the control file - generated by biblatex to work out the various biblatex options. - See Constants.pm for defaults and example of the data structure being built here. - -=cut - -sub parse_ctrlfile { - my ($self, $ctrl_file) = @_; - - my $ctrl_file_path = locate_biber_file($ctrl_file); - Biber::Config->set_ctrlfile_path($ctrl_file_path); - - $logger->logdie("Cannot find control file '$ctrl_file'! - did you pass the \"backend=biber\" option to BibLaTeX?") unless ($ctrl_file_path and -e $ctrl_file_path); - - # Validate if asked to - if (Biber::Config->getoption('validate_control')) { - require XML::LibXML; - - # Set up XML parser - my $CFxmlparser = XML::LibXML->new(); - $CFxmlparser->line_numbers(1); # line numbers for more informative errors - - # Set up schema - my $CFxmlschema; - - # we assume that the schema files are in the same dir as Biber.pm: - (my $vol, my $biber_path, undef) = File::Spec->splitpath( $INC{"Biber.pm"} ); - - # Deal with the strange world of Par::Packer paths - # We might be running inside a PAR executable and @INC is a bit odd in this case - # Specifically, "Biber.pm" in @INC might resolve to an internal jumbled name - # nowhere near to these files. You know what I mean if you've dealt with pp - my $bcf_rng; - if ($biber_path =~ m|/par\-| and $biber_path !~ m|/inc|) { # a mangled PAR @INC path - $bcf_rng = File::Spec->catpath($vol, "$biber_path/inc/lib/Biber", 'bcf.rng'); - } - else { - $bcf_rng = File::Spec->catpath($vol, "$biber_path/Biber", 'bcf.rng'); - } - - if (-e $bcf_rng) { - $CFxmlschema = XML::LibXML::RelaxNG->new( location => $bcf_rng ) - } - else { - $logger->warn("Cannot find XML::LibXML::RelaxNG schema. Skipping validation : $!"); - $self->{warnings}++; - goto CONVERT; - } - - # Parse file - my $CFxp = $CFxmlparser->parse_file($ctrl_file_path); - - # XPath context - my $CFxpc = XML::LibXML::XPathContext->new($CFxp); - $CFxpc->registerNs('bcf', 'https://sourceforge.net/projects/biblatex'); - - # Validate against schema. Dies if it fails. - if ($CFxmlschema) { - eval { $CFxmlschema->validate($CFxp) }; - if (ref($@)) { - $logger->debug( $@->dump() ); - $logger->logdie("BibLaTeX control file \"$ctrl_file_path\" failed to validate\n$@"); - } - elsif ($@) { - $logger->logdie("BibLaTeX control file \"$ctrl_file_path\" failed to validate\n$@"); - } - else { - $logger->info("BibLaTeX control file \"$ctrl_file_path\" validates"); - } - } - undef $CFxmlparser; - } - - # Convert .bcf to .html using XSLT transform if asked to - CONVERT: - if (Biber::Config->getoption('convert_control')) { - - require XML::LibXSLT; - require XML::LibXML; - - my $xslt = XML::LibXSLT->new(); - my $CFstyle; - - # we assume that the schema files are in the same dir as Biber.pm: - (my $vol, my $biber_path, undef) = File::Spec->splitpath( $INC{"Biber.pm"} ); - - # Deal with the strange world of Par::Packer paths - # We might be running inside a PAR executable and @INC is a bit odd in this case - # Specifically, "Biber.pm" in @INC might resolve to an internal jumbled name - # nowhere near to these files. You know what I mean if you've dealt with pp - my $bcf_xsl; - if ($biber_path =~ m|/par\-| and $biber_path !~ m|/inc|) { # a mangled PAR @INC path - $bcf_xsl = File::Spec->catpath($vol, "$biber_path/inc/lib/Biber", 'bcf.xsl'); - } - else { - $bcf_xsl = File::Spec->catpath($vol, "$biber_path/Biber", 'bcf.xsl'); - } - - if (-e $bcf_xsl) { - $CFstyle = XML::LibXML->load_xml( location => $bcf_xsl, no_cdata=>1 ) - } - else { - $logger->warn("Cannot find XML::LibXSLT stylesheet. Skipping conversion : $!"); - $self->{warnings}++; - goto LOADCF; - } - - my $CF = XML::LibXML->load_xml(location => $ctrl_file_path); - my $stylesheet = $xslt->parse_stylesheet($CFstyle); - my $CFhtml = $stylesheet->transform($CF); - $stylesheet->output_file($CFhtml, $ctrl_file_path . '.html'); - $logger->info("Converted BibLaTeX control file '$ctrl_file_path' to '$ctrl_file_path.html'"); - } - - # Open control file - LOADCF: - my $ctrl = new IO::File "<$ctrl_file_path" - or $logger->logdie("Cannot open $ctrl_file_path: $!"); - - $logger->info("Reading $ctrl_file_path"); - - # Read control file - require XML::LibXML::Simple; - - my $bcfxml = XML::LibXML::Simple::XMLin($ctrl, - 'ForceContent' => 1, - 'ForceArray' => [ - qr/\Acitekey\z/, - qr/\Aoption\z/, - qr/\Aoptions\z/, - qr/\Avalue\z/, - qr/\Asortitem\z/, - qr/\Abibdata\z/, - qr/\Adatasource\z/, - qr/\Asection\z/, - qr/\Asortexclusion\z/, - qr/\Aexclusion\z/, - qr/\Asort\z/, - qr/\Adisplaymode\z/, - qr/\Amode\z/, - qr/\Apresort\z/, - qr/\Atype_pair\z/, - qr/\Ainherit\z/, - qr/\Afieldor\z/, - qr/\Afieldxor\z/, - qr/\Afield\z/, - qr/\Aalias\z/, - qr/\Aconstraints\z/, - qr/\Aconstraint\z/, - qr/\Aentrytype\z/, - qr/\Adatetype\z/, - qr/\Asectionlist\z/, - qr/\A(?:or)?filter\z/, - ], - 'NsStrip' => 1, - 'KeyAttr' => []); - - my $controlversion = $bcfxml->{version}; - Biber::Config->setblxoption('controlversion', $controlversion); - $logger->warn("Warning: Found biblatex control file version $controlversion, expected version $BIBLATEX_VERSION") - unless $controlversion eq $BIBLATEX_VERSION; - - # Look at control file and populate our main data structure with its information - - # OPTIONS - foreach my $bcfopts (@{$bcfxml->{options}}) { - - # Biber options - if (lc($bcfopts->{component}) eq 'biber') { - - # Global options - if (lc($bcfopts->{type}) eq 'global') { - foreach my $bcfopt (@{$bcfopts->{option}}) { - unless (defined(Biber::Config->getcmdlineoption($bcfopt->{key}{content}))) { # already set on cmd line - if (lc($bcfopt->{type}) eq 'singlevalued') { - Biber::Config->setoption($bcfopt->{key}{content}, $bcfopt->{value}[0]{content}); - } - elsif (lc($bcfopt->{type}) eq 'multivalued') { - Biber::Config->setoption($bcfopt->{key}{content}, - [ map {$_->{content}} sort {$a->{order} <=> $b->{order}} @{$bcfopt->{value}} ]); - } - } - } - } - } - - # BibLaTeX options - if (lc($bcfopts->{component}) eq 'biblatex') { - - # Global options - if (lc($bcfopts->{type}) eq 'global') { - foreach my $bcfopt (@{$bcfopts->{option}}) { - if (lc($bcfopt->{type}) eq 'singlevalued') { - Biber::Config->setblxoption($bcfopt->{key}{content}, $bcfopt->{value}[0]{content}); - } elsif (lc($bcfopt->{type}) eq 'multivalued') { - Biber::Config->setblxoption($bcfopt->{key}{content}, - [ map {$_->{content}} sort {$a->{order} <=> $b->{order}} @{$bcfopt->{value}} ]); - } - } - } - - # Entrytype options - else { - my $entrytype = $bcfopts->{type}; - foreach my $bcfopt (@{$bcfopts->{option}}) { - if (lc($bcfopt->{type}) eq 'singlevalued') { - Biber::Config->setblxoption($bcfopt->{key}{content}, $bcfopt->{value}[0]{content}, 'PER_TYPE', $entrytype); - } elsif (lc($bcfopt->{type}) eq 'multivalued') { - Biber::Config->setblxoption($bcfopt->{key}{content}, - [ map {$_->{content}} sort {$a->{order} <=> $b->{order}} @{$bcfopt->{value}} ], - 'PER_TYPE', - $entrytype); - } - } - } - } - } - - # DISPLAYMODES - # This should not be optional any more when biblatex implements this so take - # out this conditional - if (exists($bcfxml->{displaymodes})) { - my $dms; - foreach my $dm (@{$bcfxml->{displaymodes}{displaymode}}) { - $dms->{$dm->{target}{content}} = [ map {$_->{content}} @{$dm->{mode}} ]; - } - Biber::Config->setblxoption('displaymode', $dms); - } - - # INHERITANCE schemes for crossreferences (always global) - Biber::Config->setblxoption('inheritance', $bcfxml->{inheritance}); - - # SORTING - - # sorting excludes - foreach my $sex (@{$bcfxml->{sorting}{sortexclusion}}) { - my $excludes; - foreach my $ex (@{$sex->{exclusion}}) { - $excludes->{$ex->{content}} = 1; - } - Biber::Config->setblxoption('sortexclusion', - $excludes, - 'PER_TYPE', - $sex->{type}); - } - - # presort defaults - foreach my $presort (@{$bcfxml->{sorting}{presort}}) { - # Global presort default - unless (exists($presort->{type})) { - Biber::Config->setblxoption('presort', $presort->{content}); - } - # Per-type default - else { - Biber::Config->setblxoption('presort', - $presort->{content}, - 'PER_TYPE', - $presort->{type}); - } - } - - my $sorting = _parse_sort($bcfxml->{sorting}); - - Biber::Config->setblxoption('sorting', $sorting); - - # STRUCTURE schema (always global) - # This should not be optional any more when biblatex implements this so take - # out this conditional - if (exists($bcfxml->{structure})) { - Biber::Config->setblxoption('structure', $bcfxml->{structure}); - } - - # SECTIONS - # This is also where we set data files as these are associated with a bib section - - # Data sources - my %bibdatasources = (); - foreach my $data (@{$bcfxml->{bibdata}}) { - foreach my $datasource (@{$data->{datasource}}) { - push @{$bibdatasources{$data->{section}[0]}}, { type => $datasource->{type}, - name => $datasource->{content}, - datatype => $datasource->{datatype} }; - } - } - - unless (%bibdatasources or Biber::Config->getoption('bibdata')) { - $logger->logdie("No data files on command line or provided in the file '$ctrl_file_path'! Exiting") - } - - my $key_flag = 0; - my $bib_sections = new Biber::Sections; - -SECTION: foreach my $section (@{$bcfxml->{section}}) { - my $bib_section; - my $secnum = $section->{number}; - # Can be multiple section 0 entries and so re-use that section object if it exists - if (my $existing_section = $bib_sections->get_section($secnum)) { - $bib_section = $existing_section; - } - else { - $bib_section = new Biber::Section('number' => $secnum); - } - - # Set the data files for the section unless we've already done so - # (for example, for multiple section 0 entries) - $bib_section->set_datasources($bibdatasources{$secnum}) unless - $bib_section->get_datasources; - - # Add any list specs to the Biber::Section object - foreach my $list (@{$section->{sectionlist}}) { - my $llabel = $list->{label}; - if ($bib_section->get_list($llabel)) { - $logger->warn("Section list '$llabel' is repeated for section $secnum - ignoring subsequent mentions"); - $self->{warnings}++; - next; - } - - my $seclist = Biber::Section::List->new(label => $llabel); - foreach my $filter (@{$list->{filter}}) { - $seclist->add_filter($filter->{type}, $filter->{content}); - } - # disjunctive filters - foreach my $orfilter (@{$list->{orfilter}}) { - $seclist->add_filter('orfilter', { map {$_->{type} => [$_->{content}]} @{$orfilter->{filter}} }); - } - - if (my $sorting = $list->{sorting}) { # can be undef for fallback to global sorting - $seclist->set_sortscheme(_parse_sort($sorting)); - } - else { - $seclist->set_sortscheme(Biber::Config->getblxoption('sorting')); - } - $seclist->set_type($list->{type} || 'entry'); # lists are entry lists by default - $logger->debug("Adding list '$llabel' to section $secnum"); - $bib_section->add_list($seclist); - } - - # Intermediate code until biblatex moves main \printbibliography to a list - # MAIN list has no filter and no sorting spec so it uses all citekeys and the - # global sort default. - unless ($bib_section->get_list('MAIN')) { - my $mainlist = Biber::Section::List->new(label => 'MAIN'); - $mainlist->set_sortscheme(Biber::Config->getblxoption('sorting')); - $mainlist->set_type('entry'); - $bib_section->add_list($mainlist); - } - - # Intermediate code until biblatex moves SHORTHANDS to a .bcf supported list - unless ($bib_section->get_list('SHORTHANDS')) { - my $los = Biber::Section::List->new(label => 'SHORTHANDS'); - if (Biber::Config->getblxoption('sortlos')) { - $los->set_sortscheme([ [ {}, {'shorthand' => {}} ] ]); - $los->add_filter('field', 'shorthand'); - } - else { - $los->set_sortscheme(Biber::Config->getblxoption('sorting')); - $los->add_filter('field', 'shorthand'); - } - $los->set_type('shorthand'); - $bib_section->add_list($los); - } - - # Stop reading citekeys if we encounter "*" as a citation as this means - # "all keys" - my @keys = (); - foreach my $keyc (@{$section->{citekey}}) { - my $key = $keyc->{content}; - if ($key eq '*') { - $bib_section->allkeys; - # Normalise - when allkeys is true don't need citekeys - just in case someone - # lists "*" and also some other citekeys - $bib_section->del_citekeys; - $key_flag = 1; # There is at least one key, used for error reporting below - $logger->info("Using all citekeys in bib section " . $secnum); - $bib_sections->add_section($bib_section); - next SECTION; - } - elsif (not Biber::Config->get_seenkey($key, $secnum)) { - # Dynamic set definition - # Save dynamic key -> member keys mapping for set entry auto creation later - if (exists($keyc->{type}) and $keyc->{type} eq 'set') { - $bib_section->set_dynamic_set($key, split /\s*,\s*/, $keyc->{members}); - } - push @keys, $key; - $key_flag = 1; # There is at least one key, used for error reporting below - Biber::Config->incr_seenkey($key, $secnum); - } - elsif (Biber::Config->get_keycase($key) ne $key) { - $logger->warn("Case mismatch error between cite keys '$key' and '" . Biber::Config->get_keycase($key) . "'"); - $self->{warnings}++; - next; - } - } - - unless ($bib_section->is_allkeys) { - $logger->info("Found ", $#keys+1 , " citekeys in bib section $secnum") - } - - if (Biber::Config->getoption('debug')) { - my @debug_keys = sort @keys; - unless ($bib_section->is_allkeys) { - $logger->debug("The citekeys for section $secnum are: ", join(', ', @debug_keys), "\n"); - } - } - - $bib_section->add_citekeys(@keys); - $bib_sections->add_section($bib_section); - } - - # Die if there are no citations in any section - unless ($key_flag) { - $logger->warn("The file '$ctrl_file_path' does not contain any citations!"); - $self->{warnings}++; - } - - # Add the Biber::Sections object to the Biber object - $self->{sections} = $bib_sections; - - # Normalise any UTF-8 encoding string immediately to exactly what we want - # We want the strict perl utf8 "UTF-8" - normalise_utf8(); - - return; -} - - -=head2 process_setup - - Place to put misc pre-processing things needed later - -=cut - -sub process_setup { - # Break structure information up into more processing-friendly formats - # for use in verification checks later - # This has to be here as opposed to in parse_control() so that it can pick - # up structure defaults in Constants.pm in case there is no .bcf - Biber::Config->set_structure(Biber::Structure->new(Biber::Config->getblxoption('structure'))); - - # Force bblsafechars flag if output to ASCII - if (Biber::Config->getoption('bblencoding') =~ /(?:x-)ascii/xmsi) { - Biber::Config->setoption('bblsafechars', 1); - } -} - - -=head2 instantiate_dynamic - - This instantiates any dynamic entries so that they are available - for processing later on. This has to be done before most all other - processing so that when we call $section->bibentry($key), as we - do many times in the code, we don't die because there is a key but - no Entry object. - -=cut - -sub instantiate_dynamic { - my $self = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - - $logger->debug("Creating dynamic entries (sets/related) for section $secnum"); - - # Instantiate any dynamic set entries before we do anything else - foreach my $dset (@{$section->dynamic_set_keys}) { - my @members = $section->get_dynamic_set($dset); - my $be = new Biber::Entry; - $be->set_field('entrytype', 'set'); - $be->set_field('entryset', join(',', @members)); - $be->set_field('dskey', $dset); - $be->set_field('citekey', $dset); - $be->set_field('datatype', 'dynamic'); - $section->bibentries->add_entry($dset, $be); - # Setting dataonly for members is handled by process_sets() - } - - # Instantiate any related entry clones we need - foreach my $citekey ($section->get_citekeys) { - my $be = $section->bibentry($citekey); - if (my $relkeys = $be->get_field('related')) { - $be->del_field('related'); # clear the related field - my @clonekeys; - foreach my $relkey (split /\s*,\s*/, $relkeys) { - my $relentry = $section->bibentry($relkey); - my $clonekey = md5_hex($relkey); - push @clonekeys, $clonekey; - my $relclone = $relentry->clone($clonekey); - # clone doesn't need the related fields - $relclone->del_field('related'); - $relclone->del_field('relatedtype'); - $relclone->del_field('relatedstring'); - $relclone->set_datafield('options', 'dataonly'); - $section->bibentries->add_entry($clonekey, $relclone); - Biber::Config->setblxoption('skiplab', 1, 'PER_ENTRY', $clonekey); - Biber::Config->setblxoption('skiplos', 1, 'PER_ENTRY', $clonekey); - } - # point to clone keys and add to citekeys - $section->add_citekeys(@clonekeys); - $be->set_datafield('related', join(',', @clonekeys)); - } - } - return; -} - - -=head2 process_crossrefs - - $biber->process_crossrefs - - This does several things: - 1. Ensures that all entryset key members will be output in the bbl. - 2. Ensures proper inheritance of data from cross-references. - 3. Ensures that crossrefs/xrefs that are directly cited or cross-referenced - at least mincrossrefs times are included in the bibliography. - -=cut - -sub process_crossrefs { - my $self = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - - $logger->debug("Processing explicit and implicit crossrefs for section $secnum"); - - # Loop over cited keys and count the cross/xrefs - # Can't do this when parsing entries as this would count them - # for potentially uncited children - foreach my $citekey ($section->get_citekeys) { - my $be = $section->bibentry($citekey); - my $refkey; - if ($refkey = $be->get_field('xref') or $refkey = $be->get_field('crossref')) { - $logger->debug("Incrementing cross/xrefkey count for entry '$refkey' via entry '$citekey'"); - Biber::Config->incr_crossrefkey($refkey); - } - } - - # promote indirectly cited inset set members to fully cited entries - foreach my $citekey ($section->get_citekeys) { - my $be = $section->bibentry($citekey); - if ($be->get_field('entrytype') eq 'set') { - my @inset_keys = split /\s*,\s*/, $be->get_field('entryset'); - foreach my $inset_key (@inset_keys) { - $logger->debug(" Adding set member '$inset_key' to the citekeys (section $secnum)"); - $section->add_citekeys($inset_key); - } - # automatically crossref for the first set member using plain set inheritance - $be->set_inherit_from($section->bibentry($inset_keys[0])); - if ($be->get_field('crossref')) { - $self->biber_warn($be, "Field 'crossref' is no longer needed in set entries in Biber - ignoring in entry '$citekey'"); - $be->del_field('crossref'); - } - } - # Do crossrefs inheritance - if (my $crossrefkey = $be->get_field('crossref')) { - my $parent = $section->bibentry($crossrefkey); - $logger->debug(" Entry $citekey inheriting fields from parent $crossrefkey"); - unless ($parent) { - $self->biber_warn($be, "Cannot inherit from crossref key '$crossrefkey' - does it exist?"); - } - else { - $be->inherit_from($parent); - } - } - } - - # We make sure that crossrefs that are directly cited or cross-referenced - # at least $mincrossrefs times are included in the bibliography. - foreach my $k ( @{Biber::Config->get_crossrefkeys} ) { - # If parent has been crossref'ed more than mincrossref times, upgrade it - # to cited crossref status and add it to the citekeys list - if (Biber::Config->get_crossrefkey($k) >= Biber::Config->getoption('mincrossrefs')) { - $logger->debug("cross/xref key '$k' is cross/xref'ed >= mincrossrefs, adding to citekeys"); - $section->add_citekeys($k); - } - } -} - -=head2 validate_structure - - Validate bib structure according to a bib schema - Note that we are validating the internal Biber::Entries - after they have been created from the datasources so this is - datasource neutral, as it should be. It is here to enforce - adherence to what biblatex expects. - -=cut - -sub validate_structure { - my $self = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - my $struc = Biber::Config->get_structure; - if (Biber::Config->getoption('validate_structure')) { - foreach my $citekey ($section->get_citekeys) { - my $be = $section->bibentry($citekey); - my $et = $be->get_field('entrytype'); - - # default entrytype to MISC type if not a known type - unless ($struc->is_entrytype($et)) { - $self->biber_warn($be, "Entry '$citekey' - invalid entry type '" . $be->get_field('entrytype') . "' - defaulting to 'misc'"); - $be->set_field('entrytype', 'misc'); - $et = 'misc'; # reset this too - } - - # Are all fields valid fields? - # Each field must be: - # * Valid because it's allowed for "ALL" entrytypes OR - # * Valid field for the specific entrytype OR - # * Valid because entrytype allows "ALL" fields - foreach my $ef ($be->datafields) { - unless ($struc->is_field_for_entrytype($et, $ef)) { - $self->biber_warn($be, "Entry '$citekey' - invalid field '$ef' for entrytype '$et'"); - } - } - - # Mandatory constraints - foreach my $warning ($struc->check_mandatory_constraints($be)) { - $self->biber_warn($be, $warning); - } - - # Conditional constraints - foreach my $warning ($struc->check_conditional_constraints($be)) { - $self->biber_warn($be, $warning); - } - - # Data constraints - foreach my $warning ($struc->check_data_constraints($be)) { - $self->biber_warn($be, $warning); - } - - # Date constraints - foreach my $warning ($struc->check_date_components($be)) { - $self->biber_warn($be, $warning); - } - } - } -} - -=head2 process_entries - - Main processing operations, to generate metadata and entry information - This method is automatically called by C<prepare>. - Here we parse names, generate the "namehash" and the strings for - "labelname", "labelyear", "labelalpha", "sortstrings", etc. - -=cut - -sub process_entries { - my $self = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - foreach my $citekey ( $section->get_citekeys ) { - $logger->debug("Postprocessing entry '$citekey' from section $secnum"); - - # process "set" entries: - $self->process_sets($citekey); - - # generate labelname name - $self->process_labelname($citekey); - - # generate labelyear name - $self->process_labelyear($citekey); - - # generate namehash,fullhash - $self->process_hashes($citekey); - - # generate uniqueness information - $self->process_unique($citekey); - - # track labelname/year combinations - $self->process_labelnameyear($citekey); - - # generate labelalpha information - $self->process_labelalpha($citekey); - - # push entry-specific presort fields into the presort state - $self->process_presort($citekey); - - } - - $logger->debug("Finished processing entries in section $secnum"); - - return; -} - -=head2 process_sets - - Postprocess set entries - - Checks for common set errors and enforces 'dataonly' for set members - -=cut - -sub process_sets { - my $self = shift; - my $citekey = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - my $be = $section->bibentry($citekey); - if ($be->get_field('entrytype') eq 'set') { - my @entrysetkeys = split /\s*,\s*/, $be->get_field('entryset'); - - # Enforce Biber parts of virtual "dataonly" for set members - # Also automatically create an "entryset" field for the members - foreach my $member (@entrysetkeys) { - Biber::Config->setblxoption('skiplab', 1, 'PER_ENTRY', $member); - Biber::Config->setblxoption('skiplos', 1, 'PER_ENTRY', $member); - my $me = $section->bibentry($member); - if ($me->get_field('entryset')) { - $self->biber_warn($me, "Field 'entryset' is no longer needed in set member entries in Biber - ignoring in entry '$member'"); - $me->del_field('entryset'); - } - # This ends up setting \inset{} in the bib - $me->set_field('entryset', $citekey); - } - - unless (@entrysetkeys) { - $self->biber_warn($be, "No entryset found for entry $citekey of type 'set'"); - } - } - # check if this non-set entry is in a cited set and if so, we - # have enforced Biber parts of virtual "dataonly" otherwise - # this entry will spuriously generate disambiguation data for itself - # This would only happen if the non-set entry was cited before any set - # in which it occurred of course since otherwise it would have already had - # "dataonly" enforced by the code above - else { - foreach my $pset_key ($section->get_citekeys) { - my $pset_be = $section->bibentry($pset_key); - if ($pset_be->get_field('entrytype') eq 'set') { - my @entrysetkeys = split /\s*,\s*/, $pset_be->get_field('entryset'); - foreach my $member (@entrysetkeys) { - next unless $member eq $citekey; - # Posssible that this has already been set if this set entry member - # was dealt with above but in case we haven't seen the set it's in yet ... - Biber::Config->setblxoption('skiplab', 1, 'PER_ENTRY', $member); - Biber::Config->setblxoption('skiplos', 1, 'PER_ENTRY', $member); - } - } - } - } -} - -=head2 process_labelname - - Generate labelname information. Fields set are: - - * labelnamename - the name of the labelname field to use - * labelnamenamefullhash - the name of the labelname field to use for - fulhash generation. - - We can retreive the actual labelname value later with: - - $entry->get_field($entry->get_field('labelnamename)) - - It's neat this way as we often need to know what the labelname field is - as well as it's actual string value - -=cut - -sub process_labelname { - my $self = shift; - my $citekey = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - my $be = $section->bibentry($citekey); - my $lnamespec = Biber::Config->getblxoption('labelnamespec', $be->get_field('entrytype')); - - # First we set the normal labelname name - foreach my $ln ( @{$lnamespec} ) { - my $lnameopt; - if ( $ln =~ /\Ashort(.+)\z/ ) { - $lnameopt = $1; - } else { - $lnameopt = $ln; - } - if ($be->get_field($ln) and - Biber::Config->getblxoption("use$lnameopt", $be->get_field('entrytype'), $citekey ) ) { - $be->set_field('labelnamename', $ln); - last; - } - } - - # Then we loop again to set the labelname name for the fullhash generation code - # This is because fullhash generation ignores SHORT* fields (section 4.2.4.1, BibLaTeX - # manual) - foreach my $ln ( @{$lnamespec} ) { - if ( $ln =~ /\Ashort(.+)\z/ ) { - next; - } - if ($be->get_field($ln) and - Biber::Config->getblxoption("use$ln", $be->get_field('entrytype'), $citekey ) ) { - $be->set_field('labelnamenamefullhash', $ln); - last; - } - } - - # Generate the actual labelname - if ($be->get_field('labelnamename')) { - $be->set_field('labelname', $be->get_field($be->get_field('labelnamename'))); - } - else { - $logger->debug("Could not determine the labelname of entry $citekey"); - } -} - -=head2 process_labelyear - - Generate labelyear - Here, "labelyearname" is the name of the labelyear field - and "labelyear" is the actual copy of the relevant field - -=cut - -sub process_labelyear { - my $self = shift; - my $citekey = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - my $be = $section->bibentry($citekey); - - if (Biber::Config->getblxoption('labelyear', $be->get_field('entrytype'))) { - my $lyearspec = Biber::Config->getblxoption('labelyearspec', $be->get_field('entrytype')); - - if (Biber::Config->getblxoption('skiplab', $be->get_field('entrytype'), $citekey)) { - return; - } - # make sure we gave the correct data type: - $logger->logdie("Invalid value for option labelyear: $lyearspec\n") - unless ref $lyearspec eq 'ARRAY'; - foreach my $ly ( @{$lyearspec} ) { - if ($be->get_field($ly)) { - $be->set_field('labelyearname', $ly); - last; - } - } - - # Construct labelyear - # Might not have been set due to skiplab/dataonly - if (my $yf = $be->get_field('labelyearname')) { - $be->set_field('labelyear', $be->get_field($yf)); - - # ignore endyear if it's the same as year - my ($ytype) = $yf =~ /\A(.*)year\z/xms; - # endyear can be null - if (is_def_and_notnull($be->get_field($ytype . 'endyear')) - and ($be->get_field($yf) ne $be->get_field($ytype . 'endyear'))) { - $be->set_field('labelyear', - $be->get_field('labelyear') . '\bibdatedash ' . $be->get_field($ytype . 'endyear')); - } - } - else { - $logger->debug("Could not determine the labelyearname of entry $citekey"); - } - } -} - -=head2 process_hashes - - Generate namehash and fullhash - -=cut - -sub process_hashes { - my $self = shift; - my $citekey = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - my $be = $section->bibentry($citekey); - my $bee = $be->get_field('entrytype'); - my $namehash = ''; # biblatex namehash field (manual, section 4.2.4.1) - my $fullhash = ''; # biblatex fullhash field (manual, section 4.2.4.1) - my $nameid = ''; - - # namehash is generated from the labelname - if (my $lname = $be->get_field('labelnamename')) { - if (my $ln = $be->get_field($lname)) { - $namehash .= $self->_getnamehash($citekey, $ln); - $nameid .= makenameid($ln); - } - } - # fullhash is generated from the labelname but ignores SHORT* fields and - # maxnames/minnames settings - if (my $lnamefh = $be->get_field('labelnamenamefullhash')) { - if ($be->get_field($lnamefh)) { - $fullhash .= $self->_getfullhash($citekey, $be->get_field($lnamefh)); - } - } - - # After the initial generation of namehash and fullhash, we have to append - # a suffix as they must be unique. It is possible that different entries have - # the same hashes at this stage. For example: - - # AUTHOR = {Fred Grimble and Bill Bullter} = "FGBB" - # AUTHOR = {Frank Garby and Brian Blunkley} = "FGBB" - - my $hashsuffix = 1; - - # First, check to see if we've already seen this exact name before - if (Biber::Config->get_namehashcount($namehash, $nameid)) { - # If we have, our suffix is already known - $hashsuffix = Biber::Config->get_namehashcount($namehash, $nameid); - } - # Otherwise, if the namehash already exists, we'll make a new entry with a new suffix - elsif (Biber::Config->namehashexists($namehash)) { - # Count the suffixes already defined ... - my $count = Biber::Config->get_numofnamehashes($namehash); - # ... add one to the number ... - $hashsuffix = $count + 1; - # ... and define a new suffix for that name - Biber::Config->set_namehashcount($namehash, $nameid, $hashsuffix); - } - # No entry for the namehash at all so make a new one, a new name and suffix - else { - Biber::Config->del_namehash($namehash); - Biber::Config->set_namehashcount($namehash, $nameid, 1); - } - - # Now append the suffices, making the hashes unique - $namehash .= $hashsuffix; - $fullhash .= $hashsuffix; - - # Set the hashes - $be->set_field('namehash', $namehash); - $be->set_field('fullhash', $fullhash); - - # Don't add to disambiguation data if skiplab is set - unless (Biber::Config->getblxoption('skiplab', $bee, $citekey)) { - Biber::Config->incr_seennamehash($fullhash); - } -} - -=head2 process_unique - - Generate uniqueness information. This is used later to generate unique* fields - -=cut - -sub process_unique { - my $self = shift; - my $citekey = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - my $be = $section->bibentry($citekey); - my $bee = $be->get_field('entrytype'); - my $namehash = $be->get_field('namehash'); - - # Set uniquename, if required - # Note that we don't determine if a name is unique here - - # we can't, were still processing entries at this point. - # Here we are just recording seen combinations of: - # - # lastnames and what hashes were generated from them (uniquename = 0) - # lastnames+initials and what hashes were generated from them (uniquename = 1) - # - # Naturally, anything which has more than one combination for both of these would - # be uniquename = 2 - # - # See the logic in Internals.pm for generating the actual uniquename count - # from the information collected here - if (Biber::Config->getblxoption('uniquename', $bee)) { - my $lname = $be->get_field('labelnamename'); - my $lastname; - my $namestring; - my $singlename; - - # uniquename only works (currently) with single names - if ($lname) { - $lastname = $be->get_field($lname)->nth_element(1)->get_lastname; - $namestring = $be->get_field($lname)->nth_element(1)->get_nameinitstring; - $singlename = $be->get_field($lname)->count_elements; - } - - # If we need to provide uniquename, labelnamename exists and we are only - # dealing with a single name - if ($lname and $singlename == 1 ) { - # Record a uniqueness information entry for the lastname showing that - # this lastname has been seen in the name with the namehash - Biber::Config->add_uniquenamecount($lastname, $namehash); - - # Record a uniqueness information entry for the lastname+initials showing that - # this lastname_initials has been seen in the name with the namehash - Biber::Config->add_uniquenamecount($namestring, $namehash); - } - else { - $be->set_field('ignoreuniquename', 1); - } - } -} - -=head2 process_labelnameyear - - Track author/year combination - -=cut - -sub process_labelnameyear { - my $self = shift; - my $citekey = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - my $be = $section->bibentry($citekey); - # This is all used to generate extrayear and the rules for this are: - # * Generate labelname/year combination for tracking extrayear - # * If there is no labelname to use, use empty string - # * If there is no labelyear to use, use empty string - # * Don't increment the seen_extra* count if either name or year string is empty - # (see code in incr_seen_extra* methods). - # * Don't increment if skiplab is set - - my $name_string; - # For tracking name/year combinations, use shorthand only if it exists and we - # are using labelyear - if ( Biber::Config->getblxoption('labelalpha', $be->get_field('entrytype')) and - $be->get_field('shorthand')) { - $name_string = $be->get_field('shorthand'); - } - elsif (my $lnn = $be->get_field('labelnamename')) { - $name_string = $self->_namestring($citekey, $lnn); - } - else { - $name_string = ''; - } - - # extrayear takes into account the labelyear which can be a range - my $year_string_extrayear; - if (my $ly = $be->get_field('labelyear')) { - $year_string_extrayear = $ly; - } - elsif (my $y = $be->get_field('year')) { - $year_string_extrayear = $y; - } - else { - $year_string_extrayear = ''; - } - - # extraalpha takes into account the "year of publication" and not ranges as it - # only has the last two digits of the year and so can't disambiguate using ranges - # so, we have to track it separately to extrayear - my $year_string_extraalpha; - if (my $y = $be->get_field('year')) { - $year_string_extraalpha = $y; - } - else { - $year_string_extraalpha = ''; - } - - # Don't create disambiguation data for skiplab entries - unless (Biber::Config->getblxoption('skiplab', - $be->get_field('entrytype'), - $be->get_field('dskey'))) { - my $nameyear_string_extrayear = "$name_string,$year_string_extrayear"; - $logger->debug("Setting 'nameyear_extrayear' to '$nameyear_string_extrayear' for entry '$citekey'"); - $be->set_field('nameyear_extrayear', $nameyear_string_extrayear); - Biber::Config->incr_seen_nameyear_extrayear($name_string, $year_string_extrayear); - my $nameyear_string_extraalpha = "$name_string,$year_string_extraalpha"; - $logger->debug("Setting 'nameyear_extraalpha' to '$nameyear_string_extraalpha' for entry '$citekey'"); - $be->set_field('nameyear_extraalpha', $nameyear_string_extraalpha); - Biber::Config->incr_seen_nameyear_extraalpha($name_string, $year_string_extraalpha); - } -} - -=head2 process_labelalpha - - Generate the labelalpha and also the variant for sorting - -=cut - -sub process_labelalpha { - my $self = shift; - my $citekey = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - my $be = $section->bibentry($citekey); - my $bee = $be->get_field('entrytype'); - # Don't add a label if skiplab is set for entry - if (Biber::Config->getblxoption('skiplab', $bee, $citekey)) { - return; - } - if ( Biber::Config->getblxoption('labelalpha', $be->get_field('entrytype')) ) { - my $label; - my $sortlabel; - - if ( $be->get_field('shorthand') ) { - $sortlabel = $label = $be->get_field('shorthand'); - } - else { - if ( $be->get_field('label') ) { - $sortlabel = $label = $be->get_field('label'); - } - elsif ( $be->get_field('labelnamename') and $be->get_field($be->get_field('labelnamename'))) { - ( $label, $sortlabel ) = - @{ $self->_getlabel( $citekey, $be->get_field('labelnamename') ) }; - } - else { - $sortlabel = $label = ''; - } - - # biblatex manual says "publication year" - if ( my $year = $be->get_field('year') ) { - my $yr; - # Make "in press" years look nice in alpha styles - if ($year =~ m/\A\s*in\s*press\s*\z/ixms) { - $yr = 'ip'; - } - # Normal year - else { - $yr = substr $year, 2, 2; - } - $label .= $yr; - $sortlabel .= $yr; - } - } - $be->set_field('labelalpha', $label); - $be->set_field('sortlabelalpha', $sortlabel); - } -} - - -=head2 process_presort - - Put presort fields for an entry into the main Biber bltx state - so that it's all available in the same place since this can be - set per-type and globally too. - -=cut - -sub process_presort { - my $self = shift; - my $citekey = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - my $be = $section->bibentry($citekey); - # We are treating presort as an option as it can be set per-type and globally too - if (my $ps = $be->get_field('presort')) { - Biber::Config->setblxoption('presort', $ps, 'PER_ENTRY', $citekey); - } -} - -=head2 process_lists - - Sort and filter lists for a section - -=cut - -sub process_lists { - my $self = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - foreach my $list (@{$section->get_lists}) { - my $llabel = $list->get_label; - - # Last-ditch fallback in case we still don't have a sorting spec - # probably due to being called via biber with -a and -d flags - $list->set_sortscheme(Biber::Config->getblxoption('sorting')) unless $list->get_sortscheme; - - $list->set_keys([ $section->get_citekeys ]); - $logger->debug("Populated list '$llabel' in section $secnum with keys: " . join(', ', $list->get_keys)); - - # Now we check the sorting cache to see if we already have results - # for this scheme since sorting is computationally expensive. - # We know the keys are the same as we just set them - # to a copy of the section citekeys above. If the scheme is the same - # as a previous sort then the results have to also be the same so inherit - # the results which are normally set by sorting: - # - # * sorted keys - # * sortinit data - # * extraalpha data - # * extrayear data - - my $cache_flag = 0; - $logger->debug("Checking sorting cache for list '$llabel'"); - foreach my $cacheitem (@{$section->get_sort_cache}) { - if (Compare($list->get_sortscheme, $cacheitem->[0])) { - $logger->debug("Found sorting cache entry for '$llabel'"); - $list->set_keys($cacheitem->[1]); - $list->set_sortinitdata($cacheitem->[2]); - $list->set_extraalphadata($cacheitem->[3]); - $list->set_extrayeardata($cacheitem->[4]); - $cache_flag = 1; - last; - } - } - - unless ($cache_flag) { - $logger->debug("No sorting cache entry for '$llabel'"); - # Sorting - $self->generate_sortinfo($list); # generate the sort information - $self->sort_list($list); # sort the list - $self->generate_extra($list); # generate the extra* fields - - # Cache the results - $logger->debug("Adding sorting cache entry for '$llabel'"); - $section->add_sort_cache($list->get_listdata); - } - - # Filtering - # This is not really used - filtering is more efficient to do on the biblatex - # side since we are filtering afer sorting anyway. It is used to provide - # a field=shorthand filter for type=shorthand lists though. - if (my $filters = $list->get_filters) { - my $flist = []; -KEYLOOP: foreach my $k ($list->get_keys) { - # Filter out skiplos entries as a special case in 'shorthand' type lists - if ($list->get_type eq 'shorthand') { - next if Biber::Config->getblxoption('skiplos', $section->bibentry($k), $k); - } - - $logger->debug("Checking key '$k' in list '$llabel' against list filters"); - my $be = $section->bibentry($k); - foreach my $t (keys %$filters) { - my $fs = $filters->{$t}; - # Filter disjunction is ok if any of the checks are ok, hence the grep() - if ($t eq 'orfilter') { - next KEYLOOP unless grep {check_list_filter($k, $_, $fs->{$_}, $be)} keys %$fs; - } - else { - next KEYLOOP unless check_list_filter($k, $t, $fs, $be); - } - } - push @$flist, $k; - } - $logger->debug("Keys after filtering list '$llabel' in section $secnum: " . join(', ', @$flist)); - $list->set_keys($flist); # Now save the sorted list in the list object - } - } - return; -} - - -=head2 check_list_filter - - Run an entry through a list filter. Returns a boolean. - -=cut - -sub check_list_filter { - my ($k, $t, $fs, $be) = @_; - $logger->debug(" Checking key '$k' against filter '$t=" . join(',', @$fs) . "'"); - if ($t eq 'type') { - return 0 unless grep {$be->get_field('entrytype') eq $_} @$fs; - } - elsif ($t eq 'nottype') { - return 0 if grep {$be->get_field('entrytype') eq $_} @$fs; - } - elsif ($t eq 'subtype') { - return 0 unless grep {$be->field_exists('entrysubtype') and - $be->get_field('entrysubtype') eq $_} @$fs; - } - elsif ($t eq 'notsubtype') { - return 0 if grep {$be->field_exists('entrysubtype') and - $be->get_field('entrysubtype') eq $_} @$fs; - } - elsif ($t eq 'keyword') { - return 0 unless grep {$be->has_keyword($_)} @$fs; - } - elsif ($t eq 'notkeyword') { - return 0 if grep {$be->has_keyword($_)} @$fs; - } - elsif ($t eq 'field') { - return 0 unless grep {$be->field_exists($_)} @$fs; - } - elsif ($t eq 'notfield') { - return 0 if grep {$be->field_exists($_)} @$fs; - } - return 1; -} - - -=head2 generate_sortinfo - - Generate information for sorting - -=cut - -sub generate_sortinfo { - my $self = shift; - my $list = shift; - - my $sortscheme = $list->get_sortscheme; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - foreach my $key ($list->get_keys) { - $self->_generatesortinfo($key, $list, $sortscheme); - } - return; -} - -=head2 generate_extra - - Generate: - - * extraalpha - * extrayear - -=cut - -sub generate_extra { - my $self = shift; - my $list = shift; - my $sortscheme = $list->get_sortscheme; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - Biber::Config->reset_seen_extra(); # Since this sub is per-list, have to reset the - # extra* counters per list - # This loop critically depends on the order of the citekeys which - # is why we have to do a first sorting pass before this - foreach my $key ($list->get_keys) { - my $be = $section->bibentry($key); - my $bee = $be->get_field('entrytype'); - # Only generate extrayear and extraalpha if skiplab is not set. - # Don't forget that skiplab is implied for set members - unless (Biber::Config->getblxoption('skiplab', $bee, $key)) { - if (Biber::Config->getblxoption('labelyear', $be->get_field('entrytype'))) { - my $nameyear_extrayear = $be->get_field('nameyear_extrayear'); - if (Biber::Config->get_seen_nameyear_extrayear($nameyear_extrayear) > 1) { - $list->set_extrayeardata($key, Biber::Config->incr_seen_extrayear($nameyear_extrayear)); - } - } - if (Biber::Config->getblxoption('labelalpha', $be->get_field('entrytype'))) { - my $nameyear_extraalpha = $be->get_field('nameyear_extraalpha'); - if (Biber::Config->get_seen_nameyear_extraalpha($nameyear_extraalpha) > 1) { - $list->set_extraalphadata($key, Biber::Config->incr_seen_extraalpha($nameyear_extraalpha)); - } - } - } - } - return; -} - -=head2 sort_list - - Sort a list using information in entries according to a certain sorting scheme. - Use a flag to skip info messages on first pass - -=cut - -sub sort_list { - my $self = shift; - my $list = shift; - my $sortscheme = $list->get_sortscheme; - my @keys = $list->get_keys; - my $llabel = $list->get_label; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - - if (Biber::Config->getoption('sortcase')) { - $logger->debug("Sorting is by default case-SENSITIVE"); - } - else { - $logger->debug("Sorting is by default case-INSENSITIVE"); - } - $logger->debug("Keys before sort:\n"); - foreach my $k (@keys) { - $logger->debug("$k => " . $list->get_sortdata($k)->[0] . "\n"); - } - - $logger->trace("Sorting with scheme\n-------------------\n" . Data::Dump::pp($sortscheme) . "\n-------------------\n"); - - # Set up locale. Order of priority is: - # 1. locale value passed to Unicode::Collate::Locale->new() (Unicode::Collate sorts only) - # 2. Biber sortlocale option - # 3. LC_COLLATE env variable - # 4. LANG env variable - # 5. LC_ALL env variable - # 6. Built-in defaults - - my $thislocale = Biber::Config->getoption('sortlocale'); - - if ( Biber::Config->getoption('fastsort') ) { - use locale; - $logger->info("Sorting list '$llabel' keys"); - $logger->debug("Sorting with fastsort (locale $thislocale)"); - unless (setlocale(LC_ALL, $thislocale)) { - $logger->warn("Unavailable locale $thislocale"); - $self->{warnings}++; - } - - # Construct a multi-field Schwartzian Transform with the right number of - # extractions into a string representing an array ref as we musn't eval this yet - my $num_sorts = 0; - my $data_extractor = '['; - my $sorter; - my $sort_extractor; - # Global lowercase setting - my $glc = Biber::Config->getoption('sortcase') ? '' : 'lc '; - - foreach my $sortset (@{$sortscheme}) { - $data_extractor .= '$list->get_sortdata($_)->[1][' . $num_sorts . '],'; - $sorter .= ' || ' if $num_sorts; # don't add separator before first field - my $lc = $glc; # Casing defaults to global default ... - my $sc = $sortset->[0]{sortcase}; - # but is overriden by field setting if it exists - if (defined($sc) and $sc != Biber::Config->getoption('sortcase')) { - unless ($sc) { - $lc = 'lc '; - } - else { - $lc = ''; - } - } - - my $sd = $sortset->[0]{sort_direction}; - if (defined($sd) and $sd eq 'descending') { - # descending field - $sorter .= $lc - . '$b->[' - . $num_sorts - . '] cmp ' - . $lc - . '$a->[' - . $num_sorts - . ']'; - } - else { - # ascending field - $sorter .= $lc - . '$a->[' - . $num_sorts - . '] cmp ' - . $lc - . '$b->[' - . $num_sorts - . ']'; - } - $num_sorts++; - } - $data_extractor .= '$_]'; - # Handily, $num_sorts is now one larger than the number of fields which is the - # correct index for the actual data in the sort array - $sort_extractor = '$_->[' . $num_sorts . ']'; - $logger->trace("Sorting structure is: $sorter"); - - # Schwartzian transform multi-field sort - @keys = map { eval $sort_extractor } - sort { eval $sorter } - map { eval $data_extractor } @keys; - } - else { - require Unicode::Collate::Locale; - my $opts = Biber::Config->getoption('collate_options'); - my $collopts; - unless (ref($opts) eq "HASH") { # opts for this can come in a string from cmd line - $collopts = eval "{ $opts }" or $logger->logcarp("Incorrect collate_options: $@"); - } - else { # options from config file as hash ref - $collopts = $opts; - } - - # UCA level 2 if case insensitive sorting is requested - unless (Biber::Config->getoption('sortcase')) { - $collopts->{level} = 2; - } - - # Add upper_before_lower option - $collopts->{upper_before_lower} = Biber::Config->getoption('sortupper'); - - # Add tailoring locale for Unicode::Collate - if ($thislocale and not $collopts->{locale}) { - $collopts->{locale} = $thislocale; - if ($collopts->{table}) { - my $t = delete $collopts->{table}; - $logger->info("Ignoring collation table '$t' as locale is set ($thislocale)"); - } - } - - # Remove locale from options as we need this to make the object - my $coll_locale = delete $collopts->{locale}; - # Now create the collator object - my $Collator = Unicode::Collate::Locale->new( locale => $coll_locale ) - or $logger->logcarp("Problem with Unicode::Collate options: $@"); - - # Tailor the collation object and report differences from defaults for locale - # Have to do this in ->change method a ->new can croak with conflicting tailoring - # for locales which enforce certain tailorings - my %coll_changed = $Collator->change( %{$collopts} ); - while (my ($k, $v) = each %coll_changed) { - # If we changing something that has no override tailoring in the locale, it - # is undef in this hash and we don't care about such things - next unless defined($coll_changed{$k}); - if ($coll_changed{$k} ne $collopts->{$k}) { - $logger->warn("Overriding locale '$coll_locale' default tailoring '$k = $v' with '$k = " . $collopts->{$k} . "'"); - } - } - - my $UCAversion = $Collator->version(); - $logger->info("Sorting list '$llabel' keys"); - $logger->debug("Sorting with Unicode::Collate (" . stringify_hash($collopts) . ", UCA version: $UCAversion)"); - - # Log if U::C::L currently has no tailoring for used locale - if ($Collator->getlocale eq 'default') { - $logger->info("No sort tailoring available for locale '$thislocale'"); - } - - # Construct a multi-field Schwartzian Transform with the right number of - # extractions into a string representing an array ref as we musn't eval this yet - my $num_sorts = 0; - my $data_extractor = '['; - my $sorter; - my $sort_extractor; - foreach my $sortset (@{$sortscheme}) { - my $fc = ''; - my @fc; - # If the case or upper option on a field is not the global default - # set it locally on the $Collator by constructing a change() method call - my $sc = $sortset->[0]{sortcase}; - if (defined($sc) and $sc != Biber::Config->getoption('sortcase')) { - push @fc, $sc ? 'level => 4' : 'level => 2'; - } - my $su = $sortset->[0]{sortupper}; - if (defined($su) and $su != Biber::Config->getoption('sortupper')) { - push @fc, $su ? 'upper_before_lower => 1' : 'upper_before_lower => 0'; - } - if (@fc) { - # This field has custom collation options - $fc = '->change(' . join(',', @fc) . ')'; - } - else { - # Reset collation options to global defaults if there are no field options - # We have to do this as ->change modifies the Collation object - $fc = '->change(level => ' - . $collopts->{level} - . ' ,upper_before_lower => ' - . $collopts->{upper_before_lower} - . ')'; - } - - $data_extractor .= '$list->get_sortdata($_)->[1][' . $num_sorts . '],'; - $sorter .= ' || ' if $num_sorts; # don't add separator before first field - - my $sd = $sortset->[0]{sort_direction}; - if (defined($sd) and $sd eq 'descending') { - # descending field - $sorter .= '$Collator' - . $fc - . '->cmp($b->[' - . $num_sorts - . '],$a->[' - . $num_sorts - . '])'; - } - else { - # ascending field - $sorter .= '$Collator' - . $fc - . '->cmp($a->[' - . $num_sorts - . '],$b->[' - . $num_sorts - . '])'; - } - $num_sorts++; - } - $data_extractor .= '$_]'; - # Handily, $num_sorts is now one larger than the number of fields which is the - # correct index for the actual data in the sort array - $sort_extractor = '$_->[' . $num_sorts . ']'; - $logger->trace("Sorting structure is: $sorter"); - - # Schwartzian transform multi-field sort - @keys = map { eval $sort_extractor } - sort { eval $sorter } - map { eval $data_extractor } @keys; - } - - $logger->debug("Keys after sort:\n"); - foreach my $k (@keys) { - $logger->debug("$k => " . $list->get_sortdata($k)->[0] . "\n"); - } - - $list->set_keys([ @keys ]); - - return; -} - -=head2 prepare - - Do the main work. - Process and sort all entries before writing the bbl output. - -=cut - -sub prepare { - my $self = shift; - $self->process_setup; # Place to put global pre-processing things - foreach my $section (@{$self->sections->get_sections}) { - # shortcut - skip sections that don't have any keys - next unless $section->get_citekeys or $section->is_allkeys; - my $secnum = $section->number; - - $logger->info("Processing bib section $secnum"); - - $section->reset_sort_cache; # Reset the the sorting cache - Biber::Config->_init; # (re)initialise Config object - $self->set_current_section($secnum); # Set the section number we are working on - $self->fetch_data; # Fetch cited key and dependent data from sources - $self->instantiate_dynamic; # Instantiate any dynamic entries (sets, related) - $self->process_crossrefs; # Process crossrefs/sets - $self->validate_structure; # Check bib structure - $self->process_entries; # Main entry processing loop - $self->process_lists; # process the output lists (sorting and filtering) - $self->create_output_section; # Generate and push the section output into the - # output object ready for writing - } - $self->create_output_misc; # Generate and push the final misc bits of output - # into the output object ready for writing - return; -} - -=head2 fetch_data - - Fetch citekey and dependents data from section datasources - Expects to find datasource packages named: - - Biber::Input::<type>::<datatype> - - and one defined subroutine called: - - Biber::Input::<type>::<datatype>::extract_entries - - which takes args: - - 1: Biber object - 2: Datasource name - 3: Reference to an array of cite keys to look for - - and returns an array of the cite keys it didn't find in the datasource - -=cut - -sub fetch_data { - my $self = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - # Only looking for static keys, dynamic key entries are not in any datasource ... - my @citekeys = $section->get_static_citekeys; - no strict 'refs'; # symbolic references below ... - - # Clear all T::B macro definitions between sections - # T::B never clears these - $logger->debug('Clearing Text::BibTeX macros definitions'); - Text::BibTeX::delete_all_macros(); - - # (Re-)define the old BibTeX month macros to what biblatex wants unless user stops this - unless (Biber::Config->getoption('nostdmacros')) { - my $mi = 1; - foreach my $mon ('jan','feb','mar','apr','may','jun','jul','aug','sep','oct','nov','dec') { - Text::BibTeX::add_macro_text($mon, $mi++); - } - } - - # First we look for the directly cited keys in each datasource - my @remaining_keys = @citekeys; - $logger->debug('Looking for directly cited keys: ' . join(', ', @remaining_keys)); - foreach my $datasource (@{$section->get_datasources}) { - # shortcut if we have found all the keys now - last unless (@remaining_keys or $section->is_allkeys); - my $type = $datasource->{type}; - my $name = $datasource->{name}; - my $datatype = $datasource->{datatype}; - my $package = 'Biber::Input::' . $type . '::' . $datatype; - eval "require $package" or - $logger->logdie("Error loading data source package '$package': $@"); - $logger->info("Processing $datatype format $type '$name' for section $secnum"); - @remaining_keys = &{"${package}::extract_entries"}($self, $name, \@remaining_keys); - } - - # error reporting - $logger->debug("Directly cited keys not found for section '$secnum': " . join(',', @remaining_keys)); - foreach my $citekey (@remaining_keys) { - $logger->warn("I didn't find a database entry for '$citekey' (section $secnum)"); - $self->{warnings}++; - $section->del_citekey($citekey); - $section->add_undef_citekey($citekey); - } - - $logger->debug('Building dependents for keys: ' . join(',', $section->get_citekeys)); - # dependent key list generation - my @dependent_keys = (); - my $dep_map = {}; # a map of dependent keys to entry keys in case we need to delete - foreach my $citekey ($section->get_citekeys) { - # Dynamic sets don't exist yet but their members do - if (my @dmems = $section->get_dynamic_set($citekey)) { - # skip looking for dependent if it's already been directly cited - foreach my $dm (@dmems) { - unless ($section->bibentry($dm)) { - push @dependent_keys, $dm; - $dep_map->{$dm} = $citekey; - } - } - $logger->debug("Dynamic set entry '$citekey' has members: " . join(', ', @dmems)); - } - else { - # This must exist for all but dynamic sets - my $be = $section->bibentry($citekey); - # crossrefs/xrefs - my $refkey; - if ($refkey = $be->get_field('xref') or - $refkey = $be->get_field('crossref')) { - # skip looking for dependent if it's already been directly cited - push @dependent_keys, $refkey unless $section->bibentry($refkey); - $logger->debug("Entry '$citekey' has cross/xref '$refkey'"); - $dep_map->{$refkey} = $citekey; - } - # static sets - if ($be->get_field('entrytype') eq 'set') { - my @smems = split /\s*,\s*/, $be->get_field('entryset'); - # skip looking for dependent if it's already been directly cited - foreach my $sm (@smems) { - unless ($section->bibentry($sm)) { - push @dependent_keys, $sm; - $dep_map->{$sm} = $citekey; - } - } - $logger->debug("Static set entry '$citekey' has members: " . join(', ', @smems)); - } - # Related entries - if (my $relkeys = $be->get_field('related')) { - my @rmems = split /\s*,\s*/, $relkeys; - # skip looking for dependent if it's already been directly cited - foreach my $rm (@rmems) { - unless ($section->bibentry($rm)) { - push @dependent_keys, $rm; - $dep_map->{$rm} = $citekey; - } - } - $logger->debug("Entry '$citekey' has related entries: " . join(', ', @rmems)); - } - } - } - if (@dependent_keys) { - # Now look for the dependents of the directly cited keys - @remaining_keys = @dependent_keys; - $logger->debug('Looking for dependent keys: ' . join(', ', @remaining_keys)); - - # No need to go back to the datasource if allkeys, just see if the keys - # are in section - if ($section->is_allkeys) { - my @missing; - foreach my $dk (@dependent_keys) { - push @missing, $dk unless first {$_ eq $dk} $section->get_citekeys; - } - @remaining_keys = @missing; - } - else { - foreach my $datasource (@{$section->get_datasources}) { - # shortcut if we have found all the keys now - last unless (@remaining_keys or $section->is_allkeys); - my $type = $datasource->{type}; - my $name = $datasource->{name}; - my $datatype = $datasource->{datatype}; - my $package = 'Biber::Input::' . $type . '::' . $datatype; - eval "require $package" or - $logger->logdie("Error loading data source package '$package': $@"); - @remaining_keys = &{"${package}::extract_entries"}($self, $name, \@remaining_keys); - } - } - - # error reporting - $logger->debug("Dependent keys not found for section '$secnum': " . join(',', @remaining_keys)); - foreach my $citekey (@remaining_keys) { - $logger->debug("Removing missing dependent key '$citekey' from entries"); - $self->remove_undef_dependent($dep_map, $citekey); - } - } - - $logger->debug("Citekeys for section '$secnum' after fetching data: " . join(', ', $section->get_citekeys)); - - # Reset any cache of bibtex data - $Biber::Input::file::bibtex::cache->{data} = undef; - return; -} - -=head2 remove_undef_dependent - - Remove undefined dependent keys from an entries using a map of - depedent keys to entries - -=cut - -sub remove_undef_dependent { - my $self = shift; - my $dep_map = shift; - my $missing_key = shift; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - my $entry_key = $dep_map->{$missing_key}; - - # remove from any dynamic keys - if (my @dmems = $section->get_dynamic_set($entry_key)) { - $section->set_dynamic_set($entry_key, grep {$_ ne $missing_key} @dmems); - $logger->warn("I didn't find a database entry for dynamic set member '$missing_key' - ignoring (section $secnum)"); - $self->{warnings}++; - } - else { - my $be = $section->bibentry($entry_key); - # remove any xrefs - if ($be->get_field('xref') and ($be->get_field('xref') eq $missing_key)) { - $be->del_field('xref'); - $logger->warn("I didn't find a database entry for xref '$missing_key' in entry '$entry_key' - ignoring (section $secnum)"); - $self->{warnings}++; - } - - # remove any crossrefs - if ($be->get_field('crossref') and ($be->get_field('crossref') eq $missing_key)) { - $be->del_field('crossref'); - $logger->warn("I didn't find a database entry for crossref '$missing_key' in entry '$entry_key' - ignoring (section $secnum)"); - $self->{warnings}++; - } - - # remove static sets - if ($be->get_field('entrytype') eq 'set') { - my @smems = split /\s*,\s*/, $be->get_field('entryset'); - $be->set_datafield('entryset', join(',', grep {$_ ne $missing_key} @smems)); - $logger->warn("I didn't find a database entry for static set member '$missing_key' in entry '$entry_key' - ignoring (section $secnum)"); - $self->{warnings}++; - } - - # remove related entries - if (my $relkeys = $be->get_field('related')) { - my @rmems = split /\s*,\s*/, $relkeys; - $be->set_datafield('related', join(',', grep {$_ ne $missing_key} @rmems)); - # If no more related entries, remove the other related fields - unless ($be->get_field('related')) { - $be->del_field('relatedtype'); - $be->del_field('relatedstring'); - } - $logger->warn("I didn't find a database entry for related entry '$missing_key' in entry '$entry_key' - ignoring (section $secnum)"); - $self->{warnings}++; - } - } - return; -} - -=head2 create_output_section - - Create the output from the sections data and push it into the - output object. You can subclass Biber and - override this method to output things other than .bbl - -=cut - -sub create_output_section { - my $self = shift; - my $output_obj = $self->get_output_obj; - my $secnum = $self->get_current_section; - my $section = $self->sections->get_section($secnum); - - # We rely on the order of this array for the order of the .bbl - my @citekeys = $section->get_citekeys; - foreach my $k (@citekeys) { - # Regular entry - my $be = $section->bibentry($k) or $logger->logdie("Cannot find entry with key '$k' to output"); - $output_obj->set_output_entry($be, $section, Biber::Config->get_structure); - } - - # Make sure the output object knows about the output section - $output_obj->set_output_section($secnum, $section); - - # undef citekeys are global - my @undef_citekeys = $section->get_undef_citekeys; - # Missing citekeys - foreach my $k (@undef_citekeys) { - $output_obj->set_output_undefkey($k, $section); - } - - return; -} - -=head2 create_output_misc - - Create the output for misc bits and pieces like preamble and closing - macro call and add to output object. You can subclass Biber and - override this method to output things other than .bbl - -=cut - -sub create_output_misc { - my $self = shift; - my $output_obj = $self->get_output_obj; - - if (my $pa = $self->{preamble}) { - $pa = join("%\n", @$pa); - # Decode UTF-8 -> LaTeX macros if asked to - if (Biber::Config->getoption('bblsafechars')) { - require Biber::LaTeX::Recode; - $pa = Biber::LaTeX::Recode::latex_encode($pa, - scheme => Biber::Config->getoption('bblsafecharsset')); - } - $output_obj->add_output_head("\\preamble{%\n$pa%\n}\n\n"); - } - - $output_obj->add_output_tail("\\endinput\n\n"); - return; -} - -=head2 _parse_sort - - Convenience sub to parse a .bcf sorting section and return nice - sorting object - -=cut - -sub _parse_sort { - my $root_obj = shift; - my $sorting; - - foreach my $sort (sort {$a->{order} <=> $b->{order}} @{$root_obj->{sort}}) { - my $sortingitems; - - # Generate sorting pass structures - foreach my $sortitem (sort {$a->{order} <=> $b->{order}} @{$sort->{sortitem}}) { - my $sortitemattributes = {}; - if (defined($sortitem->{substring_side})) { # Found sorting substring side attribute - $sortitemattributes->{substring_side} = $sortitem->{substring_side}; - } - if (defined($sortitem->{substring_width})) { # Found sorting substring length attribute - $sortitemattributes->{substring_width} = $sortitem->{substring_width}; - } - if (defined($sortitem->{pad_width})) { # Found sorting pad length attribute - $sortitemattributes->{pad_width} = $sortitem->{pad_width}; - } - if (defined($sortitem->{pad_char})) { # Found sorting pad char attribute - $sortitemattributes->{pad_char} = $sortitem->{pad_char}; - } - if (defined($sortitem->{pad_side})) { # Found sorting pad side attribute - $sortitemattributes->{pad_side} = $sortitem->{pad_side}; - } - push @{$sortingitems}, {$sortitem->{content} => $sortitemattributes}; - } - - # Only push a sortitem if defined. If the item has a conditional "pass" - # attribute, it may be ommitted in which case we don't want an empty array ref - # pushing - # Also, we only push the sort attributes if there are any sortitems otherwise - # we end up with a blank sort - my $sopts; - $sopts->{final} = $sort->{final} if defined($sort->{final}); - $sopts->{sort_direction} = $sort->{sort_direction} if defined($sort->{sort_direction}); - $sopts->{sortcase} = $sort->{sortcase} if defined($sort->{sortcase}); - $sopts->{sortupper} = $sort->{sortupper} if defined($sort->{sortupper}); - if (defined($sortingitems)) { - unshift @{$sortingitems}, $sopts; - push @{$sorting}, $sortingitems; - } - } - return $sorting; -} - -=head2 _filedump and _stringdump - - Dump the biber object with Data::Dump for debugging - -=cut - -sub _filedump { - my ($self, $file) = @_; - my $fh = IO::File->new($file, '>') or croak "Can't open file $file for writing"; - print $fh Data::Dump::pp($self); - close $fh; - return -} - -sub _stringdump { - my $self = shift ; - return Data::Dump::pp($self); -} - -=head1 AUTHORS - -François Charette, C<< <firmicus at gmx.net> >> -Philip Kime C<< <philip at kime.org.uk> >> - -=head1 BUGS - -Please report any bugs or feature requests on our sourceforge tracker at -L<https://sourceforge.net/tracker2/?func=browse&group_id=228270>. - -=head1 COPYRIGHT & LICENSE - -Copyright 2009-2011 François Charette and Philip Kime, all rights reserved. - -This module is free software. You can redistribute it and/or -modify it under the terms of the Artistic License 2.0. - -This program is distributed in the hope that it will be useful, -but without any warranty; without even the implied warranty of -merchantability or fitness for a particular purpose. - -=cut - -1; - -# vim: set tabstop=2 shiftwidth=2 expandtab: |