File Coverage

blib/lib/XML/RSS/Headline.pm

Criterion	Covered	Total	%
statement	27	116	23.2
branch	0	46	0.0
condition	0	19	0.0
subroutine	9	24	37.5
pod	13	13	100.0
total	49	218	22.4

package XML::RSS::Headline;
use strict;
use warnings;
use Digest::MD5 qw(md5_base64);
use Encode qw(encode_utf8);
use URI;
use Time::HiRes;
use HTML::Entities qw(decode_entities);
use Carp qw(carp);

# length of headline when from description
use constant DESCRIPTION_HEADLINE => 45;

our $VERSION = 2.32;

sub new {
    my ( $class, %args ) = @_;
    my $self           = bless {}, $class;
    my $first_seen     = $args{first_seen};
    my $headline_as_id = $args{headline_as_id} || 0;
    delete $args{first_seen}     if exists $args{first_seen};
    delete $args{headline_as_id} if exists $args{headline_as_id};

    if ( $args{item} ) {
        unless ( ( $args{item}->{title} || $args{item}->{description} )
            && $args{item}->{link} )
        {
            carp 'item must contain either title/link or description/link';
            return;
        }
    }
    else {
        unless ( $args{url} && ( $args{headline} || $args{description} ) ) {
            carp 'Either item, url/headline. or url/description are required';
            return;
        }
    }

    $self->headline_as_id($headline_as_id);

    for my $method ( keys %args ) {
        if ( $self->can($method) ) {
            $self->$method( $args{$method} );
        }
        else {
            carp "Invalid argument: '$method'";
        }
    }

    unless ( $self->headline ) {
        carp 'Failed to set headline';
        return;
    }

    $self->set_first_seen($first_seen);
    return $self;
}

sub id {
    my ($self) = @_;
    return $self->{_rss_headline_id} if $self->headline_as_id;
    return $self->guid || $self->url;
}

sub guid {
    my ( $self, $guid ) = @_;
    $self->{guid} = $guid if $guid;
    return $self->{guid};
}

sub _cache_id {
    my ($self) = @_;
    $self->{_rss_headline_id}
        = md5_base64( encode_utf8( $self->{safe_headline} ) )
        if $self->{safe_headline};
    return;
}

sub multiline_headline {
    my ($self) = @_;
    my @multiline_headline = split /\n/, $self->headline;
    return wantarray ? @multiline_headline : \@multiline_headline;
}

sub item {
    my ( $self, $item ) = @_;
    return unless $item;
    $self->url( $item->{link} );
    $self->headline( $item->{title} );
    $self->description( $item->{description} );
    $self->guid( $item->{guid} );
    return;
}

sub set_first_seen {
    my ( $self, $hires_time ) = @_;
    $self->{hires_timestamp} = $hires_time;
    $self->{hires_timestamp} = Time::HiRes::time() unless $hires_time;
    return 1;
}

sub first_seen {
    my ($self) = @_;
    return int $self->{hires_timestamp};
}

sub first_seen_hires {
    my ($self) = @_;
    return $self->{hires_timestamp};
}

sub headline {
    my ( $self, $headline ) = @_;
    if ($headline) {
        $self->{headline} = decode_entities $headline;
        if ( $self->{headline_as_id} ) {
            $self->{safe_headline} = $headline;
            $self->_cache_id;
        }
    }
    return $self->{headline};
}

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

    # clean the URL up a bit
    $self->{url} = URI->new($url)->canonical if $url;
    return $self->{url};
}

sub description {
    my ( $self, $description ) = @_;
    if ($description) {
        $self->{description} = decode_entities $description;
        $self->_description_headline unless $self->headline;
    }
    return $self->{description};
}

sub _description_headline {
    my ($self) = @_;
    my $punctuation = qr/[.,?!:;]+/s;

    my $description = $self->{description};
    $description =~ s//\n/g;    # turn br into newline
    $description =~ s/<.+?>/ /g;

    my $headline = ( split $punctuation, $description )[0] || '';
    $headline =~ s/^\s+//;
    $headline =~ s/\s+$//;

    my $build_headline = '';
    for my $word ( split /\s+/, $headline ) {
        $build_headline .= ' ' if $build_headline;
        $build_headline .= $word;
        last if length $build_headline > DESCRIPTION_HEADLINE;
    }

    return unless $build_headline;
    $self->headline( $build_headline .= '...' );
    return;
}

sub headline_as_id {
    my ( $self, $bool ) = @_;
    if ( defined $bool ) {
        $self->{headline_as_id} = $bool;
        $self->_cache_id;
    }
    return $self->{headline_as_id};
}

sub timestamp {
    my ( $self, $timestamp ) = @_;
    $self->{timestamp} = $timestamp if $timestamp;
    return $self->{timestamp};
}

1;

__END__