# -*- cperl -*-
package RssC::Checker;
use strict;
use warnings;
use RssC::DB;
use RssC::Filter;
use File::Spec;
use LWP::UserAgent;
use HTTP::Cookies;
use HTTP::Status;
use Digest::MD5;
use Encode qw(from_to);
use Encode::Alias;
use Encode::Guess;
my @FILTER;
my $LWP;
my $COOKIE_JAR;

BEGIN {
    define_alias qr/^shift.*jis$/i => '"cp932"';
    define_alias qr/^(x-)?sjis(-jp)?$/i  => '"cp932"';
}

BEGIN {
    my $filter_pm = $INC{'RssC/Filter.pm'};
    my @dirpath = File::Spec->splitdir($filter_pm);
    pop @dirpath;
    my $dirpath = File::Spec->catdir(@dirpath);
    
    foreach my $modfile (<$dirpath/Filter/*.pm>) {
        require $modfile;

        $_ = $modfile;
        s!^$dirpath/Filter/!!;
        s!\.pm$!!;
        my $modname = 'RssC::Filter::' . $_;
        push @FILTER, $modname;
    }
}

sub LWP () {
    if ($LWP) {
        return $LWP;
    }

    $COOKIE_JAR = HTTP::Cookies->new(
        file => 'lwp_cookies.dat');
    
    $LWP = LWP::UserAgent->new;
    $LWP->timeout(120);
    $LWP->agent('Mozilla/1.5 ("RssC" -- RSS Concoction)');
    $LWP->cookie_jar($COOKIE_JAR);
    $LWP->parse_head(1);
    $LWP;
}

sub uri_id {
    if ($_[0] and $_[0] eq __PACKAGE__) {
        shift @_;
    }
    my $uri = shift;

    my ($uri_id) = DB->selectrow_array(q{
        SELECT uri_id
          FROM uri
         WHERE uri = ?
    }, undef, "$uri");
    if (!$uri_id) {
        # まだURI IDが割當てられてゐない。
        DB->do(q{
            INSERT INTO uri
                   (uri)
            VALUES (?  )
        }, undef, "$uri");
        $uri_id = DB->last_insert_id(undef, undef, undef, undef);
    }

    $uri_id;
}

sub check {
    my ($class, $uri) = @_;

    # 1. どのフィルタも興味を持たないURIは、
    #    If-Modified-Since 付きでGETして、
    #    Last-Modifiedが無ければ中身のMD5を取る。
    # 2. 何れかのフィルタが興味を持つURIは、
    #    最初から If-Modified-Since 無しで GET する。
    my @interested_filters;
    foreach (@FILTER) {
        my $mod = $_->new;
        if ($mod->interested_p($uri)) {
            push @interested_filters, $mod;
        }
    }

    my ($old_lastmod) = DB->selectrow_array(q{
	    SELECT lastmod
          FROM last_modified
          LEFT JOIN uri USING (uri_id)
         WHERE uri = ?
    }, undef, $uri->as_string);

    my ($old_title) = DB->selectrow_array(q{
        SELECT title
          FROM title
          LEFT JOIN uri USING (uri_id)
         WHERE uri = ?
    }, undef, $uri->as_string);

    my $req = HTTP::Request->new(
        GET => $uri->as_string,
       );
    
    if (!@interested_filters) {
        # lastmodが存在するなら、If-Modified-Sinceを付けてリクエスト。
        if ($old_lastmod) {
            $req->headers->if_modified_since($old_lastmod);
        }
    }
    
    my $resp = LWP->request($req);
    $COOKIE_JAR->save;

    if ($resp->code eq RC_NOT_MODIFIED) {
        # 更新されてゐないので終了。
        return ($old_lastmod, $old_title);
    }
    elsif ($resp->code eq RC_OK) {
        # 取得成功。
        my $new_lastmod;
        if (!@interested_filters and
              $resp->headers->last_modified) {
            # Last-Modifiedを受け取った。
            $new_lastmod = $resp->headers->last_modified;
        }

        my $md5 = Digest::MD5->new;
        foreach my $line (split /\r?\n|\r/, $resp->content) {
            foreach my $filter (@interested_filters) {
                $line = $filter->filter($uri, $line);
            }
            $md5->add($line);
        }
	
        # DBに登録
        DB->do(q{BEGIN IMMEDIATE});

        my $uri_id = uri_id($uri);

        my $title = do {
            my $t = $resp->header('Title');
            # charset付きのContent-Typeを探し、最後に見付けたものを採用する。
            # parse_headによつて最後にhtml本文がパースされる爲。
            my $charset;
            foreach ($resp->header('Content-Type')) {
                foreach (split /\s*;\s*/, lc) {
                    if (m/^charset=(.+)$/i) {
                        $charset = $1;
                    }
                }
            }
            if ($charset) {
                from_to($t, $charset, 'UTF-8', Encode::FB_XMLCREF);
            }
            else {
                my $enc = guess_encoding(
                    $t, qw/euc-jp cp932 iso-2022-jp utf8/,
                   );
                $enc and
                  from_to($t, $enc, 'UTF-8', Encode::FB_XMLCREF);
            }
            $t;
        };
	
        my ($old_title) = DB->selectrow_array(q{
            SELECT title
              FROM title
             WHERE uri_id = ?
        }, undef, $uri_id);
	
        if ($title and
              (!$old_title or
                 $old_title ne $title)) {
            DB->do(q{
                REPLACE INTO title
                        (uri_id, title)
                 VALUES (?     , ?    )
            }, undef, $uri_id, $title);
        }
        else {
            DB->do(q{
                DELETE FROM title
                 WHERE uri_id = ?
            }, undef, $uri_id);
        }

        if ($new_lastmod) {
            # lastmodのみをREPLACE。
            # MD5は削除。

            DB->do(q{
                DELETE FROM md5
                 WHERE uri_id = ?
            }, undef, $uri_id);
	    
            DB->do(q{
                REPLACE INTO last_modified
                        (uri_id, lastmod)
                 VALUES (?     , ?      )
            }, undef, $uri_id, $new_lastmod);
        }
        else {
            my $new_md5hex = $md5->hexdigest;
            my ($old_md5hex) = DB->selectrow_array(q{
                SELECT md5
                  FROM md5
	         WHERE uri_id = ?
            }, undef, $uri_id);
	    
            if ($old_md5hex and
                  $new_md5hex eq $old_md5hex) {
                # MD5に變化無し => 更新時刻に變化無し
                $new_lastmod = $old_lastmod;
            }
            else {
                # 新しいMD5と更新時刻をREPLACE
                $new_lastmod = time;
		
                DB->do(q{
                    REPLACE INTO md5
                            (uri_id, md5)
                     VALUES (?     , ?  )
                }, undef, $uri_id, $new_md5hex);

                DB->do(q{
                    REPLACE INTO last_modified
                            (uri_id, lastmod)
                     VALUES (?     , ?      )
                }, undef, $uri_id, $new_lastmod);
            }
        }
	
        DB->do(q{COMMIT});
        return ($new_lastmod, $title);
    }
    else {
        die sprintf "Failed to fetch url [%s]: %s\n",
          $uri->as_string,
            $resp->status_line;
    }
}

1;
