blib/lib/Reference/Output/Bibtex.pm

   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 $
   6
   7 package Reference::Output::Bibtex;
   8
   9 =head1 NAME
  10
  11 Reference::Output::Bibtex -- Output references in BibTeX format
  12
  13 =head1 SYNOPSIS
  14
  15      print bibtex($reference);
  16
  17 Returns a reference formatted in bibtex format.
  18
  19 =head1 DESCRIPTION
  20
  21 Knows how to handle the reference-> bibtex field mapping for many
  22 reference types, but overridden types may need to provide their own
  23 mapping.
  24
  25
  26 =head1 BUGS
  27
  28 None known.
  29
  30 =cut
  31
  32 use warnings;
  33 use strict;
  34 use vars qw($REVISION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS);
  35
  36 use base qw(Exporter);
  37
  38 use Encode qw(encode_utf8 is_utf8 decode decode_utf8);
  39 use Text::Iconv;
  40
  41
  42 BEGIN{
  43      ($REVISION) = q$LastChangedRevision: 45 $ =~ /\$LastChangedRevision:\s+([^\s+])/;
  44      $DEBUG = 0 unless defined $DEBUG;
  45
  46      @EXPORT = qw(bibtex);
  47      @EXPORT_OK = qw();
  48      %EXPORT_TAGS = (output => [qw(bibtex)],
  49                     );
  50      Exporter::export_ok_tags(qw(output));
  51      $EXPORT_TAGS{all} = [@EXPORT_OK];
  52
  53 }
  54
  55 # Assigned and discussed at the end of this file
  56 my %bibtex_mapping;
  57
  58 use Carp;
  59 use Params::Validate qw(:types validate_with);
  60 use Text::Wrap;
  61
  62
  63 =head2 bibtex
  64
  65      print bibtex $reference;
  66      %bibtex = bibtex $reference;
  67      print bibtex($reference,mapping=>{...})
  68
  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.
  72
  73 You can also pass an optional mapping to be used for making the bibtex
  74 entry. See B<bibtex_mapping> for the details.
  75
  76 The mappings are obeyed in the following order, the first taking
  77 precedence over the last.
  78
  79 =over
  80
  81 =item Passed mapping
  82
  83 =item Object's bibtex_mapping
  84
  85 =item Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping)
  86
  87 =back
  88
  89 Returns a SCALAR bibtex reference in scalar context, a HASH bibtex
  90 reference in list context
  91
  92 =cut
  93
  94 sub bibtex{
  95      my $reference = shift;
  96
  97      # Parse options if any
  98      my %param = validate_with(params => \@_,
  99                                spec   => {mapping => {type     => HASHREF,
 100                                                       optional => 1,
 101                                                      },
 102                                          },
 103                               );
 104
 105      my $mapping = undef;
 106
 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};
 113
 114      if (not defined $mapping) {
 115           carp "This reference type doesn't support bibtex output.";
 116           return undef;
 117      }
 118
 119      my %bibtex_entry;
 120      foreach my $bibtex_field (keys %{$mapping->{mapping}}) {
 121           my $params = [];
 122           if (ref $bibtex_field) {
 123                $params = $$bibtex_field{params} if exists $$bibtex_field{params};
 124                $bibtex_field = $$bibtex_field{field};
 125           }
 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}}};
 135           }
 136           elsif (ref($bibtex_entry{$bibtex_field}) eq 'ARRAY') {
 137                $bibtex_entry{$bibtex_field} = [@{$bibtex_entry{$bibtex_field}}];
 138           }
 139      }
 140      # Return the entries in hash form if desired.
 141      return %bibtex_entry if wantarray;
 142      # Ok, stich the bibtex entry together...
 143      my $bibtex_entry;
 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 $@;
 154                     }
 155                     elsif (exists $mapping->{mapping}{$bibtex_field}{join}) {
 156                          $bibtex_entry{$bibtex_field} = join($mapping->{mapping}{$bibtex_field}{join},
 157                                                              @{$bibtex_entry{$bibtex_field}});
 158                     }
 159                     else {
 160                          carp "$bibtex_field is an ARRAYREF, joining using commas";
 161                          $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}});
 162                     }
 163                }
 164                else {
 165                     carp "$bibtex_field is an ARRAYREF, joining using commas";
 166                     $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}});
 167                }
 168           }
 169           my $entry = $bibtex_entry{$bibtex_field};
 170           $entry =~ s/%/\\%/g;
 171       $entry = encode_utf8(convert_to_utf8($entry));
 172       my $start = "{";
 173       my $stop = "}";
 174       if ($bibtex_field eq 'journal') {
 175           $start = "";
 176           $stop = "";
 177       }
 178           $bibtex_entry .= wrap(' ' x 4,' ' x 8 . ' ' x length($bibtex_field),"$bibtex_field = $start".$entry."$stop,\n");
 179      }
 180      $bibtex_entry .= "}\n";
 181      return $bibtex_entry;
 182 }
 183
 184 =head2 bibtex_mapping
 185
 186       $Reference::Output::Bibtex::bibtex_mapping{Article} =
 187         {mapping => {author   => {field  => 'author',
 188                                   join   => ' and ',
 189                                   params => [],
 190                                  },
 191                      volume   => 'volume',
 192                      Articlce => 'name',
 193                      foo      => 'bar',
 194                     },
 195          order => [qw(name author volume foo)],
 196         };
 197
 198 This variable holds the mapping to bibtex output.
 199
 200 Each type of reference has its own keys. Currently the following types
 201 are supported by the Bibtex output method:
 202
 203 =over
 204
 205 =item article
 206
 207 =item collection
 208
 209 =item book
 210
 211 =back
 212
 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.]
 217
 218 The mapping key in the reference type hashref is a hashref containing
 219 key value pairs according to the following metric:
 220
 221 =over
 222
 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>].
 227
 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
 231
 232 =back
 233
 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
 238 name pair.]
 239
 240
 241 =cut
 242
 243
 244 %bibtex_mapping =
 245 (article => {mapping => {Article  => 'name',
 246                          author   => 'author',
 247                          title    => 'title',
 248                          journal  => 'journal',
 249                          year     => 'year',
 250                          key      => 'keywords',
 251                          volume   => 'volume',
 252                          number   => 'number',
 253                          pages    => 'pages',
 254                          month    => 'month',
 255                          abstract => 'abstract',
 256                          pmid     => 'pmid',
 257                          mlid     => 'medline_id',
 258                          doi      => 'doi',
 259                          html     => 'html',
 260                          pdf      => 'pdf',
 261                         },
 262              order   => [qw(Article author title journal
 263                             year key volume number pages
 264                             month abstract pmid mlid doi
 265                             html pdf),
 266                         ],
 267             },
 268  book    => {mapping => {Book     => 'name',
 269                          author   => 'author',
 270                          title    => 'title',
 271                          year     => 'year',
 272                          key      => 'keywords',
 273                          volume   => 'volume',
 274                          number   => 'number',
 275                          pages    => 'pages',
 276                          month    => 'month',
 277                          abstract => 'abstract',
 278                          doi      => 'doi',
 279                          # html   => 'html',
 280                          # pdf    => 'pdf',
 281                         },
 282              order   => [qw(Article author title journal
 283                             year key volume number pages
 284                             month abstract doi html pdf),
 285                         ],
 286             },
 287 );
 288
 289 =head2 convert_to_utf8
 290
 291     $utf8 = convert_to_utf8("text","charset");
 292
 293 =cut
 294
 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");
 300         return $data;
 301     }
 302     if (not length $data) {
 303         return $data;
 304     }
 305     $charset = uc($charset//'UTF-8');
 306     if ($charset eq 'RAW') {
 307         # croak("Charset must not be raw when calling convert_to_utf8");
 308     }
 309     my $iconv_converter;
 310     eval {
 311         $iconv_converter = Text::Iconv->new($charset,"UTF-8") or
 312             die "Unable to create converter for '$charset'";
 313     };
 314     if ($@) {
 315         return undef if $internal_call;
 316         warn $@;
 317         # We weren't able to create the converter, so use Encode
 318         # instead
 319         return __fallback_convert_to_utf8($data,$charset);
 320     }
 321     my $converted_data = $iconv_converter->convert($data);
 322     # if the conversion failed, retval will be undefined or perhaps
 323     # -1.
 324     my $retval = $iconv_converter->retval();
 325     if (not defined $retval or
 326         $retval < 0
 327        ) {
 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;
 336             }
 337         }
 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);
 341     }
 342     return decode("UTF-8",$converted_data);
 343 }
 344
 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");
 353          return $data;
 354      }
 355      # lets assume everything that doesn't have a charset is utf8
 356      $charset //= 'utf8';
 357      my $result;
 358      eval {
 359          $result = decode($charset,$data,0);
 360      };
 361      if ($@) {
 362           warn "Unable to decode charset; '$charset' and '$data': $@";
 363           return $data;
 364      }
 365      return $result;
 366 }
 367
 368
 369
 370 1;
 371
 372
 373 __END__
 374
 375
 376
 377
 378
 379