1 |
package Bibulus; |
package Bibulus; |
2 |
|
|
|
#use strict; |
|
|
#no strict 'refs'; |
|
3 |
use warnings; |
use warnings; |
4 |
use Carp; |
use Carp; |
5 |
use XML::Twig; |
use XML::Twig; |
6 |
|
|
7 |
|
use Bibulus::formatentry; |
8 |
|
use Bibulus::formatting; |
9 |
|
use Bibulus::labels; |
10 |
|
use Bibulus::language; |
11 |
|
use Bibulus::primitives; |
12 |
|
use Bibulus::sorting; |
13 |
|
|
14 |
my $DEBUG = 0; |
my $DEBUG = 0; |
15 |
sub setdebug { |
sub setdebug { |
16 |
$DEBUG = 1; |
$DEBUG = 1; |
38 |
return $self; |
return $self; |
39 |
} |
} |
40 |
|
|
|
sub setmainlang { |
|
|
my $self = shift; |
|
|
my $lang = shift; |
|
|
$self->lang($lang); |
|
|
$self->{MAINLANG} = $lang; |
|
|
} |
|
|
|
|
41 |
# set verbosity: |
# set verbosity: |
42 |
sub verbose { |
sub verbose { |
43 |
my $self = shift; |
my $self = shift; |
174 |
# here there should be a possible to override language strings |
# here there should be a possible to override language strings |
175 |
} |
} |
176 |
|
|
|
# Language files are read for each object so that individual fields |
|
|
# can be easily overridden. |
|
|
sub initlang { |
|
|
my $self = shift; |
|
|
# do 'lang.pl'; # auto-generated from lang/*.dat |
|
|
} |
|
|
|
|
177 |
# Load XML database file. |
# Load XML database file. |
178 |
# It is possible to call this function multiple times. |
# It is possible to call this function multiple times. |
179 |
sub load { |
sub load { |
278 |
} |
} |
279 |
} |
} |
280 |
|
|
|
# Create sort-keys |
|
|
sub gensortkeys { |
|
|
my $self = shift; |
|
|
my $i; |
|
|
foreach $i (@{$self->{EL}}) { |
|
|
my $e = new XML::Twig::Elt('sortkey', sortkey_author($i) . |
|
|
sortkey_year($i)); |
|
|
$e->paste('last_child', $i); |
|
|
} |
|
|
} |
|
|
|
|
|
sub sortkey_author { |
|
|
my ($i) = @_; |
|
|
my $t = $i->first_child('author') or return ''; |
|
|
my $s = $t->first_child('name') or return ''; |
|
|
my $sortkey = $s->first_child('family')->text or return ''; |
|
|
|
|
|
return $sortkey; |
|
|
} |
|
|
|
|
|
sub sortkey_year { |
|
|
my ($i) = @_; |
|
|
my $t = $i->first_child('year'); |
|
|
defined($t) or return 0; |
|
|
my $sortkey = $t->text; |
|
|
|
|
|
return $sortkey; |
|
|
} |
|
|
|
|
|
# sort |
|
|
sub sortbib { |
|
|
my $self = shift; |
|
|
# cmp is really too simplistic, but it'll do for the moment |
|
|
@{$self->{EL}} = sort {$a->first_child('sortkey')->text |
|
|
cmp $b->first_child('sortkey')->text} |
|
|
@{$self->{EL}}; |
|
|
} |
|
|
|
|
|
# make labels |
|
|
|
|
|
sub labels { |
|
|
my $self = shift; |
|
|
if (!defined($self->{STYLE}{cite})) { |
|
|
$self->numlabels; # default |
|
|
} elsif ($self->{STYLE}{cite} eq 'numerical') { |
|
|
$self->numlabels; |
|
|
} elsif ($self->{STYLE}{cite} eq 'ay_alk') { |
|
|
$self->ay_alk_labels; |
|
|
} else { |
|
|
croak "Unknown label type"; |
|
|
} |
|
|
} |
|
|
|
|
|
# special for listing entire databases; the cite key is used as the |
|
|
# label so it may be listed |
|
|
sub citekey_labels { |
|
|
my $self = shift; |
|
|
my $i; |
|
|
foreach $i (@{$self->{EL}}) { |
|
|
my $e = new XML::Twig::Elt('label', $i->atts->{id}); |
|
|
$e->paste('last_child', $i); |
|
|
} |
|
|
} |
|
|
|
|
|
# for the apalike.sty of Oren Patashnik: |
|
|
# \bibitem[author, year]{key} |
|
|
sub ay_alk_labels { |
|
|
my $self = shift; |
|
|
my ($author, $year); |
|
|
my $i; |
|
|
foreach $i (@{$self->{EL}}) { |
|
|
($author, $year) = _authoryear($i); |
|
|
my $e = new XML::Twig::Elt('label', "$author, $year"); |
|
|
$e->paste('last_child', $i); |
|
|
} |
|
|
} |
|
|
|
|
|
# for astronomy family of styles: |
|
|
# \bibitem[\protect\astroncite{author}{year}]{key} |
|
|
sub ay_ast_labels { |
|
|
my $self = shift; |
|
|
my ($author, $year); |
|
|
my $i; |
|
|
foreach $i (@{$self->{EL}}) { |
|
|
($author, $year) = _authoryear($i); |
|
|
my $e = new XML::Twig::Elt('label', "\\protect\\astroncite{$author}{$year}"); |
|
|
$e->paste('last_child', $i); |
|
|
} |
|
|
} |
|
|
|
|
|
sub _authoryear { |
|
|
my ($el) = @_; |
|
|
my $author; |
|
|
if (defined($el->first_child('author')) |
|
|
and defined($el->first_child('author')->first_child('name')) |
|
|
and defined($el->first_child('author')->first_child('name')->first_child('family'))) { |
|
|
$author = $el->first_child('author')->first_child('name')->first_child('family')->text; |
|
|
} else { |
|
|
$author = ''; |
|
|
} |
|
|
my $year = ''; |
|
|
defined($el->first_child('year')) and $year = $el->first_child('year')->text; |
|
|
return ($author, $year); |
|
|
} |
|
|
|
|
|
# uses first three letters of first author's name, regardless of how |
|
|
# many authors |
|
|
sub alph1labels { |
|
|
my $self = shift; |
|
|
my $label; |
|
|
my $i; |
|
|
foreach $i (@{$self->{EL}}) { |
|
|
$label = substr($i->first_child('author')->first_child('name')->first_child('family')->text, 0, 3) . |
|
|
substr($i->first_child('year')->text, -2); |
|
|
my $e = new XML::Twig::Elt('label', $label); |
|
|
$e->paste('last_child', $i); |
|
|
} |
|
|
} |
|
|
|
|
|
# uses first author's whole name |
|
|
sub alphflabels { |
|
|
my $self = shift; |
|
|
my $label; |
|
|
my $i; |
|
|
foreach $i (@{$self->{EL}}) { |
|
|
$label = $i->first_child('author')->first_child('name')->first_child('family')->text . substr($i->first_child('year')->text, -2); |
|
|
my $e = new XML::Twig::Elt('label', $label); |
|
|
$e->paste('last_child', $i); |
|
|
} |
|
|
} |
|
|
|
|
|
# an abbreviation of the author names plus year: First three letters |
|
|
# of single author, or first letters of first three authors. |
|
|
sub alphalabels { |
|
|
my $self = shift; |
|
|
my $label; |
|
|
my $i; |
|
|
my @lastnames; |
|
|
|
|
|
foreach $i (@{$self->{EL}}) { |
|
|
|
|
|
# Get all the last names |
|
|
@lastnames = (); |
|
|
foreach ($i->first_child('author')->children) { |
|
|
push @lastnames, $_->first_child('family')->text; |
|
|
} |
|
|
|
|
|
# Now create the label |
|
|
if (@lastnames == 0) { |
|
|
warn "No lastnames found!"; |
|
|
$label = 'XXX'; |
|
|
} elsif (@lastnames == 1) { |
|
|
$label = substr($lastnames[0], 0, 3); |
|
|
} elsif (@lastnames == 2) { |
|
|
$label = substr($lastnames[0], 0, 1) . substr($lastnames[1], 0, 1); |
|
|
} else { |
|
|
$label = substr($lastnames[0], 0, 1) . substr($lastnames[1], 0, 1) |
|
|
. substr($lastnames[2], 0, 1); |
|
|
} |
|
|
$label .= substr($i->first_child('year')->text, -2); |
|
|
|
|
|
# And add it to the tree |
|
|
my $e = new XML::Twig::Elt('label', $label); |
|
|
$e->paste('last_child', $i); |
|
|
} |
|
|
} |
|
|
|
|
|
# Numerical labels. |
|
|
sub numlabels { |
|
|
my $self = shift; |
|
|
my $label = 1; |
|
|
my $i; |
|
|
foreach $i (@{$self->{EL}}) { |
|
|
my $e = new XML::Twig::Elt('label', $label++); |
|
|
$e->paste('last_child', $i); |
|
|
} |
|
|
} |
|
|
|
|
281 |
# print them |
# print them |
282 |
sub genbib { |
sub genbib { |
283 |
my $self = shift; |
my $self = shift; |
362 |
return $self->{STATE}; |
return $self->{STATE}; |
363 |
} |
} |
364 |
|
|
|
sub formatentry { |
|
|
my $self = shift; |
|
|
my ($e) = @_; |
|
|
my $t; |
|
|
|
|
|
my $attr = $e->atts; |
|
|
|
|
|
$self->setstate('beforeall'); |
|
|
$self->{DIDWRITESOMETHING} = 0; |
|
|
|
|
|
unless (defined($attr->{id})) { # an entry must have an id |
|
|
warn "No ID for entry.\n"; |
|
|
return; |
|
|
} |
|
|
|
|
|
$self->{CUREL} = $e; |
|
|
$self->{CURR} = $self->item_start($attr->{id}, $e->field('label')); |
|
|
|
|
|
my $et = $e->tag; # entry type |
|
|
|
|
|
if ($et eq 'article') { |
|
|
$self->formatauthors; |
|
|
$self->formatnewblock; |
|
|
$self->formattitle(); |
|
|
$self->formatnewblock; |
|
|
if (!defined($e->first_child('crossref'))) { |
|
|
$self->formatjournal; |
|
|
$self->formatvolnumpages; |
|
|
$self->formatdateasyear; |
|
|
} else { |
|
|
$self->formatcrossref; |
|
|
$self->formatpages; |
|
|
} |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'magazine') { |
|
|
$self->formattitle('plain'); |
|
|
$self->formatvolnumpages; |
|
|
$self->formatdateasyear; |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'book') { |
|
|
$self->formateditors; |
|
|
$self->formatauthors; |
|
|
$self->formatnewblock; |
|
|
$self->formattitle('emph'); |
|
|
if (!defined($e->first_child('crossref'))) { |
|
|
$self->formatbvolume; |
|
|
$self->formatnewblock; |
|
|
$self->formatnumberseries; |
|
|
$self->newsentence; |
|
|
$self->formatpublisheraddress; |
|
|
} else { |
|
|
$self->formatcrossref; |
|
|
$self->formatpages; |
|
|
} |
|
|
$self->formatedition; |
|
|
$self->formatdateasyear; |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'booklet') { |
|
|
$self->formatauthors; |
|
|
$self->formatnewblock; |
|
|
$self->formattitle('plain'); |
|
|
$self->formatnewblock |
|
|
unless ($self->empty('howpublished') and $self->empty('address')); |
|
|
$self->formathowpublished; |
|
|
$self->formataddress; |
|
|
$self->formatdateasyear; |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'misc') { |
|
|
$self->formatauthors; |
|
|
$self->formatnewblock |
|
|
unless ($self->empty('howpublished') and $self->empty('title')); |
|
|
$self->formattitle unless $self->empty('title'); |
|
|
$self->formatnewblock unless $self->empty('howpublished'); |
|
|
$self->formathowpublished; |
|
|
$self->formatdateasyear; |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
if ($self->empty('author') and |
|
|
$self->empty('title') and |
|
|
$self->empty('howpublished') and |
|
|
$self->empty('month') and |
|
|
$self->empty('year') and |
|
|
$self->empty('note')) { |
|
|
$self->warning("All relevant fields are empty"); |
|
|
} |
|
|
|
|
|
} elsif ($et eq 'thesis') { |
|
|
$self->formatauthors; |
|
|
$self->formatnewblock; |
|
|
if ($self->getatt('type') eq 'phd') { |
|
|
$self->formattitle('emph'); |
|
|
} else { |
|
|
$self->formattitle('plain'); |
|
|
} |
|
|
$self->formatnewblock; |
|
|
$self->formatthesistype; |
|
|
$self->formatinstitution; |
|
|
$self->formataddress; |
|
|
$self->formatdateasyear; |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'unpublished') { |
|
|
$self->formatauthors; |
|
|
$self->formatnewblock; |
|
|
$self->formattitle('plain'); |
|
|
$self->formatnewblock; |
|
|
# warning: <note> should come before <year>! |
|
|
$self->formatdateasyear; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'report') { |
|
|
$self->formatauthors; |
|
|
$self->formatnewblock; |
|
|
$self->formattitle('plain'); |
|
|
$self->formatnewblock; |
|
|
$self->formattrnumber; |
|
|
$self->formatinstitution; |
|
|
$self->formataddress; |
|
|
$self->formatdateasyear; |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'inbook') { |
|
|
# Some both-and/either-or checking has been removed from next two lines: |
|
|
$self->formateditors; |
|
|
$self->formatauthors; |
|
|
$self->formatnewblock; |
|
|
$self->formattitle('emph'); |
|
|
if($self->empty('crossref')) { |
|
|
$self->formatbvolume; |
|
|
$self->formatchapterpages; |
|
|
$self->formatnewblock; |
|
|
$self->formatnumberseries; |
|
|
$self->newsentence; |
|
|
$self->formatpublisheraddress; |
|
|
} else { |
|
|
$self->formatchapterpages; |
|
|
$self->formatnewblock; |
|
|
$self->formatcrossref; |
|
|
} |
|
|
$self->formatedition; |
|
|
$self->formatdateasyear;; |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'manual') { |
|
|
if($self->empty('author')) { |
|
|
unless($self->empty('institution')) { |
|
|
$self->formatinstitution; |
|
|
$self->formataddress; |
|
|
} |
|
|
} else { |
|
|
$self->formatauthors; |
|
|
} |
|
|
$self->formatnewblock; |
|
|
$self->formattitle('emph'); |
|
|
if($self->empty('author')) { |
|
|
if($self->empty('institution') and !$self->empty('address')) { |
|
|
$self->formatnewblock; |
|
|
$self->formataddress; |
|
|
} |
|
|
} else { |
|
|
$self->formatnewblock |
|
|
unless $self->empty('institution') and $self->empty('address'); |
|
|
$self->formatinstitution; |
|
|
$self->formataddress; |
|
|
} |
|
|
$self->formatedition; |
|
|
$self->formatdateasyear; |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'incollection') { |
|
|
$self->formatauthors; |
|
|
$self->formatnewblock; |
|
|
$self->formattitle('plain'); |
|
|
$self->formatnewblock; |
|
|
if ($self->empty('crossref')) { |
|
|
$self->formatinedbooktitle; |
|
|
$self->formatbvolume; |
|
|
$self->formatnumberseries; |
|
|
$self->formatchapterpages; |
|
|
$self->newsentence; |
|
|
$self->formatpublisher; |
|
|
$self->formataddress; |
|
|
$self->formatedition; |
|
|
$self->formatdateasyear; |
|
|
} else { |
|
|
$self->formatincollinproccrossref; |
|
|
$self->formatpages; |
|
|
} |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'inproceedings') { |
|
|
$self->formatauthors; |
|
|
$self->formatnewblock; |
|
|
$self->formattitle('plain'); |
|
|
$self->formatnewblock; |
|
|
if ($self->empty('crossref')) { |
|
|
$self->formatinedbooktitle; |
|
|
$self->formatbvolume; |
|
|
$self->formatnumberseries; |
|
|
$self->formatpages; |
|
|
if ($self->empty('address')) { |
|
|
$self->empty('institution') and $self->empty('publisher') |
|
|
and $self->newsentence; |
|
|
$self->formatinstitution; |
|
|
$self->formatpublisher; |
|
|
$self->formatdateasyear; |
|
|
} else { |
|
|
$self->formataddress; |
|
|
$self->formatdateasyear; |
|
|
$self->newsentence; |
|
|
$self->formatinstitution; |
|
|
$self->formatpublisher; |
|
|
} |
|
|
} else { |
|
|
$self->formatincollinproccrossref; |
|
|
$self->formatpages; |
|
|
} |
|
|
|
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} elsif ($et eq 'proceedings') { |
|
|
if ($self->empty('editor')) { |
|
|
$self->formatinstitution; |
|
|
} else { |
|
|
$self->formateditors; |
|
|
} |
|
|
$self->formatnewblock; |
|
|
$self->formattitle('emph'); |
|
|
$self->formatbvolume; |
|
|
$self->formatnumberseries; |
|
|
if ($self->empty('address')) { |
|
|
if ($self->empty('editor')) { |
|
|
$self->empty('publisher') and $self->newsentence; |
|
|
} else { |
|
|
$self->empty('institution') and $self->empty('publisher') and $self->newsentence; |
|
|
} |
|
|
$self->formatpublisher; |
|
|
$self->formatdateasyear; |
|
|
} else { |
|
|
$self->formataddress; |
|
|
$self->formatdateasyear; |
|
|
$self->newsentence; |
|
|
$self->empty('editor') or $self->formatinstitution; |
|
|
$self->formatpublisher; |
|
|
} |
|
|
$self->formatnewblock; |
|
|
$self->formatrest; |
|
|
$self->finentry; |
|
|
|
|
|
} else { |
|
|
$self->{CURR} .= " [$et: NOT IMPLEMENTED] "; |
|
|
} |
|
|
|
|
|
$self->{CURR} .= $self->item_end; |
|
|
} |
|
|
|
|
|
sub formatauthors { |
|
|
my $self = shift; |
|
|
|
|
|
|
|
|
my $i = $self->{CUREL}->first_child('author'); |
|
|
unless (defined($i)) { |
|
|
$self->warning("No <author>"); |
|
|
return; |
|
|
} |
|
|
|
|
|
$self->outputtext($self->formatnames($i)); |
|
|
} |
|
|
|
|
|
sub returneditors { |
|
|
my $self = shift; |
|
|
|
|
|
my $i = $self->{CUREL}->first_child('editor'); |
|
|
unless (defined($i)) { |
|
|
$self->warning("No <editor>"); |
|
|
return; |
|
|
} |
|
|
|
|
|
return $self->formatnames($i) . ' (editor)'; |
|
|
} |
|
|
|
|
|
sub formateditors { |
|
|
my $self = shift; |
|
|
|
|
|
$self->outputtext($self->returneditors); |
|
|
} |
|
|
|
|
|
sub formatnames { |
|
|
my $self = shift; |
|
|
|
|
|
my $authed = shift; |
|
|
|
|
|
my $r = ''; |
|
|
my @d = $authed->descendants('name'); |
|
|
foreach my $i (0 .. $#d) { |
|
|
$r .= $self->formatname($d[$i]); |
|
|
|
|
|
if ($i < $#d - 1) { |
|
|
$r .= $self->comma; |
|
|
} elsif ($i == $#d - 1) { |
|
|
$r .= ' ' . $self->and . ' '; |
|
|
} |
|
|
} |
|
|
return $r; |
|
|
} |
|
|
|
|
|
sub formatname { |
|
|
my $self = shift; |
|
|
|
|
|
my $name = shift; |
|
|
|
|
|
my ($given, $von, $family, $extrafamily, $jr) |
|
|
= (perhapstext($name->first_child('given')), |
|
|
perhapstext($name->first_child('von')), |
|
|
perhapstext($name->first_child('family')), |
|
|
perhapstext($name->first_child('extrafamily')), |
|
|
perhapstext($name->first_child('jr'))); |
|
|
|
|
|
my $r = $family; |
|
|
|
|
|
defined($extrafamily) and $r .= ' ' . $extrafamily; |
|
|
|
|
|
defined($von) and $self->{STYLE}{vonbefore} |
|
|
and $r = "$von $r"; |
|
|
|
|
|
defined($given) and $self->{STYLE}{givenbefore} |
|
|
and $r = "$given $r"; |
|
|
|
|
|
defined($given) and !$self->{STYLE}{givenbefore} |
|
|
and $r .= ", $given"; |
|
|
|
|
|
defined($jr) and $r .= ", $von"; |
|
|
|
|
|
return $r; |
|
|
} |
|
|
|
|
|
# if the text field is defined, then return it else undef |
|
|
sub perhapstext { |
|
|
my $e = shift; |
|
|
if (defined($e)) { |
|
|
return $e->text; |
|
|
} else { |
|
|
return undef; |
|
|
} |
|
|
} |
|
|
|
|
|
sub formatnewblock { |
|
|
my $self = shift; |
|
|
|
|
|
$self->getstate ne 'beforeall' |
|
|
and $self->setstate('afterblock'); |
|
|
|
|
|
$self->{DIDWRITESOMETHING} = 0; |
|
|
} |
|
|
|
|
|
sub newsentence { |
|
|
my $self = shift; |
|
|
|
|
|
$self->getstate ne 'afterblock' |
|
|
and $self->getstate ne 'beforeall' |
|
|
and $self->setstate('aftersentence'); |
|
|
$self->{DIDWRITESOMETHING} = 0; |
|
|
} |
|
|
|
|
|
sub finentry { |
|
|
my $self = shift; |
|
|
|
|
|
$self->{CURR} .= $self->fullstop . "\n"; |
|
|
} |
|
|
|
|
|
# Taken from BibTeX: |
|
|
sub output { |
|
|
my $self = shift; |
|
|
my $s = shift; |
|
|
$s and $self->outputnonnull($s); |
|
|
} |
|
|
|
|
|
sub outputcheck { |
|
|
my $self = shift; |
|
|
my $f = shift; |
|
|
my $s = $self->getfield($f); |
|
|
if ($s) { |
|
|
$self->outputnonnull($s); |
|
|
} else { |
|
|
warn("Empty <$f>"); |
|
|
} |
|
|
} |
|
|
|
|
|
sub outputnonnull { |
|
|
my $self = shift; |
|
|
|
|
|
print STDERR "State is ", $self->getstate, ".\n" if $DEBUG; |
|
|
print STDERR "CURR is <<$self->{CURR}>>.\n" if $DEBUG; |
|
|
|
|
|
if ($self->getstate eq 'midsentence') { |
|
|
$self->{CURR} .= $self->comma if $self->{DIDWRITESOMETHING}; |
|
|
} else { |
|
|
if ($self->getstate eq 'afterblock') { |
|
|
$self->{CURR} .= $self->fullstop if $self->canaddperiod; |
|
|
$self->{CURR} .= $self->newblock; |
|
|
} else { |
|
|
if ($self->getstate ne 'beforeall') { |
|
|
$self->{CURR} .= $self->fullstop if $self->canaddperiod; |
|
|
} |
|
|
} |
|
|
$self->setstate('midsentence'); |
|
|
} |
|
|
} |
|
|
|
|
|
# Return true if CURR doesn't end in a period or similar already |
|
|
sub canaddperiod { |
|
|
my $self = shift; |
|
|
if ($self->{CURR} =~ /[\.\?\!]\W*$/) { |
|
|
return 0; |
|
|
} else { |
|
|
return 1; |
|
|
} |
|
|
} |
|
|
|
|
|
sub formattitle { |
|
|
my $self = shift; |
|
|
my $type = shift; |
|
|
|
|
|
my $t = $self->getfield('title', 1); |
|
|
|
|
|
$t = $self->language($self->{CUREL}->inherit_att('xml:lang'), $t); |
|
|
|
|
|
# This approach: |
|
|
defined($type) and $type eq 'emph' and $t = $self->emph($t); |
|
|
# conflicts with this one: |
|
|
if (defined($self->{STYLE}{titlefont})) { |
|
|
if ($self->{STYLE}{titlefont} eq 'emph') { |
|
|
$t = $self->emph($t); |
|
|
} elsif ($self->{STYLE}{titlefont} eq 'bold') { |
|
|
$t = $self->bold($t); |
|
|
} |
|
|
} |
|
|
|
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatjournal { |
|
|
my $self = shift; |
|
|
my $type = shift; |
|
|
|
|
|
|
|
|
my $t = $self->getfield('journal', 1); |
|
|
|
|
|
$t = $self->emph($t); |
|
|
|
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatinstitution { |
|
|
my $self = shift; |
|
|
|
|
|
my $inst = $self->getfield('institution'); |
|
|
|
|
|
$self->outputtext($inst); |
|
|
} |
|
|
|
|
|
sub formatpublisher { |
|
|
my $self = shift; |
|
|
|
|
|
my $publ = $self->getfield('publisher'); |
|
|
|
|
|
$self->outputtext($publ); |
|
|
} |
|
|
|
|
|
sub formatvolnumpages { |
|
|
my $self = shift; |
|
|
|
|
|
|
|
|
my $volume = $self->getfield('volume'); |
|
|
my $number = $self->getfield('number'); |
|
|
my $pages = $self->getfield('pages'); |
|
|
|
|
|
my $t = ''; |
|
|
$t .= $volume if $volume; |
|
|
|
|
|
if ($number) { |
|
|
$t .= "($number)"; |
|
|
$volume or $self->warning("There's a <number> but no <volume>"); |
|
|
} |
|
|
|
|
|
if ($pages) { |
|
|
if ($t) { |
|
|
$t .= ":$pages"; |
|
|
} else { |
|
|
$t = $pages; |
|
|
} |
|
|
} |
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatnumberseries { |
|
|
my $self = shift; |
|
|
|
|
|
$self->getfield('volume') and return; # Skip if there's a volume |
|
|
|
|
|
my $number = $self->getfield('number'); |
|
|
my $series = $self->getfield('series'); |
|
|
|
|
|
my $t = ''; |
|
|
|
|
|
if (!$number) { |
|
|
$t = $series; |
|
|
} else { |
|
|
$self->warning("There's a <number> but no <series>") unless $series; |
|
|
$t .= $self->numberseries($number, $series); |
|
|
} |
|
|
|
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub outputtext { |
|
|
my $self = shift; |
|
|
my $t = shift; |
|
|
if ($t) { |
|
|
# Upcase first letter if necessary (will this work for all languages?): |
|
|
$self->getstate eq 'midsentence' or $t = "\u$t"; |
|
|
|
|
|
# Output punctuation and change state: |
|
|
$self->outputnonnull; |
|
|
|
|
|
# Output the text: |
|
|
$self->{CURR} .= $t; |
|
|
$self->{DIDWRITESOMETHING} = 1; |
|
|
} |
|
|
} |
|
|
|
|
|
sub formatvolume { |
|
|
my $self = shift; |
|
|
|
|
|
my $t = $self->getfield('volume', 1); |
|
|
|
|
|
$t and $t = "volume $t"; |
|
|
|
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatinedbooktitle { |
|
|
my $self = shift; |
|
|
|
|
|
my $t = ''; |
|
|
my $title = $self->getfield('booktitle'); |
|
|
my $editor = $self->getfield('editor'); |
|
|
|
|
|
if ($title) { |
|
|
$t = 'In '; |
|
|
if ($editor) { |
|
|
$t .= $self->returneditors . $self->comma; |
|
|
} |
|
|
$t .= $self->emph($title); |
|
|
} |
|
|
|
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatbvolume { |
|
|
my $self = shift; |
|
|
|
|
|
my $t = ''; |
|
|
my $volume = $self->getfield('volume'); |
|
|
my $series = $self->getfield('series'); |
|
|
my $number = $self->getfield('number'); # only needed for validation! |
|
|
|
|
|
if ($volume) { |
|
|
$t = $self->volume($volume, $series && $self->emph($series)); |
|
|
if ($number) { |
|
|
$self->warning("Can't use both <volume> and <number> fields"); |
|
|
} |
|
|
} |
|
|
|
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatthesistype { |
|
|
my $self = shift; |
|
|
|
|
|
my $type = $self->getatt('type'); |
|
|
|
|
|
if ($type eq 'phd') { |
|
|
$self->outputtext($self->phdthesis); |
|
|
|
|
|
} elsif ($type eq 'master') { |
|
|
$self->outputtext($self->mastersthesis); |
|
|
|
|
|
} else { |
|
|
$self->warning("Unknown or missing type attribute"); |
|
|
} |
|
|
} |
|
|
|
|
|
sub formatdateasyear { |
|
|
my $self = shift; |
|
|
|
|
|
my $t = $self->getfield('year', 1); |
|
|
|
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formathowpublished { |
|
|
my $self = shift; |
|
|
|
|
|
my $t = $self->getfield('howpublished'); |
|
|
|
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatedition { |
|
|
my $self = shift; |
|
|
|
|
|
|
|
|
my $t = $self->getfield('edition'); |
|
|
|
|
|
$t and $t = $self->edition($t); |
|
|
|
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatpublisheraddress { |
|
|
my $self = shift; |
|
|
|
|
|
my $t = $self->getfield('publisher'); |
|
|
$self->outputtext($t); |
|
|
|
|
|
$t = $self->getfield('place'); |
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formataddress { |
|
|
my $self = shift; |
|
|
|
|
|
my $t = $self->getfield('place'); |
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatcrossref { |
|
|
my $self = shift; |
|
|
|
|
|
my $i = $self->{CUREL}->first_child('crossref'); |
|
|
unless (defined($i)) { |
|
|
$self->warning("No <crossref>"); |
|
|
return; |
|
|
} |
|
|
|
|
|
my $t = $i->atts->{id}; |
|
|
|
|
|
$self->outputtext($self->in($self->outputcite($t))); |
|
|
} |
|
|
|
|
|
sub formatchapterpages { |
|
|
my $self = shift; |
|
|
|
|
|
my $pages = $self->getfield('pages'); |
|
|
my $chapter = $self->getfield('chapter'); |
|
|
|
|
|
if (!$chapter) { |
|
|
$self->formatpages; |
|
|
} else { |
|
|
# TYPE has been eliminated -- might come in again as attribute |
|
|
my $t = $self->chapter($chapter); |
|
|
$pages and $t .= ", $pages"; |
|
|
$self->outputtext($t); |
|
|
} |
|
|
} |
|
|
|
|
|
sub formattrnumber { |
|
|
my $self = shift; |
|
|
|
|
|
my $number = $self->getfield('number'); |
|
|
|
|
|
# TYPE has been eliminated -- might come in again as attribute |
|
|
my $t = $self->technicalreport($number); |
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatpages { |
|
|
my $self = shift; |
|
|
|
|
|
my $t = $self->getfield('pages', 1); |
|
|
|
|
|
$self->outputtext($t); |
|
|
} |
|
|
|
|
|
sub formatrest { |
|
|
my $self = shift; |
|
|
|
|
|
# handle notes, annotations, ISBN & ISSN numbers etc. here |
|
|
|
|
|
my $i = $self->{CUREL}->first_child('note'); |
|
|
if (defined($i)) { |
|
|
my $t = $i->text; |
|
|
$self->outputtext($t); |
|
|
} |
|
|
} |
|
|
|
|
|
# Output primitives. They should normally be redefined. |
|
|
|
|
|
sub bibliography_start { return ''; } |
|
|
|
|
|
sub bibliography_end { return ''; } |
|
|
|
|
|
sub item_start { |
|
|
my $self = shift; |
|
|
my ($id, $label) = @_; |
|
|
defined($label) and return brackets($label) or return brackets($id); |
|
|
} |
|
|
|
|
|
sub item_end { return ''; } |
|
|
|
|
|
sub newblock { return ''; } |
|
|
|
|
|
sub brackets { |
|
|
my $self = shift; |
|
|
my ($t) = @_; |
|
|
|
|
|
defined($t) or return ''; |
|
|
|
|
|
return '[' . $t . ']'; |
|
|
} |
|
|
|
|
|
sub emph { |
|
|
my $self = shift; |
|
|
my ($t) = @_; |
|
|
return '_' . $t . '_'; |
|
|
} |
|
|
|
|
|
sub bold { |
|
|
my ($t) = @_; |
|
|
return '*' . $t . '*'; |
|
|
} |
|
|
|
|
|
sub smallcaps { |
|
|
my ($t) = @_; |
|
|
return uc($t); |
|
|
} |
|
|
|
|
|
sub fullcaps { |
|
|
my ($t) = @_; |
|
|
return uc($t); |
|
|
} |
|
|
|
|
|
sub singlequote { |
|
|
my ($t) = @_; |
|
|
return "'$t'"; |
|
|
} |
|
|
|
|
|
sub doublequote { |
|
|
my ($t) = @_; |
|
|
return "\"$t\""; |
|
|
} |
|
|
|
|
|
sub outputcite { |
|
|
my $self = shift; |
|
|
my $c = shift; |
|
|
return "\\cite{$c}"; |
|
|
} |
|
|
|
|
|
sub nobreakspace { |
|
|
return ' '; |
|
|
} |
|
|
|
|
|
# Language stuff |
|
|
sub lang { |
|
|
my $self = shift; |
|
|
if (@_) { |
|
|
my $l = shift; |
|
|
if ($l =~ /^(en|da)$/) { # accepted languages |
|
|
$self->{LANG} = $l; |
|
|
} else { |
|
|
warn "Language $l unknown.\n"; |
|
|
} |
|
|
} |
|
|
return $self->{LANG}; |
|
|
} |
|
|
|
|
|
# This is magic: Whenever a function in Bibulus::Lang is called |
|
|
# that doesn't exist, this function will search for it in the |
|
|
# relevant language module. |
|
|
# E.g., if Bibulus::mastersthesis is called and |
|
|
# $self->{LANG} eq 'da', then Bibulus:da:mastersthesis |
|
|
# will be called instead (and that will presumably return 'speciale'). |
|
|
sub AUTOLOAD { |
|
|
my ($self) = @_; |
|
|
my ($pkg, $meth) = $AUTOLOAD =~ /(.*)::(.*)/; |
|
|
$meth =~ /DESTROY/ and return; |
|
|
eval "require Bibulus::$self->{LANG}" or die $@; |
|
|
$meth = "Bibulus::$self->{LANG}::$meth"; |
|
|
goto &$meth; |
|
|
} |
|
|
|
|
|
1; |
|
365 |
|
|
366 |
1; |
1; |
367 |
__END__ |
__END__ |