.svn/pristine/3b/3b230680ee0646a5802fa31112bf96cbfad8035d.svn-base

   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$
   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$ =~ /\$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].'{'.$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 $@;
 153                     }
 154                     elsif (exists $mapping->{mapping}{$bibtex_field}{join}) {
 155                          $bibtex_entry{$bibtex_field} = join($mapping->{mapping}{$bibtex_field}{join},
 156                                                              @{$bibtex_entry{$bibtex_field}});
 157                     }
 158                     else {
 159                          carp "$bibtex_field is an ARRAYREF, joining using commas";
 160                          $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}});
 161                     }
 162                }
 163                else {
 164                     carp "$bibtex_field is an ARRAYREF, joining using commas";
 165                     $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}});
 166                }
 167           }
 168           my $entry = $bibtex_entry{$bibtex_field};
 169           $entry =~ s/%/\\%/g;
 170       $entry = encode_utf8(convert_to_utf8($entry));
 171       my $start = "{";
 172       my $stop = "}";
 173       if ($bibtex_field eq 'journal') {
 174           $start = "";
 175           $stop = "";
 176       }
 177           $bibtex_entry .= wrap(' ' x 4,' ' x 8 . ' ' x length($bibtex_field),"$bibtex_field = $start".$entry."$stop,\n");
 178      }
 179      $bibtex_entry .= "}\n";
 180      return $bibtex_entry;
 181 }
 182
 183 =head2 bibtex_mapping
 184
 185       $Reference::Output::Bibtex::bibtex_mapping{Article} =
 186         {mapping => {author   => {field  => 'author',
 187                                   join   => ' and ',
 188                                   params => [],
 189                                  },
 190                      volume   => 'volume',
 191                      Articlce => 'name',
 192                      foo      => 'bar',
 193                     },
 194          order => [qw(name author volume foo)],
 195         };
 196
 197 This variable holds the mapping to bibtex output.
 198
 199 Each type of reference has its own keys. Currently the following types
 200 are supported by the Bibtex output method:
 201
 202 =over
 203
 204 =item article
 205
 206 =item collection
 207
 208 =item book
 209
 210 =back
 211
 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.]
 216
 217 The mapping key in the reference type hashref is a hashref containing
 218 key value pairs according to the following metric:
 219
 220 =over
 221
 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>].
 226
 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
 230
 231 =back
 232
 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
 237 name pair.]
 238
 239
 240 =cut
 241
 242
 243 %bibtex_mapping =
 244 (article => {mapping => {Article  => 'name',
 245                          author   => 'author',
 246                          title    => 'title',
 247                          journal  => 'journal',
 248                          year     => 'year',
 249                          key      => 'keywords',
 250                          volume   => 'volume',
 251                          number   => 'number',
 252                          pages    => 'pages',
 253                          month    => 'month',
 254                          abstract => 'abstract',
 255                          pmid     => 'pmid',
 256                          mlid     => 'medline_id',
 257                          doi      => 'doi',
 258                          html     => 'html',
 259                          pdf      => 'pdf',
 260                         },
 261              order   => [qw(Article author title journal
 262                             year key volume number pages
 263                             month abstract pmid mlid doi
 264                             html pdf),
 265                         ],
 266             },
 267  book    => {mapping => {Book     => 'name',
 268                          author   => 'author',
 269                          title    => 'title',
 270                          year     => 'year',
 271                          key      => 'keywords',
 272                          volume   => 'volume',
 273                          number   => 'number',
 274                          pages    => 'pages',
 275                          month    => 'month',
 276                          abstract => 'abstract',
 277                          doi      => 'doi',
 278                          # html   => 'html',
 279                          # pdf    => 'pdf',
 280                         },
 281              order   => [qw(Article author title journal
 282                             year key volume number pages
 283                             month abstract doi html pdf),
 284                         ],
 285             },
 286 );
 287
 288 =head2 convert_to_utf8
 289
 290     $utf8 = convert_to_utf8("text","charset");
 291
 292 =cut
 293
 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");
 299         return $data;
 300     }
 301     $charset = uc($charset//'UTF-8');
 302     if ($charset eq 'RAW') {
 303         # croak("Charset must not be raw when calling convert_to_utf8");
 304     }
 305     my $iconv_converter;
 306     eval {
 307         $iconv_converter = Text::Iconv->new($charset,"UTF-8") or
 308             die "Unable to create converter for '$charset'";
 309     };
 310     if ($@) {
 311         return undef if $internal_call;
 312         warn $@;
 313         # We weren't able to create the converter, so use Encode
 314         # instead
 315         return __fallback_convert_to_utf8($data,$charset);
 316     }
 317     my $converted_data = $iconv_converter->convert($data);
 318     # if the conversion failed, retval will be undefined or perhaps
 319     # -1.
 320     my $retval = $iconv_converter->retval();
 321     if (not defined $retval or
 322         $retval < 0
 323        ) {
 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;
 332             }
 333         }
 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);
 337     }
 338     return decode("UTF-8",$converted_data);
 339 }
 340
 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");
 349          return $data;
 350      }
 351      # lets assume everything that doesn't have a charset is utf8
 352      $charset //= 'utf8';
 353      my $result;
 354      eval {
 355          $result = decode($charset,$data,0);
 356      };
 357      if ($@) {
 358           warn "Unable to decode charset; '$charset' and '$data': $@";
 359           return $data;
 360      }
 361      return $result;
 362 }
 363
 364
 365
 366 1;
 367
 368
 369 __END__
 370
 371
 372
 373
 374
 375