summaryrefslogblamecommitdiff
path: root/parse_bibtex_html
blob: 9ee6e8def6f9901917a3351547727fed6e6a4b62 (plain) (tree)























                                                                               


                                                                       
















































































                                                                     

                                        
 
                                        






























































                                                                                                                                                             
#!/usr/bin/env perl
# The MIT License (MIT)
# 
# Copyright (c) 2011-2015 Ismaël Bouya http://www.normalesup.org/~bouya/
# 
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.


# Feel like tipping/donating? https://www.immae.eu/licenses_and_tipping


use BibTeX::Parser;
use IO::File;
use utf8;
use strict;
use open ':utf8';

sub parse_config_file {
    my ($config_line, $Name, $Value, $Config);
    (my $File, $Config) = @_;
    if (!open (CONFIG, "$File")) {
        print "ERROR: Config file not found : $File";
        exit(0);
    }
    my $multiline = 0;

    while (<CONFIG>) {
        $config_line=$_;
        chop ($config_line);
        $config_line =~ s/^\s*//;
        $config_line =~ s/\s*$//;
        if ( ($config_line !~ /^#/) && ($config_line ne "") ){
            if ($multiline) {
              $$Config{$Name} =~ s/\\$//;
              $$Config{$Name} .= $config_line;
            } else {
              ($Name, $Value) = split (/\s*=\s*/, $config_line);
              $Value =~ s/^~/$ENV{"HOME"}/;
              $$Config{$Name} = $Value;
            }
            $multiline = ($$Config{$Name} =~ /\\$/);
        }
    }
    close(CONFIG);
}

my %Config;
&parse_config_file ($ENV{"HOME"}."/.parse_bibtex_html.rc", \%Config);

my $biblio = $Config{"biblio"};
my $entete = $Config{"entete"};
my $avant  = $Config{"avant"};
my $milieu = $Config{"milieu"};
my $apres  = $Config{"apres"};
my $html   = $Config{"html"};

my $dossier    = $Config{"dossier"};
my $dossierweb = $Config{"dossier_web"};

# http://webdesign.about.com/library/bl_htmlcodes.htm
sub echap {
    my $t = shift or return;
    $t =~ s/&/&amp;/g;
    $t =~ s/</&lt;/g;
    $t =~ s/>/&gt;/g;

    $t =~ s/--/&mdash;/g;

    $t =~ s/{?\\'a}?/&aacute;/g;
    $t =~ s/{?\\`a}?/&agrave;/g;
    $t =~ s/{?\\"a}?/&auml;/g;

    $t =~ s/{?\\r A}?/&Aring;/g;

    $t =~ s/{?\\'e}?/&eacute;/g;
    $t =~ s/{?\\`e}?/&egrave;/g;
    $t =~ s/{?\\'E}?/&Eacute;/g;
    $t =~ s/{?\\"e}?/&euml;/g;

    $t =~ s/{?\\\^i}?/&icirc;/g;
    $t =~ s/{?\\"i}?/&iuml;/g;

    $t =~ s/{?\\"o}?/&ouml;/g;
    $t =~ s/{?\\"o}?/&ouml;/g;
    $t =~ s/{?\\=o}?/&#333;/g;
    $t =~ s/{?\\o}?/&oslash;/g;

    $t =~ s/{?\\"u}?/&uuml;/g;
    $t =~ s/{?\\'u}?/&uacute;/g;

    $t =~ s/{?\\~n}?/&ntilde;/g;

    $t =~ s/{?\\c\{?c\}?}? ?/&ccedil;/g;
    $t =~ s/{?\\'\{?c\}?}? ?/&#263;/g;

    $t =~ s/{?\\v\{? ?s\}?}? ?/&#353;/g;

    $t =~ s/{?\^({[^}]+}|.)}?/<sup>$1<\/sup>/g;
    $t =~ s/{(.*)}/$1/g;
    return $t;
}

open F, ">".$milieu;
opendir(DIR, $dossier);
my @FILES  = readdir(DIR); 
my $fh     = IO::File->new($biblio);
my $parser = BibTeX::Parser->new($fh);
print F "\t<ul>\n";
my %liste = ();

while (my $entry = $parser->next ) {
	if ($entry->parse_ok) {
		my $type    = $entry->type;
		my $title   = $entry->field("title");
		my $key = $entry->key;
		my @authors = $entry->author;
#		my @editors = $entry->editor;
		my $auth = "";
		my @authors_sort = ();
		foreach my $author (@authors) {
			$auth .= (($author->first)?$author->first. " ":"") .(($author->von)?$author->von." ":"") . (($author->last)?$author->last:"") . ", ";
			push(@authors_sort,$author->last);
			}
		@authors_sort = sort {lc $a cmp lc $b} @authors_sort;
		my $cle_sort = shift(@authors_sort);
		$auth = substr $auth, 0 , -2;
		my $suffix = '(\.|_)';
		my @match = grep(/^$key$suffix/,@FILES);
		my $i = 1;
		my $chaine = "\t\t<li>";
		$auth = echap $auth;
		$title = echap $title;
		if($auth =~ m/\\/ || $title =~ m/\\/) {
			warn "Unparsed item : $auth, $title";
		}
		$chaine .= "<span class='biblio_titre'>".$title."</span><br />".$auth."<br />\n";
		@match = sort {lc $a cmp lc $b} @match;
		foreach my $item (@match) {
			$chaine .= "\t\t\t<a href='".$dossierweb.$item."'>fichier ".$i++."</a> \n";
			}
		$chaine .="\t\t\t<a id='".$key."' href='#".$key."' class='bibtex'>BibTeX</a>\n";
		my $raw = $entry->raw_bibtex;
		$raw =~ s/&/&amp;/g;
		$chaine .= "\t\t\t<pre class='bibtex'>".$raw."</pre>\n";
		$chaine .= "\t\t\t</li>\n";
		$liste{$cle_sort." ".$key} = $chaine;
	} else {
		warn "Error parsing file: " . $entry->error;
		}
	}

foreach my $key (sort keys %liste) {
	print F $liste{$key};
}

print F "\t\t</ul>";
close F;

exec "cat $entete $avant $milieu $apres 1> $html" or die "$!\n";