9 |
my $DEBUG = 0; |
my $DEBUG = 0; |
10 |
sub setdebug { |
sub setdebug { |
11 |
$DEBUG = 1; |
$DEBUG = 1; |
12 |
print STDERR 'This is Bibulus $Id$; ', "\n"; |
print STDERR 'This is Bibulus $Id$', "\n"; |
13 |
} |
} |
14 |
|
|
15 |
# OO magic: |
# OO magic: |
16 |
require Exporter; |
require Exporter; |
17 |
our @ISA = qw(Exporter); |
our @ISA = qw(Exporter); |
18 |
|
|
|
# Internal block delimiter for use in list2text: |
|
|
my $newblock = '###'; |
|
|
|
|
19 |
|
|
20 |
sub new { |
sub new { |
21 |
my $class = shift; |
my $class = shift; |
25 |
# default: if a title is only xref'ed once, it will be inlined: |
# default: if a title is only xref'ed once, it will be inlined: |
26 |
$self->inlinecrossref(1); |
$self->inlinecrossref(1); |
27 |
|
|
28 |
|
# tell what you're doing! |
29 |
|
$self->verbose(1); |
30 |
|
|
31 |
return $self; |
return $self; |
32 |
} |
} |
33 |
|
|
34 |
|
# set verbosity: |
35 |
|
sub verbose { |
36 |
|
my $self = shift; |
37 |
|
my ($v) = @_; |
38 |
|
$self->{VERBOSE} = $v; |
39 |
|
} |
40 |
|
|
41 |
# add a text to the tree |
# add a text to the tree |
42 |
# (it's not used internally, but it's useful for users |
# (it's not used internally, but it's useful for users |
43 |
# who can do stuff like \bibulusadd{label}{note}{Good book!}) |
# who can do stuff like \bibulusadd{label}{note}{Good book!}) |
67 |
foreach my $n (0..$#{$self->{EL}}) { |
foreach my $n (0..$#{$self->{EL}}) { |
68 |
my $i = $self->{EL}[$n]; |
my $i = $self->{EL}[$n]; |
69 |
my $id = $i->id; |
my $id = $i->id; |
70 |
print "$id: "; |
print "Including $id\n" if $DEBUG; |
71 |
if ($self->{CITES}{$id} != 0) { # crossref'ed entries |
if ($self->{CITES}{$id} != 0) { # crossref'ed entries |
72 |
|
|
73 |
# is it crossref'ed rarely enough? |
# is it crossref'ed rarely enough? |
79 |
my $idj = $j->first_child('crossref')->atts->{id}; |
my $idj = $j->first_child('crossref')->atts->{id}; |
80 |
$idj eq $id or next J; |
$idj eq $id or next J; |
81 |
|
|
82 |
|
print "Inlining $id\n" if $DEBUG; |
83 |
# delete the crossref: |
# delete the crossref: |
84 |
$j->first_child('crossref')->delete; |
$j->first_child('crossref')->delete; |
85 |
|
|
161 |
do 'lang.pl'; # auto-generated from lang/*.dat |
do 'lang.pl'; # auto-generated from lang/*.dat |
162 |
} |
} |
163 |
|
|
164 |
# it is possible to call this multiple times |
# Load XML database file. |
165 |
|
# It is possible to call this function multiple times. |
166 |
sub load { |
sub load { |
167 |
my $self = shift; |
my $self = shift; |
168 |
my ($filename) = @_; |
my ($filename) = @_; |
195 |
foreach my $i (keys %{$self->{HOOK}}) { |
foreach my $i (keys %{$self->{HOOK}}) { |
196 |
$h{$i} = $self->{HOOK}{$i}; |
$h{$i} = $self->{HOOK}{$i}; |
197 |
} |
} |
198 |
|
|
199 |
|
# Count the number of files we're parsing: |
200 |
|
++$self->{DBCOUNTER}; |
201 |
|
# And print a message if needed: |
202 |
|
print "Database file \#$self->{DBCOUNTER}: $filename\n" if $self->{VERBOSE}; |
203 |
|
|
204 |
|
# Let XML::Twig do the parsing and calling of handlers: |
205 |
my $bib = new XML::Twig |
my $bib = new XML::Twig |
206 |
(Id => 'id', |
(Id => 'id', |
207 |
twig_handlers => \%h, |
twig_handlers => \%h, |
549 |
$r .= $self->formatname($d[$i]); |
$r .= $self->formatname($d[$i]); |
550 |
|
|
551 |
if ($i < $#d - 1) { |
if ($i < $#d - 1) { |
552 |
$r .= $self->comma . ' '; |
$r .= $self->comma; |
553 |
} elsif ($i == $#d - 1) { |
} elsif ($i == $#d - 1) { |
554 |
$r .= ' ' . $self->and . ' '; |
$r .= ' ' . $self->and . ' '; |
555 |
} |
} |
645 |
|
|
646 |
sub formatvolnumpages { |
sub formatvolnumpages { |
647 |
my $self = shift; |
my $self = shift; |
648 |
|
my ($vol, $num, $pages) = ('','',''); |
649 |
|
|
650 |
|
my $i = $self->{CUREL}->first_child('volume'); |
651 |
|
if (defined($i)) { |
652 |
|
$vol = $i->text; |
653 |
|
} |
654 |
|
|
655 |
|
$i = $self->{CUREL}->first_child('number'); |
656 |
|
if (defined($i)) { |
657 |
|
$num = $i->text; |
658 |
|
} |
659 |
|
|
660 |
|
$i = $self->{CUREL}->first_child('pages'); |
661 |
|
if (defined($i)) { |
662 |
|
$pages = $i->text; |
663 |
|
} |
664 |
|
|
665 |
$self->{CURR} .= 'XXX'; |
($vol or $num or $pages) and |
666 |
|
$self->{CURR} .= $self->comma . $vol . $num . $pages; |
667 |
} |
} |
668 |
|
|
669 |
sub formatvolume { |
sub formatvolume { |
670 |
my $self = shift; |
my $self = shift; |
671 |
|
|
672 |
$self->{CURR} .= 'XXX'; |
my $i = $self->{CUREL}->first_child('volume'); |
673 |
|
|
674 |
|
if (defined($i)) { |
675 |
|
my $t = $i->text; |
676 |
|
$self->{CURR} .= $self->comma . $t; |
677 |
|
} |
678 |
|
} |
679 |
|
|
680 |
|
sub getfield { |
681 |
|
my $self = shift; |
682 |
|
my $field = shift; # 'year', 'volume', etc. |
683 |
|
my $obl = 0; |
684 |
|
@_ and $_[0] and $obl = 1; |
685 |
|
|
686 |
|
my $i = $self->{CUREL}->first_child($field); |
687 |
|
unless (defined($i)) { |
688 |
|
warn "No <$field> for id = ", $self->{CUREL}->atts->{id}, ".\n" |
689 |
|
if $obl; |
690 |
|
return ''; |
691 |
|
} |
692 |
|
|
693 |
|
return $i->text; |
694 |
} |
} |
695 |
|
|
696 |
sub formatdate { |
sub formatdate { |
697 |
my $self = shift; |
my $self = shift; |
698 |
|
|
699 |
$self->{CURR} .= 'XXX'; |
my $t = $self->getfield('year', 1); |
700 |
|
$t and $self->{CURR} .= $self->comma . $t; |
701 |
} |
} |
702 |
|
|
703 |
sub formatedition { |
sub formatedition { |
704 |
my $self = shift; |
my $self = shift; |
705 |
|
|
706 |
$self->{CURR} .= 'XXX'; |
my $t = $self->getfield('edition'); |
707 |
|
$t and $self->{CURR} .= $self->comma . $t; |
708 |
} |
} |
709 |
|
|
710 |
sub formatpublisheraddress { |
sub formatpublisheraddress { |
711 |
my $self = shift; |
my $self = shift; |
712 |
|
|
713 |
$self->{CURR} .= 'XXX'; |
my $t = $self->getfield('publisher'); |
714 |
|
$t and $self->{CURR} .= $self->comma . $t; |
715 |
|
|
716 |
|
$t = $self->getfield('place'); |
717 |
|
$t and $self->{CURR} .= $self->comma . $t; |
718 |
|
|
719 |
} |
} |
720 |
|
|
721 |
sub formatcrossref { |
sub formatcrossref { |
743 |
|
|
744 |
my $t = $i->text; |
my $t = $i->text; |
745 |
|
|
746 |
$self->{CURR} .= $self->comma . ' ' . $t; |
$self->{CURR} .= $self->comma . $t; |
747 |
} |
} |
748 |
|
|
749 |
sub formatrest { |
sub formatrest { |
878 |
return $t; |
return $t; |
879 |
} |
} |
880 |
|
|
|
# This function takes a list of elements and formats them as an entry: |
|
|
sub list2text { |
|
|
my @r = @_; |
|
|
my $i; |
|
|
my $t = ''; |
|
|
|
|
|
$i = 0; |
|
|
while ($i <= $#r) { |
|
|
$r[$i++] or splice(@r, --$i, 1); |
|
|
} |
|
|
|
|
|
pop @r while ($r[$#r] eq $newblock); |
|
|
|
|
|
for ($i = 0; $i <= $#r; ++$i) { |
|
|
if ($r[$i] eq $newblock) { |
|
|
$t .= newblock() unless $r[$i+1] eq $newblock; |
|
|
} elsif ($r[$i]) { |
|
|
$t .= $r[$i]; |
|
|
if ($i == $#r or $r[$i+1] eq $newblock) { |
|
|
$t .= ".\n"; |
|
|
} else { |
|
|
$t .= ", "; |
|
|
} |
|
|
} |
|
|
} |
|
|
return $t; |
|
|
} |
|
|
|
|
881 |
# Output primitives. They should normally be redefined. |
# Output primitives. They should normally be redefined. |
882 |
|
|
883 |
sub bibliography_start { return ''; } |
sub bibliography_start { return ''; } |
959 |
} |
} |
960 |
|
|
961 |
sub comma { |
sub comma { |
962 |
return ','; |
return ', '; |
963 |
} |
} |
964 |
|
|
965 |
1; |
1; |