view release on metacpan or  search on metacpan

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

   # '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};
   }

   \@new
}

=item $feed_reader->url

Just returns the url that this feed reader is fetching from.

=cut

sub url { $_[0]->{url} }

=item $feed_reader->entry_ages ($new_entry_ages)

=item my $entry_ages = $feed_reader->entry_ages

This will set the age hash which will keep track of already seen entries.
The keys of the hash will be the calculated hashes of the entries and the
values will be a counter of how often they have NOT been seen anymore (kind of
an age counter). After each fetch this hash is updated and seen entries get
a value of 0.

=cut

sub entry_ages {
   defined $_[1]
      ? $_[0]->{entry_ages} = $_[1]
      : $_[0]->{entry_ages}
}

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

This will initiate a HTTP GET on the URL passed to C<new> and call C<$cb> when
done.

C<$feed_reader> is the feed reader object itself.  C<$new_entries> is an
array reference containing the new entries.  A new entry in that array is
another array containing a calculated hash over the contents of the new entry,
and the L<XML::Feed::Entry> object of that entry.  C<$feed_obj> is the
L<XML::Feed> feed object used to parse the fetched feed and contains all
entries (and not just the 'new' ones).

What a 'new' entry is, is decided by a map of hashes as described in the
C<entry_ages> method's documentation above.

=cut

sub _get_headers {
   my ($self, %hdrs) = @_;

   my %hdrs = %{$self->{headers} || {}};

   if (defined $self->{last_mod}) {
      $hdrs{'If-Modified-Since'} = $self->{last_mod};
   }

   $hdrs{Authorization} =
     "Basic " . encode_base64 (join ':', $self->{username}, $self->{password}, '')
        if defined $self->{username};

   \%hdrs
}

sub fetch {
   my ($self, $cb) = @_;

   unless (defined $cb) {
      croak "no callback given to fetch!";
   }

   http_get $self->{url}, headers => $self->_get_headers, sub {
      my ($data, $hdr) = @_;

      #d# warn "HEADERS ($self->{last_mod}): "
      #d#    . (join ",\n", map { "$_:\t$hdr->{$_}" } keys %$hdr)
      #d#    . "\n";

      if ($hdr->{Status} =~ /^2/) {
         my $feed;
         eval {
            $self->{feed} = XML::Feed->parse (\$data);
         };
         if ($@) {
            $cb->($self, undef, undef, "exception: $@");
         } elsif (not defined $self->{feed}) {
            $cb->($self, undef, undef, XML::Feed->errstr);
         } else {
            $cb->($self, $self->_new_entries, $self->{feed});

            $self->{last_mod} = $hdr->{'last-modified'};
         }

      } elsif (defined ($self->{last_mod}) && $hdr->{Status} eq '304') {
         # do nothing, everything was/is fine!
         $cb->($self, [], $self->{feed});

      } else {
         $cb->($self, undef, undef, "$hdr->{Status} $hdr->{Reason}");
      }
   };
}

=back