# ------------------------------------------------------- Monkey::BibTeX
package Monkey::BibTeX;
import Monkey;

$Monkey::Action{fullreference} = 'Monkey::BibTeX::FullReference';
$Monkey::Action{frombibtex} = 'Monkey::BibTeX::FromBibTeX';
$Monkey::Action{bibtex} = 'Monkey::BibTeX::Do';
$Monkey::Action{savebibtex} = 'Monkey::BibTeX::Save';
$Monkey::Action{referencesbibtex} = 'Monkey::BibTeX::ReferencesBibTeX';

our @BibTeXParameters = qw(
    full_reference
    bibtex
    author
    year
    bibtitle
    bibtype
    journal
    volume
    issue
    booktitle
    edition
    editor
    location
    date
    institution
    number
    publisher
    pages_start
    pages_end
    isbn
    url 
);
push @Monkey::QueryParameters, @BibTeXParameters;

sub Do 
{
    require Monkey::APAParser;

    my %Page;
    if( Monkey::Page::Exists($Parameter{id}) ) {
        %Page = Monkey::Page::Open($Parameter{id}, $Parameter{revision});
        foreach (@BibTeXParameters) {
            $Parameter{$_} = $Page{$_} unless exists $Parameter{$_};
            $Parameter{$_} = Monkey::APAParser->cleanup($Parameter{$_});
        }
    }
        
    return ('bibtex', { page => \%Page });
}

sub FullReference 
{
    require Monkey::APAParser;
    my $parser = Monkey::APAParser->new();
    my $error = $parser->parse( $Parameter{full_reference} );
    %Parameter = (%Parameter, %$parser) unless $error;
    return ('bibtex');
}

sub FromBibTeX 
{
    require Text::BibTeX;
    my $entry = new Text::BibTeX::Entry;
    $entry->parse_s( $Parameter{bibtex} );

    my $result = $entry->{values};
    
    foreach (
        [ author => 'author' ],
        [ booktitle => 'booktitle' ],
        [ chapter => 'chapter' ],
        [ edition => 'edition' ],
        [ editor => 'editor' ],
        [ institution => 'institution' ],
        [ journal => 'journal' ],
        [ number => 'issue' ],
        [ organization => 'institution' ],
        [ publisher => 'publisher' ],
        [ school => 'institution' ],
        [ title => 'bibtitle' ],
        [ volume => 'volume' ],
        [ year => 'year' ],
        [ ISBN => 'isbn' ],
        [ ISSN => 'isbn' ],
        [ URL => 'webpage' ],
    ) {
        my ($from, $to) = @$_;
        if( $result->{$from} =~ /\S/ ) {
            $result->{$from} =~ s/[\{\}]//sg;
            $Parameter{$to} = $result->{$from};
        }
    }

    ($Parameter{pages_start}, $Parameter{pages_end}) = ($1, $2)
        if $result->{pages} =~ /(\d+)(?:\D+(\d+))?/;

    $Parameter{bibtype} = $entry->type;
    
    return ('bibtex');
}

sub ToBibTeX
{
    require Monkey::APAParser;
    my %Page = @_;
    
    my %BibTeX;
    my %map = (
        (map { $_ => $_ } @BibTeXParameters),
        issue => undef,
        webpage => 'URL',
        bibtitle => 'title',
        isbn => undef,
        institution => undef,
        pages_start => undef,
        pages_end => undef,
        bibtype => undef,
        bibtex => undef,
        full_reference => undef,
    );
    foreach (@BibTeXParameters) {
        next unless $map{$_};
        $BibTeX{$map{$_}} = Monkey::APAParser->cleanup($Page{$_});
    }
    $BibTeX{number} = $Page{issue} if $Page{issue};

    $BibTeX{keywords} = $Page{tags} if $Page{tags};

    if( $Page{isbn} ) {
        my $key = 'ISBN';
        $key = 'ISSN' if $Page{bibtype} =~ /journal/i; 
        $BibTeX{$key} = $Page{isbn} 
    }

    if( $Page{institution} ) {
        $BibTeX{{
            'phdthesis' => 'school',
            'proceedings' => 'organization', 
            'inproceedings' => 'organization', 
            'techreport' => 'institution', 
        }->{$Page{bibtype}}} = $Page{institution};
    }

    if( $Page{pages_start} ) {
        $BibTeX{pages} = $Page{pages_start};
        $BibTeX{pages} .= '--' . $Page{pages_end} if $Page{pages_end};
    }

    if( $Page{tags} ) {
        $BibTeX{keywords} = $Page{tags};
    }

    require Text::BibTeX::Bib;
    my $entry = new Text::BibTeX::BibEntry;
    $entry->set( %BibTeX );

    my $type = $Page{bibtype} || 'misc';
    $entry->set_type($type);

    $entry->set_metatype(Text::BibTeX::Entry::BTE_REGULAR());

    my @names = $entry->names('author');
    my $authors = join '', 
        map { join '', $_->part('von'), $_->part('last') } @names;
    $entry->set_key( $authors . $BibTeX{year} );

    return $entry;
}

sub Save 
{
    require Monkey::APAParser;
    return &Do unless $Parameter{submit} eq 'Save';

    my @authors = grep $_, split /\s+and\s+|\b,\s+/, $Parameter{author};
    $Parameter{author} = join ' and ', @authors;

    my @editors = grep $_, split /\b\s*and\s+|\b,\s+/, $Parameter{editor};
    $Parameter{editor} = join ' and ', @editors;

    foreach( 
        [ (@authors || @editors || $Parameter{institution}), 'author' ],
        [ $Parameter{year}, 'year' ],
        [ $Parameter{bibtitle}, 'bibtitle' ],
        [ $Parameter{bibtype}, 'bibtype' ],
        [ $Parameter{bibtype} ne 'None of the above', 'bibtype' ],
    ) {
        return ('bibtex', { required => $_->[1] }) unless $_->[0];
    }

    my $entry = ToBibTeX(%Parameter);
    
    my $id = $Parameter{id};
    unless( $id ) {
        my @names = $entry->names('author');
        my $authors = join ', ', 
            map { join ' ', $_->part('von'), $_->part('last') } @names;

        $id = "$authors, $Parameter{year}";
        $id =~ s/\s*$//;
        while( Monkey::Page::Exists($id) ) {
            if( $id =~ /\d{4}$/ ) { $id .= 'a'; }
            elsif( $id =~ /n\.?d\.?$/ ) { $id = "n.d-a"; }
            elsif( $id =~ s/(\P{IsAlpha})([a-z])$/my $a=$2; $1 . ++$a/e ) { 1; }
            elsif( $id =~ /forthcoming$/ ) { $id = "forthcoming-a"; }
        }
    }        

    my %Page = (
        Monkey::Page::Open($id),
        summary => 'BibTeX updated',
        map { $_ => Monkey::APAParser->cleanup($Parameter{$_}) } @BibTeXParameters,
    );
    delete $Page{$_} foreach(qw(full_reference bibtex));

    return Monkey::Edit::Conflict()
        unless %Page = Monkey::Page::Save( %Page );
    Monkey::RecentChanges::Add( %Page );

    return ( redirect => $Parameter{ScriptURL} . '?' . QuoteURL($id));
}

sub ReferencesBibTeX {
    my %Page = Monkey::Page::Open($Parameter{id});
    Monkey::Syntax::Translate( $Page{text} );
    my $references = Monkey::BibIndex::References(Monkey::Syntax::Links());
    
    my $text = join '', map { 
        Monkey::BibTeX::ToBibTeX( %$_ )->print_s . "\n\n"
    } @$references;

    return ( 
        'raw',
        $text,
        {
            type => 'text/plain',
            'content-length' => length($text)
        }
    );
}

1;

package Text::BibTeX::Entry;

use Text::BibTeX qw(change_case);
use Text::BibTeX::NameFormat;
import Monkey;

sub apa {
    my ($self) = @_;

    my $type = $self->type;
    return unless $type;
    my $method = "apa_$type";
    eval {
        my $ref = $self->$method . $self->apa_url;
        $ref =~ s/~/\ /sg;
        $ref =~ s/\.\././s;
        return $ref;
    };
}

sub apa_book {
    my ($self) = @_;

    my @authors = $self->names('author');
    my @editors = $self->names('editor');
    my (undef, $Ed) = $self->apa_editors;
    
    my ($authors, $editors);
    if( @authors ) {
        $authors = $self->apa_authors(@authors);
        $editors = ' (' . $self->apa_editors(@editors) . ", $Ed)" if @editors;
    }

    elsif( @editors ) {
        $authors = $self->apa_authors(@editors) . " ($Ed)";
    }

    return   $authors 
           . $self->apa_year
           . $self->apa_booktitle
           . $editors
           . '.'
           . $self->apa_publisher;
}

sub apa_inbook {
    my ($self) = @_;
    
    my ($editors, $Ed) = $self->apa_editors;

    return   $self->apa_authors 
           . $self->apa_year
           . QuoteHTML($self->{values}->{title}, 'pass entities')
           . ". In $editors ($Ed), "
           . $self->apa_booktitle
           . $self->apa_pages('pp')
           . '.'
           . $self->apa_publisher;
}

sub apa_booktitle {
    my ($self, $title) = @_;
    ($title) = grep $_, ($title, $self->{values}->{booktitle}, $self->{values}->{title});
    $title = QuoteHTML($title, 'pass entities');
    return "<em>$title</em>" . $self->apa_edition;
}

sub apa_article {
    my ($self) = @_;

    my ($title, $journal, $volume, $number) =
        map { QuoteHTML( $self->{values}->{$_}, 'pass entities' ) }
           qw( title journal volume number );

    my $issue = "($number)" if length($number);

    my $pages = $self->apa_pages;
    $pages = ",$pages" if $pages;

    return   $self->apa_authors 
           . $self->apa_year
           . "$title. <em>$journal, $volume</em>$issue$pages."
}

sub apa_proceedings {
    my ($self) = @_;

    my ($editors, $Ed) = $self->apa_editors;
    return   "$editors ($Ed)"
           . $self->apa_year
           . $self->apa_booktitle
           . '.'
           . $self->apa_publisher;
}

sub apa_inproceedings {
    my ($self) = @_;
    my %values = %{$self->{values}};

    my ($editors, $Ed) = $self->apa_editors;
    $editors .= ' ($Ed), ' if $editors;
    return   $self->apa_authors 
           . $self->apa_year('date')
           . QuoteHTML($self->{values}->{title}, 'pass entities')
           . ". In $editors"
           . $self->apa_booktitle
           . $self->apa_pages('pp') 
           . '.' 
           . $self->apa_publisher;
}

sub apa_techreport {
    my ($self) = @_;
    return   $self->apa_institution 
           . $self->apa_year
           . $self->apa_booktitle
           . '. '
           . (join ': ', 
                 $self->apa_location,
                 $self->apa_editors($self->names('author')));
}

sub apa_webpage {
    my ($self) = @_;
    return $self->apa_book;
}

sub apa_url {
    my ($self) = @_;
    my $quoted = QuoteHTML($self->{values}->{URL});
    if ($self->{values}->{URL}) {
        return " Available from <a href='$quoted'>$quoted</a>."
    } 
}

sub apa_year {
    my ($self, $with_date) = @_;
    my ($year, $date) = map { QuoteHTML($self->{values}->{$_}) } qw( year date );
    $date =~ s/,?\s*\d{4}//; # lose the year;
    $year .= ", $date" if $with_date;
    
    return " ($year). ";
}

sub apa_authors {
    my ($self, @authors) = @_;
    @authors = $self->names('author') unless @authors;
    my $formatter = new Text::BibTeX::NameFormat( 'vljf', 1 );
    @authors = map { $formatter->apply($_) } @authors; 
    return $self->apa_namelist(@authors);
}

sub apa_editors {
    my ($self, @editors) = @_;
    @editors = $self->names('editor') unless @editors;
    my $formatter = new Text::BibTeX::NameFormat( 'fvlj', 1 );
    @editors = map { $formatter->apply($_) } @editors;
    
    my $Ed = @editors > 1 ? 'Eds.' : 'Ed.';
    my $names = $self->apa_namelist(@editors);

    return ($names, $Ed) if wantarray;
    return $names;
}

sub apa_namelist {
    my ($self, @names) = @_;
    
    $names[$#names] = "& $names[$#names]" 
        if @names > 1 && $names[$#names] !~ /^et\b/i;
    return QuoteHTML( (join ', ', @names), 'pass entities' ); 
}

sub apa_edition {
    my ($self) = @_;
    my $edition = QuoteHTML($self->{values}->{edition}, 'pass entities');
    return " ($edition ed.)" if $edition;
}

sub apa_pages {
    my ($self, $pp) = @_;
    my $pages = QuoteHTML($self->{values}->{pages}, 'pass entities');
    return unless $pages;
    $pages =~ s/--/-/;
    if( $pp ) {
        my $pp = 'p';
        $pp = 'pp' if $pages =~ /-/;
        return " ($pp. $pages)";
    }
    return " $pages";
}

sub apa_institution {
    my ($self) = @_;
    my @institutions = grep $_, map { QuoteHTML($self->{values}->{$_}, 'pass entities') } qw( institution school organization );
    return shift @institutions;
}

sub apa_location {
    my ($self) = @_;
    if( $self->{values}->{location} ) {
        return QuoteHTML( $self->{values}->{location}, 'pass entities' );
    }
}

sub apa_publisher {
    my ($self) = @_;
    my $result = join ': ', grep $_,
        $self->apa_location, 
        QuoteHTML($self->{values}->{publisher}, 'pass entities');
    return " $result." if $result =~ /\S/;
}

1;