1package Biber::Config;
2use v5.16;
3
4use Biber;
5use Biber::Constants;
6use Biber::Utils;
7use IPC::Cmd qw( can_run );
8use IPC::Run3; # This works with PAR::Packer and Windows. IPC::Run doesn't
9use Cwd qw( abs_path );
10use Data::Compare;
11use Data::Dump;
12use Encode;
13use File::Slurp;
14use File::Spec;
15use Carp;
16use List::AllUtils qw(first max);
17use Log::Log4perl qw( :no_extra_logdie_message ); # To keep PAR::Packer happy, explicitly load these
18use Log::Log4perl::Appender::Screen;
19use Log::Log4perl::Appender::File;
20use Log::Log4perl::Layout::SimpleLayout;
21use Log::Log4perl::Layout::PatternLayout;
22use Unicode::Normalize;
23
24our $VERSION = '2.1';
25our $BETA_VERSION = 0; # Is this a beta version?
26
27our $logger  = Log::Log4perl::get_logger('main');
28our $screen  = Log::Log4perl::get_logger('screen');
29our $logfile = Log::Log4perl::get_logger('logfile');
30
31=encoding utf-8
32
33
34=head1 NAME
35
36Biber::Config - Configuration items which need to be saved across the
37                lifetime of a Biber object
38
39  This class contains a static object and static methods to access
40  configuration and state data. There are several classes of data in here
41  which have separate accessors:
42
43  * Biber options
44  * Biblatex options
45  * State information used by Biber as it processes entries
46  * displaymode date
47
48=cut
49
50
51# Static (class) data
52our $CONFIG;
53$CONFIG->{state}{crossrefkeys} = {};
54$CONFIG->{state}{seenwork} = {};
55
56# Set tracking, parent->child and child->parent
57$CONFIG->{state}{set}{pc} = {};
58$CONFIG->{state}{set}{cp} = {};
59
60# Citekeys which refer to the same entry
61$CONFIG->{state}{citkey_aliases} = {};
62
63# Disambiguation data for labelalpha. Used for labelalphatemplate autoinc method
64$CONFIG->{state}{ladisambiguation} = {};
65
66# Record of which entries have inherited from other fields. Used for loop detection.
67$CONFIG->{state}{crossref} = [];
68$CONFIG->{state}{xdata} = [];
69
70# Record of which entries have inherited what from whom, with the fields inherited.
71# Used for generating inheritance trees
72$CONFIG->{state}{graph} = {};
73
74# For the uniquelist feature. Records the number of times a name list occurs in all entries
75$CONFIG->{state}{uniquelistcount} = {};
76
77# Boolean to say whether uniquename/uniquelist information has changed
78# Default is true so that uniquename/uniquelist processing starts
79$CONFIG->{state}{unulchanged} = 1;
80
81# uniquenamecount holds a hash of lastnames and lastname/initials
82$CONFIG->{state}{uniquenamecount} = {};
83# Same as uniquenamecount but for all names, regardless of visibility. Needed to track
84# uniquelist
85$CONFIG->{state}{uniquenamecount_all} = {};
86# Counter for tracking name/year combinations for extrayear
87$CONFIG->{state}{seen_nameyear} = {};
88# Counter for the actual extrayear value
89$CONFIG->{state}{seen_extrayear} = {};
90
91# Counter for tracking name/title combinations for extratitle
92$CONFIG->{state}{seen_nametitle} = {};
93# Counter for the actual extratitle value
94$CONFIG->{state}{seen_extratitle} = {};
95
96# Counter for tracking title/year combinations for extratitleyear
97$CONFIG->{state}{seen_titleyear} = {};
98# Counter for the actual extratitleyear value
99$CONFIG->{state}{seen_extratitleyear} = {};
100
101# Counter for the actual extraalpha value
102$CONFIG->{state}{seen_extraalpha} = {};
103$CONFIG->{state}{seenkeys} = {};
104
105# Track the order of keys as cited. Keys cited in the same \cite*{} get the same order
106# Used for sorting schemes which use \citeorder
107$CONFIG->{state}{keyorder} = {};
108
109# Location of the control file
110$CONFIG->{state}{control_file_location} = '';
111
112# Data files per section being used by biber
113$CONFIG->{state}{datafiles} = [];
114
115=head2 _init
116
117    Reset internal hashes to defaults.
118
119=cut
120
121sub _init {
122  $CONFIG->{options}{biblatex}{PER_ENTRY} = {};
123  $CONFIG->{state}{unulchanged} = 1;
124  $CONFIG->{state}{control_file_location} = '';
125  $CONFIG->{state}{seenwork} = {};
126  $CONFIG->{state}{crossrefkeys} = {};
127  $CONFIG->{state}{ladisambiguation} = {};
128  $CONFIG->{state}{uniquenamecount} = {};
129  $CONFIG->{state}{uniquenamecount_all} = {};
130  $CONFIG->{state}{uniquelistcount} = {};
131  $CONFIG->{state}{seen_nameyear} = {};
132  $CONFIG->{state}{seen_extrayear} = {};
133  $CONFIG->{state}{seen_nametitle} = {};
134  $CONFIG->{state}{seen_extratitle} = {};
135  $CONFIG->{state}{seen_titleyear} = {};
136  $CONFIG->{state}{seen_extratitleyear} = {};
137  $CONFIG->{state}{seen_extrayearalpha} = {};
138  $CONFIG->{state}{seenkeys} = {};
139  $CONFIG->{state}{datafiles} = [];
140  $CONFIG->{state}{crossref} = [];
141  $CONFIG->{state}{xdata} = [];
142  $CONFIG->{state}{set}{pc} = {};
143  $CONFIG->{state}{set}{cp} = {};
144
145  return;
146}
147
148=head2 _initopts
149
150    Initialise default options, optionally with config file as argument
151
152=cut
153
154sub _initopts {
155  shift; # class method so don't care about class name
156  my $opts = shift;
157  my $userconf;
158
159  # For testing, need to be able to force ignore of conf file in case user
160  # already has one which interferes with test settings.
161  unless (defined($opts->{noconf})) {
162    # if a config file was given as cmd-line arg, it overrides all other
163    # config file locations
164    unless ( defined($opts->{configfile}) and -f $opts->{configfile} ) {
165      $opts->{configfile} = config_file();
166    }
167  }
168
169  # Set hard-coded biber option defaults
170  while (my ($k, $v) = each %$CONFIG_DEFAULT_BIBER) {
171    if (exists($v->{content})) { # simple option
172      Biber::Config->setoption($k, $v->{content});
173    }
174    # mildly complex options
175    elsif (lc($k) eq 'dot_include' or
176           lc($k) eq 'collate_options' or
177           lc($k) eq 'nosort' or
178           lc($k) eq 'noinit' ) {
179      Biber::Config->setoption($k, $v->{option});
180    }
181  }
182
183  # There is a special default config file for tool mode
184  # Referring to as yet unprocessed cmd-line tool option as it isn't processed until below
185  if ($opts->{tool}) {
186    (my $vol, my $dir, undef) = File::Spec->splitpath( $INC{"Biber/Config.pm"} );
187    $dir =~ s/\/$//; # splitpath sometimes leaves a trailing '/'
188    _config_file_set(File::Spec->catpath($vol, "$dir", 'biber-tool.conf'));
189  }
190
191  # Normal user config file - overrides tool mode defaults, if any
192  _config_file_set($opts->{configfile});
193
194  # Set hard-coded biblatex option defaults
195  # This has to go after _config_file_set() as this is what defines option scope
196  # in tool mode (from the .conf file)
197  foreach (keys %CONFIG_DEFAULT_BIBLATEX) {
198    Biber::Config->setblxoption($_, $CONFIG_DEFAULT_BIBLATEX{$_});
199  }
200
201  # Command-line overrides everything else
202  foreach my $copt (keys %$opts) {
203    # This is a tricky option as we need to keep non-overriden defaults
204    # If we don't we can get errors when contructing the sorting call to eval() later
205    if (lc($copt) eq 'collate_options') {
206      my $collopts = Biber::Config->getoption('collate_options');
207      my $copt_h = eval "{ $opts->{$copt} }" or croak('Bad command-line collation options');
208      # Override defaults with any cmdline settings
209      foreach my $co (keys %$copt_h) {
210        $collopts->{$co} = $copt_h->{$co};
211      }
212      Biber::Config->setconfigfileoption('collate_options', $collopts);
213    }
214    else {
215      Biber::Config->setcmdlineoption($copt, $opts->{$copt});
216    }
217  }
218
219  # Set control file name. In a conditional as @ARGV might not be set in tests
220  if (my $bcf = $ARGV[0]) {         # ARGV is ok even in a module
221    $bcf .= '.bcf' unless $bcf =~ m/\.bcf$/;
222    Biber::Config->setoption('bcf', $bcf); # only referenced in biber program
223  }
224
225  # Set log file name
226  my $biberlog;
227  if (my $log = Biber::Config->getoption('logfile')) { # user specified logfile name
228    # Sanitise user-specified log name
229    $log =~ s/\.blg\z//xms;
230    $biberlog = $log . '.blg';
231  }
232  elsif (not @ARGV) { # default if no .bcf file specified - mainly in tests
233    Biber::Config->setoption('nolog', 1);
234  }
235  else {                        # set log to \jobname.blg
236    my $bcf = $ARGV[0];         # ARGV is ok even in a module
237    # Sanitise control file name
238    $bcf =~ s/\.bcf\z//xms;
239    $biberlog = $bcf . '.blg';
240  }
241
242  # prepend output directory for log, if specified
243  if (my $outdir = Biber::Config->getoption('output_directory')) {
244    $biberlog = File::Spec->catfile($outdir, $biberlog);
245  }
246
247  # Setting up Log::Log4perl
248  my $LOGLEVEL;
249  if (Biber::Config->getoption('trace')) {
250    $LOGLEVEL = 'TRACE'
251  }
252  elsif (Biber::Config->getoption('debug')) {
253    $LOGLEVEL = 'DEBUG'
254  }
255  elsif (Biber::Config->getoption('quiet') == 1) {
256    $LOGLEVEL = 'ERROR'
257  }
258  elsif (Biber::Config->getoption('quiet') > 1) {
259    $LOGLEVEL = 'FATAL'
260  }
261  else {
262    $LOGLEVEL = 'INFO'
263  }
264
265  my $LOGLEVEL_F;
266  my $LOG_MAIN;
267  if (Biber::Config->getoption('nolog')) {
268    $LOG_MAIN = 'Screen';
269    $LOGLEVEL_F = 'OFF'
270  }
271  else {
272    $LOG_MAIN = 'Logfile, Screen';
273    $LOGLEVEL_F = $LOGLEVEL
274  }
275
276  my $LOGLEVEL_S;
277  if (Biber::Config->getoption('onlylog')) {
278    $LOGLEVEL_S = 'OFF'
279  }
280  else {
281    # Max screen loglevel is INFO
282    if (Biber::Config->getoption('quiet') == 1) {
283      $LOGLEVEL_S = 'ERROR';
284    }
285    elsif (Biber::Config->getoption('quiet') > 1) {
286      $LOGLEVEL_S = 'FATAL'
287    }
288    else {
289      $LOGLEVEL_S = 'INFO';
290    }
291  }
292
293  # configuration "file" for Log::Log4perl
294  my $l4pconf = qq|
295    log4perl.category.main                             = $LOGLEVEL, $LOG_MAIN
296    log4perl.category.screen                           = $LOGLEVEL_S, Screen
297
298    log4perl.appender.Screen                           = Log::Log4perl::Appender::Screen
299    log4perl.appender.Screen.utf8                      = 1
300    log4perl.appender.Screen.Threshold                 = $LOGLEVEL_S
301    log4perl.appender.Screen.stderr                    = 0
302    log4perl.appender.Screen.layout                    = Log::Log4perl::Layout::SimpleLayout
303|;
304
305  # Only want a logfile appender if --nolog isn't set
306  if ($LOGLEVEL_F ne 'OFF') {
307    $l4pconf .= qq|
308    log4perl.category.logfile                          = $LOGLEVEL_F, Logfile
309    log4perl.appender.Logfile                          = Log::Log4perl::Appender::File
310    log4perl.appender.Logfile.utf8                     = 1
311    log4perl.appender.Logfile.Threshold                = $LOGLEVEL_F
312    log4perl.appender.Logfile.filename                 = $biberlog
313    log4perl.appender.Logfile.mode                     = clobber
314    log4perl.appender.Logfile.layout                   = Log::Log4perl::Layout::PatternLayout
315    log4perl.appender.Logfile.layout.ConversionPattern = [%r] %F{1}:%L> %p - %m%n
316|;
317  }
318
319  Log::Log4perl->init(\$l4pconf);
320
321  my $vn = $VERSION;
322  $vn .= ' (beta)' if $BETA_VERSION;
323  my $tool = ' running in TOOL mode' if Biber::Config->getoption('tool');
324
325  $logger->info("This is Biber $vn$tool") unless Biber::Config->getoption('nolog');
326
327  $logger->info("Config file is '" . $opts->{configfile} . "'") if $opts->{configfile};
328  $logger->info("Logfile is '$biberlog'") unless Biber::Config->getoption('nolog');
329
330  if (Biber::Config->getoption('debug')) {
331    $screen->info("DEBUG mode: all messages are logged to '$biberlog'")
332  }
333
334  return;
335}
336
337# read a config file and set options from it
338sub _config_file_set {
339  my $conf = shift;
340  my $userconf;
341
342  # Can't use logcroak here because logging isn't initialised yet
343  if (defined($conf)) {
344    require XML::LibXML::Simple;
345
346    my $buf = File::Slurp::read_file($conf);
347    $buf = NFD(decode('UTF-8', $buf));# Unicode NFD boundary
348
349    $userconf = XML::LibXML::Simple::XMLin($buf,
350                                           'ForceContent' => 1,
351                                           'ForceArray' => [
352                                                            qr/\Aoption\z/,
353                                                            qr/\Amaps\z/,
354                                                            qr/\Amap\z/,
355                                                            qr/\Amap_step\z/,
356                                                            qr/\Aper_type\z/,
357                                                            qr/\Aper_datasource\z/,
358                                                            qr/\Atype_pair\z/,
359                                                            qr/\Ainherit\z/,
360                                                            qr/\Afieldor\z/,
361                                                            qr/\Afieldxor\z/,
362                                                            qr/\Afield\z/,
363                                                            qr/\Aalias\z/,
364                                                            qr/\Aalsoset\z/,
365                                                            qr/\Aconstraints\z/,
366                                                            qr/\Aconstraint\z/,
367                                                            qr/\Aentrytype\z/,
368                                                            qr/\Adatetype\z/,
369                                                            qr/\Acondition\z/,
370                                                            qr/\A(?:or)?filter\z/,
371                                                            qr/\Asortexclusion\z/,
372                                                            qr/\Aexclusion\z/,
373                                                            qr/\Asort\z/,
374                                                            qr/\Asortitem\z/,
375                                                            qr/\Apresort\z/,
376                                                            qr/\Aoptionscope\z/,
377                                                           ],
378                                           'NsStrip' => 1,
379                                           'KeyAttr' => []) or
380                                             croak("Failed to read biber config file '$conf'\n $@");
381  }
382  # Option scope has to be set first
383  foreach my $bcfscopeopts (@{$userconf->{optionscope}}) {
384    my $type = $bcfscopeopts->{type};
385    foreach my $bcfscopeopt (@{$bcfscopeopts->{option}}) {
386      $CONFIG_SCOPE_BIBLATEX{$bcfscopeopt->{content}}{$type} = 1;
387    }
388  }
389  delete $userconf->{optionscope};
390
391  # Set options from config file
392  while (my ($k, $v) = each %$userconf) {
393    if (exists($v->{content})) { # simple option
394      Biber::Config->setconfigfileoption($k, $v->{content});
395    }
396    # mildly complex options - nosort/collate_options
397    elsif (lc($k) eq 'nosort' or
398           lc($k) eq 'noinit' ) {
399      Biber::Config->setconfigfileoption($k, $v->{option});
400    }
401    # rather complex options
402    elsif (lc($k) eq 'collate_options') {
403      my $collopts = Biber::Config->getoption('collate_options');
404      # Override defaults with any user settings
405      foreach my $co (@{$v->{option}}) {
406        $collopts->{$co->{name}} = $co->{value};
407      }
408      Biber::Config->setconfigfileoption($k, $collopts);
409    }
410    elsif (lc($k) eq 'sourcemap') {
411      my $sms;
412      foreach my $sm (@{$v->{maps}}) {
413        if (defined($sm->{level}) and $sm->{level} eq 'driver') {
414          carp("You can't set driver level sourcemaps via biber - use \\DeclareDriverSourcemap in biblatex. Ignoring map.");
415        }
416        elsif (defined($sm->{level}) and $sm->{level} eq 'style') {
417          carp("You can't set style level sourcemaps via biber - use \\DeclareStyleSourcemap in biblatex. Ignoring map.");
418        }
419        else {
420          push @$sms, $sm;
421        }
422      }
423      Biber::Config->setconfigfileoption($k, $sms);
424    }
425    elsif (lc($k) eq 'inheritance') {# This is a biblatex option
426      Biber::Config->setblxoption($k, $v);
427    }
428    elsif (lc($k) eq 'sorting') {# This is a biblatex option
429      # sorting excludes
430      foreach my $sex (@{$v->{sortexclusion}}) {
431        my $excludes;
432        foreach my $ex (@{$sex->{exclusion}}) {
433          $excludes->{$ex->{content}} = 1;
434        }
435        Biber::Config->setblxoption('sortexclusion',
436                                    $excludes,
437                                    'PER_TYPE',
438                                    $sex->{type});
439      }
440
441      # presort defaults
442      foreach my $presort (@{$v->{presort}}) {
443        # Global presort default
444        unless (exists($presort->{type})) {
445          Biber::Config->setblxoption('presort', $presort->{content});
446        }
447        # Per-type default
448        else {
449          Biber::Config->setblxoption('presort',
450                                      $presort->{content},
451                                      'PER_TYPE',
452                                      $presort->{type});
453        }
454      }
455      Biber::Config->setblxoption('sorting', Biber::_parse_sort($v));
456    }
457    elsif (lc($k) eq 'datamodel') {# This is a biblatex option
458      Biber::Config->setblxoption('datamodel', $v);
459    }
460  }
461}
462
463=head2 config_file
464
465Returns the full path of the B<Biber> configuration file.
466If returns the first file found among:
467
468=over 4
469
470=item * C<biber.conf> in the current directory
471
472=item * C<$HOME/.biber.conf>
473
474=item * C<$ENV{XDG_CONFIG_HOME}/biber/biber.conf>
475
476=item * C<$HOME/Library/biber/biber.conf> (Mac OSX only)
477
478=item * C<$ENV{APPDATA}/biber.conf> (Windows only)
479
480=item * the output of C<kpsewhich biber.conf> (if available on the system).
481
482=back
483
484If no file is found, it returns C<undef>.
485
486=cut
487
488sub config_file {
489  my $biberconf;
490
491  if ( -f $BIBER_CONF_NAME ) {
492    $biberconf = abs_path($BIBER_CONF_NAME);
493  }
494  elsif ( -f File::Spec->catfile($ENV{HOME}, ".$BIBER_CONF_NAME" ) ) {
495    $biberconf = File::Spec->catfile($ENV{HOME}, ".$BIBER_CONF_NAME" );
496  }
497  elsif ( defined $ENV{XDG_CONFIG_HOME} and
498    -f File::Spec->catfile($ENV{XDG_CONFIG_HOME}, "biber", $BIBER_CONF_NAME) ) {
499    $biberconf = File::Spec->catfile($ENV{XDG_CONFIG_HOME}, "biber", $BIBER_CONF_NAME);
500  }
501  elsif ( $^O =~ /(?:Mac|darwin)/ and
502    -f File::Spec->catfile($ENV{HOME}, "Library", "biber", $BIBER_CONF_NAME) ) {
503    $biberconf = File::Spec->catfile($ENV{HOME}, "Library", "biber", $BIBER_CONF_NAME);
504  }
505  elsif ( $^O =~ /Win/ and
506    defined $ENV{APPDATA} and
507    -f File::Spec->catfile($ENV{APPDATA}, "biber", $BIBER_CONF_NAME) ) {
508    $biberconf = File::Spec->catfile($ENV{APPDATA}, "biber", $BIBER_CONF_NAME);
509  }
510  elsif ( can_run('kpsewhich') ) {
511    my $err;
512    run3 [ 'kpsewhich', $BIBER_CONF_NAME ], \undef, \$biberconf, \$err, { return_if_system_error => 1};
513    if ($? == -1) {
514      biber_error("Error running kpsewhich to look for config file: $err");
515    }
516
517    chomp $biberconf;
518    $biberconf =~ s/\cM\z//xms; # kpsewhich in cygwin sometimes returns ^M at the end
519    $biberconf = undef unless $biberconf; # sanitise just in case it's an empty string
520  }
521  else {
522    $biberconf = undef;
523  }
524
525  return $biberconf;
526}
527
528##############################
529# Biber options static methods
530##############################
531
532=head2 get_unul_done
533
534    Return a boolean saying whether uniquenename+uniquelist processing is finished
535
536=cut
537
538sub get_unul_done {
539  shift; # class method so don't care about class name
540  return $CONFIG->{state}{unulchanged} ? 0 : 1;
541}
542
543=head2 set_unul_changed
544
545    Set a boolean saying whether uniquename+uniquelist has changed
546
547=cut
548
549sub set_unul_changed {
550  shift; # class method so don't care about class name
551  my $val = shift;
552  $CONFIG->{state}{unulchanged} = $val;
553  return;
554}
555
556=head2 postprocess_biber_opts
557
558    Place to postprocess biber options when they have been
559    gathered from all the possible places that set them
560
561=cut
562
563sub postprocess_biber_opts {
564  shift; # class method so don't care about class name
565  # Turn sortcase, sortupper, sortfirstinits into booleans if they are not already
566  # They are not booleans on the command-line/config file so that they
567  # mirror biblatex option syntax for users, for example
568
569  foreach my $opt ('sortfirstinits', 'sortcase', 'sortupper') {
570    if (exists($CONFIG->{options}{biber}{$opt})) {
571      if ($CONFIG->{options}{biber}{$opt} eq 'true') {
572        $CONFIG->{options}{biber}{$opt} = 1;
573      }
574      elsif ($CONFIG->{options}{biber}{$opt} eq 'false') {
575        $CONFIG->{options}{biber}{$opt} = 0;
576      }
577      unless ($CONFIG->{options}{biber}{$opt} eq '1' or
578              $CONFIG->{options}{biber}{$opt} eq '0') {
579        Biber::Utils::biber_error("Invalid value for option '$opt'");
580      }
581    }
582  }
583}
584
585=head2 set_dm
586
587    Sets the data model information object
588
589=cut
590
591sub set_dm {
592  shift;
593  my $obj = shift;
594  $CONFIG->{dm} = $obj;
595  return;
596}
597
598=head2 get_dm
599
600    Gets the data model information object
601
602=cut
603
604sub get_dm {
605  shift;
606  return $CONFIG->{dm};
607}
608
609=head2 set_ctrlfile_path
610
611    Stores the path to the control file
612
613=cut
614
615sub set_ctrlfile_path {
616  shift;
617  $CONFIG->{control_file_location} = shift;
618  return;
619}
620
621=head2 get_ctrlfile_path
622
623    Retrieved the path to the control file
624
625=cut
626
627sub get_ctrlfile_path {
628  shift;
629  return $CONFIG->{control_file_location};
630}
631
632=head2 setoption
633
634    Store a Biber config option
635
636=cut
637
638sub setoption {
639  shift; # class method so don't care about class name
640  my ($opt, $val) = @_;
641  $CONFIG->{options}{biber}{$opt} = $val;
642  return;
643}
644
645=head2 getoption
646
647    Get a Biber option
648
649=cut
650
651sub getoption {
652  shift; # class method so don't care about class name
653  my $opt = shift;
654  return $CONFIG->{options}{biber}{$opt};
655}
656
657=head2 setcmdlineoption
658
659    Store a Biber command-line option
660
661=cut
662
663sub setcmdlineoption {
664  shift; # class method so don't care about class name
665  my ($opt, $val) = @_;
666  # Command line options are also options ...
667  $CONFIG->{options}{biber}{$opt} = $CONFIG->{cmdlineoptions}{$opt} = $val;
668  return;
669}
670
671=head2 setconfigfileoption
672
673    Store a Biber config-file option
674
675=cut
676
677sub setconfigfileoption {
678  shift; # class method so don't care about class name
679  my ($opt, $val) = @_;
680  # Config file options are also options ...
681  $CONFIG->{options}{biber}{$opt} = $CONFIG->{configfileoptions}{$opt} = $val;
682  return;
683}
684
685
686=head2 iscmdlineoption
687
688    Check if an option is explicitly set by user on the command
689    line
690
691=cut
692
693sub iscmdlineoption {
694  shift; # class method so don't care about class name
695  my $opt = shift;
696  return 1 if defined($CONFIG->{cmdlineoptions}{$opt});
697  return 0;
698}
699
700=head2 isconfigfileoption
701
702    Check if an option is explicitly set by user in their
703    config file
704
705=cut
706
707sub isconfigfileoption {
708  shift; # class method so don't care about class name
709  my $opt = shift;
710  return 1 if defined($CONFIG->{configfileoptions}{$opt});
711  return 0;
712}
713
714=head2 isexplicitoption
715
716    Check if an option is explicitly set by user on the command
717    line or in the config file
718
719=cut
720
721sub isexplicitoption {
722  my $self = shift;
723  my $opt = shift;
724  return 1 if ($self->iscmdlineoption($opt) || $self->isconfigfileoption($opt));
725  return 0;
726}
727
728
729#################################
730# BibLaTeX options static methods
731#################################
732
733
734=head2 setblxoption
735
736    Set a biblatex option on the appropriate scope
737
738=cut
739
740sub setblxoption {
741  shift; # class method so don't care about class name
742  my ($opt, $val, $scope, $scopeval) = @_;
743  if (not defined($scope)) { # global is the default
744    if ($CONFIG_SCOPE_BIBLATEX{$opt}->{GLOBAL}) {
745      $CONFIG->{options}{biblatex}{GLOBAL}{$opt} = $val;
746    }
747  }
748  else { # Per-type/entry options need to specify type/entry too
749    if ($CONFIG_SCOPE_BIBLATEX{$opt}->{$scope}) {
750      $CONFIG->{options}{biblatex}{$scope}{$scopeval}{$opt} = $val;
751    }
752  }
753  return;
754}
755
756=head2 getblxoption
757
758    Get a biblatex option from the global or per entry-type scope
759
760    getblxoption('option', ['entrytype'], ['citekey'])
761
762    Returns the value of option. In order of decreasing preference, returns:
763    1. Biblatex option defined for entry
764    2. Biblatex option defined for entry type
765    3. Biblatex option defined globally
766
767=cut
768
769sub getblxoption {
770  shift; # class method so don't care about class name
771  my ($opt, $entrytype, $citekey) = @_;
772  if ( defined($citekey) and
773       $CONFIG_SCOPE_BIBLATEX{$opt}->{PER_ENTRY} and
774       defined $CONFIG->{options}{biblatex}{PER_ENTRY}{$citekey} and
775       defined $CONFIG->{options}{biblatex}{PER_ENTRY}{$citekey}{$opt}) {
776    return $CONFIG->{options}{biblatex}{PER_ENTRY}{$citekey}{$opt};
777  }
778  elsif (defined($entrytype) and
779         $CONFIG_SCOPE_BIBLATEX{$opt}->{PER_TYPE} and
780         defined $CONFIG->{options}{biblatex}{PER_TYPE}{lc($entrytype)} and
781         defined $CONFIG->{options}{biblatex}{PER_TYPE}{lc($entrytype)}{$opt}) {
782    return $CONFIG->{options}{biblatex}{PER_TYPE}{lc($entrytype)}{$opt};
783  }
784  elsif ($CONFIG_SCOPE_BIBLATEX{$opt}->{GLOBAL}) {
785    return $CONFIG->{options}{biblatex}{GLOBAL}{$opt};
786  }
787}
788
789
790
791##############################
792# Inheritance state methods
793##############################
794
795=head2 set_graph
796
797   Record node and arc connection types for .dot output
798
799=cut
800
801sub set_graph {
802  shift; # class method so don't care about class name
803  my $type = shift;
804  if ($type eq 'set') {
805    my ($source_key, $target_key) = @_;
806    $logger->debug("Saving DOT graph information type 'set' with SOURCEKEY=$source_key, TARGETKEY=$target_key");
807    $CONFIG->{state}{graph}{$type}{settomem}{$source_key}{$target_key} = 1;
808    $CONFIG->{state}{graph}{$type}{memtoset}{$target_key} = $source_key;
809  }
810  elsif ($type eq 'xref') {
811    my ($source_key, $target_key) = @_;
812    $logger->debug("Saving DOT graph information type 'xref' with SOURCEKEY=$source_key, TARGETKEY=$target_key");
813    $CONFIG->{state}{graph}{$type}{$source_key} = $target_key;
814  }
815  elsif ($type eq 'related') {
816    my ($clone_key, $related_key, $target_key) = @_;
817    $logger->debug("Saving DOT graph information type 'related' with CLONEKEY=$clone_key, RELATEDKEY=$related_key, TARGETKEY=$target_key");
818    $CONFIG->{state}{graph}{$type}{reltoclone}{$related_key}{$clone_key} = 1;
819    $CONFIG->{state}{graph}{$type}{clonetotarget}{$clone_key}{$target_key} = 1;
820  }
821  else {
822    my ($source_key, $target_key, $source_field, $target_field) = @_;
823    $logger->debug("Saving DOT graph information type '$type' with SOURCEKEY=$source_key, TARGETKEY=$target_key, SOURCEFIELD=$source_field, TARGETFIELD=$target_field");
824    $CONFIG->{state}{graph}{$type}{$source_key}{$source_field}{$target_key} = $target_field;
825  }
826  return;
827}
828
829=head2 get_graph
830
831    Return an inheritance graph data structure for an inheritance type
832
833=cut
834
835sub get_graph {
836  shift; # class method so don't care about class name
837  my $type = shift;
838  return $CONFIG->{state}{graph}{$type};
839}
840
841=head2 set_set_pc
842
843  Record a parent->child set relationship
844
845=cut
846
847sub set_set_pc {
848  shift; # class method so don't care about class name
849  my ($parent, $child) = @_;
850  $CONFIG->{state}{set}{pc}{$parent}{$child} = 1;
851  return;
852}
853
854=head2 set_set_cp
855
856  Record a child->parent set relationship
857
858=cut
859
860sub set_set_cp {
861  shift; # class method so don't care about class name
862  my ($child, $parent) = @_;
863  $CONFIG->{state}{set}{cp}{$child}{$parent} = 1;
864  return;
865}
866
867=head2 get_set_pc
868
869  Return a boolean saying if there is a parent->child set relationship
870
871=cut
872
873sub get_set_pc {
874  shift; # class method so don't care about class name
875  my ($parent, $child) = @_;
876  return exists($CONFIG->{state}{set}{pc}{$parent}{$child}) ? 1 : 0;
877}
878
879=head2 get_set_cp
880
881  Return a boolean saying if there is a child->parent set relationship
882
883=cut
884
885sub get_set_cp {
886  shift; # class method so don't care about class name
887  my ($child, $parent) = @_;
888  return exists($CONFIG->{state}{set}{cp}{$child}{$parent}) ? 1 : 0;
889}
890
891=head2 get_set_children
892
893  Return a list of children for a parent set
894
895=cut
896
897sub get_set_children {
898  shift; # class method so don't care about class name
899  my $parent = shift;
900  if (exists($CONFIG->{state}{set}{pc}{$parent})) {
901    return (keys %{$CONFIG->{state}{set}{pc}{$parent}});
902  }
903  else {
904    return ();
905  }
906}
907
908=head2 get_set_parents
909
910  Return a list of parents for a child of a set
911
912=cut
913
914sub get_set_parents {
915  shift; # class method so don't care about class name
916  my $child = shift;
917  if (exists($CONFIG->{state}{set}{cp}{$child})) {
918    return (keys %{$CONFIG->{state}{set}{cp}{$child}});
919  }
920  else {
921    return ();
922  }
923}
924
925
926=head2 set_inheritance
927
928    Record that $target inherited information from $source
929    Can be used for crossrefs and xdata. This just records that an entry
930    inherited from another entry, for loop detection.
931
932=cut
933
934sub set_inheritance {
935  shift; # class method so don't care about class name
936  my ($type, $source, $target) = @_;
937  push @{$CONFIG->{state}{$type}}, {s => $source, t => $target};
938  return;
939}
940
941
942=head2 get_inheritance
943
944    Check if $target directly inherited information from $source
945    Can be used for crossrefs and xdata
946
947=cut
948
949sub get_inheritance {
950  shift; # class method so don't care about class name
951  my ($type, $source, $target) = @_;
952  return first {$_->{s} eq $source and $_->{t} eq $target} @{$CONFIG->{state}{$type}};
953}
954
955=head2 is_inheritance_path
956
957  Checks for an inheritance path from entry $e1 to $e2
958  Can be used for crossrefs and xdata
959
960[
961             {s => 'A',
962              t => 'B'},
963             {s => 'A',
964              t => 'E'},
965             {s => 'B',
966              t => 'C'},
967             {s => 'C',
968              t => 'D'}
969];
970
971=cut
972
973sub is_inheritance_path {
974  my ($self, $type, $e1, $e2) = @_;
975  foreach my $dps (grep {$_->{s} eq $e1} @{$CONFIG->{state}{$type}}) {
976    return 1 if $dps->{t} eq $e2;
977    return 1 if is_inheritance_path($self, $type, $dps->{t}, $e2);
978  }
979  return 0;
980}
981
982
983=head1 labelalpha disambiguation
984
985=head2 incr_la_disambiguation
986
987    Increment a counter to say we have seen this labelalpha
988
989=cut
990
991sub incr_la_disambiguation {
992  shift; # class method so don't care about class name
993  my $la = shift;
994  $CONFIG->{state}{ladisambiguation}{$la}++;
995  return;
996}
997
998
999=head2 get_la_disambiguation
1000
1001    Get the disambiguation counter for this labelalpha.
1002    Return a 0 for undefs to avoid spurious errors.
1003
1004=cut
1005
1006sub get_la_disambiguation {
1007  shift; # class method so don't care about class name
1008  my $la = shift;
1009  return $CONFIG->{state}{ladisambiguation}{$la} // 0;
1010}
1011
1012=head1 keyorder
1013
1014=head2 set_keyorder
1015
1016  Set some key order information
1017
1018=cut
1019
1020sub set_keyorder {
1021  shift; # class method so don't care about class name
1022  my ($section, $key, $keyorder) = @_;
1023  $CONFIG->{state}{keyorder}{$section}{$key} = $keyorder;
1024  return;
1025}
1026
1027=head2 get_keyorder
1028
1029  Get some key order information
1030
1031=cut
1032
1033sub get_keyorder {
1034  shift; # class method so don't care about class name
1035  my ($section, $key) = @_;
1036  return $CONFIG->{state}{keyorder}{$section}{$key};
1037}
1038
1039
1040=head2 get_keyorder_max
1041
1042  Get maximum key order number for a section
1043
1044=cut
1045
1046sub get_keyorder_max {
1047  shift; # class method so don't care about class name
1048  my $section = shift;
1049  return (max values %{$CONFIG->{state}{keyorder}{$section}}) || 0;
1050}
1051
1052=head2 reset_keyorder
1053
1054  Reset keyorder - for use in tests where we switch to allkeys
1055
1056=cut
1057
1058sub reset_keyorder {
1059  shift; # class method so don't care about class name
1060  my $section = shift;
1061  delete $CONFIG->{state}{keyorder}{$section};
1062  return;
1063}
1064
1065
1066=head1 seenkey
1067
1068=head2 get_seenkey
1069
1070    Get the count of a key
1071
1072=cut
1073
1074sub get_seenkey {
1075  shift; # class method so don't care about class name
1076  my $key = shift;
1077  my $section = shift; # If passed, return count for just this section
1078  if (defined($section)) {
1079    return $CONFIG->{state}{seenkeys}{$section}{$key};
1080  }
1081  else {
1082    my $count;
1083    foreach my $section (keys %{$CONFIG->{state}{seenkeys}}) {
1084      $count += $CONFIG->{state}{seenkeys}{$section}{$key};
1085    }
1086    return $count;
1087  }
1088}
1089
1090
1091=head2 incr_seenkey
1092
1093    Increment the seen count of a key
1094
1095=cut
1096
1097sub incr_seenkey {
1098  shift; # class method so don't care about class name
1099  my $key = shift;
1100  my $section = shift;
1101  $CONFIG->{state}{seenkeys}{$section}{$key}++;
1102  return;
1103}
1104
1105=head2 get_seenwork
1106
1107    Get the count of occurences of a labelname or labeltitle
1108
1109=cut
1110
1111sub get_seenwork {
1112  shift; # class method so don't care about class name
1113  my $identifier = shift;
1114  return $CONFIG->{state}{seenwork}{$identifier};
1115}
1116
1117=head2 incr_seenwork
1118
1119    Increment the count of occurences of a labelname or labeltitle
1120
1121=cut
1122
1123sub incr_seenwork {
1124  shift; # class method so don't care about class name
1125  my $identifier = shift;
1126  $CONFIG->{state}{seenwork}{$identifier}++;
1127  return;
1128}
1129
1130
1131
1132=head2 reset_seen_extra
1133
1134    Reset the counters for extra*
1135
1136=cut
1137
1138sub reset_seen_extra {
1139  shift; # class method so don't care about class name
1140  my $ay = shift;
1141  $CONFIG->{state}{seen_extrayear} = {};
1142  $CONFIG->{state}{seen_extratitle} = {};
1143  $CONFIG->{state}{seen_extratitleyear} = {};
1144  $CONFIG->{state}{seen_extraalpha} = {};
1145  return;
1146}
1147
1148
1149=head2 incr_seen_extrayear
1150
1151    Increment and return the counter for extrayear
1152
1153=cut
1154
1155sub incr_seen_extrayear {
1156  shift; # class method so don't care about class name
1157  my $ey = shift;
1158  return ++$CONFIG->{state}{seen_extrayear}{$ey};
1159}
1160
1161=head2 incr_seen_extratitle
1162
1163    Increment and return the counter for extratitle
1164
1165=cut
1166
1167sub incr_seen_extratitle {
1168  shift; # class method so don't care about class name
1169  my $et = shift;
1170  return ++$CONFIG->{state}{seen_extratitle}{$et};
1171}
1172
1173=head2 incr_seen_extratitleyear
1174
1175    Increment and return the counter for extratitleyear
1176
1177=cut
1178
1179sub incr_seen_extratitleyear {
1180  shift; # class method so don't care about class name
1181  my $ety = shift;
1182  return ++$CONFIG->{state}{seen_extratitleyear}{$ety};
1183}
1184
1185
1186=head2 incr_seen_extraalpha
1187
1188    Increment and return the counter for extraalpha
1189
1190=cut
1191
1192sub incr_seen_extraalpha {
1193  shift; # class method so don't care about class name
1194  my $ea = shift;
1195  return ++$CONFIG->{state}{seen_extraalpha}{$ea};
1196}
1197
1198
1199=head2 get_seen_nameyear
1200
1201    Get the count of an labelname/labelyear combination for tracking
1202    extrayear. It uses labelyear plus name as we need to disambiguate
1203    entries with different labelyear (like differentiating 1984--1986 from
1204    just 1984)
1205
1206=cut
1207
1208sub get_seen_nameyear {
1209  shift; # class method so don't care about class name
1210  my $ny = shift;
1211  return $CONFIG->{state}{seen_nameyear}{$ny};
1212}
1213
1214=head2 incr_seen_nameyear
1215
1216    Increment the count of an labelname/labelyear combination for extrayear
1217
1218    We pass in the name and year strings seperately as we have to
1219    be careful and only increment this counter beyond 1 if there is
1220    a name component. Otherwise, extrayear gets defined for all
1221    entries with no name but the same year etc.
1222
1223=cut
1224
1225sub incr_seen_nameyear {
1226  shift; # class method so don't care about class name
1227  my ($ns, $ys) = @_;
1228  my $tmp = "$ns,$ys";
1229  # We can always increment this to 1
1230  unless ($CONFIG->{state}{seen_nameyear}{$tmp}) {
1231    $CONFIG->{state}{seen_nameyear}{$tmp}++;
1232  }
1233  # But beyond that only if we have a labelname in the entry since
1234  # this counter is used to create extrayear which doesn't mean anything for
1235  # entries with no name
1236  # We allow empty year so that we generate extrayear for the same name with no year
1237  # so we can do things like "n.d.-a", "n.d.-b" etc.
1238  else {
1239    if ($ns) {
1240      $CONFIG->{state}{seen_nameyear}{$tmp}++;
1241    }
1242  }
1243  return;
1244}
1245
1246
1247=head2 get_seen_nametitle
1248
1249    Get the count of an labelname/labeltitle combination for tracking
1250    extratitle.
1251
1252=cut
1253
1254sub get_seen_nametitle {
1255  shift; # class method so don't care about class name
1256  my $nt = shift;
1257  return $CONFIG->{state}{seen_nametitle}{$nt};
1258}
1259
1260=head2 incr_seen_nametitle
1261
1262    Increment the count of an labelname/labeltitle combination for extratitle
1263
1264    We pass in the name and year strings seperately as we have to
1265    be careful and only increment this counter beyond 1 if there is
1266    a title component. Otherwise, extratitle gets defined for all
1267    entries with no title.
1268
1269=cut
1270
1271sub incr_seen_nametitle {
1272  shift; # class method so don't care about class name
1273  my ($ns, $ts) = @_;
1274  my $tmp = "$ns,$ts";
1275  # We can always increment this to 1
1276  unless ($CONFIG->{state}{seen_nametitle}{$tmp}) {
1277    $CONFIG->{state}{seen_nametitle}{$tmp}++;
1278  }
1279  # But beyond that only if we have a labeltitle in the entry since
1280  # this counter is used to create extratitle which doesn't mean anything for
1281  # entries with no title
1282  else {
1283    if ($ts) {
1284      $CONFIG->{state}{seen_nametitle}{$tmp}++;
1285    }
1286  }
1287  return;
1288}
1289
1290
1291=head2 get_seen_titleyear
1292
1293    Get the count of an labeltitle/labelyear combination for tracking
1294    extratitleyear
1295
1296=cut
1297
1298sub get_seen_titleyear {
1299  shift; # class method so don't care about class name
1300  my $ty = shift;
1301  return $CONFIG->{state}{seen_titleyear}{$ty};
1302}
1303
1304=head2 incr_seen_titleyear
1305
1306    Increment the count of an labeltitle/labelyear combination for extratitleyear
1307
1308    We pass in the title and year strings seperately as we have to
1309    be careful and only increment this counter beyond 1 if there is
1310    a title component. Otherwise, extratitleyear gets defined for all
1311    entries with no title.
1312
1313=cut
1314
1315sub incr_seen_titleyear {
1316  shift; # class method so don't care about class name
1317  my ($ts, $ys) = @_;
1318  my $tmp = "$ts,$ys";
1319  # We can always increment this to 1
1320  unless ($CONFIG->{state}{seen_titleyear}{$tmp}) {
1321    $CONFIG->{state}{seen_titleyear}{$tmp}++;
1322  }
1323  # But beyond that only if we have a labeltitle in the entry since
1324  # this counter is used to create extratitleyear which doesn't mean anything for
1325  # entries with no title
1326  else {
1327    if ($ts) {
1328      $CONFIG->{state}{seen_titleyear}{$tmp}++;
1329    }
1330  }
1331  return;
1332}
1333
1334
1335
1336=head1 uniquelistcount
1337
1338=head2 get_uniquelistcount
1339
1340    Get the number of uniquelist entries for a (possibly partial) list
1341
1342=cut
1343
1344sub get_uniquelistcount {
1345  shift; # class method so don't care about class name
1346  my $namelist = shift;
1347  return $CONFIG->{state}{uniquelistcount}{global}{join("\x{10FFFD}", @$namelist)};
1348}
1349
1350=head2 add_uniquelistcount
1351
1352    Incremenent the count for a list part to the data for a name
1353
1354=cut
1355
1356sub add_uniquelistcount {
1357  shift; # class method so don't care about class name
1358  my $namelist = shift;
1359  $CONFIG->{state}{uniquelistcount}{global}{join("\x{10FFFD}", @$namelist)}++;
1360  return;
1361}
1362
1363=head2 add_uniquelistcount_final
1364
1365    Incremenent the count for a complete list to the data for a name
1366
1367=cut
1368
1369sub add_uniquelistcount_final {
1370  shift; # class method so don't care about class name
1371  my $namelist = shift;
1372  $CONFIG->{state}{uniquelistcount}{global}{final}{join("\x{10FFFD}", @$namelist)}++;
1373  return;
1374}
1375
1376
1377=head2 add_uniquelistcount_minyear
1378
1379    Incremenent the count for a list and year to the data for a name
1380    Used to track uniquelist = minyear
1381
1382=cut
1383
1384sub add_uniquelistcount_minyear {
1385  shift; # class method so don't care about class name
1386  my ($minyearnamelist, $year, $namelist) = @_;
1387  # Allow year a default in case labelname is undef
1388  $CONFIG->{state}{uniquelistcount}{minyear}{join("\x{10FFFD}", @$minyearnamelist)}{$year // '0'}{join("\x{10FFFD}", @$namelist)}++;
1389  return;
1390}
1391
1392=head2 get_uniquelistcount_minyear
1393
1394    Get the count for a list and year to the data for a name
1395    Used to track uniquelist = minyear
1396
1397=cut
1398
1399sub get_uniquelistcount_minyear {
1400  shift; # class method so don't care about class name
1401  my ($minyearnamelist, $year) = @_;
1402  return scalar keys %{$CONFIG->{state}{uniquelistcount}{minyear}{join("\x{10FFFD}", @$minyearnamelist)}{$year}};
1403}
1404
1405
1406
1407=head2 get_uniquelistcount_final
1408
1409    Get the number of uniquelist entries for a full list
1410
1411=cut
1412
1413sub get_uniquelistcount_final {
1414  shift; # class method so don't care about class name
1415  my $namelist = shift;
1416  my $c = $CONFIG->{state}{uniquelistcount}{global}{final}{join("\x{10FFFD}", @$namelist)};
1417  return $c // 0;
1418}
1419
1420
1421=head2 reset_uniquelistcount
1422
1423    Reset the count for list parts and complete lists
1424
1425=cut
1426
1427sub reset_uniquelistcount {
1428  shift; # class method so don't care about class name
1429  $CONFIG->{state}{uniquelistcount} = {};
1430  return;
1431}
1432
1433=head2 list_differs_nth
1434
1435    Returns true if some other list differs at passed nth place
1436    and is at least as long
1437
1438    list_differs_nth([a, b, c, d, e], 3) = 1
1439
1440    if there is another list like any of these:
1441
1442    [a, b, d, e, f]
1443    [a, b, e, z, z, y]
1444
1445=cut
1446
1447sub list_differs_nth {
1448  shift; # class method so don't care about class name
1449  my ($list, $n) = @_;
1450  my @list_one = @$list;
1451  # Loop over all final lists, looking for ones which match:
1452  # * up to n - 1
1453  # * differ at $n
1454  # * are at least as long
1455  foreach my $l_s (keys %{$CONFIG->{state}{uniquelistcount}{global}{final}}) {
1456    my @l = split("\x{10FFFD}", $l_s);
1457    # If list is shorter than the list we are checking, it's irrelevant
1458    next unless $#l >= $#$list;
1459    # If list matches at $n, it's irrelevant;
1460    next if ($list_one[$n-1] eq $l[$n-1]);
1461    # If list doesn't match up to $n - 1, it's irrelevant
1462    next unless Compare([@list_one[0 .. $n-2]], [@l[0 .. $n-2]]);
1463    $logger->trace("list_differs_nth() returning true: " . join(',', @list_one) . " vs " . join(',', @l));
1464    return 1;
1465  }
1466  return 0;
1467}
1468
1469
1470
1471=head2 list_differs_last
1472
1473    Returns true if some list differs from passed list in its last place
1474
1475    list_differs_last([a, b, c]) = 1
1476
1477    if there is another list like any of these:
1478
1479    [a, b, d]
1480    [a, b, d, e]
1481
1482=cut
1483
1484sub list_differs_last {
1485  shift; # class method so don't care about class name
1486  my $list = shift;
1487  my @list_one = @$list;
1488  my $list_last = pop @list_one;
1489
1490  # Loop over all final lists, looking for ones which match up to
1491  # length of list to check minus 1 but which differ in the last place of the
1492  # list to check.
1493  foreach my $l_s (keys %{$CONFIG->{state}{uniquelistcount}{global}{final}}) {
1494    my @l = split("\x{10FFFD}", $l_s);
1495    # If list is shorter than the list we are checking, it's irrelevant
1496    next unless $#l >= $#$list;
1497    # get the list elements up to length of the list we are checking
1498    my @ln = @l[0 .. $#$list];
1499    # pop off the last element which is the potential point of difference
1500    my $ln_last = pop @ln;
1501    if (Compare(\@list_one, \@ln) and ($list_last ne $ln_last)) {
1502      $logger->trace("list_differs_last() returning true: (" . join(',', @list_one) . " vs " . join(',', @ln) . " -> $list_last vs $ln_last)");
1503      return 1;
1504    }
1505  }
1506  return 0;
1507}
1508
1509=head2 list_differs_superset
1510
1511    Returns true if some list differs from passed list by being
1512    identical to the list up to the end of the list but also
1513    by having extra elements after this
1514
1515    list_differs_superset([a, b, c]) = 1
1516
1517    if there is another list like any of these:
1518
1519    [a, b, c, d]
1520    [a, b, c, d, e]
1521
1522=cut
1523
1524sub list_differs_superset {
1525  shift; # class method so don't care about class name
1526  my $list = shift;
1527  # Loop over all final lists, looking for ones which match up to
1528  # length of list to check but which differ after this length
1529  foreach my $l_s (keys %{$CONFIG->{state}{uniquelistcount}{global}{final}}) {
1530    my @l = split("\x{10FFFD}", $l_s);
1531    # If list is not longer than the list we are checking, it's irrelevant
1532    next unless $#l > $#$list;
1533    # get the list elements up to length of the list we are checking
1534    my @ln = @l[0 .. $#$list];
1535    if (Compare($list, \@ln)) {
1536      $logger->trace("list_differs_superset() returning true: (" . join(',', @$list) . " vs " . join(',', @l) . ")");
1537      return 1;
1538    }
1539  }
1540  return 0;
1541}
1542
1543
1544=head1 uniquenamecount
1545
1546=head2 get_numofuniquenames
1547
1548    Get the number of uniquenames entries for a visible name
1549
1550=cut
1551
1552sub get_numofuniquenames {
1553  shift; # class method so don't care about class name
1554  my ($name, $namecontext) = @_;
1555  my $return = scalar keys %{$CONFIG->{state}{uniquenamecount}{$name}{$namecontext}};
1556  $logger->trace("get_numofuniquenames() returning $return for NAME='$name' and NAMECONTEXT='$namecontext'");
1557  return $return;
1558}
1559
1560=head2 get_numofuniquenames_all
1561
1562    Get the number of uniquenames entries for a name
1563
1564=cut
1565
1566sub get_numofuniquenames_all {
1567  shift; # class method so don't care about class name
1568  my ($name, $namecontext) = @_;
1569  my $return = scalar keys %{$CONFIG->{state}{uniquenamecount_all}{$name}{$namecontext}};
1570  $logger->trace("get_numofuniquenames_all() returning $return for NAME='$name' and NAMECONTEXT='$namecontext'");
1571  return $return;
1572}
1573
1574
1575=head2 add_uniquenamecount
1576
1577    Add a name to the list of name contexts which have the name in it
1578    (only called for visible names)
1579
1580=cut
1581
1582sub add_uniquenamecount {
1583  shift; # class method so don't care about class name
1584  my ($name, $namecontext, $key) = @_;
1585  $CONFIG->{state}{uniquenamecount}{$name}{$namecontext}{$key}++;
1586  return;
1587}
1588
1589=head2 add_uniquenamecount_all
1590
1591    Add a name to the list of name contexts which have the name in it
1592    (called for all names)
1593
1594=cut
1595
1596sub add_uniquenamecount_all {
1597  shift; # class method so don't care about class name
1598  my ($name, $namecontext, $key) = @_;
1599  $CONFIG->{state}{uniquenamecount_all}{$name}{$namecontext}{$key}++;
1600  return;
1601}
1602
1603=head2 reset_uniquenamecount
1604
1605    Reset the list of names which have the name part in it
1606
1607=cut
1608
1609sub reset_uniquenamecount {
1610  shift; # class method so don't care about class name
1611  $CONFIG->{state}{uniquenamecount} = {};
1612  $CONFIG->{state}{uniquenamecount_all} = {};
1613  return;
1614}
1615
1616=head2 _get_uniquename
1617
1618    Get the list of name contexts which contain a name
1619    Mainly for use in tests
1620
1621=cut
1622
1623sub _get_uniquename {
1624  shift; # class method so don't care about class name
1625  my ($name, $namecontext) = @_;
1626  my @list = sort keys %{$CONFIG->{state}{uniquenamecount}{$name}{$namecontext}};
1627  return \@list;
1628}
1629
1630=head1 crossrefkeys
1631
1632=head2 get_crossrefkeys
1633
1634    Return ref to array of keys which are crossref targets
1635
1636=cut
1637
1638sub get_crossrefkeys {
1639  shift; # class method so don't care about class name
1640  return [ keys %{$CONFIG->{state}{crossrefkeys}} ];
1641}
1642
1643=head2 get_crossrefkey
1644
1645    Return an integer representing the number of times a
1646    crossref target key has been ref'ed
1647
1648=cut
1649
1650sub get_crossrefkey {
1651  shift; # class method so don't care about class name
1652  my $k = shift;
1653  return $CONFIG->{state}{crossrefkeys}{$k};
1654}
1655
1656=head2 del_crossrefkey
1657
1658    Remove a crossref target key from the crossrefkeys state
1659
1660=cut
1661
1662sub del_crossrefkey {
1663  shift; # class method so don't care about class name
1664  my $k = shift;
1665  if (exists($CONFIG->{state}{crossrefkeys}{$k})) {
1666    delete $CONFIG->{state}{crossrefkeys}{$k};
1667  }
1668  return;
1669}
1670
1671=head2 incr_crossrefkey
1672
1673    Increment the crossreferences count for a target crossref key
1674
1675=cut
1676
1677sub incr_crossrefkey {
1678  shift; # class method so don't care about class name
1679  my $k = shift;
1680  $CONFIG->{state}{crossrefkeys}{$k}++;
1681  return;
1682}
1683
1684
1685############################
1686# Displaymode static methods
1687############################
1688
1689=head2 set_displaymode
1690
1691    Set the display mode for a field.
1692    setdisplaymode(['entrytype'], ['field'], ['citekey'], $value)
1693
1694    This sets the desired displaymode to use for some data in the bib.
1695    Of course, this is entirey seperate semantically from the
1696    displaymodes *defined* in the bib which just tell you what to return
1697    for a particular displaymode request for some data.
1698
1699=cut
1700
1701sub set_displaymode {
1702  shift; # class method so don't care about class name
1703  my ($val, $entrytype, $fieldtype, $citekey) = @_;
1704  if ($citekey) {
1705    if ($fieldtype) {
1706      $CONFIG->{displaymodes}{PER_FIELD}{$citekey}{$fieldtype} = $val;
1707    }
1708    else {
1709      $CONFIG->{displaymodes}{PER_ENTRY}{$citekey} = $val;
1710    }
1711  }
1712  elsif ($fieldtype) {
1713    $CONFIG->{displaymodes}{PER_FIELDTYPE}{$fieldtype} = $val;
1714  }
1715  elsif ($entrytype) {
1716    $CONFIG->{displaymodes}{PER_ENTRYTYPE}{$entrytype} = $val;
1717  }
1718  else {
1719    $CONFIG->{displaymodes}{GLOBAL} = $val ;
1720  }
1721}
1722
1723=head2 get_displaymode
1724
1725    Get the display mode for a field.
1726    getdisplaymode(['entrytype'], ['field'], ['citekey'])
1727
1728    Returns the displaymode. In order of decreasing preference, returns:
1729    1. Mode defined for a specific field in a specific citekey
1730    2. Mode defined for a citekey
1731    3. Mode defined for a fieldtype (any citekey)
1732    4. Mode defined for an entrytype (any citekey)
1733    5. Mode defined globally (any citekey)
1734
1735=cut
1736
1737sub get_displaymode {
1738  shift; # class method so don't care about class name
1739  my ($entrytype, $fieldtype, $citekey) = @_;
1740  my $dm;
1741  if ($citekey) {
1742    if ($fieldtype and
1743      defined($CONFIG->{displaymodes}{PER_FIELD}) and
1744      defined($CONFIG->{displaymodes}{PER_FIELD}{$citekey}) and
1745      defined($CONFIG->{displaymodes}{PER_FIELD}{$citekey}{$fieldtype})) {
1746      $dm = $CONFIG->{displaymodes}{PER_FIELD}{$citekey}{$fieldtype};
1747    }
1748    elsif (defined($CONFIG->{displaymodes}{PER_ENTRY}) and
1749      defined($CONFIG->{displaymodes}{PER_ENTRY}{$citekey})) {
1750      $dm = $CONFIG->{displaymodes}{PER_ENTRY}{$citekey};
1751    }
1752  }
1753  elsif ($fieldtype and
1754    defined($CONFIG->{displaymodes}{PER_FIELDTYPE}) and
1755    defined($CONFIG->{displaymodes}{PER_FIELDTYPE}{$fieldtype})) {
1756    $dm = $CONFIG->{displaymodes}{PER_FIELDTYPE}{$fieldtype};
1757  }
1758  elsif ($entrytype and
1759    defined($CONFIG->{displaymodes}{PER_ENTRYTYPE}) and
1760    defined($CONFIG->{displaymodes}{PER_ENTRYTYPE}{$entrytype})) {
1761    $dm = $CONFIG->{displaymodes}{PER_ENTRYTYPE}{$entrytype};
1762  }
1763  $dm = $CONFIG->{displaymodes}{'*'} unless $dm; # Global if nothing else;
1764  return $dm;
1765}
1766
1767=head2 dump
1768
1769    Dump config information (for debugging)
1770
1771=cut
1772
1773sub dump {
1774  shift; # class method so don't care about class name
1775  dd($CONFIG);
1776}
1777
17781;
1779
1780__END__
1781
1782=head1 AUTHORS
1783
1784François Charette, C<< <firmicus at ankabut.net> >>
1785Philip Kime C<< <philip at kime.org.uk> >>
1786
1787=head1 BUGS
1788
1789Please report any bugs or feature requests on our Github tracker at
1790L<https://github.com/plk/biber/issues>.
1791
1792=head1 COPYRIGHT & LICENSE
1793
1794Copyright 2009-2015 François Charette and Philip Kime, all rights reserved.
1795
1796This module is free software.  You can redistribute it and/or
1797modify it under the terms of the Artistic License 2.0.
1798
1799This program is distributed in the hope that it will be useful,
1800but without any warranty; without even the implied warranty of
1801merchantability or fitness for a particular purpose.
1802
1803=cut
1804