view release on metacpan or  search on metacpan

lib/AnyEvent/Feed.pm  view on Meta::CPAN

package AnyEvent::Feed;
use strict;
no warnings;

use Carp qw/croak/;
use Encode;
use XML::Feed;
use MIME::Base64;
use AnyEvent::HTTP;
use Digest::SHA1 qw/sha1_base64/;
use Scalar::Util qw/weaken/;

our $VERSION = '0.3';

=head1 NAME

AnyEvent::Feed - Receiving RSS/Atom Feed reader with XML::Feed

=head1 VERSION

Version 0.3

=head1 SYNOPSIS

   use AnyEvent;
   use AnyEvent::Feed;

   my $feed_reader =
      AnyEvent::Feed->new (
         url   => 'http://example.com/atom.xml',
      );

   $feed_reader->fetch (sub {
      my ($feed_reader, $new_entries, $feed, $error) = @_;

      if (defined $error) {
         warn "ERROR: $error\n";
         return;
      }

      # $feed is the XML::Feed object belonging to that fetch.

      for (@$new_entries) {
         my ($hash, $entry) = @$_;
         # $hash a unique hash describing the $entry
         # $entry is the XML::Feed::Entry object of the new entries
         # since the last fetch.
      }
   });

   # Or:

   my $feed_reader =
      AnyEvent::Feed->new (
         url      => 'http://example.com/atom.xml',
         interval => $seconds,

         on_fetch => sub {
            my ($feed_reader, $new_entries, $feed, $error) = @_;

            if (defined $error) {
               warn "ERROR: $error\n";
               return;
            }

            # see above
         }
      );

=head1 DESCRIPTION

lib/AnyEvent/Feed.pm  view on Meta::CPAN

=over 4

=item interval => $seconds

If this is set you also have to specify the C<on_fetch> callback (see below).
It will try to fetch the C<$url> every C<$seconds> seconds and call the
callback given by C<on_fetch> with the result.

=item headers => $http_hdrs

Additional HTTP headers for each GET request can be passed in the C<$http_hdrs>
hash reference, just like you would pass it to the C<headers> argument of
the C<http_get> request of L<AnyEvent::HTTP>.

=item username => $http_user

=item password => $http_pass

These are the HTTP username and password that will be used for Basic HTTP
Authentication with the HTTP server when fetching the feed. This is mostly
sugar for you so you don't have to encode them yourself and pass them to the
C<headers> argument above.

=item on_fetch => $cb->($feed_reader, $new_entries, $feed_obj, $error)

This callback is called if the C<interval> parameter is given (see above)
with the same arguments as the callback given to the C<fetch> method (see below).

=item entry_ages => $hash

This will set the hash which keeps track of seen and old entries.
See also the documentation of the C<entry_ages> method below.
The default will be an empty hash reference.

=item max_entry_age => $count

This will set the maximum number of times an entry is kept in the C<entry_ages>
hash after it has not been seen in the feed anymore. The default value is 2
which means that an entry hash is removed from the C<entry_ages> hash after it
has not been seen in the feed for 2 fetches.

=back

=cut

sub new {
   my $this  = shift;
   my $class = ref($this) || $this;
   my $self  = { @_ };
   bless $self, $class;

   $self->{entry_ages} ||= {};

   if (defined $self->{interval}) {
      unless (defined $self->{on_fetch}) {
         croak "no 'on_fetch' callback given!";
      }

      my $wself = $self;
      weaken $wself;

      $self->{timer_cb} = sub {
         $wself->fetch (sub {
            my ($self, $e, $f, $err) = @_;

            $self->{on_fetch}->($self, $e, $f, $err);

            $self->{timer} =
               AnyEvent->timer (
                  after => $self->{interval}, cb => $self->{timer_cb});
         })
      };

      $self->{timer_cb}->();
   }

   return $self
}


sub _entry_to_hash {
   my ($entry) = @_;
   my $x = sha1_base64
      encode 'utf-8',
         (my $a = join '/',
            $entry->title,
            ($entry->summary  ? $entry->summary->body : ''),
            ($entry->content  ? $entry->content->body : ''),
            $entry->id,
            $entry->link);
   $x
}

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

   $self->{entry_ages} ||= {};

   my (@ents) = $self->{feed}->entries;

   my @new;

   # 'age' the old entries
   $self->{entry_ages}->{$_}++ for keys %{$self->{entry_ages}};

   for my $ent (@ents) {
      my $hash = _entry_to_hash ($ent);

      unless (exists $self->{entry_ages}->{$hash}) {
         push @new, [$hash, $ent];
      }

      $self->{entry_ages}->{$hash} = 0; # reset age of old entry.
   }

   for (keys %{$self->{entry_ages}}) {
      delete $self->{entry_ages}->{$_}
         if $self->{entry_ages}->{$_} > $self->{max_entry_ages};
   }