#!/usr/bin/perl

use warnings;
use strict;

use Data::Dumper;
use HTML::Entities;
use LWP::UserAgent qw();
use URI::Encode qw(uri_encode uri_decode);

# Where to grab from
my %sources = (
    "article" => "http://csl.anthropomatik.kit.edu/books.php", # or book. that will need manual fixing.
    "inproceedings" => "http://csl.anthropomatik.kit.edu/konferenzen.php", # conference names will need fixing also
    "phdthesis" => "http://csl.anthropomatik.kit.edu/theses.php",
    "diplomathesis" => "http://csl.anthropomatik.kit.edu/diplomarbeiten.php",
    "bachelorsthesis" => "http://csl.anthropomatik.kit.edu/1853.php",
    "mastersthesis" => "http://csl.anthropomatik.kit.edu/1855.php",
    "studentresearchproject" => "http://csl.anthropomatik.kit.edu/studienarbeiten.php",
    "techreport" => "http://csl.anthropomatik.kit.edu/reports.php",
);

# Where to write files to
my $files_folder = "csl_files/";

# Really download files?
my $really_download = 1;

# Source types
my %sourcetypes = (
    "article" => "journal",
    "inproceedings" => "booktitle",
    "phdthesis" => undef,
    "diplomathesis" => undef,
    "bachelorsthesis" => undef,
    "mastersthesis" => undef,
    "studentresearchproject" => undef,
    "techreport" => undef,
);

# Publications go here
my @publications = ();

# List parsing regular expressions
my $regex_title_link = '<td class="link"><a href="\/([^"]*)">([^<]*)<';

# Single publication parsing regular expressions
my $regex_author = '<th scope="row">Autor:</th>\s*<td[^>]*>(?:<p>)?([^>]*)<';
my $regex_source = '<th scope="row">Quelle:</th>\s*<td[^>]*>(?:<p>)?([^>]*)<';
my $regex_date = '<th scope="row">Datum:</th>\s*<td[^>]*>(?:<p>)?([^>]*)<';
my $regex_pdf = '<td rowspan="3" class="links">\s*<a href="/([^"]*)">';
my $regex_supervisor = '<th scope="row">Betreuer:</th>\s*<td[^>]*>(?:<p>)?([^>]*)<';
my $regex_contentlinks = '<th scope="row">Links:</th>\s*<td[^>]*>(.*?)</td>';
my $regex_additional = '<!-- Textblock \[start\] -->(.*)<!-- Textblock \[end\] -->';
my $regex_additional_inline = '<th scope="row">Zusatzfeld:</th>\s*<td[^>]*>(?:<p>)?([^>]*)<';

# Field sub-parsing regular expressions
my $regex_singlelinks = 'href="/([^"]*)"';

my $regex_volume_a = '\bvol. ([0-9\-()]+),';
my $regex_volume_b = '\bvolume ([0-9\-()]+),';

my $regex_number_a = '\bno. ([0-9\-()]+),*';
my $regex_number_b = '\bnb. ([0-9\-()]+),*';
my $regex_number_c = '\bissue ([0-9\-()]+),*';
my $regex_number_d = '\bnumber ([0-9\-()]+),*';

my $regex_doi_a = '\bdoi:?\s*([^,]*),*';
my $regex_doi_b = '\bdoi=\s*([^,]*),*';

my $regex_pages_a = '\bp+.? ([0-9\-() ]+),*';
my $regex_pages_b = '\bpg.? ([0-9\-() ]+),*';
my $regex_pages_c = '\bpages? ([0-9\-() ]+),*';
my $regex_pages_d = '\bs.? ([0-9\-() ]+),*';

my $regex_conference_a = '\s*\(([^)]*)\)';
my $regex_conference_b = '\s*- (.*)$';

# Collect publication addresses (And titles, for convenience)
for my $type(keys %sources) {

    # Grab website with list
    my $address = $sources{$type};
    my $source = `wget -qO - $address`;
    $source =~ s/\015?\012?//g;
    $source =~ s/\xC3//g; # weird bug
    $source =~ s/\xC2//g; # weird bug
    
    while($source =~ /$regex_title_link/gi) {
        my %publication = ();
        $publication{"type"} = $type;
        $publication{"title"} = $2;
        $publication{"oldlink"} = "http://csl.anthropomatik.kit.edu/$1";
        
        # Trim whitespace from title
        $publication{"title"} =~ s/^\s+|\s+$//g;
        
        push @publications, \%publication;
    }
}

# Iterate publications, get site, grab info
print STDERR "Getting info\n";
for my $publication(@publications) {

    # Grab website
    my $publication_address = $publication->{"oldlink"};
    my $publication_source = `wget -qO - $publication_address`;
    $publication_source =~ s/\015?\012?//g;
    $publication_source =~ s/\xC3//g; # weird bug
    $publication_source =~ s/\xC2//g; # weird bug
    
    # Before cleaning any more:
    # Grab additional data (optional)
    my ($additional) = ($publication_source =~ /$regex_additional/i);
    if(defined $additional) {
        $additional =~ s/^\s+|\s+$//g;
        $additional =~ s/>\s*</></g;
        $publication->{"additional"} = $additional;
    }
    
    # Clean a bit
    $publication_source =~ s/&nbsp;/ /gi;
    decode_entities($publication_source);
    
    $publication_source =~ s/<br>/, /gi;
    $publication_source =~ s/<br\s*\/>/, /gi;
    $publication_source =~ s/<\/br>/, /gi;
    $publication_source =~ s/<p[^>]*>//gi;
    $publication_source =~ s/<\/p[^>]*>//gi;
    $publication_source =~ s/<span[^>]*>//gi;
    $publication_source =~ s/<\/span[^>]*>//gi;
    $publication_source =~ s/<div[^>]*>//gi;
    $publication_source =~ s/<\/div[^>]*>//gi;
    
    # Grab authors
    my ($authors) = ($publication_source =~ /$regex_author/);
    my @authors = split(/\s*,\s*/, $authors);
    $publication->{"authors"} = \@authors;
    
    # Grab date
    my ($date) = ($publication_source =~ /$regex_date/);
    $publication->{"year"} = $date;
    
    # Grab source (optional)
    my ($source) = ($publication_source =~ /$regex_source/);
    if(defined $source) {
        # Sub-parse source for volume
        my ($volume) = ($source =~ /$regex_volume_a/i);
        if(defined($volume)) {
            $source =~ s/$regex_volume_a//i;
            $publication->{"volume"} = $volume;
        }
        
        ($volume) = ($source =~ /$regex_volume_b/i);
        if(defined($volume)) {
            $source =~ s/$regex_volume_b//i;
            $publication->{"volume"} = $volume;
        }
        
        # Sub-parse source for number
        my ($number) = ($source =~ /$regex_number_a/i);
        if(defined($number)) {
            $source =~ s/$regex_number_a//i;
            $publication->{"number"} = $number;
        }
        
        ($number) = ($source =~ /$regex_number_b/i);
        if(defined($number)) {
            $source =~ s/$regex_number_b//i;
            $publication->{"number"} = $number;
        }
        
        ($number) = ($source =~ /$regex_number_c/i);
        if(defined($number)) {
            $source =~ s/$regex_number_c//i;
            $publication->{"number"} = $number;
        }
        
        ($number) = ($source =~ /$regex_number_d/i);
        if(defined($number)) {
            $source =~ s/$regex_number_d//i;
            $publication->{"number"} = $number;
        }
        
        # Sub-parse source for DOI
        my ($doi) = ($source =~ /$regex_doi_a/i);
        if(defined($doi)) {
            $source =~ s/$regex_doi_a//i;
            $publication->{"doi"} = $doi;
        }
        
        ($doi) = ($source =~ /$regex_doi_b/i);
        if(defined($doi)) {
            $source =~ s/$regex_doi_b//i;
            $publication->{"doi"} = $doi;
        }
        
        # Sub-parse source for pages
        my ($pages) = ($source =~ /$regex_pages_a/i);
        if(defined($pages)) {
            $source =~ s/$regex_pages_a//i;
            $publication->{"pages"} = $pages;
        }
        
        ($pages) = ($source =~ /$regex_pages_b/i);
        if(defined($pages)) {
            $source =~ s/$regex_pages_b//i;
            $publication->{"pages"} = $pages;
        }
        
        ($pages) = ($source =~ /$regex_pages_c/i);
        if(defined($pages)) {
            $source =~ s/$regex_pages_c//i;
            $publication->{"pages"} = $pages;
        }
        
        ($pages) = ($source =~ /$regex_pages_d/i);
        if(defined($pages)) {
            $source =~ s/$regex_pages_d//i;
            $publication->{"pages"} = $pages;
        }
        
        # If conference, try to grab conference shortname
        if($publication->{"type"} eq "inproceedings") {
            my ($conference_shortname) = ($source =~ /$regex_conference_a/i);
            if(defined($conference_shortname)) {
                $source =~ s/$regex_conference_a//i;
                $publication->{"note"} = $conference_shortname;
            }
            
            ($conference_shortname) = ($source =~ /$regex_conference_b/i);
            if(defined($conference_shortname)) {
                $source =~ s/$regex_conference_b//i;
                $publication->{"note"} = $conference_shortname;
            }
        }
        
        # Remove excess whitespace and commas from source
        $source =~ s/^\s+|\s+$//g;
        $source =~ s/^,+|,+$//g;
        $source =~ s/^\s+|\s+$//g;
        $source =~ s/^,+|,+$//g;
        $publication->{"source"} = $source;
    }
    
    # Links can be specified in two ways, collect all
    my @links = ();
    
    # Grab PDF link (optional)
    my ($pdflink) = ($publication_source =~ /$regex_pdf/);
    if(defined $pdflink) {
       push @links, "http://csl.anthropomatik.kit.edu/$pdflink";
    }
    
    # Grab links specified as content
    my ($links_source) = ($publication_source =~ /$regex_contentlinks/);
    if(defined $links_source) {
        while($links_source =~ /$regex_singlelinks/gi) {
             push @links, "http://csl.anthropomatik.kit.edu/$1";
        }
    }
    
    # Store links, if any
    if(scalar @links != 0) {
        $publication->{"links"} = \@links;
    }
    
    # Grab supervisors (optional)
    my ($supervisors) = ($publication_source =~ /$regex_supervisor/);
    if(defined $supervisors) {
        my @supervisors = split(/\s*,\s*/, $supervisors);
        $publication->{"supervisors"} = \@supervisors;
    }
    
    # Grab inline additional data (optional)
    my ($additional_inline) = ($publication_source =~ /$regex_additional_inline/);
    if(defined $additional_inline) {
        my $additional = $publication->{"additional"};
        if(not defined $additional) {
            $additional = "";
        }
        $additional .= $additional_inline;
        $publication->{"additional"} = $additional;
    }
}

# Download and fix URLs
print STDERR "Getting files\n";
for my $publication(@publications) {
    my $ua = LWP::UserAgent->new;
    
    # Get all links
    my $links = $publication->{"links"};
    my $url_bibtex = undef;
    if(defined $links) {
        my @links = @{$links};
        my @new_links = ();
        for my $link(@links) {
            my $response = $ua->get($link);
            my @linkparts = split("/", $response->request->uri);
            my $name = uri_decode($linkparts[-1]);
            
            print STDERR "Getting $link -> $name\n";
            my $wget_command = "wget -q -O '" . $files_folder . "/" . $name . "' " . $link;
            if($really_download == 1) {
                `$wget_command`;
            }
            
            my $new_link = "http://new.csl.url.for.files/" . $name;
            push @new_links, $new_link;
        }
        $publication->{"links"} = \@new_links;
    }
}

# Write personal name and conference name summary (to help with fixing up problems)
my %all_persons = ();
my %all_conferences = ();
my %all_conferences_noshort = ();
for my $publication(@publications) {
    my @person_names = @{$publication->{"authors"}};
    my $supervisors = $publication->{"supervisors"};
    if(defined $supervisors) {
        push @person_names, @{$supervisors};
    }
    for my $person(@person_names) {
        $person =~ s/^\s+|\s+$//g;
        $person =~ s/^,+|,+$//g;
        $person =~ s/^\s+|\s+$//g;
        $person =~ s/^,+|,+$//g;
        $all_persons{$person} = 1;
    }
    
    my $conference_shortname = $publication->{"note"};
    if(defined $conference_shortname) {
        if(not defined $all_conferences{$conference_shortname}) {
            $all_conferences{$conference_shortname} = [];
        }
        my @all_conferences_list = @{$all_conferences{$conference_shortname}};
        push @all_conferences_list, $publication->{"source"};
        $all_conferences{$conference_shortname} = \@all_conferences_list;
    }
    else {
        if($publication->{"type"} eq "inproceedings") {
            $all_conferences_noshort{$publication->{"source"}} = 1;
        }
    }
}

print '@comment{List of persons:';
my @all_persons_list = keys %all_persons;
@all_persons_list = sort { lc($a) cmp lc($b) } @all_persons_list;
for my $person(@all_persons_list) {
    print '  ' . $person . "\n";
}
print '}' . "\n\n";

print '@comment{List of conferences:';
my @all_conferences_list = keys %all_conferences;
@all_conferences_list = sort { lc($a) cmp lc($b) } @all_conferences_list;
for my $conference(@all_conferences_list) {
    print '  ' . $conference . " =>\n";
    my @conference_long = @{$all_conferences{$conference}};
    @conference_long = do { my %seen; grep { !$seen{$_}++ } @conference_long };
    for my $conference_long(@conference_long) {
        print '    ' . $conference_long . "\n";
    }
}
print '}' . "\n\n";

print '@comment{List of conferences with no shortname:';
my @all_conferences_list_noshort = keys %all_conferences_noshort;
@all_conferences_list_noshort = sort { lc($a) cmp lc($b) } @all_conferences_list_noshort;
for my $conference_noshort(@all_conferences_list_noshort) {
    print '  ' . $conference_noshort . "\n";
}
print '}' . "\n\n";

# Write an approximation of bibtex
print STDERR "Writing bibtex\n";
for my $publication(@publications) {
    my %publication = %{$publication};
    
    # Type field decides class
    my $type = $publication{"type"};
    delete $publication{"type"};
    
    # Authors need to be lastname, rest (and ...)
    my @authors = @{$publication{"authors"}};
    delete $publication{"authors"};
    
    # We also need the first authors last name
    my $first_author = undef;
    
    my @authors_bibtex = ();
    foreach my $name(@authors) {
        # Remove excess whitespace and commas
        $name =~ s/^\s+|\s+$//g;
        $name =~ s/^,+|,+$//g;
        $name =~ s/^\s+|\s+$//g;
        $name =~ s/^,+|,+$//g;
        
        # Twiddle into correct form
        my @name = split(/\s+/, $name);
        my $last = pop @name;
        my $newname = "$last, " . join(" ", @name);
        push @authors_bibtex, $newname;
        if(not defined $first_author) {
            $first_author = $last;
        }
    }
    my $authors_bibtex = join(" and ", @authors_bibtex);
    
    # Supervisors as well (not a real bibtex field, but w/e)
    my $supervisors = $publication{"supervisors"};
    my $supervisors_bibtex = undef;
    if(defined $supervisors) {
        my @supervisors = @{$supervisors};
        delete $publication{"supervisors"};
        
        my @supervisors_bibtex = ();
        foreach my $name(@supervisors) {
            # Remove excess whitespace and commas
            $name =~ s/^\s+|\s+$//g;
            $name =~ s/^,+|,+$//g;
            $name =~ s/^\s+|\s+$//g;
            $name =~ s/^,+|,+$//g;
            
            # Twiddle into correct form
            my @name = split(/\s+/, $name);
            my $last = pop @name;
            my $newname = "$last, " . join(" ", @name);
            push @supervisors_bibtex, $newname;
        }
        $supervisors_bibtex= join(" and ", @supervisors_bibtex);
    }
    
    # Source field changes depending on type
    my $source_value = $publication{"source"};
    if(defined $source_value) {
        delete $publication{"source"};
    }
    my $source_type = $sourcetypes{$type};
    
    # Old-link goes in a comment
    my $oldlink_comment = '@comment{Old page: ' . $publication{"oldlink"} . '}';
    delete $publication{"oldlink"};
    
    # Additional data goes in a comment as well
    my $additional_comment = undef;
    if(defined  $publication{"additional"}) {
        $additional_comment = '@comment{Additional data: ' . $publication{"additional"} . '}';
        delete $publication{"additional"};
    }
    
    # Links go into url, space-separated
    my $links = $publication{"links"};
    my $url_bibtex = undef;
    if(defined $links) {
        my @links = @{$links};
        delete $publication{"links"};
        $url_bibtex = join(" ", @links);
    }
    
    # Construct reference name
    my @title_parts = split("[^[:alpha:]]", $publication{"title"});
    my $bibtex_cite_name = lc($first_author) . $publication{"year"} . lc($title_parts[0]);
    
    # Umlauts not welcome
    $bibtex_cite_name =~ s/ü/ue/;
    $bibtex_cite_name =~ s/ä/ae/;
    $bibtex_cite_name =~ s/ö/oe/;
    $bibtex_cite_name =~ s/ß/ss/;
    
    # Begin bibtex output
    print $oldlink_comment . "\n";
    print $additional_comment . "\n" if defined($additional_comment);
    print "@" . $type . "{$bibtex_cite_name,\n";
    foreach my $key(keys %publication) {
        print "  " . $key . "={" . $publication{$key} . "},\n";
    }
    print "  " . $source_type . "={" . $source_value . "},\n" if defined($source_type);
    print "  supervisor={" . $supervisors_bibtex . "},\n" if defined($supervisors_bibtex);
    print "  url={" . $url_bibtex . "},\n" if defined($url_bibtex);
    print "  author={" . $authors_bibtex . "}\n";
    print "}\n\n";
}
