source: trunk/gsdl/perllib/plugins/BibTexPlug.pm@ 13416

###########################################################################
#
# BibTexPlug.pm - a plugin for bibliography records in BibTex format
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright 2000 Gordon W. Paynter
# Copyright 1999-2001 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################


# BibTexPlug reads bibliography files in BibTex format.
#
# by Gordon W. Paynter ([email protected]), November 2000
# Based on ReferPlug.  See ReferPlug for geneology.
#
# BibTexPlug creates a document object for every reference a the file.
# It is a subclass of SplitPlug, so if there are multiple records, all
# are read.
#
# Modified Dec 2001 by John McPherson:
#  *  some modifications submitted by Sergey Yevtushenko
#                      <[email protected]>
#  *  some non-ascii char support (ie mostly Latin)


package BibTexPlug;

use SplitPlug;
use strict;
no strict 'refs'; # allow filehandles to be variables and viceversa

# BibTexPlug is a sub-class of BasPlug.
sub BEGIN {
    @BibTexPlug::ISA = ('SplitPlug');
}

my $arguments = 
    [ { 'name' => "process_exp",
    'desc' => "{BasPlug.process_exp}",
    'type' => "regexp",
    'reqd' => "no",
    'deft' => &get_default_process_exp() },
      { 'name' => "split_exp",
    'desc' => "{SplitPlug.split_exp}",
    'type' => "regexp",
    'deft' => &get_default_split_exp(),
    'reqd' => "no" }
      ];

my $options = { 'name'     => "BibTexPlug",
        'desc'     => "{BibTexPlug.desc}",
        'abstract' => "no",
        'inherits' => "yes",
        'explodes' => "yes",
        'args'     => $arguments };

# This plugin processes files with the suffix ".bib"
sub get_default_process_exp {
    return q^(?i)\.bib$^;
}

# This plugin splits the input text at blank lines
sub get_default_split_exp {
    return q^\n+(?=@)^;
}
sub new {
    my ($class) = shift (@_);
    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
    push(@$pluginlist, $class);

    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};

    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);

    return bless $self, $class;
}



# The process function reads a single bibliographic record and stores
# it as a new document.

sub process {
    my $self = shift (@_);
    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
    my $outhandle = $self->{'outhandle'};

    my $cursection = $doc_obj->get_top_section();
    $self->{'key'} = "default";

    # Check that we're dealing with a valid BibTex record
    return undef unless ($$textref =~ /^@\w+\{.*\}/s);

    # Ignore things we can't use
    return 0 if ($$textref =~ /^\@String/);

    # Report that we're processing the file
    print STDERR "<Processing n='$file' p='BibTexPlug'>\n" if ($gli);
    print $outhandle "BibTexPlug: processing $file\n"
    if ($self->{'verbosity'}) > 1;


    # This hash translates BibTex field names into metadata names.  The
    # BibTex names are taken from the "Local Guide to Latex" Graeme
    # McKinstry.  Metadata names are consistent with ReferPlug.

    # The author metadata will be stored as one "Creator" entry, but will
    # also be split up into several individual "Author" fields.

    my %field = (
         'address', 'PublisherAddress',
         'author', 'Creator',
          
         'booktitle', 'Booktitle',
         'chapter', 'Chapter',
         'edition', 'Edition',
         'editor', 'Editor', 
         'institution', 'Publisher',
         'journal', 'Journal',
         'month', 'Month',
         'number', 'Number',
         'pages', 'Pages',
         'publisher', 'Publisher',
         'school', 'Publisher',
         'title', 'Title',
         'volume', 'Volume',
         'year', 'Year', # Can't use "Date" as this implies DDDDMMYY!

         'keywords', 'Keywords',
         'abstract', 'Abstract',
         'copyright', 'Copyright',
         'note', 'Note',
         'url', 'URL',
         );

    # Metadata fields 
    my %metadata;
    my ($EntryType, $Creator, $Keywords, $text);

    my $verbosity = $self->{'verbosity'};
    $verbosity = 0 unless $verbosity;

    # Make sure the text has exactly one entry per line -
    # append line to previous if it doesn't start with "  <key> = "

    my @input_lines=split(/\r?\n/, $$textref);
    my @all_lines;
    my $entry_line=shift @input_lines;
    foreach my $input_line (@input_lines) {
    if ($input_line =~ m/^\s*\w+\s*=\s*/) {
        # this is a new key
        push(@all_lines, $entry_line);
        $entry_line=$input_line;
    } else {
        # this is a continuation of previous line
        $entry_line .= " " . $input_line;
    }
    
    }
    # add final line, removing trailing '}'
    $entry_line =~ s/\}\s*$//;
    push(@all_lines, $entry_line);
    push(@all_lines, "}");

    # Read and process each line in the bib file.
    my ($entryname, $name, $value, $line);
    foreach $line (@all_lines) {

    # Add each line.  Most lines consist of a field identifer and
    # then data, and we simply store them, though we treat some
    # of the fields a bit differently.

    $line =~ s/\s+/ /g;
    $text .= "$line\n";


    print "Processing line = $line \n" if $verbosity>=4;

    # The first line is special, it contains the reference type and OID
    if ($line =~ /\@(\w+)\W*\{\W*([\*\.\w\d:-]*)\W*$/) {
        $EntryType = $1;
        my $EntryID = (defined $2) ? $2 : "default";
        print "** $EntryType - \"$EntryID\" \n"
        if ($verbosity >= 4);

        next;
    }
    if ($line =~ /\@/) {
        print $outhandle "bibtexplug: suspect line in bibtex file: $line\n"
        if ($verbosity >= 2);
        print $outhandle "bibtexplug: if that's the start of a new bibtex record ammend regexp in bibtexplug::process()\n"
        if ($verbosity >= 2);
    }
    
    # otherwise, parse the metadata out of this line
    next unless ($line =~ /^\s*(\w+)\s*=\s*(.*)/);
    $entryname = lc($1);
    $value = $2;
    $value =~ s/,?\s*$//; # remove trailing comma and space
    if ($value =~ /^"/ && $value =~ /"$/) {
        # remove surrounding " marks
        $value =~ s/^"//; $value =~ s/"$//;
    } elsif ($value =~ /^\{/ && $value =~ /\}$/) {
        # remove surrounding {} marks
        $value =~ s/^\{//; $value =~ s/\}$//;
    }
    # special case for year - we only want a 4 digit year, not 
    # "circa 2004" etc
    if ($entryname=~ /^year$/i) {
        if ($value=~ /(\d{4})/) {
        $value=$1;
        $metadata{$entryname} .= "$value";
        }
    } 
    else {
        
        $value = &process_latex($value);
        # Add this line of metadata
        $metadata{$entryname} .= "$value";  
    }
    }

    # Add the Entry type as metadata
    $doc_obj->add_utf8_metadata ($cursection, "EntryType", $EntryType);
    
    #Add the fileformat as metadata
    $doc_obj->add_metadata($cursection, "FileFormat", "BibTex");


    # Add the various field as metadata
    foreach my $entryname (keys %metadata) {
    next unless (defined $field{$entryname});
    next unless (defined $metadata{$entryname});    
    
    $name = $field{$entryname};
    $value = $metadata{$entryname};

    if ($name =~ /^Month/) {
        $value=expand_month($value);
    }

    # Several special operatons on metadata follow
    
    # Add individual keywords.
    # The full set of keywords will be added, in due course, as "Keywords".
    # However, we also want to add them as individual "Keyword" metadata elements.
    if ($entryname eq "keywords") {
        my @keywordlist = split(/,/, $value);
        foreach my $k (@keywordlist) {
        $k = lc($k); 
        $k =~ s/\s*$//; 
        $k =~ s/^\s*//; 
        if ($k =~ /\w/) {
            $doc_obj->add_utf8_metadata ($cursection, "Keyword", $k);
        }
        } 
    }
    
    # Add individual authors
    # The author metadata will be stored as one "Creator" entry, but we
    # also want to split it into several individual "Author" fields in
    # "Lastname, Firstnames" format so we can browse it.
    if ($entryname eq "author") { #added also comparison with editor
       
        # take care of "et al."...
        my $etal='';
        if ($value =~ s/\s+(and\s+others|et\.?\s+al\.?)\s*$//i) {
        $etal=' <em>et. al.</em>';
        }
        # und here for german language...
        # don't use brackets in pattern, else the matched bit becomes
        # an element in the list!
        my @authorlist = split(/\s+and\s+|\s+und\s+/, $value); 
        my @formattedlist = ();
        foreach $a (@authorlist) {
        $a =~ s/\s*$//; 
        $a =~ s/^\s*//; 
        # Reformat and add author name
        next if $a=~ /^\s*$/;
        
        # names are "First von Last", "von Last, First"
        # or "von Last, Jr, First". See the "BibTeXing" manual, page 16
        my $first="";
        my $vonlast="";
        my $jr="";

        if ($a =~ /,/) {
            my @parts=split(/,\s*/, $a);
            $first = pop @parts;
            if (scalar(@parts) == 2) {
            $jr = pop @parts;
            }
            $vonlast=shift @parts;
            if (scalar(@parts) > 0) {
            print $outhandle "BibTexPlug: couldn't parse name $a\n";
            # but we continue anyway...
            }
        } else { # First von Last
            my @words = split(/ /, $a);
            while (scalar(@words) > 1 && $words[0] !~ /^[a-z]{2..}/) {
            $first .= " " . shift (@words);
            }
            $first =~ s/^\s//;
            $vonlast = join (' ', @words); # whatever's left...
        }
        my $von="";
        my $last="";
        if ($vonlast =~ m/^[a-z]/) { # lowercase implies "von"
            $vonlast =~ s/^(([a-z]\w+\s+)+)//;
            $von = $1;
            if (!defined ($von)) {
            # some non-English names do start with lowercase
            # eg "Marie desJardins". Also we can get typos...
            print $outhandle "BibTexPlug: couldn't parse surname $vonlast\n";
            $von="";
            if ($vonlast =~ /^[a-z]+$/) {
                # if it's all lowercase, uppercase 1st.
                $vonlast =~ s/^(.)/\u$1/;

            }
            }
            $von =~ s/\s*$//;
            $last=$vonlast;
        } else {
            $last=$vonlast;
        }
        my $wholename="$first $von $last $jr";
        $wholename =~ s/\s+/ /g; # squeeze multiple spaces
        $wholename =~ s/ $//;
        push (@formattedlist, $wholename);
        my $fullname = "$last";
        $fullname .= " $jr" if ($jr);
        $fullname .= ", $first";
        $fullname .= " $von" if ($von);

        # Add each name to set of Authors
        $doc_obj->add_utf8_metadata ($cursection, "Author", $fullname);
        }

        # Only want at most one "and" in the Creator field
        if (scalar(@formattedlist) > 2) {
        my $lastauthor=pop @formattedlist;
        $value=join(', ', @formattedlist);
        $value.=" and $lastauthor";
        } else { # 1 or 2 authors...
        $value=join(" and ",@formattedlist);
        }
        $value.=$etal; # if there was "et al."
    }

    # Books and Journals are additionally marked for display purposes
    if ($entryname eq "booktitle") {
        $doc_obj->add_utf8_metadata($cursection, "BookConfOnly", 1);
    } elsif ($entryname eq "journal") {
        $doc_obj->add_utf8_metadata($cursection, "JournalsOnly", 1); 
    }

    # Add the various fields as metadata    
    $doc_obj->add_utf8_metadata ($cursection, $name, $value); 
    
    }

    # for books and journals...
    if (!exists $metadata{'title'}) {
    my $name=$field{'title'}; # get Greenstone metadata name
    my $value;
    if (exists $metadata{'booktitle'}) {
        $value=$metadata{'booktitle'};
    } elsif (exists $metadata{'journal'}) {
        $value=$metadata{'journal'};
    }
    if ($value) {
        $doc_obj->add_utf8_metadata ($cursection, $name, $value); 
    }
    }

    # Add Date (yyyymmdd) metadata
    if (defined ($metadata{'year'}) ) {
    my $date=$metadata{'year'};
    chomp $date;
    my $month=$metadata{'month'};
    if (defined($month)) {
        # month is currently 3 letter code or a range...
        $month = expand_month($month);
        # take the first month found... might not find one!
        $month =~ m/_textmonth(\d\d)_/;
        $month = $1;
    }
    if (!defined($month)) {
        $month="00";
    }
    $date .= "${month}00";
    $doc_obj->add_utf8_metadata($cursection, "Date", $date); 
}

#    # Add the text in BibTex format (all fields)
    if ($text =~ /\w/) {

    $text =~ s@&@&amp;@g;
    $text =~ s@<@&lt;@g;
    $text =~ s@>@&gt;@g;
    $text =~ s@\n@<br/>\n@g;
    $text =~ s@\\@\\\\@g;

    $doc_obj->add_utf8_text ($cursection, $text);
    }

    return 1;
}




# convert email addresses and URLs into links
sub convert_urls_into_links{
   my ($text) = @_;
 
   $text =~ s/([\w\d\.\-]+@[\w\d\.\-]+)/<a href=\"mailto:$1\">$1<\/a>/g;
   $text =~ s/(http:\/\/[\w\d\.\-]+[\/\w\d\.\-]*)/<a href=\"$1\">$1<\/a>/g;

   return $text;
}

# Clean up whitespace and convert \n charaters to <BR> or <P>
sub clean_up_whitespaces{
   my ($text) = @_;

   $text =~ s/%%%%%/<BR> <BR>/g;
   $text =~ s/ +/ /g;
   $text =~ s/\s*$//; 
   $text =~ s/^\s*//; 
   $text =~ s/\n/\n<BR>/g;
   $text =~ s/<BR>\s*<BR>/<P>/g;

   return $text;
}


sub convert_problem_characters_without_ampersand{
    my ($text) = @_;
    $text =~ s/</&lt;/g;
    $text =~ s/>/&gt;/g;
    
    $text =~ s/\'\'/\"/g; #Latex -specific conversion
    $text =~ s/\`\`/\"/g; #Latex -specific conversion

    $text =~ s/\"/&quot;/g;
    $text =~ s/\'/&#8217;/g;
    $text =~ s/\`/&#8216;/g;

#    $text =~ s/\+/ /g;
#    $text =~ s/\(/ /g;
#    $text =~ s/\)/ /g;

    $text =~ s/\\/\\\\/g;

#    $text =~ s/\./\\\./g;

    return $text;
}

# Convert a text string into HTML.

# The HTML is going to be inserted into a GML file, so we have to be
# careful not to use symbols like ">", which occurs frequently in email
# messages (and use &gt instead.

# This function also turns URLs and email addresses into links, and
# replaces carriage returns with <BR> tags (and multiple carriage returns
# with <P> tags).

sub text_into_html {
    my ($text) = @_;

    # Convert problem characters into HTML symbols
    $text =~ s/&/&amp;/g;

    $text = &convert_problem_characters_without_ampersand( $text );

    # convert email addresses and URLs into links
    $text = &convert_urls_into_links( $text );

    $text = &clean_up_whitespaces( $text );

    return $text;
}


sub expand_month {
    my $text=shift;

    # bibtex style files expand abbreviations for months.
    # Entries can contain more than one month (eg ' month = jun # "-" # aug, ')
    $text =~ s/jan/_textmonth01_/g;
    $text =~ s/feb/_textmonth02_/g;
    $text =~ s/mar/_textmonth03_/g;
    $text =~ s/apr/_textmonth04_/g;
    $text =~ s/may/_textmonth05_/g;
    $text =~ s/jun/_textmonth06_/g;
    $text =~ s/jul/_textmonth07_/g;
    $text =~ s/aug/_textmonth08_/g;
    $text =~ s/sep/_textmonth09_/g;
    $text =~ s/oct/_textmonth10_/g;
    $text =~ s/nov/_textmonth11_/g;
    $text =~ s/dec/_textmonth12_/g;

    return $text;
}


# Convert accented characters, remove { }, interprete some commands....
# Note!! This is not comprehensive! Also assumes Latin -> Unicode!
sub process_latex {
    my ($text) = @_;
      
    # note - this is really ugly, but it works. There may be a prettier way
    # of mapping latex accented chars to utf8, but we just brute force it here.
    # Also, this isn't complete - not every single possible accented letter
    # is in here yet, but most of the common ones are.

    my %utf8_chars =
    (
     # acutes
     '\'a' => chr(0xc3).chr(0xa1),
     '\'c' => chr(0xc4).chr(0x87),
     '\'e' => chr(0xc3).chr(0xa9),
     '\'i' => chr(0xc3).chr(0xad),
     '\'l' => chr(0xc3).chr(0xba),
     '\'n' => chr(0xc3).chr(0x84),
     '\'o' => chr(0xc3).chr(0xb3),
     '\'r' => chr(0xc5).chr(0x95),
     '\'s' => chr(0xc5).chr(0x9b),
     '\'u' => chr(0xc3).chr(0xba),
     '\'y' => chr(0xc3).chr(0xbd),
     '\'z' => chr(0xc5).chr(0xba),
     # graves
     '`a' => chr(0xc3).chr(0xa0),
     '`A' => chr(0xc3).chr(0x80),
     '`e' => chr(0xc3).chr(0xa8),
     '`E' => chr(0xc3).chr(0x88),
     '`i' => chr(0xc3).chr(0xac),
     '`I' => chr(0xc3).chr(0x8c),
     '`o' => chr(0xc3).chr(0xb2),
     '`O' => chr(0xc3).chr(0x92),
     '`u' => chr(0xc3).chr(0xb9),
     '`U' => chr(0xc3).chr(0x99),
     # circumflex
     '^a' => chr(0xc3).chr(0xa2),
     '^A' => chr(0xc3).chr(0x82),
     '^c' => chr(0xc4).chr(0x89),
     '^C' => chr(0xc4).chr(0x88),
     '^e' => chr(0xc3).chr(0xaa),
     '^E' => chr(0xc3).chr(0x8a),
     '^g' => chr(0xc4).chr(0x9d),
     '^G' => chr(0xc4).chr(0x9c),
     '^h' => chr(0xc4).chr(0xa5),
     '^H' => chr(0xc4).chr(0xa4),
     '^i' => chr(0xc3).chr(0xae),
     '^I' => chr(0xc3).chr(0x8e),
     '^j' => chr(0xc4).chr(0xb5),
     '^J' => chr(0xc4).chr(0xb4),
     '^o' => chr(0xc3).chr(0xb4),
     '^O' => chr(0xc3).chr(0x94),
     '^s' => chr(0xc5).chr(0x9d),
     '^S' => chr(0xc5).chr(0x9c),
     '^u' => chr(0xc3).chr(0xa2),
     '^U' => chr(0xc3).chr(0xbb),
     '^w' => chr(0xc5).chr(0xb5),
     '^W' => chr(0xc5).chr(0xb4),
     '^y' => chr(0xc5).chr(0xb7),
     '^Y' => chr(0xc5).chr(0xb6),
     
     # diaeresis
     '"a' => chr(0xc3).chr(0xa4),
     '"A' => chr(0xc3).chr(0x84),
     '"e' => chr(0xc3).chr(0xab),
     '"E' => chr(0xc3).chr(0x8b),
     '"\\\\i' => chr(0xc3).chr(0xaf),
     '"\\\\I' => chr(0xc3).chr(0x8f),
     '"o' => chr(0xc3).chr(0xb6),
     '"O' => chr(0xc3).chr(0x96),
     '"u' => chr(0xc3).chr(0xbc),
     '"U' => chr(0xc3).chr(0x9c),
     '"y' => chr(0xc3).chr(0xbf),
     '"Y' => chr(0xc3).chr(0xb8),
     # tilde
     '~A' => chr(0xc3).chr(0x83),
     '~N' => chr(0xc3).chr(0x91),
     '~O' => chr(0xc3).chr(0x95),
     '~a' => chr(0xc3).chr(0xa3),
     '~n' => chr(0xc3).chr(0xb1),
     '~o' => chr(0xc3).chr(0xb5),
     # caron - handled specially
     # double acute
     # ring
     # dot
     '.c' => chr(0xc4).chr(0x8b),
     '.C' => chr(0xc4).chr(0x8a),
     '.e' => chr(0xc4).chr(0x97),
     '.E' => chr(0xc4).chr(0x96),
     '.g' => chr(0xc4).chr(0xa1),
     '.G' => chr(0xc4).chr(0xa0),
     '.I' => chr(0xc4).chr(0xb0),
     '.z' => chr(0xc5).chr(0xbc),
     '.Z' => chr(0xc5).chr(0xbb),
     # macron
     '=a' => chr(0xc4).chr(0x81),
     '=A' => chr(0xc4).chr(0x80),
     '=e' => chr(0xc4).chr(0x93),
     '=E' => chr(0xc4).chr(0x92),
     '=i' => chr(0xc4).chr(0xab),
     '=I' => chr(0xc4).chr(0xaa),
     '=o' => chr(0xc4).chr(0x8d),
     '=O' => chr(0xc4).chr(0x8c),
     '=u' => chr(0xc4).chr(0xab),
     '=U' => chr(0xc4).chr(0xaa),
     
     # stroke - handled specially - see below
     
     # cedilla - handled specially
     );
    
# these are one letter latex commands - we make sure they're not a longer
# command name. eg {\d} is d+stroke, so careful of \d
    my %special_utf8_chars = 
    (
     # breve
     'u g' => chr(0xc4).chr(0x9f),
     'u G' => chr(0xc4).chr(0x9e),
     'u i' => chr(0xc4).chr(0xad),
     'u I' => chr(0xc4).chr(0xac),
     'u o' => chr(0xc5).chr(0x8f),
     'u O' => chr(0xc5).chr(0x8e),
     'u u' => chr(0xc5).chr(0xad),
     'u U' => chr(0xc5).chr(0xac),
     # caron
     'v c' => chr(0xc4).chr(0x8d),
     'v C' => chr(0xc4).chr(0x8c),
     'v n' => chr(0xc5).chr(0x88),
     'v N' => chr(0xc5).chr(0x87),
     'v s' => chr(0xc5).chr(0xa1),
     'v S' => chr(0xc5).chr(0xa5),
     'v z' => chr(0xc5).chr(0xbe),
     'v Z' => chr(0xc5).chr(0xbd),
     # cedilla
     'c c' => chr(0xc3).chr(0xa7),
     'c C' => chr(0xc3).chr(0x87),
     'c g' => chr(0xc4).chr(0xa3),
     'c G' => chr(0xc4).chr(0xa2),
     'c k' => chr(0xc4).chr(0xb7),
     'c K' => chr(0xc4).chr(0xb6),
     'c l' => chr(0xc4).chr(0xbc),
     'c L' => chr(0xc4).chr(0xbb),
     'c n' => chr(0xc5).chr(0x86),
     'c N' => chr(0xc5).chr(0x85),
     'c r' => chr(0xc5).chr(0x97),
     'c R' => chr(0xc5).chr(0x96),
     'c s' => chr(0xc5).chr(0x9f),
     'c S' => chr(0xc5).chr(0x9e),
     'c t' => chr(0xc5).chr(0xa3),
     'c T' => chr(0xc5).chr(0xa2),
     # double acute / Hungarian accent
     'H O' => chr(0xc5).chr(0x90),
     'H o' => chr(0xc5).chr(0x91),
     'H U' => chr(0xc5).chr(0xb0),
     'H u' => chr(0xc5).chr(0xb1),
     
     # stroke 
     'd' => chr(0xc4).chr(0x91),
     'D' => chr(0xc4).chr(0x90),
     'h' => chr(0xc4).chr(0xa7),
#    'H' => chr(0xc4).chr(0xa6), # !! this normally(!!?) means Hung. umlaut
     'i' => chr(0xc4).chr(0xb1), # dotless lowercase i
     'l' => chr(0xc5).chr(0x82),
     'L' => chr(0xc5).chr(0x81),
     'o' => chr(0xc3).chr(0xb8),
     'O' => chr(0xc3).chr(0x98),
     't' => chr(0xc5).chr(0xa7),
     'T' => chr(0xc5).chr(0xa6),
     # german ss/szlig/sharp s
     'ss' => chr(0xc3).chr(0x9f),
     );
    
    # convert latex-style accented characters.

    # remove space (if any) between \ and letter to accent (eg {\' a})

    $text =~ s@(\\[`'="^~\.])\s(\w)@$1$2@g; #`
           
    # remove {} around a single character (eg \'{e})
    $text =~ s@(\\[`'="^~\.]){(\w)}@{$1$2}@g; #`

    # \, is another way of doing cedilla \c
    $text =~ s@\\,(.)@\\c $1@g;

    # remove {} around a single character for special 1 letter commands -
    # need to insert a space. Eg \v{s}  ->  {\v s}
    $text =~ s@(\\[uvcH]){(\w)}@{$1 $2}@g;

    # only do if the text contains a '\' character. 
    if ($text =~ m|\\|) {
    # "normal" accents - ie non-alpha latex tag
    while ($text =~ m@\\([`'="^~\.])([\w])@) { #`
        my $tex="$1$2"; my $char="$2";
        my $replacement=$utf8_chars{$tex};
        if (!defined($replacement)) {
        print STDERR "BibTexPlug: Warning: unknown latex accent \"$tex\" in \"$text\"\n";
        $replacement=$char;
        }
        $text =~ s/\\\Q$tex/$replacement/g;
    }

        # where the following letter matters (eg "sm\o rrebr\o d", \ss{})
        # only do the change if immediately followed by a space, }, {, or \
    # one letter accents ( + ss)
        while ($text =~ m@\\([DdhiLlOoTt]|ss)[{}\s\"\\]@) {
        my $tex=$1;
        my $replacement=$special_utf8_chars{$tex};
        if (!defined($replacement)) {
        print STDERR "BibTexPlug: Warning: unknown latex accent \"$tex\" in \"$text\"\n";
        $replacement=$tex;
        }
        $text =~ s/\\$tex([{}\s\"\\])/$replacement$1/g;

    }

    # one letter latex accent commands that affect following letter
        while ($text =~ m@\\([uvcH]) ([\w])@) {
          my $tex="$1 $2"; my $char="$2";
          my $replacement=$special_utf8_chars{$tex};
          if (!defined($replacement)) {
          print STDERR "BibTexPlug: Warning: unknown latex accent \"$tex\" in \"$text\"\n";
          $replacement=$char;
      }
          $text =~ s/\\$tex/$replacement/g;
        }
    }

    # escape html-sensitive characters
    $text =~ s@&@&amp;@g;
    $text =~ s@<@&lt;@g;
    $text =~ s@>@&gt;@g;
    $text =~ s/''/"/g; # Latex-specific
    $text =~ s/``/"/g; # Latex-specific
    # greenstone-specific
    $text =~ s@\[@&\#91;@g;
    $text =~ s@\]@&\#93;@g;

    # remove latex commands

    # explicitly recognised commands
    $text =~ s@\\ldots@&hellip;@g;

    # maths mode
    $text =~ s@\$(.*?)\$@&process_latex_math($1)@ge;

    # remove all other commands with optional arguments...
    $text =~ s@\\\w+(\[.*?\])?\s*@@g;
    # $text =~ s@\\noopsort{[^}]+\}@@g;
    # $text =~ s@\\\w+{(([^}]*[^\\])*)}@$1@g; # all other commands
    
    # remove latex groupings { } (but not \{ or \} )
    while ($text =~ s/([^\\])[\{\}]/$1/g) {;} # needed for "...}{..."
    $text =~ s/^\{//; # remove { if first char
    
    # latex characters
    # spaces - nobr space (~), opt break (\-), append ("#" - bibtex only)
    $text =~ s/([^\\])~+/$1 /g; # non-breaking space  "~"
    # optional break "\-"
    if ($text =~ m/[^&]\#/) { # concat macros (bibtex) but not HTML codes
    # the non-macro bits have quotes around them - we just remove quotes
    $text =~ s/([^&])[\"\#]/$1/g;
    }
    # dashes. Convert (m|n)-dash into single dash for html.
    $text =~ s@\-\-+@\-@g;

    # quoted { } chars
    $text =~ s@\\{@{@g;
    $text =~ s@\\}@}@g;

    # finally to protect against macro language...
    $text =~ s@\\@\\\\@g;

    return $text;
}


sub process_latex_math {
    my $text = shift;

    $text =~ s@\\infty@infinity@g;       # or unicode 0x221E...
    $text =~ s@\^{(.*?)}@<sup>$1</sup>@g; # superscript
    $text =~ s@\^([^\{])@<sup>$1</sup>@g;
    $text =~ s@\_{(.*?)}@<sub>$1</sub>@g; # subscript
    $text =~ s@\_([^\{])@<sub>$1</sub>@g;

    # put all other command names in italics
    $text =~ s@\\([\w]+)@<i>$1</i>@g;

    return $text;
}

sub set_OID {
    my $self = shift (@_);
    my ($doc_obj, $id, $segment_number) = @_;
    
    if ( $self->{'key'} eq "default") {
    $doc_obj->set_OID("$id\_$segment_number");
    } else {
    $doc_obj->set_OID($self->{'key'});
    }
}

1;