1package Biber::Entry::Name;
2use v5.16;
3use strict;
4use warnings;
5
6use Regexp::Common qw( balanced );
7use Biber::Config;
8use Data::Dump qw( pp );
9use Log::Log4perl qw( :no_extra_logdie_message );
10use List::Util qw( first );
11use Unicode::Normalize;
12my $logger = Log::Log4perl::get_logger('main');
13
14=encoding utf-8
15
16=head1 NAME
17
18Biber::Entry::Name
19
20=head2 new
21
22    Initialize a Biber::Entry::Name object, optionally with key=>value arguments.
23
24    Ex: Biber::Entry::Name->new( lastname=>"Bolzmann", firstname=>"Anna Maria", prefix => "von" )
25
26=cut
27
28sub new {
29  my ($class, %params) = @_;
30  if (%params) {
31    my $name = {};
32    foreach my $attr (qw/gender
33                         lastname
34                         lastname_i
35                         firstname
36                         firstname_i
37                         middlename
38                         middlename_i
39                         prefix
40                         prefix_i
41                         suffix
42                         suffix_i
43                         namestring
44                         nameinitstring
45                         strip/) {
46      if (exists $params{$attr}) {
47        $name->{$attr} = $params{$attr}
48      }
49    }
50    return bless $name, $class;
51  } else {
52    return bless {}, $class;
53  }
54}
55
56=head2 TO_JSON
57
58   Serialiser for JSON::XS::encode
59
60=cut
61
62sub TO_JSON {
63  my $self = shift;
64  my $json;
65  while (my ($k, $v) = each(%{$self})) {
66    $json->{$k} = $v;
67  }
68  return $json;
69}
70
71=head2 notnull
72
73    Test for an empty object
74
75=cut
76
77sub notnull {
78  my $self = shift;
79  my @arr = keys %$self;
80  return $#arr > -1 ? 1 : 0;
81}
82
83
84=head2 was_stripped
85
86    Return boolean to tell if the passed field had braces stripped from the original
87
88=cut
89
90sub was_stripped {
91  my ($self, $part) = @_;
92  return exists($self->{strip}) ? $self->{strip}{$part} : undef;
93}
94
95=head2 set_hash
96
97    Set a hash for the name
98
99=cut
100
101sub set_hash {
102  my ($self, $hash) = @_;
103  $self->{hash} = $hash;
104  return;
105}
106
107=head2 get_hash
108
109    Get a hash for the name
110
111=cut
112
113sub get_hash {
114  my $self = shift;
115  return $self->{hash};
116}
117
118
119
120=head2 set_index
121
122    Set a field telling what position in the name list the name is
123
124=cut
125
126sub set_index {
127  my ($self, $index) = @_;
128  $self->{index} = $index;
129  return;
130}
131
132=head2 get_index
133
134    Get the index of a Biber::Entry::Name object
135
136=cut
137
138sub get_index {
139  my $self = shift;
140  return $self->{index};
141}
142
143
144=head2 set_uniquename
145
146    Set uniquename for a visible Biber::Entry::Name object
147    Sets global flag to say that some uniquename value has changed
148
149=cut
150
151sub set_uniquename {
152  my ($self, $uniquename) = @_;
153  my $currval = $self->{uniquename};
154
155  # Set modified flag to positive if we change something
156  if (not defined($currval) or $currval != $uniquename) {
157    Biber::Config->set_unul_changed(1);
158  }
159  $logger->trace('Setting uniquename for "' . $self->get_namestring . '" to ' . $uniquename);
160  $self->{uniquename} = $uniquename;
161  return;
162}
163
164=head2 set_uniquename_all
165
166    Set uniquename for a Biber::Entry::Name object
167
168=cut
169
170sub set_uniquename_all {
171  my ($self, $uniquename) = @_;
172
173  $logger->trace('Setting uniquename_all for "' . $self->get_namestring . '" to ' . $uniquename);
174  $self->{uniquename_all} = $uniquename;
175  return;
176}
177
178
179=head2 get_uniquename
180
181    Get uniquename for a visible Biber::Entry::Name object
182
183=cut
184
185sub get_uniquename {
186  my $self = shift;
187  return $self->{uniquename};
188}
189
190=head2 get_uniquename_all
191
192    Get uniquename for a Biber::Entry::Name object
193
194=cut
195
196sub get_uniquename_all {
197  my $self = shift;
198  return $self->{uniquename_all};
199}
200
201
202=head2 reset_uniquename
203
204    Reset uniquename for a Biber::Entry::Name object
205
206=cut
207
208sub reset_uniquename {
209  my $self = shift;
210  $self->{uniquename} = 0;
211  return;
212}
213
214
215=head2 set_minimal_info
216
217    Set the string of lastnames and string of fullnames
218    Used to track uniquename=5 or 6
219
220=cut
221
222sub set_minimal_info {
223  my ($self, $lns) = @_;
224  $self->{lastnames_string} = $lns;
225  return;
226}
227
228
229=head2 get_minimal_info
230
231    Get the name context used to track uniquename=5 or 6
232
233=cut
234
235sub get_minimal_info {
236  my $self = shift;
237  return $self->{lastnames_string};
238}
239
240
241=head2 get_namepart
242
243    Get a namepart by passed name
244
245=cut
246
247sub get_namepart {
248  my ($self, $namepart) = @_;
249  return $self->{$namepart};
250}
251
252
253=head2 set_firstname
254
255    Set firstname for a Biber::Entry::Name object
256
257=cut
258
259sub set_firstname {
260  my ($self, $val) = @_;
261  $self->{firstname} = $val;
262  return;
263}
264
265=head2 get_firstname
266
267    Get firstname for a Biber::Entry::Name object
268
269=cut
270
271sub get_firstname {
272  my $self = shift;
273  return $self->{firstname};
274}
275
276=head2 get_firstname_i
277
278    Get firstname initials for a Biber::Entry::Name object
279
280=cut
281
282sub get_firstname_i {
283  my $self = shift;
284  return $self->{firstname_i};
285}
286
287
288=head2 set_middlename
289
290    Set middlename for a Biber::Entry::Name object
291
292=cut
293
294sub set_middlename {
295  my ($self, $val) = @_;
296  $self->{middlename} = $val;
297  return;
298}
299
300=head2 get_middlename
301
302    Get middlename for a Biber::Entry::Name object
303
304=cut
305
306sub get_middlename {
307  my $self = shift;
308  return $self->{middlename};
309}
310
311=head2 get_middlename_i
312
313    Get middlename initials for a Biber::Entry::Name object
314
315=cut
316
317sub get_middlename_i {
318  my $self = shift;
319  return $self->{middlename_i};
320}
321
322
323=head2 set_lastname
324
325    Set lastname for a Biber::Entry::Name object
326
327=cut
328
329sub set_lastname {
330  my ($self, $val) = @_;
331  $self->{lastname} = $val;
332  return;
333}
334
335=head2 get_lastname
336
337    Get lastname for a Biber::Entry::Name object
338
339=cut
340
341sub get_lastname {
342  my $self = shift;
343  return $self->{lastname};
344}
345
346=head2 get_lastname_i
347
348    Get lastname initials for a Biber::Entry::Name object
349
350=cut
351
352sub get_lastname_i {
353  my $self = shift;
354  return $self->{lastname_i};
355}
356
357
358=head2 set_suffix
359
360    Set suffix for a Biber::Entry::Name object
361
362=cut
363
364sub set_suffix {
365  my ($self, $val) = @_;
366  $self->{suffix} = $val;
367  return;
368}
369
370=head2 get_suffix
371
372    Get suffix for a Biber::Entry::Name object
373
374=cut
375
376sub get_suffix {
377  my $self = shift;
378  return $self->{suffix};
379}
380
381=head2 get_suffix_i
382
383    Get suffix initials for a Biber::Entry::Name object
384
385=cut
386
387sub get_suffix_i {
388  my $self = shift;
389  return $self->{suffix_i};
390}
391
392
393=head2 set_prefix
394
395    Set prefix for a Biber::Entry::Name object
396
397=cut
398
399sub set_prefix {
400  my ($self, $val) = @_;
401  $self->{prefix} = $val;
402  return;
403}
404
405=head2 get_prefix
406
407    Get prefix for a Biber::Entry::Name object
408
409=cut
410
411sub get_prefix {
412  my $self = shift;
413  return $self->{prefix};
414}
415
416=head2 get_prefix_i
417
418    Get prefix initials for a Biber::Entry::Name object
419
420=cut
421
422sub get_prefix_i {
423  my $self = shift;
424  return $self->{prefix_i};
425}
426
427
428=head2 set_gender
429
430    Set gender for a Biber::Entry::Name object
431
432=cut
433
434sub set_gender {
435  my ($self, $val) = @_;
436  $self->{gender} = $val;
437  return;
438}
439
440=head2 get_gender
441
442    Get gender for a Biber::Entry::Name object
443
444=cut
445
446sub get_gender {
447  my $self = shift;
448  return $self->{gender};
449}
450
451
452
453=head2 set_namestring
454
455    Set namestring for a Biber::Entry::Name object
456
457=cut
458
459sub set_namestring {
460  my ($self, $val) = @_;
461  $self->{namestring} = $val;
462  return;
463}
464
465=head2 get_namestring
466
467    Get namestring for a Biber::Entry::Name object
468
469=cut
470
471sub get_namestring {
472  my $self = shift;
473  return $self->{namestring};
474}
475
476=head2 set_nameinitstring
477
478    Set nameinitstring for a Biber::Entry::Name object
479
480=cut
481
482sub set_nameinitstring {
483  my ($self, $val) = @_;
484  $self->{nameinitstring} = $val;
485  return;
486}
487
488=head2 get_nameinitstring
489
490    Get nameinitstring for a Biber::Entry::Name object
491
492=cut
493
494sub get_nameinitstring {
495  my $self = shift;
496  return $self->{nameinitstring};
497}
498
499=head2 name_to_biblatexml {
500
501    Create biblatexml data for a name
502
503=cut
504
505sub name_to_biblatexml {
506  my $self = shift;
507  my $xml = shift;
508  my $out = shift;
509  my $xml_prefix = $out->{xml_prefix};
510  $xml->startTag([$xml_prefix, 'person']);
511
512  # lastname
513  _name_part_to_bltxml($xml,
514                       $xml_prefix,
515                       $self->get_lastname,
516                       $self->get_lastname_i,
517                       'last');
518
519  # firstname
520  _name_part_to_bltxml($xml,
521                       $xml_prefix,
522                       $self->get_firstname,
523                       $self->get_firstname_i,
524                       'first');
525
526  # middlename
527  _name_part_to_bltxml($xml,
528                       $xml_prefix,
529                       $self->get_middlename,
530                       $self->get_middlename_i,
531                       'middle');
532
533  # prefix
534  _name_part_to_bltxml($xml,
535                       $xml_prefix,
536                       $self->get_prefix,
537                       $self->get_prefix_i,
538                       'prefix');
539
540  # suffix
541  _name_part_to_bltxml($xml,
542                       $xml_prefix,
543                       $self->get_suffix,
544                       $self->get_suffix_i,
545                       'suffix');
546
547  $xml->endTag(); # Name
548}
549
550sub _name_part_to_bltxml {
551  my ($xml, $xml_prefix, $np, $nip, $npn) = @_;
552  if ($np) {
553    $xml->startTag([$xml_prefix, $npn]);
554    my $parts = [split(/[\s~]/, $np)];
555    for (my $i=0;$i <= $#$parts;$i++) {
556      if (my $init = $nip->[$i]) {
557        $xml->startTag([$xml_prefix, 'namepart'], initial => $init);
558      }
559      else {
560        $xml->startTag([$xml_prefix, 'namepart']);
561      }
562      $xml->characters(NFC($parts->[$i]));
563      $xml->endTag();
564    }
565    $xml->endTag();
566  }
567}
568
569=head2 name_to_bbl {
570
571    Return bbl data for a name
572
573=cut
574
575sub name_to_bbl {
576  my $self = shift;
577
578  my @pno; # per-name options
579  my $pno; # per-name options final string
580
581  # lastname is always defined
582  my $lni;
583  my $ln  = Biber::Utils::join_name($self->get_lastname);
584  if ($self->was_stripped('lastname')) {
585    $ln = Biber::Utils::add_outer($ln);
586  }
587  $lni = join('\bibinitperiod\bibinitdelim ', @{$self->get_lastname_i}) . '\bibinitperiod';
588  $lni =~ s/\p{Pd}/\\bibinithyphendelim /gxms;
589
590  # firstname
591  my $fn;
592  my $fni;
593  if ($fn = $self->get_firstname) {
594    $fn = Biber::Utils::join_name($fn);
595    if ($self->was_stripped('firstname')) {
596      $fn = Biber::Utils::add_outer($fn);
597    }
598    $fni = join('\bibinitperiod\bibinitdelim ', @{$self->get_firstname_i}) . '\bibinitperiod';
599    $fni =~ s/\p{Pd}/\\bibinithyphendelim /gxms;
600  }
601  else {
602    $fn = '';
603    $fni = '';
604  }
605
606  # middlename
607  my $mn;
608  my $mni;
609  if ($mn = $self->get_middlename) {
610    $mn = Biber::Utils::join_name($mn);
611    $mni = join('\bibinitperiod\bibinitdelim ', @{$self->get_middlename_i}) . '\bibinitperiod';
612    $mni =~ s/\p{Pd}/\\bibinithyphendelim /gxms;
613  }
614  else {
615    $mn = '';
616    $mni = '';
617  }
618
619  # prefix
620  my $pre;
621  my $prei;
622  if ($pre = $self->get_prefix) {
623    $pre = Biber::Utils::join_name($pre);
624    if ($self->was_stripped('prefix')) {
625      $pre = Biber::Utils::add_outer($pre);
626    }
627    $prei = join('\bibinitperiod\bibinitdelim ', @{$self->get_prefix_i}) . '\bibinitperiod';
628    $prei =~ s/\p{Pd}/\\bibinithyphendelim /gxms;
629  }
630  else {
631    $pre = '';
632    $prei = '';
633  }
634
635  # suffix
636  my $suf;
637  my $sufi;
638  if ($suf = $self->get_suffix) {
639    $suf = Biber::Utils::join_name($suf);
640    if ($self->was_stripped('suffix')) {
641      $suf = Biber::Utils::add_outer($suf);
642    }
643    $sufi = join('\bibinitperiod\bibinitdelim ', @{$self->get_suffix_i}) . '\bibinitperiod';
644    $sufi =~ s/\p{Pd}/\\bibinithyphendelim /gxms;
645  }
646  else {
647    $suf = '';
648    $sufi = '';
649  }
650
651  # Generate uniquename if uniquename is requested
652  if (defined($self->get_uniquename)) {
653    push @pno, 'uniquename=' . $self->get_uniquename;
654  }
655  # Add the name hash to the options
656  push @pno, 'hash=' . $self->get_hash;
657  $pno = join(',', @pno);
658  # Some data sources support middle names
659  if ($self->get_middlename) {
660    return "        {{$pno}{$ln}{$lni}{$fn}{$fni}{$mn}{$mni}{$pre}{$prei}{$suf}{$sufi}}%\n";
661  }
662  else {
663    return "        {{$pno}{$ln}{$lni}{$fn}{$fni}{$pre}{$prei}{$suf}{$sufi}}%\n";
664  }
665}
666
667=head2 dump
668
669    Dump Biber::Entry::Name object
670
671=cut
672
673sub dump {
674  my $self = shift;
675  return pp($self);
676}
677
6781;
679
680__END__
681
682=head1 AUTHORS
683
684François Charette, C<< <firmicus at ankabut.net> >>
685Philip Kime C<< <philip at kime.org.uk> >>
686
687=head1 BUGS
688
689Please report any bugs or feature requests on our Github tracker at
690L<https://github.com/plk/biber/issues>.
691
692=head1 COPYRIGHT & LICENSE
693
694Copyright 2009-2015 François Charette and Philip Kime, all rights reserved.
695
696This module is free software.  You can redistribute it and/or
697modify it under the terms of the Artistic License 2.0.
698
699This program is distributed in the hope that it will be useful,
700but without any warranty; without even the implied warranty of
701merchantability or fitness for a particular purpose.
702
703=cut
704