summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/source/bibtex/biber/lib/Biber/Input/file/bibtex.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/source/bibtex/biber/lib/Biber/Input/file/bibtex.pm')
-rw-r--r--Master/texmf-dist/source/bibtex/biber/lib/Biber/Input/file/bibtex.pm820
1 files changed, 820 insertions, 0 deletions
diff --git a/Master/texmf-dist/source/bibtex/biber/lib/Biber/Input/file/bibtex.pm b/Master/texmf-dist/source/bibtex/biber/lib/Biber/Input/file/bibtex.pm
new file mode 100644
index 00000000000..0eb684d21e7
--- /dev/null
+++ b/Master/texmf-dist/source/bibtex/biber/lib/Biber/Input/file/bibtex.pm
@@ -0,0 +1,820 @@
+package Biber::Input::file::bibtex;
+#use feature 'unicode_strings';
+use sigtrap qw(handler TBSIG SEGV);
+use strict;
+use warnings;
+use Carp;
+
+use Text::BibTeX 0.50 qw(:nameparts :joinmethods :metatypes);
+use Text::BibTeX::Name;
+use Text::BibTeX::NameFormat;
+use Biber::Constants;
+use Biber::Entries;
+use Biber::Entry;
+use Biber::Entry::Names;
+use Biber::Entry::Name;
+use Biber::Sections;
+use Biber::Section;
+use Biber::Structure;
+use Biber::Utils;
+use Biber::Config;
+use Encode;
+use File::Spec;
+use Log::Log4perl qw(:no_extra_logdie_message);
+use base 'Exporter';
+use List::AllUtils qw(first);
+use XML::LibXML::Simple;
+
+my $logger = Log::Log4perl::get_logger('main');
+
+our $cache = {};
+
+# Handlers for field types
+# The names of these have nothing to do whatever with the biblatex field types
+# They just started out copying them - they are categories of this specific
+# data source date types
+my %handlers = (
+ 'date' => \&_date,
+ 'list' => \&_list,
+ 'literal' => \&_literal,
+ 'name' => \&_name,
+ 'range' => \&_range,
+ 'verbatim' => \&_verbatim
+);
+
+
+# we assume that the driver config file is in the same dir as the driver:
+(my $vol, my $driver_path, undef) = File::Spec->splitpath( $INC{"Biber/Input/file/bibtex.pm"} );
+
+# Deal with the strange world of Par::Packer paths, see similar code in Biber.pm
+my $dcf;
+if ($driver_path =~ m|/par\-| and $driver_path !~ m|/inc|) { # a mangled PAR @INC path
+ $dcf = File::Spec->catpath($vol, "$driver_path/inc/lib/Biber/Input/file", 'bibtex.dcf');
+}
+else {
+ $dcf = File::Spec->catpath($vol, $driver_path, 'bibtex.dcf');
+}
+
+# Read driver config file
+my $dcfxml = XML::LibXML::Simple::XMLin($dcf,
+ 'ForceContent' => 1,
+ 'ForceArray' => [
+ qr/\Aentry-type\z/,
+ qr/\Afield\z/,
+ ],
+ 'NsStrip' => 1,
+ 'KeyAttr' => ['name']);
+
+# Check we have the right driver
+unless ($dcfxml->{driver} eq 'bibtex') {
+ $logger->logdie("Expected driver config type 'bibtex', got '" . $dcfxml->{driver} . "'");
+}
+
+=head2 TBSIG
+
+ Signal handler to catch fatal Text::BibTex SEGFAULTS. It has bugs
+ and we want to say at least something if it coredumps
+
+=cut
+
+sub TBSIG {
+ my $sig = shift;
+ $logger->logdie("Caught signal: $sig\nLikely your .bib has a bad entry: $!");
+}
+
+=head2 extract_entries
+
+ Main data extraction routine.
+ Accepts a data source identifier, preprocesses the file and then
+ looks for the passed keys, creating entries when it finds them and
+ passes out an array of keys it didn't find.
+
+=cut
+
+sub extract_entries {
+ my ($biber, $filename, $keys) = @_;
+ my $secnum = $biber->get_current_section;
+ my $section = $biber->sections->get_section($secnum);
+ my $bibentries = $section->bibentries;
+ my @rkeys = @$keys;
+ my $tf; # Up here so that the temp file has enough scope to survive until we've
+ # used it
+ $logger->trace("Entering extract_entries()");
+
+ # If it's a remote .bib file, fetch it first
+ if ($filename =~ m/\A(?:https?|ftp):/xms) {
+ $logger->info("Data source '$filename' is a remote .bib - fetching ...");
+ require LWP::Simple;
+ require File::Temp;
+ $tf = File::Temp->new(SUFFIX => '.bib');
+ unless (LWP::Simple::getstore($filename, $tf->filename) == 200) {
+ $logger->logdie ("Could not fetch file '$filename'");
+ }
+ $filename = $tf->filename;
+ }
+ else {
+ # Need to get the filename even if using cache so we increment
+ # the filename count for preambles at the bottom of this sub
+ my $trying_filename = $filename;
+ unless ($filename = locate_biber_file($filename)) {
+ $logger->logdie("Cannot find file '$trying_filename'!")
+ }
+ }
+
+ # Text::BibTeX can't be controlled by Log4perl so we have to do something clumsy
+ if (Biber::Config->getoption('quiet')) {
+ open OLDERR, '>&', \*STDERR;
+ open STDERR, '>', '/dev/null';
+ }
+
+ # Don't read the file again if it's already cached
+ unless ($cache->{data}{$filename}) {
+ $logger->debug("Caching data for bibtex format file '$filename' for section $secnum");
+ cache_data($biber, $filename);
+ }
+ else {
+ $logger->debug("Using cached data for bibtex format file '$filename' for section $secnum");
+ }
+
+ if ($section->is_allkeys) {
+ $logger->debug("All cached citekeys will be used for section '$secnum'");
+ # Loop over all entries, creating objects
+ while (my (undef, $entry) = each %{$cache->{data}{$filename}}) {
+ # We have to pass the datasource cased (and UTF-8ed) key to
+ # create_entry() as this sub needs to know the original case of the
+ # citation key so we can do case-insensitive key/entry comparisons
+ # later but we need to put the original citation case when we write
+ # the .bbl. If we lowercase before this, we lose this information.
+ # Of course, with allkeys, "citation case" means "datasource entry case"
+ create_entry($biber, decode_utf8($entry->key), $entry);
+ }
+
+ # if allkeys, push all bibdata keys into citekeys (if they are not already there)
+ $section->add_citekeys($section->bibentries->sorted_keys);
+ $logger->debug("Added all citekeys to section '$secnum': " . join(', ', $section->get_citekeys));
+ }
+ else {
+ # loop over all keys we're looking for and create objects
+ $logger->debug('Text::BibTeX cache keys: ' . join(', ', keys %{$cache->{data}{$filename}}));
+ $logger->debug('Wanted keys: ' . join(', ', @$keys));
+ foreach my $wanted_key (@$keys) {
+ $logger->debug("Looking for key '$wanted_key' in Text::BibTeX cache");
+ # Cache index keys are lower-cased. This next line effectively implements
+ # case insensitive citekeys
+ if (my $entry = $cache->{data}{$filename}{lc($wanted_key)}) {
+ $logger->debug("Found key '$wanted_key' in Text::BibTeX cache");
+ # See comment above about the importance of the case of the key
+ # passed to create_entry()
+ create_entry($biber, $wanted_key, $entry);
+ # found a key, remove it from the list of keys we want
+ @rkeys = grep {$wanted_key ne $_} @rkeys;
+ }
+ $logger->debug('Wanted keys now: ' . join(', ', @rkeys));
+ }
+ }
+
+ if (Biber::Config->getoption('quiet')) {
+ open STDERR, '>&', \*OLDERR;
+ }
+
+ # Only push the preambles from the file if we haven't seen this data file before
+ # and there are some preambles to push
+ if ($cache->{counts}{$filename} < 2 and @{$cache->{preamble}{$filename}}) {
+ push @{$biber->{preamble}}, @{$cache->{preamble}{$filename}};
+ }
+
+ return @rkeys;
+}
+
+=head2 create_entry
+
+ Create a Biber::Entry object from a Text::BibTeX object
+
+=cut
+
+sub create_entry {
+ my ($biber, $dskey, $entry) = @_;
+ my $secnum = $biber->get_current_section;
+ my $section = $biber->sections->get_section($secnum);
+ my $bibentries = $section->bibentries;
+
+ # Want a version of the key that is the same case as any citations which
+ # reference it, in case they are different. We use this as the .bbl
+ # entry key
+ # In case of allkeys, this will just be the datasource key as ->get_citekeys
+ # returns an empty list
+ my $citekey = first {lc($dskey) eq lc($_)} $section->get_citekeys;
+ $citekey = $dskey unless $citekey;
+ my $lc_key = lc($dskey);
+
+ my $bibentry = new Biber::Entry;
+ # We record the original keys of both the datasource and citation. They may differ in case.
+ $bibentry->set_field('dskey', $dskey);
+ $bibentry->set_field('citekey', $citekey);
+
+ if ( $entry->metatype == BTE_REGULAR ) {
+
+ # Set entrytype taking note of any aliases for this datasource driver
+ if (my $ealias = $dcfxml->{'entry-types'}{'entry-type'}{$entry->type}) {
+ $bibentry->set_field('entrytype', $ealias->{aliasof}{content});
+ if (my $alsoset = $ealias->{alsoset}) {
+ unless ($bibentry->field_exists($alsoset->{target})) {
+ $bibentry->set_field($alsoset->{target}, $alsoset->{value});
+ }
+ }
+ }
+ else {
+ $bibentry->set_field('entrytype', $entry->type);
+ }
+
+ # We put all the fields we find modulo field aliases into the object
+ # validation happens later and is not datasource dependent
+ foreach my $f ($entry->fieldlist) {
+ # We have to process local options as early as possible in order
+ # to make them available for things that need them like parsename()
+ if ($f eq 'options') {
+ my $value = decode_utf8($entry->get($f));
+ $biber->process_entry_options($dskey, $value);
+ }
+
+ if (my $fm = $dcfxml->{fields}{field}{$f}) {
+ my $to = $f; # By default, field to set internally is the same as data source
+ # Redirect any alias
+ if (my $alias = $fm->{aliasof}) {
+ $logger->debug("Found alias '$alias' of field '$f' in entry '$dskey'");
+ # If both a field and its alias is set, warn and delete alias field
+ if ($entry->exists($alias)) {
+ # Warn as that's wrong
+ $biber->biber_warn($bibentry, "Field '$f' is aliased to field '$alias' but both are defined in entry with key '$dskey' - skipping field '$f'");
+ next;
+ }
+ $fm = $dcfxml->{fields}{field}{$alias};
+ $to = $alias; # Field to set internally is the alias
+ }
+ &{$handlers{$fm->{handler}}}($biber, $bibentry, $entry, $f, $to, $dskey);
+ }
+ # Default if no explicit way to set the field
+ else {
+ my $value = decode_utf8($entry->get($f));
+ $bibentry->set_datafield($f, $value);
+ }
+ }
+
+ $bibentry->set_field('datatype', 'bibtex');
+ $bibentries->add_entry($lc_key, $bibentry);
+ }
+
+ return;
+}
+
+
+# Literal fields
+sub _literal {
+ my ($biber, $bibentry, $entry, $f, $to, $dskey) = @_;
+ my $value = decode_utf8($entry->get($f));
+
+ # If we have already split some date fields into literal fields
+ # like date -> year/month/day, don't overwrite them with explicit
+ # year/month
+ return if ($to eq 'year' and $bibentry->get_datafield('year'));
+ return if ($to eq 'month' and $bibentry->get_datafield('month'));
+
+ # Try to sanitise months to biblatex requirements
+ if ($to eq 'month') {
+ $bibentry->set_datafield($to, _hack_month($value));
+ }
+ else {
+ $bibentry->set_datafield($to, $value);
+ }
+ return;
+}
+
+# Verbatim fields
+sub _verbatim {
+ my ($biber, $bibentry, $entry, $f, $to, $dskey) = @_;
+ my $value = decode_utf8($entry->get($f));
+ $bibentry->set_datafield($to, $value);
+ return;
+}
+
+# Range fields
+sub _range {
+ my ($biber, $bibentry, $entry, $f, $to, $dskey) = @_;
+ my $values_ref;
+ my @values = split(/\s*,\s*/, decode_utf8($entry->get($f)));
+ # Here the "-–" contains two different chars even though they might
+ # look the same in some fonts ...
+ # If there is a range sep, then we set the end of the range even if it's null
+ # If no range sep, then the end of the range is undef
+ foreach my $value (@values) {
+ $value =~ m/\A\s*([^-–]+)([-–]*)([^-–]*)\s*\z/xms;
+ my $end;
+ if ($2) {
+ $end = $3;
+ }
+ else {
+ $end = undef;
+ }
+ push @$values_ref, [$1 || '', $end];
+ }
+ $bibentry->set_datafield($to, $values_ref);
+ return;
+}
+
+
+# Names
+sub _name {
+ my ($biber, $bibentry, $entry, $f, $to, $dskey) = @_;
+ my $secnum = $biber->get_current_section;
+ my $section = $biber->sections->get_section($secnum);
+ my @tmp = $entry->split($f);
+ my $lc_key = lc($dskey);
+ my $useprefix = Biber::Config->getblxoption('useprefix', $bibentry->get_field('entrytype'), $lc_key);
+ my $names = new Biber::Entry::Names;
+ foreach my $name (@tmp) {
+
+ # Consecutive "and" causes Text::BibTeX::Name to segfault
+ unless ($name) {
+ $biber->biber_warn($bibentry, "Name in key '$dskey' is empty (probably consecutive 'and'): skipping name");
+ $section->del_citekey($dskey);
+ next;
+ }
+
+ $name = decode_utf8($name);
+
+ # Check for malformed names in names which aren't completely escaped
+
+ # Too many commas
+ unless ($name =~ m/\A{.+}\z/xms) { # Ignore these tests for escaped names
+ my @commas = $name =~ m/,/g;
+ if ($#commas > 1) {
+ $biber->biber_warn($bibentry, "Name \"$name\" has too many commas: skipping name");
+ $section->del_citekey($dskey);
+ next;
+ }
+
+ # Consecutive commas cause Text::BibTeX::Name to segfault
+ if ($name =~ /,,/) {
+ $biber->biber_warn($bibentry, "Name \"$name\" is malformed (consecutive commas): skipping name");
+ $section->del_citekey($dskey);
+ next;
+ }
+ }
+
+ $names->add_element(parsename($name, $f, {useprefix => $useprefix}));
+ }
+ $bibentry->set_datafield($to, $names);
+ return;
+}
+
+# Dates
+sub _date {
+ my ($biber, $bibentry, $entry, $f, $to, $dskey) = @_;
+ my ($datetype) = $f =~ m/\A(.*)date\z/xms;
+ my $date = decode_utf8($entry->get($f));
+ # We are not validating dates here, just syntax parsing
+ my $date_re = qr/(\d{4}) # year
+ (?:-(\d{2}))? # month
+ (?:-(\d{2}))? # day
+ /xms;
+ if (my ($byear, $bmonth, $bday, $r, $eyear, $emonth, $eday) =
+ $date =~ m|\A$date_re(/)?(?:$date_re)?\z|xms) {
+ # did this entry get its year/month fields from splitting an ISO8601 date field?
+ # We only need to know this for date, year/month as year/month can also
+ # be explicitly set. It makes a difference on how we do any potential future
+ # date validation
+ $bibentry->set_field('datesplit', 1) if $datetype eq '';
+ # Some warnings for overwriting YEAR and MONTH from DATE
+ if ($byear and
+ ($datetype . 'year' eq 'year') and
+ $entry->get('year')) {
+ $biber->biber_warn($bibentry, "Overwriting field 'year' with year value from field 'date' for entry '$dskey'");
+ }
+ if ($bmonth and
+ ($datetype . 'month' eq 'month') and
+ $entry->get('month')) {
+ $biber->biber_warn($bibentry, "Overwriting field 'month' with month value from field 'date' for entry '$dskey'");
+ }
+
+ $bibentry->set_datafield($datetype . 'year', $byear) if $byear;
+ $bibentry->set_datafield($datetype . 'month', $bmonth) if $bmonth;
+ $bibentry->set_datafield($datetype . 'day', $bday) if $bday;
+ $bibentry->set_datafield($datetype . 'endmonth', $emonth) if $emonth;
+ $bibentry->set_datafield($datetype . 'endday', $eday) if $eday;
+ if ($r and $eyear) { # normal range
+ $bibentry->set_datafield($datetype . 'endyear', $eyear);
+ }
+ elsif ($r and not $eyear) { # open ended range - endyear is defined but empty
+ $bibentry->set_datafield($datetype . 'endyear', '');
+ }
+ }
+ else {
+ $biber->biber_warn($bibentry, "Invalid format '$date' of date field '$f' in entry '$dskey' - ignoring");
+ }
+ return;
+}
+
+# List fields
+sub _list {
+ my ($biber, $bibentry, $entry, $f, $to, $dskey) = @_;
+ my @tmp = $entry->split($f);
+
+ @tmp = map { decode_utf8($_) } @tmp;
+ @tmp = map { remove_outer($_) } @tmp;
+ $bibentry->set_datafield($to, [ @tmp ]);
+ return;
+}
+
+
+
+=head2 cache_data
+
+ Caches file data into T::B objects indexed by the original
+ datasource key, decoded into UTF8
+
+=cut
+
+sub cache_data {
+ my ($biber, $filename) = @_;
+
+ # Initialise this
+ $cache->{preamble}{$filename} = [];
+
+ # Convert/decode file
+ my $pfilename = preprocess_file($biber, $filename);
+
+ my $bib = Text::BibTeX::File->new( $pfilename, '<' )
+ or $logger->logdie("Cannot create Text::BibTeX::File object from $pfilename: $!");
+ while ( my $entry = new Text::BibTeX::Entry $bib ) {
+
+ if ( $entry->metatype == BTE_PREAMBLE ) {
+ push @{$cache->{preamble}{$filename}}, decode_utf8($entry->value);
+ next;
+ }
+
+ # Ignore misc bibtex entry types we don't care about
+ next if ( $entry->metatype == BTE_MACRODEF or $entry->metatype == BTE_UNKNOWN
+ or $entry->metatype == BTE_COMMENT );
+
+ # If an entry has no key, ignore it and warn
+ unless ($entry->key) {
+ $logger->warn("Invalid or undefined BibTeX entry key in file '$pfilename', skipping ...");
+ next;
+ }
+
+ # Text::BibTeX >= 0.46 passes through all citekey bits, thus allowing utf8 keys
+ my $dskey = decode_utf8($entry->key);
+
+ # Bad entry
+ unless ($entry->parse_ok) {
+ $logger->warn("Entry $dskey does not parse correctly: skipping");
+ next;
+ }
+
+ # Cache the entry so we don't have to read the file again on next pass.
+ # Two reasons - So we avoid T::B macro redef warnings and speed
+ $cache->{data}{$filename}{lc($dskey)} = $entry;
+ $logger->debug("Cached Text::BibTeX entry for key '$dskey' from bibtex file '$filename'");
+ }
+
+ $bib->close; # If we don't do this, we can't unlink the temp file on Windows
+
+ unlink $pfilename if -e $pfilename;
+
+ return;
+}
+
+
+=head2 preprocess_file
+
+ Convert file to UTF-8 and potentially decode LaTeX macros to UTF-8
+
+=cut
+
+sub preprocess_file {
+ my ($biber, $filename) = @_;
+ my $secnum = $biber->get_current_section;
+ my $section = $biber->sections->get_section($secnum);
+
+ my $ufilename = "${filename}_$$.utf8";
+
+ # bib encoding is not UTF-8
+ if (Biber::Config->getoption('bibencoding') ne 'UTF-8') {
+ require File::Slurp::Unicode;
+ my $buf = File::Slurp::Unicode::read_file($filename, encoding => Biber::Config->getoption('bibencoding'))
+ or $logger->logdie("Can't read $filename");
+
+ File::Slurp::Unicode::write_file($ufilename, {encoding => 'UTF-8'}, $buf)
+ or $logger->logdie("Can't write $ufilename");
+
+ }
+ else {
+ File::Copy::copy($filename, $ufilename);
+ }
+
+ # Decode LaTeX to UTF8 if output is UTF-8
+ if (Biber::Config->getoption('bblencoding') eq 'UTF-8') {
+ require File::Slurp::Unicode;
+ my $buf = File::Slurp::Unicode::read_file($ufilename, encoding => 'UTF-8')
+ or $logger->logdie("Can't read $ufilename");
+ require Biber::LaTeX::Recode;
+ $logger->info('Decoding LaTeX character macros into UTF-8');
+ $buf = Biber::LaTeX::Recode::latex_decode($buf, strip_outer_braces => 1,
+ scheme => Biber::Config->getoption('decodecharsset'));
+
+ File::Slurp::Unicode::write_file($ufilename, {encoding => 'UTF-8'}, $buf)
+ or $logger->logdie("Can't write $ufilename");
+ }
+
+ # Increment the number of times each datafile has been referenced
+ # For example, a datafile might be referenced in more than one section.
+ # Some things find this information useful, for example, setting preambles is global
+ # and so we need to know if we've already saved the preamble for a datafile.
+ $cache->{counts}{$filename}++;
+
+ return $ufilename;
+}
+
+=head2 parsename
+
+ Given a name string, this function returns a Biber::Entry::Name object
+ with all parts of the name resolved according to the BibTeX conventions.
+
+ parsename('John Doe')
+ returns an object which internally looks a bit like this:
+
+ { firstname => 'John',
+ firstname_i => 'J.',
+ firstname_it => 'J',
+ lastname => 'Doe',
+ lastname_i => 'D.',
+ lastname_it => 'D',
+ prefix => undef,
+ prefix_i => undef,
+ prefix_it => undef,
+ suffix => undef,
+ suffix_i => undef,
+ suffix_it => undef,
+ namestring => 'Doe, John',
+ nameinitstring => 'Doe_J',
+ strip => {'firstname' => 0,
+ 'lastname' => 0,
+ 'prefix' => 0,
+ 'suffix' => 0}
+ }
+
+=cut
+
+sub parsename {
+ my ($namestr, $fieldname, $opts) = @_;
+ $logger->debug(" Parsing namestring '$namestr'");
+ my $usepre = $opts->{useprefix};
+ # First sanitise the namestring due to Text::BibTeX::Name limitations on whitespace
+ $namestr =~ s/\A\s*//xms; # leading whitespace
+ $namestr =~ s/\s*\z//xms; # trailing whitespace
+ $namestr =~ s/\s+/ /g; # Collapse internal whitespace
+
+ open OLDERR, '>&', \*STDERR;
+ open STDERR, '>', '/dev/null';
+ my $name = new Text::BibTeX::Name($namestr);
+ open STDERR, '>&', \*OLDERR;
+
+ # Formats so we can get BibTeX compatible nbsp inserted
+ my $l_f = new Text::BibTeX::NameFormat('l', 0);
+ my $f_f = new Text::BibTeX::NameFormat('f', 0);
+ my $p_f = new Text::BibTeX::NameFormat('v', 0);
+ my $s_f = new Text::BibTeX::NameFormat('j', 0);
+ $l_f->set_options(BTN_LAST, 0, BTJ_MAYTIE, BTJ_NOTHING);
+ $f_f->set_options(BTN_FIRST, 0, BTJ_MAYTIE, BTJ_NOTHING);
+ $p_f->set_options(BTN_VON, 0, BTJ_MAYTIE, BTJ_NOTHING);
+ $s_f->set_options(BTN_JR, 0, BTJ_MAYTIE, BTJ_NOTHING);
+
+ # Generate name parts
+ my $lastname = decode_utf8($name->format($l_f));
+ my $firstname = decode_utf8($name->format($f_f));
+ my $prefix = decode_utf8($name->format($p_f));
+ my $suffix = decode_utf8($name->format($s_f));
+
+ # Variables to hold either the Text::BibTeX::NameFormat generated initials
+ # or our own generated ones in case we are using a broken version of Text::BibTeX
+ my $gen_lastname_i;
+ my $gen_lastname_it;
+ my $gen_firstname_i;
+ my $gen_firstname_it;
+ my $gen_prefix_i;
+ my $gen_prefix_it;
+ my $gen_suffix_i;
+ my $gen_suffix_it;
+
+ # Use a copy of $name so that when we generate the
+ # initials, we do so without certain things. This is easier than trying
+ # hack robust initials code into btparse ...
+ # This is a hard-coded hack
+ my $nd_namestr = $namestr;
+ $nd_namestr =~ s/\b\p{L}{2}\p{Pd}//gxms; # strip prefices
+ $nd_namestr =~ s/[\x{2bf}\x{2018}]//gxms; # strip specific diacritics
+ my $nd_name = new Text::BibTeX::Name($nd_namestr, $fieldname);
+
+ # Initials formats
+ my $li_f = new Text::BibTeX::NameFormat('l', 1);
+ my $fi_f = new Text::BibTeX::NameFormat('f', 1);
+ my $pi_f = new Text::BibTeX::NameFormat('v', 1);
+ my $si_f = new Text::BibTeX::NameFormat('j', 1);
+
+ # Truncated initials formats
+ my $lit_f = new Text::BibTeX::NameFormat('l', 1);
+ my $fit_f = new Text::BibTeX::NameFormat('f', 1);
+ my $pit_f = new Text::BibTeX::NameFormat('v', 1);
+ my $sit_f = new Text::BibTeX::NameFormat('j', 1);
+
+ # Period following normal initials
+ $li_f->set_text(BTN_LAST, undef, undef, undef, '.');
+ $fi_f->set_text(BTN_FIRST, undef, undef, undef, '.');
+ $pi_f->set_text(BTN_VON, undef, undef, undef, '.');
+ $si_f->set_text(BTN_JR, undef, undef, undef, '.');
+ $li_f->set_options(BTN_LAST, 1, BTJ_MAYTIE, BTJ_NOTHING);
+ $fi_f->set_options(BTN_FIRST, 1, BTJ_MAYTIE, BTJ_NOTHING);
+ $pi_f->set_options(BTN_VON, 1, BTJ_MAYTIE, BTJ_NOTHING);
+ $si_f->set_options(BTN_JR, 1, BTJ_MAYTIE, BTJ_NOTHING);
+
+ # Nothing following truncated initials
+ $lit_f->set_text(BTN_LAST, undef, undef, undef, '');
+ $fit_f->set_text(BTN_FIRST, undef, undef, undef, '');
+ $pit_f->set_text(BTN_VON, undef, undef, undef, '');
+ $sit_f->set_text(BTN_JR, undef, undef, undef, '');
+ $lit_f->set_options(BTN_LAST, 1, BTJ_NOTHING, BTJ_NOTHING);
+ $fit_f->set_options(BTN_FIRST, 1, BTJ_NOTHING, BTJ_NOTHING);
+ $pit_f->set_options(BTN_VON, 1, BTJ_NOTHING, BTJ_NOTHING);
+ $sit_f->set_options(BTN_JR, 1, BTJ_NOTHING, BTJ_NOTHING);
+
+ $gen_lastname_i = decode_utf8($nd_name->format($li_f));
+ $gen_lastname_it = decode_utf8($nd_name->format($lit_f));
+ $gen_firstname_i = decode_utf8($nd_name->format($fi_f));
+ $gen_firstname_it = decode_utf8($nd_name->format($fit_f));
+ $gen_prefix_i = decode_utf8($nd_name->format($pi_f));
+ $gen_prefix_it = decode_utf8($nd_name->format($pit_f));
+ $gen_suffix_i = decode_utf8($nd_name->format($si_f));
+ $gen_suffix_it = decode_utf8($nd_name->format($sit_f));
+
+ # Only warn about lastnames since there should always be one
+ $logger->warn("Couldn't determine Last Name for name \"$namestr\"") unless $lastname;
+
+ my $namestring = '';
+ # prefix
+ my $ps;
+ my $prefix_stripped;
+ my $prefix_i;
+ my $prefix_it;
+ if ($prefix) {
+ $prefix_i = $gen_prefix_i;
+ $prefix_it = $gen_prefix_it;
+ $prefix_stripped = remove_outer($prefix);
+ $ps = $prefix ne $prefix_stripped ? 1 : 0;
+ $namestring .= "$prefix_stripped ";
+ }
+ # lastname
+ my $ls;
+ my $lastname_stripped;
+ my $lastname_i;
+ my $lastname_it;
+ if ($lastname) {
+ $lastname_i = $gen_lastname_i;
+ $lastname_it = $gen_lastname_it;
+ $lastname_stripped = remove_outer($lastname);
+ $ls = $lastname ne $lastname_stripped ? 1 : 0;
+ $namestring .= "$lastname_stripped, ";
+ }
+ # suffix
+ my $ss;
+ my $suffix_stripped;
+ my $suffix_i;
+ my $suffix_it;
+ if ($suffix) {
+ $suffix_i = $gen_suffix_i;
+ $suffix_it = $gen_suffix_it;
+ $suffix_stripped = remove_outer($suffix);
+ $ss = $suffix ne $suffix_stripped ? 1 : 0;
+ $namestring .= "$suffix_stripped, ";
+ }
+ # firstname
+ my $fs;
+ my $firstname_stripped;
+ my $firstname_i;
+ my $firstname_it;
+ if ($firstname) {
+ $firstname_i = $gen_firstname_i;
+ $firstname_it = $gen_firstname_it;
+ $firstname_stripped = remove_outer($firstname);
+ $fs = $firstname ne $firstname_stripped ? 1 : 0;
+ $namestring .= "$firstname_stripped";
+ }
+
+ # Remove any trailing comma and space if, e.g. missing firstname
+ # Replace any nbspes
+ $namestring =~ s/,\s+\z//xms;
+ $namestring =~ s/~/ /gxms;
+
+ # Construct $nameinitstring
+ my $nameinitstr = '';
+ $nameinitstr .= $prefix_it . '_' if ( $usepre and $prefix );
+ $nameinitstr .= $lastname if $lastname;
+ $nameinitstr .= '_' . $suffix_it if $suffix;
+ $nameinitstr .= '_' . $firstname_it if $firstname;
+ $nameinitstr =~ s/\s+/_/g;
+ $nameinitstr =~ s/~/_/g;
+
+ # The "strip" entry tells us which of the name parts had outer braces
+ # stripped during processing so we can add them back when printing the
+ # .bbl so as to maintain maximum BibTeX compatibility
+ return Biber::Entry::Name->new(
+ firstname => $firstname eq '' ? undef : $firstname_stripped,
+ firstname_i => $firstname eq '' ? undef : $firstname_i,
+ firstname_it => $firstname eq '' ? undef : $firstname_it,
+ lastname => $lastname eq '' ? undef : $lastname_stripped,
+ lastname_i => $lastname eq '' ? undef : $lastname_i,
+ lastname_it => $lastname eq '' ? undef : $lastname_it,
+ prefix => $prefix eq '' ? undef : $prefix_stripped,
+ prefix_i => $prefix eq '' ? undef : $prefix_i,
+ prefix_it => $prefix eq '' ? undef : $prefix_it,
+ suffix => $suffix eq '' ? undef : $suffix_stripped,
+ suffix_i => $suffix eq '' ? undef : $suffix_i,
+ suffix_it => $suffix eq '' ? undef : $suffix_it,
+ namestring => $namestring,
+ nameinitstring => $nameinitstr,
+ strip => {'firstname' => $fs,
+ 'lastname' => $ls,
+ 'prefix' => $ps,
+ 'suffix' => $ss}
+ );
+}
+
+
+# Routine to try to hack month into the right biblatex format
+# Especially since we support remote .bibs which we potentially have no control over
+my %months = (
+ 'jan' => '01',
+ 'feb' => '02',
+ 'mar' => '03',
+ 'apr' => '04',
+ 'may' => '05',
+ 'jun' => '06',
+ 'jul' => '07',
+ 'aug' => '08',
+ 'sep' => '09',
+ 'oct' => '10',
+ 'nov' => '11',
+ 'dec' => '12'
+ );
+
+sub _hack_month {
+ my $in_month = shift;
+ if ($in_month =~ m/\A\s*((?:jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec).*)\s*\z/i) {
+ return $months{lc(substr($1,0,3))};
+ }
+ else {
+ return $in_month;
+ }
+}
+
+
+1;
+
+__END__
+
+=pod
+
+=encoding utf-8
+
+=head1 NAME
+
+Biber::Input::file::bibtex - look in a BibTeX file for an entry and create it if found
+
+=head1 DESCRIPTION
+
+Provides the extract_entries() method to get entries from a bibtex data source
+and instantiate Biber::Entry objects for what it finds
+
+=head1 AUTHOR
+
+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
+
+# vim: set tabstop=2 shiftwidth=2 expandtab: