#!/usr/bin/env perl

# Usage: blogparse entry.html
#
# This example script takes a blog entry from omasana.fi and extracts
# its contents. The result is stored into a MLDBM file 'entries.db',
# which provides a persistent, semi-transparent hash structure. See
# printentries.pl for a use example.
#
# Note that this script needs an internet connection to fetch the
# comments, as they are not stored on the same page as the blog entry.
#
# See http://search.cpan.org/perldoc?MLDBM for more information

use strict;
use warnings;
use diagnostics;

use URI;
use LWP::UserAgent;
use HTML::TreeBuilder;

use MLDBM qw(DB_File Storable);
use Fcntl;

use constant URI_OMASANA => URI->new("http://omasana.fi");

my $inputfile = $ARGV[0];

print STDERR "Usage: ./blogparse blogentry.html\n" and exit unless defined $inputfile;

my $outputfile = "entries.db";

my %entries;
tie(%entries, 'MLDBM', $outputfile, O_CREAT|O_RDWR, 0640) or die $!;

my $tree = HTML::TreeBuilder->new_from_file($inputfile);
my $entry = get_entry(\$tree);

sub get_entry {
    my $tree = ${shift()};

    my $entry = $tree->look_down('_tag' => 'div',
                                 'class' => 'entry');

    ### Title, Writer, Date

    my $title = $entry->look_down('_tag' => 'h3')->as_text();

    # FIXME: We should also get the name of the blog. Pay attention to
    # cases where there are multiple writers in one blog. (e.g. 'ylläpidossa')
    my $writer = $entry->look_down('_tag' => 'span',
                                   'class' => 'writer')->as_text();

    my $date = $entry->look_down('_tag' => 'span',
                                 'class' => 'date')->as_text();

    ### Rating

    my $rating = $entry->look_down('_tag' => 'div',
                                   'class' => 'rating');

    $rating = $rating->look_down('_tag' => 'h4');

    my $sign = $rating->attr('class') eq 'negative' ? '-' : '+';

    my $score = $sign . $rating->as_text();

    ### Content
    # Note: This might not actually get all of the content; we should perhaps filter out the divs that hold the metadata.

    my @paragraphs = $entry->look_down('_tag' => 'p');

    my $text = join("\n", map {$_->as_text()} @paragraphs);

    ### Tags
    my $taglist = $tree->look_down('_tag' => 'div',
                                   'class' => 'tags');
    my @tags = map {$_->as_text()} $taglist->look_down('_tag' => 'a') if $taglist;

    ### Comments

    # Comments are very cleverly hidden inside an iframe, so we have to fetch that page

    my $commentsframe = $tree->look_down('_tag' => 'iframe',
                                         'name' => 'keskusteluframe');

    # ID of the entry; this might not be the best place to get it from.
    my ($id) = $commentsframe->attr('src') =~ /articleID=(\d+)$/;

    my $uri = URI->new_abs($commentsframe->attr('src'), URI_OMASANA);
    my $ua = LWP::UserAgent->new();
    my $response = $ua->get($uri);
    my $comments = {};

    if ($response->is_success()) {
        my $commentstree = HTML::TreeBuilder->new_from_content($response->decoded_content);
        $comments = get_comments(\$commentstree);
    }

    my $tmp = {'title'    => $title,
               'writer'   => $writer,
               'tags'     => \@tags,
               'date'     => $date,
               'rating'   => $score,
               'text'     => $text,
               'comments' => $comments};
    $entries{$id} = $tmp;
}

sub get_comments {
    my $tree = ${shift()};

    my $result = {};

    my @comments = $tree->look_down('_tag' => 'div',
                                    'class' => 'msg');

    foreach my $comment (@comments) {
        my $id = $comment->attr('id');

        ### Rating
        my $rating = $comment->look_down('_tag' => 'div',
                                         'class' => 'rating');
        $rating = $rating->look_down('_tag' => 'h4');
        my $sign = $rating->attr('class') eq 'negative' ? '-' : '+';
        my $score = $sign . $rating->as_text();

        ### Writer
        my $writer = $comment->look_down('_tag' => 'span',
                                         'class' => 'writer')->as_text();

        ### Date
        my $date = $comment->look_down('_tag' => 'span',
                                       'class' => 'date')->as_text();
        # TODO: Remove the junk from the end.

        ### Text
        my $text = $comment->look_down('_tag' => 'div',
                                       'class' => 'msgText')->as_text();


        $result->{$id} = {'writer' => $writer,
                          'date'   => $date,
                          'text'   => $text,
                          'rating' => $score};
    }

    return $result;
}
