lib/Yuki/RSS.pm

package Yuki::RSS;
use strict;
use vars qw($VERSION);

$VERSION = '0.2';

=head1 NAME

Yuki::RSS - The smallest module to generate RSS 1.0. 
It is downward compatible to XML::RSS.

=head1 SYNOPSIS

    use strict;
    use Yuki::RSS;

    my $rss = new Yuki::RSS(
        version => '1.0',
        encoding => 'Shift_JIS'
    );

    $rss->channel(
        title => "Site Title",
        link => "http://url.of.your.site/",
        description  => "The description of your site",
    );

    $rss->add_item(
        title => "Item Title",
        link => "http://url.of.your/item.html",
        description => "Yoo, hoo, hoo",
    );

    print $rss->as_string;

=head1 DESCRIPTION

Yuki::RSS is the smallest RSS 1.0 generator.
This module helps you to create the minimum document of RSS 1.0.
If you need more than that, use XML::RSS.

=head1 METHODS

=over 4

=item new Yuki::RSS (version => $version, encoding => $encoding)

Constructor for Yuki::RSS.
It returns a reference to a Yuki::RSS object.
B<version> must be 1.0.
B<encoding> will be inserted output document as a XML encoding.
This module does not convert to this encoding.

=item add_item (title => $title, link => $link, description => $description)

Adds an item to the Yuki::RSS object.

=item as_string

Returns the RSS string.

=item channel (title => $title, link => $link, description => $desc)

Channel information of RSS.

=head1 SEE ALSO

=over 4

=item L<XML::RSS>

=back

=head1 AUTHOR

Hiroshi Yuki <hyuki@hyuki.com> http://www.hyuki.com/

=head1 LICENSE

Copyright (C) 2001 by Hiroshi Yuki.

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

=cut

# The constructor.
sub new {
    my ($class, %hash) = @_;
    my $self = {
        version => $hash{version},
        encoding => $hash{encoding},
        channel => { },
        items => [],
    };
    return bless $self, $class;
}

# Setting channel.
sub channel {
    my ($self, %hash) = @_;
    foreach (keys %hash) {
        $self->{channel}->{$_} = $hash{$_};
    }
    return $self->{channel};
}

# Adding item.
sub add_item {
    my ($self, %hash) = @_;
    push(@{$self->{items}}, \%hash);
    return $self->{items};
}

sub stylesheet ($%) {
  my $self = shift;
  $self->{stylesheet} = {@_};
}

# 
sub as_string {
    my ($self) = @_;
    unless ($self->{channel}->{'dc:date'}) {
      $self->{channel}->{'dc:date'} = _rfc3339_date (time);
    } else {
      $self->{channel}->{'dc:date'} = _rfc3339_date ($self->{channel}->{'dc:date'});
    }
    my $doc = <<"EOD";
<?xml version="1.0" encoding="$self->{encoding}" ?>
@{[ ref ($self->{stylesheet}) ?
  '<?xml-stylesheet '.(join (' ', map {qq($_="@{[&_escape($self->{stylesheet}->{$_})]}")} keys %{$self->{stylesheet}})).'?>':''
]}
<rdf:RDF
 xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
 xmlns="http://purl.org/rss/1.0/"
 xmlns:dc="http://purl.org/dc/elements/1.1/"
>

<channel rdf:about="@{[&_escape($self->{channel}->{link})]}">
 <title>@{[&_escape($self->{channel}->{title})]}</title>
 <link>@{[&_escape($self->{channel}->{link})]}</link>
 <description>@{[&_escape($self->{channel}->{description})]}</description>
 <dc:language>@{[&_escape($self->{channel}->{'dc:language'})]}</dc:language>
 <dc:date>$self->{channel}->{'dc:date'}</dc:date>
 <items>
  <rdf:Seq>
   @{[
    map {
     qq{<rdf:li rdf:resource="@{[&_escape($_->{link})]}" />}
    } @{$self->{items}}
   ]}
  </rdf:Seq>
 </items>
</channel>
@{[
 map { do {
  my $r = qq{<item rdf:about="@{[&_escape($_->{link})]}">\n};
  for my $element (keys %{$_}) {
    my $c = $_->{$element};
    $c = _rfc3339_date ($c) if $element eq 'dc:date';
    $r .= qq{   <$element>@{[&_escape($c)]}</$element>\n};
  }
  $r . "</item>\n";
 }} @{$self->{items}}
]}
</rdf:RDF>
EOD
}

sub _escape {
    my $s = shift;
    $s =~ s|&|&amp;|g;
    $s =~ s|<|&lt;|g;
    $s =~ s|>|&gt;|g;
    $s =~ s|"|&quot;|g;
    return $s;
}

sub _rfc3339_date ($) {
  my @time = gmtime (shift);
  sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
}

1; # $Date: 2002/12/25 02:04:11 $
1	wakaba	1.1	package Yuki::RSS;
2			use strict;
3			use vars qw($VERSION);
4
5			$VERSION = '0.2';
6
7			=head1 NAME
8
9			Yuki::RSS - The smallest module to generate RSS 1.0.
10			It is downward compatible to XML::RSS.
11
12			=head1 SYNOPSIS
13
14			use strict;
15			use Yuki::RSS;
16
17			my $rss = new Yuki::RSS(
18			version => '1.0',
19			encoding => 'Shift_JIS'
20			);
21
22			$rss->channel(
23			title => "Site Title",
24			link => "http://url.of.your.site/",
25			description => "The description of your site",
26			);
27
28			$rss->add_item(
29			title => "Item Title",
30			link => "http://url.of.your/item.html",
31			description => "Yoo, hoo, hoo",
32			);
33
34			print $rss->as_string;
35
36			=head1 DESCRIPTION
37
38			Yuki::RSS is the smallest RSS 1.0 generator.
39			This module helps you to create the minimum document of RSS 1.0.
40			If you need more than that, use XML::RSS.
41
42			=head1 METHODS
43
44			=over 4
45
46			=item new Yuki::RSS (version => $version, encoding => $encoding)
47
48			Constructor for Yuki::RSS.
49			It returns a reference to a Yuki::RSS object.
50			B<version> must be 1.0.
51			B<encoding> will be inserted output document as a XML encoding.
52			This module does not convert to this encoding.
53
54			=item add_item (title => $title, link => $link, description => $description)
55
56			Adds an item to the Yuki::RSS object.
57
58			=item as_string
59
60			Returns the RSS string.
61
62			=item channel (title => $title, link => $link, description => $desc)
63
64			Channel information of RSS.
65
66			=head1 SEE ALSO
67
68			=over 4
69
70			=item L<XML::RSS>
71
72			=back
73
74			=head1 AUTHOR
75
76			Hiroshi Yuki <hyuki@hyuki.com> http://www.hyuki.com/
77
78			=head1 LICENSE
79
80			Copyright (C) 2001 by Hiroshi Yuki.
81
82			This program is free software; you can redistribute it and/or
83			modify it under the same terms as Perl itself.
84
85			=cut
86
87			# The constructor.
88			sub new {
89			my ($class, %hash) = @_;
90			my $self = {
91			version => $hash{version},
92			encoding => $hash{encoding},
93			channel => { },
94			items => [],
95			};
96			return bless $self, $class;
97			}
98
99			# Setting channel.
100			sub channel {
101			my ($self, %hash) = @_;
102			foreach (keys %hash) {
103			$self->{channel}->{$_} = $hash{$_};
104			}
105			return $self->{channel};
106			}
107
108			# Adding item.
109			sub add_item {
110			my ($self, %hash) = @_;
111			push(@{$self->{items}}, \%hash);
112			return $self->{items};
113			}
114
115	wakaba	1.2	sub stylesheet ($%) {
116			my $self = shift;
117			$self->{stylesheet} = {@_};
118			}
119
120	wakaba	1.1	#
121			sub as_string {
122			my ($self) = @_;
123	wakaba	1.2	unless ($self->{channel}->{'dc:date'}) {
124			$self->{channel}->{'dc:date'} = _rfc3339_date (time);
125			} else {
126			$self->{channel}->{'dc:date'} = _rfc3339_date ($self->{channel}->{'dc:date'});
127			}
128	wakaba	1.1	my $doc = <<"EOD";
129			<?xml version="1.0" encoding="$self->{encoding}" ?>
130	wakaba	1.2	@{[ ref ($self->{stylesheet}) ?
131			'<?xml-stylesheet '.(join (' ', map {qq($_="@{[&_escape($self->{stylesheet}->{$_})]}")} keys %{$self->{stylesheet}})).'?>':''
132			]}
133	wakaba	1.1	<rdf:RDF
134			xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
135			xmlns="http://purl.org/rss/1.0/"
136	wakaba	1.2	xmlns:dc="http://purl.org/dc/elements/1.1/"
137	wakaba	1.1	>
138
139	wakaba	1.2	<channel rdf:about="@{[&_escape($self->{channel}->{link})]}">
140			<title>@{[&_escape($self->{channel}->{title})]}</title>
141			<link>@{[&_escape($self->{channel}->{link})]}</link>
142			<description>@{[&_escape($self->{channel}->{description})]}</description>
143			<dc:language>@{[&_escape($self->{channel}->{'dc:language'})]}</dc:language>
144			<dc:date>$self->{channel}->{'dc:date'}</dc:date>
145	wakaba	1.1	<items>
146			<rdf:Seq>
147			@{[
148			map {
149	wakaba	1.2	qq{<rdf:li rdf:resource="@{[&_escape($_->{link})]}" />}
150	wakaba	1.1	} @{$self->{items}}
151			]}
152			</rdf:Seq>
153			</items>
154			</channel>
155			@{[
156	wakaba	1.2	map { do {
157			my $r = qq{<item rdf:about="@{[&_escape($_->{link})]}">\n};
158			for my $element (keys %{$_}) {
159			my $c = $_->{$element};
160			$c = _rfc3339_date ($c) if $element eq 'dc:date';
161			$r .= qq{ <$element>@{[&_escape($c)]}</$element>\n};
162	wakaba	1.1	}
163	wakaba	1.2	$r . "</item>\n";
164			}} @{$self->{items}}
165	wakaba	1.1	]}
166			</rdf:RDF>
167			EOD
168			}
169
170	wakaba	1.2	sub _escape {
171			my $s = shift;
172			$s =~ s\|&\|&\|g;
173			$s =~ s\|<\|<\|g;
174			$s =~ s\|>\|>\|g;
175			$s =~ s\|"\|"\|g;
176			return $s;
177			}
178
179			sub _rfc3339_date ($) {
180			my @time = gmtime (shift);
181			sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
182			}
183
184	w	1.3	1; # $Date: 2002/12/25 02:04:11 $