package OliveHTTP;

=head1 NAME

OliveHTTP - Olive's HTTP Engine

=head1 DESCRIPTION

This library handles most network activity for Olive, and will
eventually handle it all. The whole thing is just a wrapper around
L<LWP::UserAgent>.

=cut

require Exporter;
use warnings;
use strict;
use HTTP::Request;
use OliveMisc;
use OliveWindow;

our @ISA       = qw(Exporter);
our @EXPORT    = qw( &fetchfeed );


=head1 Exported Subroutines

=head2 fetchfeed



=cut

sub fetchfeed {
    my ($cui,$nick) = @_;

    my $c  = $cui->userdata->{c};
    my $l  = $cui->userdata->{log};
    my $ua = $cui->userdata->{ua};
    my $cachefile   = $cui->userdata->{feeds} . "/$nick.cache";
    my $redir_count = 0;
    my $handled     = 0;
    my $res;

    # load cached feed status
    my $msg = join(' ', 'Checking', $c->{feeds}{$nick}{disp}, 'status...');
    winstatmsg($cui,$msg);
    my $cache = load_feed_cache($cui,$cachefile,$nick);

    until ($handled or $redir_count == 10) {
        # check current feed status
        $l->log( level => "debug", message => "$nick: Pinging $c->{feeds}{$nick}{feed}" );
        $res = ping_feed($cui,$nick,
                         $cache->{If_None_Match},$cache->{If_Last_Modified});
        # and handle response
        $handled = handle_feed($res,$cui,$c,$nick);
        $redir_count++;
    }

    # if we hit the redirection limit, count it as a failure
    if ($redir_count == 5) {
        $l->log( level => "warning", message => "$nick: REDIRECT LIMIT EXCEEDED");
        failure_handler($cui,$nick);
    }

    return $handled;
}


=head1 Internal Subroutines

=head2 load_feed_cache

=cut

sub load_feed_cache {
    my ($cui,$cachefile,$nick) = @_;
    my $l = $cui->userdata->{log};
    my $headers;

    $l->log( level => "debug", message => "$nick: Reading cached feed header data");

    if (-e $cachefile) {
        open (CACHE,"<",$cachefile) or 
            $l->log( level => "warning", message => "Can't open feed cache file $cachefile");
        $headers = { If_None_Match => <CACHE>,
                     If_Last_Modified => <CACHE> };
        close CACHE;
        chomp $headers->{If_None_Match} if (defined $headers->{If_None_Match});
        chomp $headers->{If_Last_Modified} if (defined $headers->{If_Last_Modified});
    }
    return $headers;
}


=head2 ping_feed

=cut

sub ping_feed {
    my ($cui, $nick, $nomatch, $lastmod) = @_;
    my $c  = $cui->userdata->{c};
    my $l  = $cui->userdata->{log};
    my $ua = $cui->userdata->{ua};
    my $cachefile = $cui->userdata->{feeds} . "/$nick.cache";

    # get current feed status
    $l->log( level => "debug", message => "$nick: Sending HEAD request");
    my $req = HTTP::Request->new( HEAD => $c->{feeds}{$nick}{feed} );
    $req->header(If_None_Match => $nomatch);
    $req->header(If_Last_Modified => $lastmod);
    my $res = $ua->simple_request($req);

    # store new headers for next time if we have them
    $l->log( level => "debug", message => "$nick: Storing headers in cache file $cachefile");
    if ($res->is_success) {
        open (CACHE,">",$cachefile) or
            $l->log( level => "warning", message => "Can't open feed cache file $cachefile");
        print CACHE $res->header('ETag'), "\n";
        print CACHE $res->header('Last-Modified'), "\n";
        close CACHE;
    }
    return $res
}


=head2 handle_feed

This rountine is the heart of the revamped HTTP processing. It handles
most of the real-world possible HTTP response codes.

Returns 0 to indicate that a redirect has occurred and processing
should restart, otherwise returns the actual HTTP response
code. Currently handled codes:

    200 OK
    301 Permanent Redirect
    302 Temporary Redirect (300, 307 treated as 302)
    304 Not Modified
    404 Not Found
    410 Gone
    4xx Treated as generic client error
    500 Internal Server Error
    5xx Treated as generic server error

Any other response will be treated as unhandled, and a generic
failure.

200 triggers execution of L</get_feed>. 404, 4xx, 500, 5xx, and
unhandled response codes trigger execution of the L</failure_handler>
subroutine.

=cut

sub handle_feed {
    my ($res,$cui,$c,$nick) = @_;
    my $hrc = $res->code;
    my $l   = $cui->userdata->{log};

    $l->log( level => "debug", message => "$nick: Handling HTTP response code");

    if ($hrc == 200) {
        # 200 OK
        get_feed($cui,$nick);
        $l->log( level => "info", message => "$nick: 200 OK" );
        return $hrc;
    } elsif ($hrc == 301) {
        # 301 Permanent Redirect
        # Get new location (store it on success), and reprocess
        my $loc = $res->header('Location');
        $c->{feeds}{$nick}{permfeed} = $c->{feeds}{$nick}{feed} 
            unless (defined $c->{feeds}{$nick}{permfeed});
        $c->{feeds}{$nick}{feed} = $loc;
        $l->log( level => "warning", message => "$nick: 301 REDIRECT - $loc" );
        return 0;
    } elsif ($hrc == 302 or $hrc == 307 or $hrc == 300) {
        # 302 Temporary Redirect (also 307, 300)
        # Fetch from new location and reprocess but don't change URL
        my $loc = $res->header('Location');
        $c->{feeds}{$nick}{origfeed} = $c->{feeds}{$nick}{feed} 
            unless (defined $c->{feeds}{$nick}{origfeed});
        $c->{feeds}{$nick}{feed} = $loc;
        $l->log( level => "info", message => "$nick: 302 TEMP REDIRECT - $loc" );
        return 0;
    } elsif ($hrc == 304) {
        if ($c->{feeds}{$nick}{force}) {
            get_feed($cui,$nick);
            $l->log( level => "info", message => "$nick: 304 BUT FORCED - Fetching anyway" );
            return $hrc;
        } else {
            # 304 Not Modified
            # Do nothing but mark feed as successfully checked (unless forced)
            $c->{feeds}{$nick}{last} = time();
            $c->write;
            $l->log( level => "info", message => "$nick: 304 NOT MODIFIED" );
            return $hrc;
        }
    } elsif ($hrc == 404) {
        # 404 Not Found
        # Increment failure count by one and return unless fail threshold is exceeded
        $l->log( level => "warning", message => "$nick: 404 NOT FOUND" );
        failure_handler($cui,$nick);
        return $hrc;
    } elsif ($hrc == 410) {
        # 410 Gone
        # Mark feed as dormant and inform user
        $c->{feeds}{$nick}{dormant} = 1;
        $c->write;
        $l->log( level => "warning", message => "$nick: 410 GONE - Marked as dormant" );
        feed_err_gone($cui,$nick);
        return $hrc;
    } elsif ($hrc >= 400 and $hrc < 500) {
        # Generic client-side error
        $l->log( level => "warning", message => "$nick: $hrc UNHANDLED CLIENT ERROR" );
        failure_handler($cui,$nick);
        return $hrc;
    } elsif ($hrc == 500) {
        # 500 Internal Server Error
        # Increment failure count by one and return unless fail threshold is exceeded
        $l->log( level => "warning", message => "$nick: 500 TIMEOUT / SERVER ERROR" );
        failure_handler($cui,$nick);
        return $hrc;
    } elsif ($hrc > 500) {
        # Generic server-side error
        $l->log( level => "warning", message => "$nick: $hrc UNHANDLED SERVER ERROR" );
        failure_handler($cui,$nick);
        return $hrc;
    } else {
        # Got a weird one...
        $l->log( level => "warning", message => "$nick: $hrc UNHANDLED HTTP RESPONSE" );
        failure_handler($cui,$nick);
        return $hrc;
    }        
}


=head2 get_feed

=cut

sub get_feed {
    my ($cui,$nick) = @_;
    my $c   = $cui->userdata->{c};
    my $l   = $cui->userdata->{log};
    my $ua  = $cui->userdata->{ua};
    my $feedfile = join('/',$cui->userdata->{feeds},$nick);

    $l->log( level => "debug", message => "$nick: Fetching feed over network");
    my $msg = join(' ','Fetching',$c->{feeds}{$nick}{disp},'...');
    winstatmsg($cui,$msg);

    my $rc = $ua->get($c->{feeds}{$nick}{feed}, ':content_file' => $feedfile);
    if ($rc->is_success) {
        $l->log( level => "debug", message => "$nick: Feed successfully fetched");
        $c->{feeds}{$nick}{last} = time();
        $c->{feeds}{$nick}{failure} = 0;
    } else {
        # sudden error -- we just pinged this feed!
        $l->log( level => "warning", message => ("$nick: ERROR IN FETCH - " . $rc->status_line) );
        failure_handler($cui,$nick);
        return;
    }

    # unset perm feed url for 301s, as the redirect was successful
    if (defined $c->{feeds}{$nick}{permfeed}) {
        $l->log( level => "debug", message => "$nick: Unstoring original URL after successful 301 redirect");
        delete $c->{feeds}{$nick}{permfeed};
    }
    # reset feed url for 302s
    if (defined $c->{feeds}{$nick}{origfeed}) {
        $l->log( level => "debug", message => "$nick: Restoring original URL after 302 redirect");
        $c->{feeds}{$nick}{feed} = $c->{feeds}{$nick}{origfeed};
        delete $c->{feeds}{$nick}{origfeed};
    }
}


=head2 failure_handler

This routine is called when a feed cannot be fetched for any reason
other than a response code of 410 Gone. First the feed's failure count
is incremented by one and then its TTL is modified as follows:

    Fail  TTL Mod
    ----  --------------------------
     1    Set to 0 (Immediate retry)
     2    Original TTL * 0.75
     3    Original TTL * 1.5
     4    Original TTL * 2
     5    Feed marked dormant

After this, a check is made to see if we were attempting to handle a
301 Permanent Redirect; if so then the feed's original URL is restored
so as not to destroy user-entered data on an unsuccessful redirect.

Finally, the feed's last-checked time is set so that the TTL
modifications will have the intended effect even though a successful
check was not made.

=cut

sub failure_handler {
    my ($cui,$nick) = @_;
    my $c = $cui->userdata->{c};
    my $l = $cui->userdata->{log};

    $l->log( level => "debug", message => "$nick: Handling failure status");

    $c->{feeds}{$nick}{failure}++;
    my $fc = $c->{feeds}{$nick}{failure};

    if ($fc == 1) {
        $c->{feeds}{$nick}{origttl} = $c->{feeds}{$nick}{ttl};
        $c->{feeds}{$nick}{ttl} = 0;
    } elsif ($fc == 2) {
        $c->{feeds}{$nick}{ttl} = int( $c->{feeds}{$nick}{origttl} * 0.75 );
    } elsif ($fc == 3) {
        $c->{feeds}{$nick}{ttl} = int( $c->{feeds}{$nick}{origttl} * 1.5 );
    } elsif ($fc == 4) {
        $c->{feeds}{$nick}{ttl} = int( $c->{feeds}{$nick}{origttl} * 2 );
    } elsif ($fc == 5) {
        $c->{feeds}{$nick}{ttl} = $c->{feeds}{$nick}{origttl};
        delete $c->{feeds}{$nick}{origttl};
        $c->{feeds}{$nick}{dormant} = 1;
        feed_err_dormant($cui,$nick);
    }

    # reset feed url for 301s, as the redirect was unsuccessful
    if (defined $c->{feeds}{$nick}{permfeed}) {
        $l->log( level => "warning", message => "$nick: Restoring original URL after failed 301 redirect");
        $c->{feeds}{$nick}{feed} = $c->{feeds}{$nick}{permfeed};
        delete $c->{feeds}{$nick}{permfeed};
    }

    $l->log( level => "warning", 
             message => "$nick: Failure $fc - TTL set to $c->{feeds}{$nick}{ttl}" );
    $c->{feeds}{$nick}{last} = time();
    $c->write;
}


=head2 feed_err_dormant

Alerts user that a feed has been marked dormant due to repeated
retrieval failures.

=cut

sub feed_err_dormant {
    my ($cui, $nick) = @_;
    my $err = <<ERR;
Due to repeated errors in fetching $nick,
the feed has been marked as dormant and will no longer be polled.
You may remove it from your Feeds list or attempt reactivation at
your leisure. Check ~/.olive/errors.log for more information.
ERR
1;
    errorbox($cui,$err,"Alert");
}

=head2 feed_err_gone

Alerts user that a feed has returned a response code of 410 Gone, and
has been marked dormant.

=cut

sub feed_err_gone {
    my ($cui, $nick) = @_;
    my $err = <<ERR;
HTTP code 410 was recieved when fetching $nick
This means the server has marked the feed as 'Gone'.
The feed has been marked as dormant and will no longer be polled.
You may remove it from your Feeds list at your leisure.
ERR
1;
    errorbox($cui,$err,"Alert");
}

=head1 COPYRIGHT & LICENSE

Copyright 2005,2006 Shawn Boyette, All Rights Reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;