1 # This module is part of da_reference, and is released under the terms
2 # of the GPL version 2, or any later version, at your option. See the
3 # file README and COPYING for more information.
4 # Copyright 2004 by Don Armstrong <don@donarmstrong.com>.
5 # $Id: Bibtex.pm 45 2013-09-10 18:05:31Z don $
7 package Reference::Output::Bibtex;
11 Reference::Output::Bibtex -- Output references in BibTeX format
15 print bibtex($reference);
17 Returns a reference formatted in bibtex format.
21 Knows how to handle the reference-> bibtex field mapping for many
22 reference types, but overridden types may need to provide their own
34 use vars qw($REVISION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS);
36 use base qw(Exporter);
38 use Encode qw(encode_utf8 is_utf8 decode decode_utf8);
43 ($REVISION) = q$LastChangedRevision: 45 $ =~ /\$LastChangedRevision:\s+([^\s+])/;
44 $DEBUG = 0 unless defined $DEBUG;
48 %EXPORT_TAGS = (output => [qw(bibtex)],
50 Exporter::export_ok_tags(qw(output));
51 $EXPORT_TAGS{all} = [@EXPORT_OK];
55 # Assigned and discussed at the end of this file
59 use Params::Validate qw(:types validate_with);
65 print bibtex $reference;
66 %bibtex = bibtex $reference;
67 print bibtex($reference,mapping=>{...})
69 In scalar context, returns a formatted bibtex entry, suitable for
70 printing. In list context, returns a hash of key, value pairs which
71 can be used to print a formatted bibtex entry.
73 You can also pass an optional mapping to be used for making the bibtex
74 entry. See B<bibtex_mapping> for the details.
76 The mappings are obeyed in the following order, the first taking
77 precedence over the last.
83 =item Object's bibtex_mapping
85 =item Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping)
89 Returns a SCALAR bibtex reference in scalar context, a HASH bibtex
90 reference in list context
95 my $reference = shift;
97 # Parse options if any
98 my %param = validate_with(params => \@_,
99 spec => {mapping => {type => HASHREF,
107 # Use our mapping by default if it exists
108 $mapping = $bibtex_mapping{lc($reference->{type})} if exists $bibtex_mapping{lc($reference->{type})};
109 # Override that with the module's mapping
110 $mapping = $reference->{bibtex_mapping} if exists $reference->{bibtex_mapping};
111 # Finally, override everything with passed mapping
112 $mapping = $param{mapping} if exists $param{mapping};
114 if (not defined $mapping) {
115 carp "This reference type doesn't support bibtex output.";
120 foreach my $bibtex_field (keys %{$mapping->{mapping}}) {
122 if (ref $bibtex_field) {
123 $params = $$bibtex_field{params} if exists $$bibtex_field{params};
124 $bibtex_field = $$bibtex_field{field};
126 my $function = $reference->can($mapping->{mapping}->{$bibtex_field});
127 next unless $function;
128 $bibtex_entry{$bibtex_field} = &{$function}($reference,output=>'bibtex',@$params);
129 # dereference the entries if necessesary.
130 next unless wantarray;
131 # Make new copies of the entries if necessary so we can
132 # mogrify to our hearts content.
133 if (ref($bibtex_entry{$bibtex_field}) eq 'HASH') {
134 $bibtex_entry{$bibtex_field} = {%{$bibtex_entry{$bibtex_field}}};
136 elsif (ref($bibtex_entry{$bibtex_field}) eq 'ARRAY') {
137 $bibtex_entry{$bibtex_field} = [@{$bibtex_entry{$bibtex_field}}];
140 # Return the entries in hash form if desired.
141 return %bibtex_entry if wantarray;
142 # Ok, stich the bibtex entry together...
144 $bibtex_entry = '@'.$mapping->{order}[0].'{'.encode_utf8(convert_to_utf8($bibtex_entry{$mapping->{order}[0]})).",\n";
145 foreach my $bibtex_field (@{$mapping->{order}}[1..$#{$mapping->{order}}]) {
146 next unless defined $bibtex_entry{$bibtex_field};
147 if (ref $bibtex_entry{$bibtex_field} eq 'ARRAY') {
148 next unless @{$bibtex_entry{$bibtex_field}};
149 if (ref $mapping->{mapping}{$bibtex_field}) {
150 if (exists $mapping->{mapping}{$bibtex_field}{code}) {
151 local $_ = $bibtex_entry{$bibtex_field};
152 eval $mapping->{mapping}{$bibtex_field}{code};
153 carp "Error while executing code to assemble bibtex entry: $@" if $@;
155 elsif (exists $mapping->{mapping}{$bibtex_field}{join}) {
156 $bibtex_entry{$bibtex_field} = join($mapping->{mapping}{$bibtex_field}{join},
157 @{$bibtex_entry{$bibtex_field}});
160 carp "$bibtex_field is an ARRAYREF, joining using commas";
161 $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}});
165 carp "$bibtex_field is an ARRAYREF, joining using commas";
166 $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}});
169 my $entry = $bibtex_entry{$bibtex_field};
171 $entry = encode_utf8(convert_to_utf8($entry));
174 if ($bibtex_field eq 'journal') {
178 $bibtex_entry .= wrap(' ' x 4,' ' x 8 . ' ' x length($bibtex_field),"$bibtex_field = $start".$entry."$stop,\n");
180 $bibtex_entry .= "}\n";
181 return $bibtex_entry;
184 =head2 bibtex_mapping
186 $Reference::Output::Bibtex::bibtex_mapping{Article} =
187 {mapping => {author => {field => 'author',
195 order => [qw(name author volume foo)],
198 This variable holds the mapping to bibtex output.
200 Each type of reference has its own keys. Currently the following types
201 are supported by the Bibtex output method:
213 If you wish to add support for your own custom reference type, you
214 merely need to add a bibtex_mapping element to your class's hashref,
215 or add to this variable. [Preferbly the former, as the latter should
216 only be used by the end user.]
218 The mapping key in the reference type hashref is a hashref containing
219 key value pairs according to the following metric:
223 =item If the mapping key value is not a reference, the value is used
224 as the name function to call via C<$reference->field>. [In the example
225 above, the volume mapping is built by a call to
226 C<$reference->volume>].
228 =item If the mapping key value is a hashref, the hashref contains two
229 keys. The C<field> key contains the name of the function to call. The
230 C<params> key contains the parameters
234 The order key in the reference type hashref is an arrayref which
235 defines the order in which keys are listed in the BibTeX
236 output. Values in the arrayref should be the keys of the mapping
237 hashref. [The first value listed is the type of reference/reference
245 (article => {mapping => {Article => 'name',
248 journal => 'journal',
255 abstract => 'abstract',
257 mlid => 'medline_id',
262 order => [qw(Article author title journal
263 year key volume number pages
264 month abstract pmid mlid doi
268 book => {mapping => {Book => 'name',
277 abstract => 'abstract',
282 order => [qw(Article author title journal
283 year key volume number pages
284 month abstract doi html pdf),
289 =head2 convert_to_utf8
291 $utf8 = convert_to_utf8("text","charset");
295 sub convert_to_utf8 {
296 my ($data,$charset,$internal_call) = @_;
297 $internal_call //= 0;
298 if (is_utf8($data)) {
299 # cluck("utf8 flag is set when calling convert_to_utf8");
302 if (not length $data) {
305 $charset = uc($charset//'UTF-8');
306 if ($charset eq 'RAW') {
307 # croak("Charset must not be raw when calling convert_to_utf8");
311 $iconv_converter = Text::Iconv->new($charset,"UTF-8") or
312 die "Unable to create converter for '$charset'";
315 return undef if $internal_call;
317 # We weren't able to create the converter, so use Encode
319 return __fallback_convert_to_utf8($data,$charset);
321 my $converted_data = $iconv_converter->convert($data);
322 # if the conversion failed, retval will be undefined or perhaps
324 my $retval = $iconv_converter->retval();
325 if (not defined $retval or
328 # try iso8559-1 first
329 if (not $internal_call) {
330 my $call_back_data = convert_to_utf8($data,'ISO8859-1',1);
331 # if there's an à (0xC3), it's probably something
332 # horrible, and we shouldn't try to convert it.
333 if (defined $call_back_data and $call_back_data !~ /\x{C3}/) {
334 # warn "failed to convert to utf8 (charset: $charset, data: $data), but succeeded with ISO8859-1: ".encode_utf8($call_back_data);
335 return $call_back_data;
338 warn "failed to convert to utf8 (charset: $charset, data: $data)";
339 # Fallback to encode, which will probably also fail.
340 return __fallback_convert_to_utf8($data,$charset);
342 return decode("UTF-8",$converted_data);
345 # this returns data in perl's internal encoding
346 sub __fallback_convert_to_utf8 {
347 my ($data, $charset) = @_;
348 # raw data just gets returned (that's the charset WordDecorder
349 # uses when it doesn't know what to do)
350 return $data if $charset eq 'raw';
351 if (not defined $charset and not is_utf8($data)) {
352 warn ("Undefined charset, and string '$data' is not in perl's internal encoding");
355 # lets assume everything that doesn't have a charset is utf8
359 $result = decode($charset,$data,0);
362 warn "Unable to decode charset; '$charset' and '$data': $@";