tex2bib.pl

#! /usr/local/bin/perl

$Script = 'tex2bib';
$Version=0.97;  # 22 Feb 2006 10:50:35
$Author='Michael Friendly (friendly@yorku.ca)';

# Copyright (c) 1997 Michael Friendly
#
# License:
#  This is free software subject to copyright, released according to the
#  BSD style license.  It may be freely used, modified and distributed.
#  See: http://www.ctan.org/tex-archive/help/Catalogue/licenses.bsd.html
#  for details and further information.

# tex2bib
#   Input a TeX document containing \bibitems, translate these
#   to BibTeX format
#
# Usage:
#		tex2bib [-k][-i infile] [-o outfile]
#		-k:  regenerate keys
#		if infile not given, reads from stdin
#		if outfile not given, prints to stdout

# The entire tex document is scanned for \bibitems, ending when
# the string '\end{thebibliography}' is read.

# Assumes that bibitems are formatted as follows:
#  -- {key}author(s), (date) at the beginning
#  -- titles of books or names of journals: {\em title}
#  -- article titles: 	after date, `` '' quotes optional
#  -- volume, pages: 	{\it vol}, nnn-nnn.
#  -- publisher/address:    address:publisher
#
#  All text in the bibitem which cannot be parsed is included
#  in a note = { } field
#
# Changes
#  0.96 1998/06/22  Allow \bibitem keys to contain [\w:-]
#  0.97 2006/02/21  Added BSD license
#################################################################
# Examples of a book, article, inproceedings:

#\bibitem{Bertin83}Bertin, J. (1983),
#        {\em Semiology of Graphics} (trans. W. Berg).  Madison, WI:
#        University of Wisconsin Press.
#
#\bibitem{Bickel75}Bickel, P. J., Hammel, J. W. and O'Connell, J. W.
#        (1975).
#        Sex bias in graduate admissions: data from Berkeley.  {\em
#        Science}, {\it 187}, 398-403.
#
#\bibitem{Farebrother87}Farebrother, R. W. (1987),
#        ``Mechanical representations of the ${L}_1$ and ${L}_2$ estimation
#        problems'', In Y. Dodge (ed.)  {\em Statistical data analysis
#        based on the L1 norm and related methods}, Amsterdam:
#        North-Holland., 455-464.


# These are output as:

#@Book{  Bertin:83,
#    author      = {J. Bertin},
#    year        = 1983,
#    title       = {Semiology of Graphics},
#    publisher   = {University of Wisconsin Press},
#    address     = {Madison, WI},
#    note        = {(trans. W. Berg).}
#}
#@Article{       Bickel:75,
#    author      = {Bickel, P. J. and Hammel, J. W. and O'Connell, J. W.},
#    year        = 1975,
#    title       = {Sex Bias in Graduate Admissions: Data from Berkeley},
#    journal     = {Science},
#    volume      = 187,
#    pages       = {398-403}
#}
#@InCollection{  Farebrother:87,
#    author      = {R. W. Farebrother},
#    year        = 1987,
#    title       = {Mechanical Representations of the ${L}_1$ and ${L}_2$ Estimation Problems},
#    booktitle   = {Statistical Data Analysis Based on the L1 Norm and Related Methods},
#    editor      = {Y. Dodge},
#    publisher   = {North-Holland},
#    address     = {Amsterdam},
#    pages       = {455-464}

# Text in a bibitem is removed from the bibitem as it is assigned to
# bibtex fields.  Any text remaining is assigned to a note={  } field
# at the end.  Since the parsing is heuristic, some manual fixup work
# can be expected at the end.

#################################################################

require 'getopt.pl' ;

Getopt("oikdrt:");             # ARGV now contains [inputfile] and
#   $opt_o, $opt_i might be set.

$default_type = $opt_t || 'Article';

open(STDIN, "<$opt_i") or die "-i $opt_i: can't open.\n" if $opt_i ;
open(STDOUT, ">$opt_o") or die "-o $opt_o: can't create.\n" if $opt_o ;

#######################  Process input files  ####################
$bibs=0;
while (<>)
{
  /^\s*\\end\{thebibliography/ && last;
    if (/\\bibitem\s*\{([\w\d:-]+)\}/) {
      $bibs++;
      $key = $1;
      #		print STDERR "$bibs key: $key\n";
    }
    # skip if we're still reading tex text (no bibitems encountered)
    next unless $bibs;
    chomp;
    s/^\s*/ /;
    $lines .= $_;
  }
  
  # All lines containing \bibitems have been read into the $lines string.
  # Now, split into separate items
  
  @items = split(/\\bibitem\s*/, $lines);
  print STDERR "items has ", scalar(@items), " items\n";
  
  @months = qw(january february march april may jun july august september
  october november december);
  $month_pat = join('|', @months);
  
  foreach (@months) {
    $month_abbrv{$_} = substr($_, 0,3);
  }
  
  $ordinal = 'first|second|third|fourth|1st\.?|2nd\.?|3rd\.?|4th\.?';
  
  # title words to ignore for casing;
  foreach ( qw(a about an and by for from in of on the to von with) ) {
    $ignore_case{$_} = 1;
  }
  
  $outitems =0;
  %keys_seen = {};
  
  foreach $i (0..$#items) {
    undef $title;
    undef $pages;
    undef $journal;
    undef $volume;
    undef $number;
    undef $booktitle;
    undef $editor;
    undef $edition;
    undef $month;
    undef $publisher;
    undef $address;
    undef $chapter;
    undef $rest;
    
    print "$items[$i]\n" if $opt_d;
    # assume each entry starts with
    #	{key}Author, F.I. etc (date[a-z]?)
    #	$items[$i] =~ /^\{([^}]+)\}([^\(]*)\((\d{4})[a-z]?\)[,.]?\s*/;
    #	($key, $authors, $date) = ($1, $2, $3);
    $items[$i] =~ /^\{([^}]+)\}\s*/;
  $key = $1;
  #	print  "key: $key\n";
  $rest = $';
		
  $rest =~ /\((\d{4})[a-z]?\)[,.]?\s*/ &&
		do {
      $authors = $`;
      $date = $1;
      $rest = $';
    };
  
  unless (defined($key)) {
    print STDERR "Skipping: $authors, $date in \n$items[$i]\n";
    next;
  }
		
  
  $rest =~ s/^[.,]?\s+//;
  $rest =~ s/\s+$//;
  
  #	print "key: $key\n";
  #	$key =~ m/(['A-Za-z]+)([^:]*)/ &&
  #		do { $key = "$1:$2"; };
  #	print "key: $key\n";
  
  &parse_authors;
  
  $orig_key = $key;
  $key = &generate_key if $opt_k or $keys_seen{$key};
  
  # if the $key has already been seen, make a new, unique one
  if ($keys_seen{$key}) {
    foreach $suffix (('b'..'z')) {
      $try = $key . $suffix;
      #			print STDERR "Seen $key ... trying $try\n";
      unless ($keys_seen{$try}) {$key = $try; last; };
    }
    print STDERR "New unique key generated: $key (was $orig_key)\n"
    unless $key eq $orig_key;
  }
  $keys_seen{$key}++;
  
  # assume it's an article at first
  $type = '@' . $default_type;
  
  if ($rest =~ /^\{\\em\s+/) {
    #tech report or book
    $type = '@Book';
    $rest =~ m/^\{\\em\s+(['\w ,?:]+)\}[., ]*/;
      $title = $1;
      $rest = $';
      &parse_edition;
      &parse_publish;
      
      $rest =~ m/\sreport(s?)[,]?\s*/i &&
      do {
        $type ='@TechReport';
        $rest = $` . $';
        &parse_report_number;
      };
    }
    
    else {
      #does it begin with quoted title?
      if ($rest =~ /^``/){
        $rest =~ m/^``([^`]+)''[., ]*/;
        $title = $1;
        $rest = $';
        }
        else {
        $rest =~ m#^(['\{\}\w\d,\(\)\\ :\?/-]+)[. ]*#;
        $title = $1;
        $rest = $';
        }
        $rest =~ s/^[,\s]+//;
        
        if ($rest =~ /^\{\\em\s+/) {
        $rest =~ m/^\{\\em\s+([\w\\& ,'-?]+)\}[., ]*/;
        $journal = $1;
        $rest = $';
        }
        # parse {\it volume (number)}
        &parse_volume;
        
        $rest =~ m/,?\s*(\d{1,4}--?\d{1,4})[.,]?\s*/ &&
        do {
        $pages = $1;
        $rest = $`. $';
        $pages =~ s/(\d)-(\d)/$1--$2/;
      };
      
      $rest =~ m/\(($month_pat)\)/i &&
      do {
        ($month = $1) =~ tr/A-Z/a-z/;
        $month = $month_abbrv{$month};
        $rest = $` . $';
      };
      
      $rest =~ m/(technical|tech\.)\s+report[,.]?/i &&
      do {
        $type ='@TechReport';
        $rest = $` . $';
        &parse_report_number;
      };
      
      $rest =~ m/^In\s+/i &&
      do {
        $rest = $';
        $type ='@InCollection';  # maybe, proceedings
        $rest =~ m/\{\\em\s+([\w ,':!?]+)\}[., ]*/ &&
          do {
            $booktitle = $1;
            $rest = $` . $';
            $type = '@InProceedings' if $booktitle =~ m/proceedings/i;
          };
          $rest =~ m/([\w., ]+)\s+\(eds?\.\)[,.]?\s*/i &&
          do {
            $editor = $1;
            $rest = $` . $';
          };
          $rest =~ m/Chapter\s+(\d+)[.,]?\s*/i &&
          do {
            $chapter = $1;
            $rest = $` . $';
          };
          
          &parse_edition;
          &parse_publish;
        };
        
        $rest =~ m/proceedings/i &&
        do {
          $type = '@InProceedings';
          #	print "$items[$i]\n";
        };
      }
      
      $rest =~ s/^\s+//;
      $rest =~ s/$date([,]?)//;
      
      $title = &case_title($title);
      $booktitle = &case_title($booktitle) if $booktitle;
      
      print "$type\{$key";
      print ",\n    author\t= {$authors}";
      print ",\n    year\t= $date";
      print ",\n    title\t= {$title}" if $title;
      print ",\n    booktitle\t= {$booktitle}" if $booktitle;
      print ",\n    edition\t= {$edition}" if $edition;
      print ",\n    editor\t= {$editor}" if $editor;
      print ",\n    publisher\t= {$publisher}" if $publisher;
      print ",\n    address\t= {$address}" if $address;
      print ",\n    journal\t= {$journal}" if $journal;
      print ",\n    volume\t= $volume" if $volume;
      print ",\n    month\t= $month" if $month;
      print ",\n    number\t= $number" if $number;
      print ",\n    pages\t= {$pages}" if $pages;
      print ",\n    chapter\t= {$chapter}" if $chapter;
      print ",\n    note\t= {$rest}" if $rest;
      print "\n\}\n";
      $outitems++;
    }
    print STDERR "$outitems items processed\n";
    exit;
    
    ########################### subroutines #############################
    
    # separate multiple authors with 'and'
    sub parse_authors {
      # fix authors field
      $authors =~ s/\s+$//;
      $authors =~ s/\\&/and/;
      $authors =~ s/([A-Z])\.([A-Z])\./$1. $2./g;
      $authors =~ s/ ([A-Z])\.,\s+(?!Jr.)/ $1. and /g;
      $authors =~ s/ and and / and /;
      #	$authors =~ s/Friendly, M./Friendly, Michael/;
      $authors =~ s/M. Friendly/Friendly, M./;
      local($commas) = ($authors =~ tr/,/,/);
      if ($opt_r && $commas == 1) {
        @auth = split(/, /, $authors);
        $authors = join(' ',reverse(@auth));
      }
      
    }
    
    # extract last names of authors into @auth array
    sub split_authors {
      @auth = split(/ and /, $authors);
      @auth =~ grep(s/, .*$//g,@auth);          # strip trailing initials
      @auth =~ grep(s/^([A-Z]\.\s*)+//g,@auth);
      #	@auth =~ grep(s/^[a-z ]+//,@auth);        # strip any name prefixes
      
      foreach  $i (0..$#auth) {
        @n = split(/ /, $auth[$i]);
        $auth[$i] = pop(@n);               # strip anything before lastname
        $auth[$i] =~ s/[^\w]//g;           # remove non-word chars
      }
      
      #	print STDERR "Authors: $authors --> ",
      join('|',@auth),"\n"    if scalar(@auth) > 1;
      
    }
    
    sub parse_volume {
      $rest =~ m/,?\s*\{\\it\s+([A-Za-z \d()]+)\s*\}[.,]?/ &&
      do {
        $volume = $1;
        $rest = $`. $';
        $volume =~ m/\(([ \w]+)\)/ &&
        do {
          $volume = $`;
          $number = $1;
        };
        $volume = "{$volume}" unless $volume =~ m/^\d*$/;
        $number = "\{$number\}" unless $number =~ m/^\d*$/;
      };
      
    }
    
    # find publisher and address in book/inproceedings items
    #	assume the format is address:publisher
    sub parse_publish {
      local($before, $after);
      $rest =~ m#:\s*([\w-\\/& ]+)[.]?# &&
      do {
        $publisher = $1;
        ($before, $after) = ($`, $');
        $before =~ m/([\w, ]+)$/ &&
        do {
          $address = $1;
          $before = $`;
          $address =~ s/^\s+//;
        };
        $rest = $before . $after;
      };
    }
    
    sub parse_report_number {
      $rest =~ m/\s*(no\.|number)\s+(\d+)[,.]?\s*/i &&
      do {
        $number = $2;
        $rest = $` . $';
      }
    }
    
    sub parse_edition {
      $rest =~ m/\(?($ordinal).*(edition|ed\.)\)?\.?\s*/i &&
      do {
        $edition = $1;
        $rest = $` . $';
      }
    }
    
    # Initial-caps for all non-ignored words
    sub case_title {
      local($t) = @_;
      local(@words) = split(/\s+/, $t);
      local($w) =0;
      local($colon);
      foreach (@words) {
        $w++;
        next if /^[A-Z]/;
        unless ($colon) {next if $ignore_case{$_}};		
        s/^([a-z])/\u$1/;
        $colon = tr/:/:/;
      }
      join(' ', @words);
    }
    
    sub generate_key {
      local($yr, $key);
      ($yr = $date) =~ s/^1\d//;
      &split_authors;	
      if (scalar(@auth) < 3) {
        $key = join('', @auth, ':', $yr);
      }
      else {
        $key = join('', $auth[0], '-etal:', $yr);
      }
      #	print STDERR "New key: $key (", join('|', @auth), ": $date)\n";
      $key;
    }