[catagits/XML-Feed.git] / lib / XML / Feed / Format / RSS.pm

# $Id$

package XML::Feed::Format::RSS;
use strict;

use base qw( XML::Feed );
use DateTime::Format::Mail;
use DateTime::Format::W3CDTF;

our $PREFERRED_PARSER = "XML::RSS";


sub identify {
    my $class   = shift;
    my $xml     = shift;
    my $tag     = $class->_get_first_tag($xml);
    return ($tag eq 'rss' || $tag eq 'RDF');
}

sub init_empty {
    my ($feed, %args) = @_;
    $args{'version'} ||= '2.0';
    eval "use $PREFERRED_PARSER"; die $@ if $@;
    $feed->{rss} = $PREFERRED_PARSER->new(%args);
    $feed->{rss}->add_module(prefix => "content", uri => 'http://purl.org/rss/1.0/modules/content/');
    $feed->{rss}->add_module(prefix => "dcterms", uri => 'http://purl.org/dc/terms/');    
    $feed->{rss}->add_module(prefix => "atom", uri => 'http://www.w3.org/2005/Atom');
    $feed->{rss}->add_module(prefix => "geo", uri => 'http://www.w3.org/2003/01/geo/wgs84_pos#');
    $feed;
}

sub init_string {
    my $feed = shift;
    my($str) = @_;
    $feed->init_empty;
    if ($str) {
        $feed->{rss}->parse($$str, { hashrefs_instead_of_strings => 1 } );
    }
    $feed;
}

sub format { 'RSS ' . $_[0]->{rss}->{'version'} }

## The following elements are the same in all versions of RSS.
sub title       { shift->{rss}->channel('title', @_) }
sub link        { shift->{rss}->channel('link', @_) }
sub description { shift->{rss}->channel('description', @_) }

# This doesn't exist in RSS
sub id          { }

## This is RSS 2.0 only--what's the equivalent in RSS 1.0?
sub copyright   { shift->{rss}->channel('copyright', @_) }

sub base {
    my $feed = shift;
    if (@_) {
        $feed->{rss}->{'xml:base'} = $_[0];
    } else {
        $feed->{rss}->{'xml:base'};
    }
}

## The following all work transparently in any RSS version.
sub language {
    my $feed = shift;
    if (@_) {
        $feed->{rss}->channel('language', $_[0]);
        $feed->{rss}->channel->{dc}{language} = $_[0];
    } else {
        $feed->{rss}->channel('language') ||
        $feed->{rss}->channel->{dc}{language};
    }
}

sub self_link {
    my $feed = shift;

    if (@_) {
        my $uri = shift;

        $feed->{rss}->channel->{'atom'}{'link'} =
        {
            rel => "self",
            href => $uri,
            type => "application/rss+xml",
        };
    }

    return $feed->{rss}->channel->{'atom'}{'link'};
}


sub generator {
    my $feed = shift;
    if (@_) {
        $feed->{rss}->channel('generator', $_[0]);
        $feed->{rss}->channel->{'http://webns.net/mvcb/'}{generatorAgent} =
            $_[0];
    } else {
        $feed->{rss}->channel('generator') ||
        $feed->{rss}->channel->{'http://webns.net/mvcb/'}{generatorAgent};
    }
}

sub author {
    my $feed = shift;
    if (@_) {
        $feed->{rss}->channel('webMaster', $_[0]);
        $feed->{rss}->channel->{dc}{creator} = $_[0];
    } else {
        $feed->{rss}->channel('webMaster') ||
        $feed->{rss}->channel->{dc}{creator};
    }
}

sub modified {
    my $rss = shift->{rss};
    if (@_) {
        $rss->channel('pubDate',
            DateTime::Format::Mail->format_datetime($_[0]));
        ## XML::RSS is so weird... if I set this, it will try to use
        ## the value for the lastBuildDate, which I don't want--because
        ## this date is formatted for an RSS 1.0 feed. So it's commented out.
        #$rss->channel->{dc}{date} =
        #    DateTime::Format::W3CDTF->format_datetime($_[0]);
    } else {
        my $date;
        eval {
            if (my $ts = $rss->channel('pubDate')) {
                $date = DateTime::Format::Mail->parse_datetime($ts);
            } elsif ($ts = $rss->channel->{dc}{date}) {
                $date = DateTime::Format::W3CDTF->parse_datetime($ts);
            }
        };
        return $date;
    }
}

sub entries {
    my $rss = $_[0]->{rss};
    my @entries;
    for my $item (@{ $rss->{items} }) {
        push @entries, XML::Feed::Entry::Format::RSS->wrap($item);
		$entries[-1]->{_version} = $rss->{'version'};		
    }
    @entries;
}

sub add_entry {
    my $feed  = shift;
    my $entry = shift || return;
    $entry    = $feed->_convert_entry($entry);
    $feed->{rss}->add_item(%{ $entry->unwrap });
}

sub as_xml { $_[0]->{rss}->as_string }

package XML::Feed::Entry::Format::RSS;
use strict;

sub format { 'RSS ' . $_[0]->{'_version'} }

use XML::Feed::Content;

use base qw( XML::Feed::Entry );

sub init_empty { $_[0]->{entry} = { } }

sub base {
    my $entry = shift;
    @_ ? $entry->{entry}->{'xml:base'} = $_[0] : $entry->{entry}->{'xml:base'};
}

sub title {
    my $entry = shift;
    @_ ? $entry->{entry}{title} = $_[0] : $entry->{entry}{title};
}

sub link {
    my $entry = shift;
    if (@_) {
        $entry->{entry}{link} = $_[0];
        ## For RSS 2.0 output from XML::RSS. Sigh.
        $entry->{entry}{permaLink} = $_[0];
    } else {
        $entry->{entry}{link} || $entry->{entry}{guid};
    }
}

sub summary {
    my $item = shift->{entry};
    if (@_) {
        $item->{description} = ref($_[0]) eq 'XML::Feed::Content' ?
            $_[0]->body : $_[0];
        ## Because of the logic below, we need to add some dummy content,
        ## so that we'll properly recognize the description we enter as
        ## the summary.
        if (!$item->{content}{encoded} &&
            !$item->{'http://www.w3.org/1999/xhtml'}{body}) {
            $item->{content}{encoded} = ' ';
        }
    } else {
        ## Some RSS feeds use <description> for a summary, and some use it
        ## for the full content. Pretty gross. We don't want to return the
        ## full content if the caller expects a summary, so the heuristic is:
        ## if the <entry> contains both a <description> and one of the elements
        ## typically used for the full content, use <description> as summary.
        my $txt;
        if ($item->{description} &&
            ($item->{content}{encoded} ||
             $item->{'http://www.w3.org/1999/xhtml'}{body})) {
            $txt = $item->{description};
        }
        XML::Feed::Content->wrap({ type => 'text/plain', body => $txt });
    }
}

sub content {
    my $item = shift->{entry};
    if (@_) {
        my $c;
        if (ref($_[0]) eq 'XML::Feed::Content') {
            if (defined $_[0]->base) {
                $c = { 'content' => $_[0]->body, 'xml:base' => $_[0]->base };
            } else {
                $c = $_[0]->body;
            }
        } else {
            $c = $_[0];
        }
        $item->{content}{encoded} = $c;
    } else {
        my $base;
        my $body =
            $item->{content}{encoded} ||
            $item->{'http://www.w3.org/1999/xhtml'}{body} ||
            $item->{description};
        if ('HASH' eq ref($body)) {
            $base = $body->{'xml:base'};
            $body = $body->{content};
        }
        XML::Feed::Content->wrap({ type => 'text/html', body => $body, base => $base });
    }
}

sub category {
    my $entry = shift;
    my $item  = $entry->{entry};
    if (@_) {
        my @tmp = ($entry->category, @_);
        $item->{category}    = [@tmp];
        $item->{dc}{subject} = [@tmp];
    } else {
        my $r = $item->{category} || $item->{dc}{subject};
        my @r = ref($r)? @$r : ($r);
        return wantarray? @r : $r[0];
    }
}

sub author {
    my $item = shift->{entry};
    if (@_) {
        $item->{author} = $item->{dc}{creator} = $_[0];
    } else {
        $item->{author} || $item->{dc}{creator};
    }
}

## XML::RSS doesn't give us access to the rdf:about for the <item>,
## so we have to fall back to the <link> element in RSS 1.0 feeds.
sub id {
    my $item = shift->{entry};
    if (@_) {
        $item->{guid} = $_[0];
    } else {
        $item->{guid} || $item->{link};
    }
}

sub issued {
    my $item = shift->{entry};
    if (@_) {
        $item->{dc}{date} = DateTime::Format::W3CDTF->format_datetime($_[0]);
        $item->{pubDate} = DateTime::Format::Mail->format_datetime($_[0]);
    } else {
        ## Either of these could die if the format is invalid.
        my $date;
        eval {
            if (my $ts = $item->{pubDate}) {
                my $parser = DateTime::Format::Mail->new;
                $parser->loose;
                $date = $parser->parse_datetime($ts);
            } elsif ($ts = $item->{dc}{date}) {
                $date = DateTime::Format::W3CDTF->parse_datetime($ts);
            }
        };
        return $date;
    }
}

sub modified {
    my $item = shift->{entry};
    if (@_) {
        $item->{dcterms}{modified} =
            DateTime::Format::W3CDTF->format_datetime($_[0]);
    } else {
        if (my $ts = $item->{dcterms}{modified}) {
            return eval { DateTime::Format::W3CDTF->parse_datetime($ts) };
        }
    }
}

sub lat {
    my $item = shift->{entry};
    if (@_) {
        $item->{geo}{lat} = $_[0];
    } else {
        return $item->{geo}{lat};
    }
}

sub long {
    my $item = shift->{entry};
    if (@_) {
        $item->{geo}{long} = $_[0];
    } else {
         return $item->{geo}{long};
    }
}


1;
Commit	Line	Data
3353d70c	1	# $Id$
0d5e38d1	2
729cd7a8	3	package XML::Feed::Format::RSS;
0d5e38d1	4	use strict;
	5
	6	use base qw( XML::Feed );
0d5e38d1	7	use DateTime::Format::Mail;
	8	use DateTime::Format::W3CDTF;
	9
973e1f9e	10	our $PREFERRED_PARSER = "XML::RSS";
973e1f9e	11
9b6bc912	12
	13	sub identify {
	14	my $class = shift;
	15	my $xml = shift;
	16	my $tag = $class->_get_first_tag($xml);
	17	return ($tag eq 'rss' \|\| $tag eq 'RDF');
	18	}
	19
973e1f9e	20	sub init_empty {
4e9c4625	21	my ($feed, %args) = @_;
4e9c4625	22	$args{'version'} \|\|= '2.0';
973e1f9e	23	eval "use $PREFERRED_PARSER"; die $@ if $@;
4e9c4625	24	$feed->{rss} = $PREFERRED_PARSER->new(%args);
fe3b3201	25	$feed->{rss}->add_module(prefix => "content", uri => 'http://purl.org/rss/1.0/modules/content/');
813f78d8	26	$feed->{rss}->add_module(prefix => "dcterms", uri => 'http://purl.org/dc/terms/');
9a36f82c	27	$feed->{rss}->add_module(prefix => "atom", uri => 'http://www.w3.org/2005/Atom');
9a36f82c	28	$feed->{rss}->add_module(prefix => "geo", uri => 'http://www.w3.org/2003/01/geo/wgs84_pos#');
973e1f9e	29	$feed;
	30	}
	31
0d5e38d1	32	sub init_string {
	33	my $feed = shift;
	34	my($str) = @_;
973e1f9e	35	$feed->init_empty;
0d5e38d1	36	if ($str) {
f62087b4	37	$feed->{rss}->parse($$str, { hashrefs_instead_of_strings => 1 } );
0d5e38d1	38	}
	39	$feed;
	40	}
	41
	42	sub format { 'RSS ' . $_[0]->{rss}->{'version'} }
	43
	44	## The following elements are the same in all versions of RSS.
973e1f9e	45	sub title { shift->{rss}->channel('title', @_) }
	46	sub link { shift->{rss}->channel('link', @_) }
	47	sub description { shift->{rss}->channel('description', @_) }
0d5e38d1	48
813f78d8	49	# This doesn't exist in RSS
	50	sub id { }
	51
0d5e38d1	52	## This is RSS 2.0 only--what's the equivalent in RSS 1.0?
973e1f9e	53	sub copyright { shift->{rss}->channel('copyright', @_) }
0d5e38d1	54
5383a560	55	sub base {
	56	my $feed = shift;
	57	if (@_) {
	58	$feed->{rss}->{'xml:base'} = $_[0];
	59	} else {
	60	$feed->{rss}->{'xml:base'};
	61	}
	62	}
	63
0d5e38d1	64	## The following all work transparently in any RSS version.
0d5e38d1	65	sub language {
973e1f9e	66	my $feed = shift;
	67	if (@_) {
	68	$feed->{rss}->channel('language', $_[0]);
	69	$feed->{rss}->channel->{dc}{language} = $_[0];
	70	} else {
	71	$feed->{rss}->channel('language') \|\|
	72	$feed->{rss}->channel->{dc}{language};
	73	}
0d5e38d1	74	}
0d5e38d1	75
9a36f82c	76	sub self_link {
	77	my $feed = shift;
	78
	79	if (@_) {
	80	my $uri = shift;
	81
	82	$feed->{rss}->channel->{'atom'}{'link'} =
	83	{
	84	rel => "self",
	85	href => $uri,
	86	type => "application/rss+xml",
	87	};
	88	}
	89
	90	return $feed->{rss}->channel->{'atom'}{'link'};
	91	}
	92
	93
0d5e38d1	94	sub generator {
973e1f9e	95	my $feed = shift;
	96	if (@_) {
	97	$feed->{rss}->channel('generator', $_[0]);
	98	$feed->{rss}->channel->{'http://webns.net/mvcb/'}{generatorAgent} =
	99	$_[0];
	100	} else {
	101	$feed->{rss}->channel('generator') \|\|
	102	$feed->{rss}->channel->{'http://webns.net/mvcb/'}{generatorAgent};
	103	}
0d5e38d1	104	}
	105
	106	sub author {
973e1f9e	107	my $feed = shift;
	108	if (@_) {
	109	$feed->{rss}->channel('webMaster', $_[0]);
	110	$feed->{rss}->channel->{dc}{creator} = $_[0];
	111	} else {
	112	$feed->{rss}->channel('webMaster') \|\|
	113	$feed->{rss}->channel->{dc}{creator};
	114	}
0d5e38d1	115	}
	116
	117	sub modified {
973e1f9e	118	my $rss = shift->{rss};
	119	if (@_) {
	120	$rss->channel('pubDate',
	121	DateTime::Format::Mail->format_datetime($_[0]));
	122	## XML::RSS is so weird... if I set this, it will try to use
	123	## the value for the lastBuildDate, which I don't want--because
	124	## this date is formatted for an RSS 1.0 feed. So it's commented out.
	125	#$rss->channel->{dc}{date} =
	126	# DateTime::Format::W3CDTF->format_datetime($_[0]);
fe3b3201	127	} else {
	128	my $date;
	129	eval {
	130	if (my $ts = $rss->channel('pubDate')) {
	131	$date = DateTime::Format::Mail->parse_datetime($ts);
	132	} elsif ($ts = $rss->channel->{dc}{date}) {
	133	$date = DateTime::Format::W3CDTF->parse_datetime($ts);
	134	}
	135	};
	136	return $date;
0d5e38d1	137	}
	138	}
	139
	140	sub entries {
	141	my $rss = $_[0]->{rss};
	142	my @entries;
	143	for my $item (@{ $rss->{items} }) {
729cd7a8	144	push @entries, XML::Feed::Entry::Format::RSS->wrap($item);
3bdbab6f	145	$entries[-1]->{_version} = $rss->{'version'};
0d5e38d1	146	}
	147	@entries;
	148	}
	149
973e1f9e	150	sub add_entry {
33d4cb3f	151	my $feed = shift;
	152	my $entry = shift \|\| return;
	153	$entry = $feed->_convert_entry($entry);
973e1f9e	154	$feed->{rss}->add_item(%{ $entry->unwrap });
	155	}
	156
	157	sub as_xml { $_[0]->{rss}->as_string }
	158
729cd7a8	159	package XML::Feed::Entry::Format::RSS;
0d5e38d1	160	use strict;
0d5e38d1	161
3bdbab6f	162	sub format { 'RSS ' . $_[0]->{'_version'} }
3bdbab6f	163
a749d9b9	164	use XML::Feed::Content;
a749d9b9	165
0d5e38d1	166	use base qw( XML::Feed::Entry );
0d5e38d1	167
973e1f9e	168	sub init_empty { $_[0]->{entry} = { } }
973e1f9e	169
5383a560	170	sub base {
	171	my $entry = shift;
	172	@_ ? $entry->{entry}->{'xml:base'} = $_[0] : $entry->{entry}->{'xml:base'};
	173	}
	174
973e1f9e	175	sub title {
	176	my $entry = shift;
	177	@_ ? $entry->{entry}{title} = $_[0] : $entry->{entry}{title};
	178	}
	179
	180	sub link {
	181	my $entry = shift;
	182	if (@_) {
	183	$entry->{entry}{link} = $_[0];
	184	## For RSS 2.0 output from XML::RSS. Sigh.
	185	$entry->{entry}{permaLink} = $_[0];
	186	} else {
	187	$entry->{entry}{link} \|\| $entry->{entry}{guid};
	188	}
	189	}
a749d9b9	190
a749d9b9	191	sub summary {
973e1f9e	192	my $item = shift->{entry};
	193	if (@_) {
	194	$item->{description} = ref($_[0]) eq 'XML::Feed::Content' ?
	195	$_[0]->body : $_[0];
	196	## Because of the logic below, we need to add some dummy content,
	197	## so that we'll properly recognize the description we enter as
	198	## the summary.
fe3b3201	199	if (!$item->{content}{encoded} &&
973e1f9e	200	!$item->{'http://www.w3.org/1999/xhtml'}{body}) {
fe3b3201	201	$item->{content}{encoded} = ' ';
973e1f9e	202	}
	203	} else {
	204	## Some RSS feeds use <description> for a summary, and some use it
	205	## for the full content. Pretty gross. We don't want to return the
	206	## full content if the caller expects a summary, so the heuristic is:
	207	## if the <entry> contains both a <description> and one of the elements
	208	## typically used for the full content, use <description> as summary.
	209	my $txt;
	210	if ($item->{description} &&
fe3b3201	211	($item->{content}{encoded} \|\|
973e1f9e	212	$item->{'http://www.w3.org/1999/xhtml'}{body})) {
	213	$txt = $item->{description};
	214	}
	215	XML::Feed::Content->wrap({ type => 'text/plain', body => $txt });
a749d9b9	216	}
a749d9b9	217	}
0d5e38d1	218
0d5e38d1	219	sub content {
973e1f9e	220	my $item = shift->{entry};
973e1f9e	221	if (@_) {
e3b96b9c	222	my $c;
	223	if (ref($_[0]) eq 'XML::Feed::Content') {
	224	if (defined $_[0]->base) {
	225	$c = { 'content' => $_[0]->body, 'xml:base' => $_[0]->base };
	226	} else {
	227	$c = $_[0]->body;
	228	}
	229	} else {
	230	$c = $_[0];
	231	}
fe3b3201	232	$item->{content}{encoded} = $c;
973e1f9e	233	} else {
7c89ffff	234	my $base;
973e1f9e	235	my $body =
fe3b3201	236	$item->{content}{encoded} \|\|
973e1f9e	237	$item->{'http://www.w3.org/1999/xhtml'}{body} \|\|
e3b96b9c	238	$item->{description};
	239	if ('HASH' eq ref($body)) {
	240	$base = $body->{'xml:base'};
	241	$body = $body->{content};
	242	}
7c89ffff	243	XML::Feed::Content->wrap({ type => 'text/html', body => $body, base => $base });
973e1f9e	244	}
0d5e38d1	245	}
	246
	247	sub category {
a0cca2a4	248	my $entry = shift;
a0cca2a4	249	my $item = $entry->{entry};
973e1f9e	250	if (@_) {
a0cca2a4	251	my @tmp = ($entry->category, @_);
	252	$item->{category} = [@tmp];
	253	$item->{dc}{subject} = [@tmp];
973e1f9e	254	} else {
a0cca2a4	255	my $r = $item->{category} \|\| $item->{dc}{subject};
	256	my @r = ref($r)? @$r : ($r);
	257	return wantarray? @r : $r[0];
973e1f9e	258	}
0d5e38d1	259	}
	260
	261	sub author {
973e1f9e	262	my $item = shift->{entry};
	263	if (@_) {
	264	$item->{author} = $item->{dc}{creator} = $_[0];
	265	} else {
	266	$item->{author} \|\| $item->{dc}{creator};
	267	}
0d5e38d1	268	}
	269
	270	## XML::RSS doesn't give us access to the rdf:about for the <item>,
	271	## so we have to fall back to the <link> element in RSS 1.0 feeds.
	272	sub id {
973e1f9e	273	my $item = shift->{entry};
	274	if (@_) {
	275	$item->{guid} = $_[0];
	276	} else {
	277	$item->{guid} \|\| $item->{link};
	278	}
0d5e38d1	279	}
	280
	281	sub issued {
973e1f9e	282	my $item = shift->{entry};
	283	if (@_) {
	284	$item->{dc}{date} = DateTime::Format::W3CDTF->format_datetime($_[0]);
	285	$item->{pubDate} = DateTime::Format::Mail->format_datetime($_[0]);
	286	} else {
ecac864a	287	## Either of these could die if the format is invalid.
	288	my $date;
	289	eval {
	290	if (my $ts = $item->{pubDate}) {
	291	my $parser = DateTime::Format::Mail->new;
	292	$parser->loose;
	293	$date = $parser->parse_datetime($ts);
	294	} elsif ($ts = $item->{dc}{date}) {
	295	$date = DateTime::Format::W3CDTF->parse_datetime($ts);
	296	}
	297	};
	298	return $date;
0d5e38d1	299	}
	300	}
	301
	302	sub modified {
973e1f9e	303	my $item = shift->{entry};
973e1f9e	304	if (@_) {
fe3b3201	305	$item->{dcterms}{modified} =
973e1f9e	306	DateTime::Format::W3CDTF->format_datetime($_[0]);
973e1f9e	307	} else {
fe3b3201	308	if (my $ts = $item->{dcterms}{modified}) {
ecac864a	309	return eval { DateTime::Format::W3CDTF->parse_datetime($ts) };
973e1f9e	310	}
0d5e38d1	311	}
	312	}
	313
9a36f82c	314	sub lat {
	315	my $item = shift->{entry};
	316	if (@_) {
bd19b444	317	$item->{geo}{lat} = $_[0];
9a36f82c	318	} else {
bd19b444	319	return $item->{geo}{lat};
9a36f82c	320	}
	321	}
	322
	323	sub long {
	324	my $item = shift->{entry};
	325	if (@_) {
bd19b444	326	$item->{geo}{long} = $_[0];
9a36f82c	327	} else {
bd19b444	328	return $item->{geo}{long};
9a36f82c	329	}
	330	}
	331
	332
0d5e38d1	333	1;