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>.
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$ =~ /\$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].'{'.$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 if (ref $mapping->{mapping}{$bibtex_field}) {
149 if (exists $mapping->{mapping}{$bibtex_field}{code}) {
150 local $_ = $bibtex_entry{$bibtex_field};
151 eval $mapping->{mapping}{$bibtex_field}{code};
152 carp "Error while executing code to assemble bibtex entry: $@" if $@;
154 elsif (exists $mapping->{mapping}{$bibtex_field}{join}) {
155 $bibtex_entry{$bibtex_field} = join($mapping->{mapping}{$bibtex_field}{join},
156 @{$bibtex_entry{$bibtex_field}});
159 carp "$bibtex_field is an ARRAYREF, joining using commas";
160 $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}});
164 carp "$bibtex_field is an ARRAYREF, joining using commas";
165 $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}});
168 my $entry = $bibtex_entry{$bibtex_field};
170 $entry = encode_utf8(convert_to_utf8($entry));
173 if ($bibtex_field eq 'journal') {
177 $bibtex_entry .= wrap(' ' x 4,' ' x 8 . ' ' x length($bibtex_field),"$bibtex_field = $start".$entry."$stop,\n");
179 $bibtex_entry .= "}\n";
180 return $bibtex_entry;
183 =head2 bibtex_mapping
185 $Reference::Output::Bibtex::bibtex_mapping{Article} =
186 {mapping => {author => {field => 'author',
194 order => [qw(name author volume foo)],
197 This variable holds the mapping to bibtex output.
199 Each type of reference has its own keys. Currently the following types
200 are supported by the Bibtex output method:
212 If you wish to add support for your own custom reference type, you
213 merely need to add a bibtex_mapping element to your class's hashref,
214 or add to this variable. [Preferbly the former, as the latter should
215 only be used by the end user.]
217 The mapping key in the reference type hashref is a hashref containing
218 key value pairs according to the following metric:
222 =item If the mapping key value is not a reference, the value is used
223 as the name function to call via C<$reference->field>. [In the example
224 above, the volume mapping is built by a call to
225 C<$reference->volume>].
227 =item If the mapping key value is a hashref, the hashref contains two
228 keys. The C<field> key contains the name of the function to call. The
229 C<params> key contains the parameters
233 The order key in the reference type hashref is an arrayref which
234 defines the order in which keys are listed in the BibTeX
235 output. Values in the arrayref should be the keys of the mapping
236 hashref. [The first value listed is the type of reference/reference
244 (article => {mapping => {Article => 'name',
247 journal => 'journal',
254 abstract => 'abstract',
256 mlid => 'medline_id',
261 order => [qw(Article author title journal
262 year key volume number pages
263 month abstract pmid mlid doi
267 book => {mapping => {Book => 'name',
276 abstract => 'abstract',
281 order => [qw(Article author title journal
282 year key volume number pages
283 month abstract doi html pdf),
288 =head2 convert_to_utf8
290 $utf8 = convert_to_utf8("text","charset");
294 sub convert_to_utf8 {
295 my ($data,$charset,$internal_call) = @_;
296 $internal_call //= 0;
297 if (is_utf8($data)) {
298 # cluck("utf8 flag is set when calling convert_to_utf8");
301 $charset = uc($charset//'UTF-8');
302 if ($charset eq 'RAW') {
303 # croak("Charset must not be raw when calling convert_to_utf8");
307 $iconv_converter = Text::Iconv->new($charset,"UTF-8") or
308 die "Unable to create converter for '$charset'";
311 return undef if $internal_call;
313 # We weren't able to create the converter, so use Encode
315 return __fallback_convert_to_utf8($data,$charset);
317 my $converted_data = $iconv_converter->convert($data);
318 # if the conversion failed, retval will be undefined or perhaps
320 my $retval = $iconv_converter->retval();
321 if (not defined $retval or
324 # try iso8559-1 first
325 if (not $internal_call) {
326 my $call_back_data = convert_to_utf8($data,'ISO8859-1',1);
327 # if there's an à (0xC3), it's probably something
328 # horrible, and we shouldn't try to convert it.
329 if (defined $call_back_data and $call_back_data !~ /\x{C3}/) {
330 # warn "failed to convert to utf8 (charset: $charset, data: $data), but succeeded with ISO8859-1: ".encode_utf8($call_back_data);
331 return $call_back_data;
334 warn "failed to convert to utf8 (charset: $charset, data: $data)";
335 # Fallback to encode, which will probably also fail.
336 return __fallback_convert_to_utf8($data,$charset);
338 return decode("UTF-8",$converted_data);
341 # this returns data in perl's internal encoding
342 sub __fallback_convert_to_utf8 {
343 my ($data, $charset) = @_;
344 # raw data just gets returned (that's the charset WordDecorder
345 # uses when it doesn't know what to do)
346 return $data if $charset eq 'raw';
347 if (not defined $charset and not is_utf8($data)) {
348 warn ("Undefined charset, and string '$data' is not in perl's internal encoding");
351 # lets assume everything that doesn't have a charset is utf8
355 $result = decode($charset,$data,0);
358 warn "Unable to decode charset; '$charset' and '$data': $@";