| 1 | package XML::Atom::Atompub; |
|---|
| 2 | |
|---|
| 3 | use strict; |
|---|
| 4 | use warnings; |
|---|
| 5 | |
|---|
| 6 | use XML::Atom::Entry; |
|---|
| 7 | use XML::Atom::Service; |
|---|
| 8 | use XML::Atom::Thing; |
|---|
| 9 | |
|---|
| 10 | unless (XML::Atom::Entry->can('edited')) { |
|---|
| 11 | *XML::Atom::Entry::edited = sub { |
|---|
| 12 | my($self, $edited) = @_; |
|---|
| 13 | my $ns_uri = $XML::Atom::Service::DefaultNamespace; |
|---|
| 14 | my $app = XML::Atom::Namespace->new(app => $ns_uri); |
|---|
| 15 | if ($edited) { |
|---|
| 16 | $self->set($app, 'edited', $edited); |
|---|
| 17 | } |
|---|
| 18 | else { |
|---|
| 19 | $self->get($app, 'edited'); |
|---|
| 20 | } |
|---|
| 21 | }; |
|---|
| 22 | } |
|---|
| 23 | |
|---|
| 24 | unless (XML::Atom::Entry->can('control')) { |
|---|
| 25 | XML::Atom::Entry->mk_object_list_accessor('control' => 'XML::Atom::Control'); |
|---|
| 26 | |
|---|
| 27 | package XML::Atom::Control; |
|---|
| 28 | |
|---|
| 29 | use base qw(XML::Atom::Base); |
|---|
| 30 | |
|---|
| 31 | __PACKAGE__->mk_elem_accessors(qw(draft)); |
|---|
| 32 | |
|---|
| 33 | sub element_name { 'control' } |
|---|
| 34 | |
|---|
| 35 | sub element_ns { $XML::Atom::Service::DefaultNamespace } |
|---|
| 36 | } |
|---|
| 37 | |
|---|
| 38 | unless (XML::Atom::Content->can('src')) { |
|---|
| 39 | XML::Atom::Content->mk_attr_accessors(qw(src)); |
|---|
| 40 | } |
|---|
| 41 | |
|---|
| 42 | unless (XML::Atom::Thing->can('alternate_link')) { |
|---|
| 43 | *XML::Atom::Thing::alternate_link = sub { |
|---|
| 44 | my($atom, @args) = @_; |
|---|
| 45 | my @hrefs; |
|---|
| 46 | if (@args) { |
|---|
| 47 | my @links1 = grep { $_->rel && $_->rel ne 'alternate'} $atom->links; |
|---|
| 48 | my @links2 = map { my $link = XML::Atom::Link->new; |
|---|
| 49 | $link->rel('alternate'); |
|---|
| 50 | $link->href($_); |
|---|
| 51 | $link } |
|---|
| 52 | @args; |
|---|
| 53 | $atom->link( @links1, @links2 ); |
|---|
| 54 | @hrefs = @_; |
|---|
| 55 | } |
|---|
| 56 | else { |
|---|
| 57 | @hrefs = map { $_->href } grep { ! $_->rel || $_->rel eq 'alternate' } $atom->links; |
|---|
| 58 | } |
|---|
| 59 | wantarray ? @hrefs : $hrefs[0]; |
|---|
| 60 | }; |
|---|
| 61 | } |
|---|
| 62 | |
|---|
| 63 | for my $rel qw(self edit edit-media related enclosure via first previous next last) { |
|---|
| 64 | no strict 'refs'; ## no critic |
|---|
| 65 | |
|---|
| 66 | my $method = join '_', $rel, 'link'; |
|---|
| 67 | $method =~ s/-/_/g; |
|---|
| 68 | |
|---|
| 69 | next if XML::Atom::Thing->can($method); |
|---|
| 70 | |
|---|
| 71 | *{"XML::Atom::Thing::$method"} = sub { |
|---|
| 72 | my($atom, @args) = @_; |
|---|
| 73 | my @hrefs; |
|---|
| 74 | if (@args) { |
|---|
| 75 | my @links1 = grep { ! $_->rel || $_->rel ne $rel } $atom->links; |
|---|
| 76 | my @links2 = map { my $link = XML::Atom::Link->new; |
|---|
| 77 | $link->rel( $rel ); |
|---|
| 78 | $link->href($_); |
|---|
| 79 | $link } |
|---|
| 80 | @args; |
|---|
| 81 | $atom->link( @links1, @links2 ); |
|---|
| 82 | @hrefs = @_; |
|---|
| 83 | } |
|---|
| 84 | else { |
|---|
| 85 | @hrefs = map { $_->href } grep { $_->rel && $_->rel eq $rel } $atom->links; |
|---|
| 86 | } |
|---|
| 87 | wantarray ? @hrefs : $hrefs[0]; |
|---|
| 88 | }; |
|---|
| 89 | } |
|---|
| 90 | |
|---|
| 91 | 1; |
|---|
| 92 | __END__ |
|---|
| 93 | |
|---|
| 94 | =head1 NAME |
|---|
| 95 | |
|---|
| 96 | XML::Atom::Atompub |
|---|
| 97 | - Extensions of XML::Atom for the Atom Publishing Protocol |
|---|
| 98 | |
|---|
| 99 | |
|---|
| 100 | =head1 SYNOPSIS |
|---|
| 101 | |
|---|
| 102 | use XML::Atom::Entry; |
|---|
| 103 | use XML::Atom::Feed; |
|---|
| 104 | use XML::Atom::Atompub; |
|---|
| 105 | |
|---|
| 106 | my $entry = XML::Atom::Entry->new; |
|---|
| 107 | |
|---|
| 108 | # <app:edited>2007-01-01T00:00:00Z</app:edited> |
|---|
| 109 | $entry->edited('2007-01-01T00:00:00Z'); |
|---|
| 110 | |
|---|
| 111 | # <app:control><app:draft>yes</app:draft></app:control> |
|---|
| 112 | my $control = XML::Atom::Control->new; |
|---|
| 113 | $control->draft('yes'); |
|---|
| 114 | $entry->control($control); |
|---|
| 115 | |
|---|
| 116 | # <content type="image/png" src="http://example.com/foo.png"/> |
|---|
| 117 | my $content = XML::Atom::Content->new; |
|---|
| 118 | $content->type('image/png'); |
|---|
| 119 | $content->src('http://example.com/foo.png'); |
|---|
| 120 | $entry->content($content); |
|---|
| 121 | |
|---|
| 122 | # <link rel="alternate" href="http://example.com/foo.html"/> |
|---|
| 123 | $entry->alternate_link('http://example.com/foo.html'); |
|---|
| 124 | |
|---|
| 125 | my $feed = XML::Atom::Feed->new; |
|---|
| 126 | |
|---|
| 127 | # <link rel="self" href="http://example.com"/> |
|---|
| 128 | $feed->self_link('http://example.com'); |
|---|
| 129 | |
|---|
| 130 | |
|---|
| 131 | =head1 METHODS of XML::Atom |
|---|
| 132 | |
|---|
| 133 | Some elements are introduced by the Atom Publishing Protocol, which |
|---|
| 134 | are imported into L<XML::Atom> by this module. |
|---|
| 135 | |
|---|
| 136 | =head2 $entry->control([ $control ]) |
|---|
| 137 | |
|---|
| 138 | Returns an L<XML::Atom::Control> object representing the control of the |
|---|
| 139 | Entry, or C<undef> if there is no control. |
|---|
| 140 | |
|---|
| 141 | If $control is supplied, it should be an L<XML::Atom::Control> object |
|---|
| 142 | representing the control. For example: |
|---|
| 143 | |
|---|
| 144 | my $control = XML::Atom::Control->new; |
|---|
| 145 | $control->draft('yes'); |
|---|
| 146 | $entry->control($control); |
|---|
| 147 | |
|---|
| 148 | =head2 $entry->edited([ $edited ]) |
|---|
| 149 | |
|---|
| 150 | Returns an I<atom:edited> element. |
|---|
| 151 | |
|---|
| 152 | If $edited is given, sets the I<atom:edited> element. |
|---|
| 153 | |
|---|
| 154 | |
|---|
| 155 | =head2 $content->src([ $src ]) |
|---|
| 156 | |
|---|
| 157 | Returns a value of I<src> attribute in I<atom:content> element. |
|---|
| 158 | |
|---|
| 159 | If $src is given, the I<src> attribute is added. |
|---|
| 160 | |
|---|
| 161 | |
|---|
| 162 | =head2 $atom->alternate_link([ $href ]) |
|---|
| 163 | |
|---|
| 164 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<alternate>. |
|---|
| 165 | |
|---|
| 166 | If $href is given, an I<atom:link> element with a link relation of I<alternate> is added. |
|---|
| 167 | |
|---|
| 168 | |
|---|
| 169 | =head2 $atom->self_link([ $href ]) |
|---|
| 170 | |
|---|
| 171 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<self>. |
|---|
| 172 | |
|---|
| 173 | If $href is given, an I<atom:link> element with a link relation of I<self> is added. |
|---|
| 174 | |
|---|
| 175 | |
|---|
| 176 | =head2 $atom->edit_link([ $href ]) |
|---|
| 177 | |
|---|
| 178 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<edit>. |
|---|
| 179 | |
|---|
| 180 | If $href is given, an I<atom:link> element with a link relation of I<edit> is added. |
|---|
| 181 | |
|---|
| 182 | |
|---|
| 183 | =head2 $atom->edit_media_link([ $href ]) |
|---|
| 184 | |
|---|
| 185 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<edit-media>. |
|---|
| 186 | |
|---|
| 187 | If $href is given, an I<atom:link> element with a link relation of I<edit-media> is added. |
|---|
| 188 | |
|---|
| 189 | |
|---|
| 190 | =head2 $atom->related_link([ $href ]) |
|---|
| 191 | |
|---|
| 192 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<related>. |
|---|
| 193 | |
|---|
| 194 | If $href is given, an I<atom:link> element with a link relation of I<related> is added. |
|---|
| 195 | |
|---|
| 196 | |
|---|
| 197 | =head2 $atom->enclosure_link([ $href ]) |
|---|
| 198 | |
|---|
| 199 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<enclosure>. |
|---|
| 200 | |
|---|
| 201 | If $href is given, an I<atom:link> element with a link relation of I<enclosure> is added. |
|---|
| 202 | |
|---|
| 203 | |
|---|
| 204 | =head2 $atom->via_link([ $href ]) |
|---|
| 205 | |
|---|
| 206 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<via>. |
|---|
| 207 | |
|---|
| 208 | If $href is given, an I<atom:link> element with a link relation of I<via> is added. |
|---|
| 209 | |
|---|
| 210 | |
|---|
| 211 | =head2 $atom->first_link([ $href ]) |
|---|
| 212 | |
|---|
| 213 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<first>. |
|---|
| 214 | |
|---|
| 215 | If $href is given, an I<atom:link> element with a link relation of I<first> is added. |
|---|
| 216 | |
|---|
| 217 | |
|---|
| 218 | =head2 $atom->previous_link([ $href ]) |
|---|
| 219 | |
|---|
| 220 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<previous>. |
|---|
| 221 | |
|---|
| 222 | If $href is given, an I<atom:link> element with a link relation of I<previous> is added. |
|---|
| 223 | |
|---|
| 224 | |
|---|
| 225 | =head2 $atom->next_link([ $href ]) |
|---|
| 226 | |
|---|
| 227 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<next>. |
|---|
| 228 | |
|---|
| 229 | If $href is given, an I<atom:link> element with a link relation of I<next> is added. |
|---|
| 230 | |
|---|
| 231 | |
|---|
| 232 | =head2 $atom->last_link([ $href ]) |
|---|
| 233 | |
|---|
| 234 | Returns a value of I<href> attribute in I<atom:link> element with a link relation of I<last>. |
|---|
| 235 | |
|---|
| 236 | If $href is given, an I<atom:link> element with a link relation of I<last> is added. |
|---|
| 237 | |
|---|
| 238 | |
|---|
| 239 | =head1 SEE ALSO |
|---|
| 240 | |
|---|
| 241 | L<XML::Atom> |
|---|
| 242 | L<XML::Atom::Service> |
|---|
| 243 | |
|---|
| 244 | |
|---|
| 245 | =head1 AUTHOR |
|---|
| 246 | |
|---|
| 247 | Takeru INOUE, E<lt>takeru.inoue _ gmail.comE<gt> |
|---|
| 248 | |
|---|
| 249 | |
|---|
| 250 | =head1 LICENCE AND COPYRIGHT |
|---|
| 251 | |
|---|
| 252 | Copyright (c) 2007, Takeru INOUE C<< <takeru.inoue _ gmail.com> >>. All rights reserved. |
|---|
| 253 | |
|---|
| 254 | This module is free software; you can redistribute it and/or |
|---|
| 255 | modify it under the same terms as Perl itself. See L<perlartistic>. |
|---|
| 256 | |
|---|
| 257 | |
|---|
| 258 | =head1 DISCLAIMER OF WARRANTY |
|---|
| 259 | |
|---|
| 260 | BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY |
|---|
| 261 | FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN |
|---|
| 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES |
|---|
| 263 | PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER |
|---|
| 264 | EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
|---|
| 265 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE |
|---|
| 266 | ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH |
|---|
| 267 | YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL |
|---|
| 268 | NECESSARY SERVICING, REPAIR, OR CORRECTION. |
|---|
| 269 | |
|---|
| 270 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING |
|---|
| 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR |
|---|
| 272 | REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE |
|---|
| 273 | LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, |
|---|
| 274 | OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE |
|---|
| 275 | THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING |
|---|
| 276 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A |
|---|
| 277 | FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF |
|---|
| 278 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF |
|---|
| 279 | SUCH DAMAGES. |
|---|
| 280 | |
|---|
| 281 | =cut |
|---|