File Coverage

blib/lib/XML/RSS/Private/Output/Base.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 26 28 92.8


line stmt bran cond sub pod time code
1             package XML::RSS::Private::Output::Base;
2              
3 1     1   3 use strict;
  1         1  
  1         21  
4 1     1   3 use warnings;
  1         1  
  1         15  
5              
6 1     1   3 use Carp;
  1         1  
  1         46  
7              
8 1     1   417 use HTML::Entities qw(encode_entities_numeric encode_entities);
  1         3842  
  1         57  
9 1     1   431 use DateTime::Format::Mail;
  1         71396  
  1         27  
10 1     1   403 use DateTime::Format::W3CDTF;
  1         545  
  1         34  
11              
12 1     1   49 use XML::RSS;
  0            
  0            
13              
14             sub new {
15             my $class = shift;
16              
17             my $self = {};
18              
19             bless $self, $class;
20              
21             $self->_initialize(@_);
22              
23             return $self;
24             }
25              
26             # _main() is a reference to the main XML::RSS module
27             sub _main {
28             my $self = shift;
29              
30             if (@_) {
31             $self->{_main} = shift;
32             }
33              
34             return $self->{_main};
35             }
36              
37             sub _encode_cb {
38             my $self = shift;
39              
40             if (@_) {
41             $self->{_encode_cb} = shift;
42             }
43              
44             return $self->{_encode_cb};
45             }
46              
47             sub _item_idx
48             {
49             my $self = shift;
50              
51             if (@_)
52             {
53             $self->{_item_idx} = shift;
54             }
55              
56             return $self->{_item_idx};
57             }
58              
59             sub _initialize {
60             my $self = shift;
61             my $args = shift;
62              
63             $self->{_output} = "";
64             $self->_main($args->{main});
65             # TODO : Remove once we have inheritance proper.
66             $self->_rss_out_version($args->{version});
67             if (defined($args->{encode_cb})) {
68             $self->_encode_cb($args->{encode_cb});
69             }
70             else {
71             $self->_encode_cb(\&_default_encode);
72             }
73              
74             $self->_item_idx(-1);
75              
76             return 0;
77             }
78              
79             sub _rss_out_version {
80             my $self = shift;
81              
82             if (@_) {
83             $self->{_rss_out_version} = shift;
84             }
85             return $self->{_rss_out_version};
86             }
87              
88             sub _encode {
89             my ($self, $text) = @_;
90             return $self->_encode_cb()->($self, $text);
91             }
92              
93             sub _default_encode {
94             my ($self, $text) = @_;
95              
96             #return "" unless defined $text;
97             if (!defined($text)) {
98             confess "\$text is undefined in XML::RSS::_encode(). We don't know how " . "to handle it!";
99             }
100              
101             return $text if (!$self->_main->_encode_output);
102              
103             my $encoded_text = '';
104              
105             while ($text =~ s/(.*?)(\<\!\[CDATA\[.*?\]\]\>)//s) {
106              
107             # we use &named; entities here because it's HTML
108             $encoded_text .= encode_entities($1) . $2;
109             }
110              
111             # we use numeric entities here because it's XML
112             $encoded_text .= encode_entities_numeric($text);
113              
114             return $encoded_text;
115             }
116              
117             sub _out {
118             my ($self, $string) = @_;
119             $self->{_output} .= $string;
120             return;
121             }
122              
123             sub _out_tag {
124             my ($self, $tag, $inner) = @_;
125             my $content = $inner;
126             my $attr = "";
127             if (ref($inner) eq 'HASH') {
128             my %inner_copy = %$inner;
129             $content = delete $inner_copy{content};
130             foreach my $key (keys %inner_copy) {
131             my $value = $inner->{$key};
132             if (defined($value)) {
133             $attr .= " " . $self->_encode($key) . qq{="}
134             . $self->_encode($value) . '"'
135             ;
136             }
137             }
138             }
139             return $self->_out("<$tag$attr>" . $self->_encode($content) . "\n");
140             }
141              
142             # Remove non-alphanumeric elements and return the modified string.
143             # Useful for user-specified tags' attributes.
144              
145             sub _sanitize {
146             my ($self, $string) = @_;
147              
148             $string =~ s{[^a-zA-Z_\-0-9]}{}g;
149             return $string;
150             }
151              
152             sub _out_ns_tag {
153             my ($self, $prefix, $tag, $inner) = @_;
154              
155             my @subtags;
156              
157             if (ref($inner) eq "HASH")
158             {
159             $self->_out("<${prefix}:${tag}");
160             foreach my $attr (sort { $a cmp $b } keys(%{$inner}))
161             {
162             if (ref($inner->{$attr}) eq '')
163             {
164             $self->_out(
165             q{ }
166             . $self->_sanitize($attr)
167             . q{="}
168             . $self->_encode($inner->{$attr})
169             . q{"}
170             );
171             }
172             else
173             {
174             push(@subtags,$attr);
175             }
176             }
177              
178             if (! @subtags)
179             {
180             $self->_out("/>\n");
181             }
182             else
183             {
184             $self->_out(">\n");
185              
186             foreach my $attr (sort { $a cmp $b } @subtags)
187             {
188             if (ref($inner->{$attr}))
189             {
190             _out_ns_tag($self, $prefix, $tag, $inner->{$attr});
191             }
192             }
193              
194             $self->_out("\n");
195             }
196             }
197             elsif (ref($inner) eq 'ARRAY')
198             {
199             map { $self->_out_ns_tag($prefix, $tag, $_) } @{ $inner };
200             }
201             else
202             {
203             return $self->_out_tag("${prefix}:${tag}", $inner);
204             }
205             }
206              
207             sub _out_defined_tag {
208             my ($self, $tag, $inner) = @_;
209              
210             if (defined($inner)) {
211             $self->_out_tag($tag, $inner);
212             }
213              
214             return;
215             }
216              
217             sub _out_array_tag {
218             my ($self, $tag, $inner) = @_;
219              
220             if (ref($inner) eq "ARRAY") {
221             foreach my $elem (@$inner)
222             {
223             $self->_out_defined_tag($tag, $elem);
224             }
225             }
226             else {
227             $self->_out_defined_tag($tag, $inner);
228             }
229              
230             return;
231             }
232              
233             sub _out_inner_tag {
234             my ($self, $params, $tag) = @_;
235              
236             if (ref($params) eq "") {
237             $params = {'ext' => $params, 'defined' => 0,};
238             }
239              
240             my $ext_tag = $params->{ext};
241              
242             if (ref($ext_tag) eq "") {
243             $ext_tag = $self->$ext_tag();
244             }
245              
246             my $value = $ext_tag->{$tag};
247              
248             if ($params->{defined} ? defined($value) : 1) {
249             $self->_out_tag($tag, $value);
250             }
251              
252             return;
253             }
254              
255             sub _output_item_tag {
256             my ($self, $item, $tag) = @_;
257              
258             return $self->_out_tag($tag, $item->{$tag});
259             }
260              
261             sub _output_def_image_tag {
262             my ($self, $tag) = @_;
263              
264             return $self->_out_inner_tag({ext => "image", 'defined' => 1}, $tag);
265             }
266              
267             sub _output_multiple_tags {
268             my ($self, $ext_tag, $tags_ref) = @_;
269              
270             foreach my $tag (@$tags_ref) {
271             $self->_out_inner_tag($ext_tag, $tag);
272             }
273              
274             return;
275             }
276              
277             sub _output_common_textinput_sub_elements {
278             my $self = shift;
279              
280             $self->_output_multiple_tags("textinput", [qw(title description name link)],);
281             }
282              
283              
284             sub _get_top_elem_about {
285             return "";
286             }
287              
288             sub _start_top_elem {
289             my ($self, $tag, $about_sub) = @_;
290              
291             my $about = $self->_get_top_elem_about($tag, $about_sub);
292              
293             return $self->_out("<$tag$about>\n");
294             }
295              
296             sub _out_textinput_rss_1_0_elems {
297             }
298              
299             sub _get_textinput_tag {
300             return "textinput";
301             }
302              
303             sub _output_complete_textinput {
304             my $self = shift;
305              
306             my $master_tag = $self->_get_textinput_tag();
307              
308             if (defined(my $link = $self->textinput('link'))) {
309             $self->_start_top_elem($master_tag,
310             sub { $link }
311             );
312              
313             $self->_output_common_textinput_sub_elements();
314              
315             $self->_out_textinput_rss_1_0_elems();
316              
317             $self->_end_top_level_elem($master_tag);
318             }
319              
320             return;
321             }
322              
323             sub _flush_output {
324             my $self = shift;
325              
326             my $ret = $self->{_output};
327             $self->{_output} = "";
328              
329             # Detach _main to avoid referencing loops.
330             $self->_main(undef);
331              
332             return $ret;
333             }
334              
335              
336              
337              
338              
339             sub _date_from_dc_date {
340             my ($self, $string) = @_;
341             my $f = DateTime::Format::W3CDTF->new();
342             return $f->parse_datetime($string);
343             }
344              
345             sub _date_from_rss2 {
346             my ($self, $string) = @_;
347             my $f = DateTime::Format::Mail->new();
348             return $f->parse_datetime($string);
349             }
350              
351             sub _date_to_rss2 {
352             my ($self, $date) = @_;
353              
354             my $pf = DateTime::Format::Mail->new();
355             return $pf->format_datetime($date);
356             }
357              
358             sub _date_to_dc_date {
359             my ($self, $date) = @_;
360              
361             my $pf = DateTime::Format::W3CDTF->new();
362             return $pf->format_datetime($date);
363             }
364              
365             sub _channel_dc
366             {
367             my ($self, $key) = @_;
368              
369             if ($self->channel('dc')) {
370             return $self->channel('dc')->{$key};
371             }
372             else {
373             return undef;
374             }
375             }
376              
377             sub _channel_syn
378             {
379             my ($self, $key) = @_;
380              
381             if ($self->channel('syn')) {
382             return $self->channel('syn')->{$key};
383             }
384             else {
385             return undef;
386             }
387             }
388              
389             sub _calc_lastBuildDate {
390             my $self = shift;
391             if (defined(my $d = $self->_channel_dc('date'))) {
392             return $self->_date_to_rss2($self->_date_from_dc_date($d));
393             }
394             else
395             {
396             # If lastBuildDate is undef we can still return it because we
397             # need to return undef.
398             return $self->channel("lastBuildDate");
399             }
400             }
401              
402             sub _calc_pubDate {
403             my $self = shift;
404              
405             if (defined(my $d = $self->channel('pubDate'))) {
406             return $d;
407             }
408             elsif (defined(my $d2 = $self->_channel_dc('date'))) {
409             return $self->_date_to_rss2($self->_date_from_dc_date($d2));
410             }
411             else {
412             return undef;
413             }
414             }
415              
416             sub _get_other_dc_date {
417             my $self = shift;
418              
419             if (defined(my $d1 = $self->channel('pubDate'))) {
420             return $d1;
421             }
422             elsif (defined(my $d2 = $self->channel('lastBuildDate'))) {
423             return $d2;
424             }
425             else {
426             return undef;
427             }
428             }
429              
430             sub _calc_dc_date {
431             my $self = shift;
432              
433             if (defined(my $d1 = $self->_channel_dc('date'))) {
434             return $d1;
435             }
436             else {
437             my $date = $self->_get_other_dc_date();
438              
439             if (!defined($date)) {
440             return undef;
441             }
442             else {
443             return $self->_date_to_dc_date($self->_date_from_rss2($date));
444             }
445             }
446             }
447              
448             sub _output_xml_declaration {
449             my $self = shift;
450              
451             my $encoding = (defined $self->_main->_encoding())? ' encoding="' . $self->_main->_encoding() . '"' : "";
452             $self->_out('' . "\n");
453             if (defined(my $stylesheet = $self->_main->_stylesheet)) {
454             my $style_url = $self->_encode($stylesheet);
455             $self->_out(qq{\n});
456             }
457              
458             $self->_out("\n");
459              
460             return undef;
461             }
462              
463             sub _out_image_title_and_url {
464             my $self = shift;
465              
466             return $self->_output_multiple_tags({ext => "image"}, [qw(title url)]);
467             }
468              
469             sub _start_image {
470             my $self = shift;
471              
472             $self->_start_top_elem("image", sub { $self->image('url') });
473              
474             $self->_out_image_title_and_url();
475              
476             $self->_output_def_image_tag("link");
477              
478             return;
479             }
480              
481             sub _start_item {
482             my ($self, $item) = @_;
483              
484             my $tag = "item";
485             my $base = $item->{'xml:base'};
486             $tag .= qq{ xml:base="$base"} if defined $base;
487             $self->_start_top_elem($tag, sub { $self->_get_item_about($item)});
488              
489             $self->_output_common_item_tags($item);
490              
491             return;
492             }
493              
494             sub _end_top_level_elem {
495             my ($self, $elem) = @_;
496              
497             $self->_out("\n");
498             }
499              
500             sub _end_item {
501             shift->_end_top_level_elem("item");
502             }
503              
504             sub _end_image {
505             shift->_end_top_level_elem("image");
506             }
507              
508             sub _end_channel {
509             shift->_end_top_level_elem("channel");
510             }
511              
512             sub _output_array_item_tag {
513             my ($self, $item, $tag) = @_;
514              
515             if (defined($item->{$tag})) {
516             $self->_out_array_tag($tag, $item->{$tag});
517             }
518              
519             return;
520             }
521              
522             sub _output_def_item_tag {
523             my ($self, $item, $tag) = @_;
524              
525             if (defined($item->{$tag})) {
526             $self->_output_item_tag($item, $tag);
527             }
528              
529             return;
530             }
531              
532             sub _get_item_defined {
533             return 0;
534             }
535              
536             sub _out_item_desc {
537             my ($self, $item) = @_;
538             return $self->_output_def_item_tag($item, "description");
539             }
540              
541             # Outputs the common item tags for RSS 0.9.1 and above.
542             sub _output_common_item_tags {
543             my ($self, $item) = @_;
544              
545             my @fields = (qw( title link ));
546              
547             my $defined = $self->_get_item_defined;
548              
549             if (! $defined) {
550             foreach my $f (@fields)
551             {
552             if (!defined($item->{$f})) {
553             die qq/Item No. / . $self->_item_idx() . qq/ is missing the "$f" field./;
554             }
555             }
556             }
557              
558             $self->_output_multiple_tags(
559             {ext => $item, type => 'item', idx => $self->_item_idx(), 'defined' => $defined,},
560             [@fields],);
561              
562             $self->_out_item_desc($item);
563              
564             return;
565             }
566              
567             sub _output_common_channel_elements {
568             my $self = shift;
569              
570             $self->_output_multiple_tags("channel", [qw(title link description)],);
571             }
572              
573              
574             sub _out_language {
575             my $self = shift;
576              
577             return $self->_out_channel_self_dc_field("language");
578             }
579              
580             sub _start_channel {
581             my $self = shift;
582              
583             $self->_start_top_elem("channel", sub { $self->_get_channel_rdf_about });
584              
585             $self->_output_common_channel_elements();
586              
587             $self->_out_language();
588              
589             return;
590             }
591              
592             # Calculates a channel field that has a dc: and non-dc alternative,
593             # prefering the dc: one.
594             sub _calc_channel_dc_field {
595             my ($self, $dc_key, $non_dc_key) = @_;
596              
597             my $dc_value = $self->_channel_dc($dc_key);
598              
599             return defined($dc_value) ? $dc_value : $self->channel($non_dc_key);
600             }
601              
602             sub _prefer_dc {
603             my $self = shift;
604              
605             if (@_) {
606             $self->{_prefer_dc} = shift;
607             }
608             return $self->{_prefer_dc};
609             }
610              
611             sub _calc_channel_dc_field_params {
612             my ($self, $dc_key, $non_dc_key) = @_;
613              
614             return
615             (
616             $self->_prefer_dc() ? "dc:$dc_key" : $non_dc_key,
617             $self->_calc_channel_dc_field($dc_key, $non_dc_key)
618             );
619             }
620              
621             sub _out_channel_dc_field {
622             my ($self, $dc_key, $non_dc_key) = @_;
623              
624             return $self->_out_defined_tag(
625             $self->_calc_channel_dc_field_params($dc_key, $non_dc_key),
626             );
627             }
628              
629             sub _out_channel_array_self_dc_field {
630             my ($self, $key) = @_;
631              
632             $self->_out_array_tag(
633             $self->_calc_channel_dc_field_params($key, $key),
634             );
635             }
636              
637             sub _out_channel_self_dc_field {
638             my ($self, $key) = @_;
639              
640             return $self->_out_channel_dc_field($key, $key);
641             }
642              
643             sub _out_managing_editor {
644             my $self = shift;
645              
646             return $self->_out_channel_dc_field("publisher", "managingEditor");
647             }
648              
649             sub _out_webmaster {
650             my $self = shift;
651              
652             return $self->_out_channel_dc_field("creator", "webMaster");
653             }
654              
655             sub _out_copyright {
656             my $self = shift;
657              
658             return $self->_out_channel_dc_field("rights", "copyright");
659             }
660              
661             sub _out_editors {
662             my $self = shift;
663              
664             $self->_out_managing_editor;
665             $self->_out_webmaster;
666             }
667              
668             sub _get_channel_rdf_about {
669             my $self = shift;
670              
671             if (defined(my $about = $self->channel('about'))) {
672             return $about;
673             }
674             else {
675             return $self->channel('link');
676             }
677             }
678              
679             sub _output_taxo_topics {
680             my ($self, $elem) = @_;
681              
682             if (my $list = $elem->{'taxo'}) {
683             $self->_out("\n \n");
684             foreach my $taxo (@{$list}) {
685             $self->_out(" _encode($taxo) . "\" />\n");
686             }
687             $self->_out(" \n\n");
688             }
689              
690             return;
691             }
692              
693             # Output the Dublin core properties of a certain elements (channel, image,
694             # textinput, item).
695              
696             sub _get_dc_ok_fields {
697             my $self = shift;
698              
699             return $self->_main->_get_dc_ok_fields();
700             }
701              
702             sub _out_dc_elements {
703             my $self = shift;
704             my $elem = shift;
705             my $skip_hash = shift || {};
706              
707             foreach my $dc (@{$self->_get_dc_ok_fields()}) {
708             next if $skip_hash->{$dc};
709              
710             $self->_out_array_tag("dc:$dc", $elem->{dc}->{$dc});
711             }
712              
713             return;
714             }
715              
716             sub _out_module_prefix_elements_hash
717             {
718             my ($self, $args) = @_;
719              
720             my $prefix = $args->{prefix};
721             my $data = $args->{data};
722             my $url = $args->{url};
723              
724             while (my ($el, $value) = each(%$data)) {
725             $self->_out_module_prefix_pair(
726             {
727             %$args,
728             el => $el,
729             val => $value,
730             }
731             );
732             }
733              
734             return;
735             }
736              
737             sub _out_module_prefix_pair
738             {
739             my ($self, $args) = @_;
740              
741             my $prefix = $args->{prefix};
742             my $url = $args->{url};
743              
744             my $el = $args->{el};
745             my $value = $args->{val};
746              
747             if ($self->_main->_is_rdf_resource($el,$url)) {
748             $self->_out(
749             qq{<${prefix}:${el} rdf:resource="} . $self->_encode($value) . qq{" />\n});
750             }
751             else {
752             $self->_out_ns_tag($prefix, $el, $value);
753             }
754              
755             return;
756             }
757              
758             sub _out_module_prefix_elements_array
759             {
760             my ($self, $args) = @_;
761              
762             my $prefix = $args->{prefix};
763             my $data = $args->{data};
764             my $url = $args->{url};
765              
766             foreach my $element (@$data)
767             {
768             $self->_out_module_prefix_pair(
769             {
770             %$args,
771             el => $element->{'el'},
772             val => $element->{'val'},
773             }
774             )
775             }
776              
777             return;
778             }
779              
780             sub _out_module_prefix_elements
781             {
782             my ($self, $args) = @_;
783              
784             my $data = $args->{'data'};
785              
786             if (! $data) {
787             # Do nothing - empty data
788             return;
789             }
790             elsif (ref($data) eq "HASH") {
791             return $self->_out_module_prefix_elements_hash($args);
792             }
793             elsif (ref($data) eq "ARRAY") {
794             return $self->_out_module_prefix_elements_array($args);
795             }
796             else {
797             die "Don't know how to handle module data of type " . ref($data) . "!";
798             }
799             }
800              
801             # Output the Ad-hoc modules
802             sub _out_modules_elements {
803             my ($self, $super_elem) = @_;
804              
805             # Ad-hoc modules
806             while (my ($url, $prefix) = each %{$self->_modules}) {
807             next if $prefix =~ /^(dc|syn|taxo)$/;
808              
809             $self->_out_module_prefix_elements(
810             {
811             prefix => $prefix,
812             url => $url,
813             data => $super_elem->{$prefix},
814             }
815             );
816              
817             }
818              
819             return;
820             }
821              
822             sub _out_complete_outer_tag {
823             my ($self, $outer, $inner) = @_;
824              
825             my $value = $self->_main->{$outer}->{$inner};
826              
827             if (defined($value)) {
828             $self->_out("<$outer>\n");
829             $self->_out_array_tag($inner, $value);
830             $self->_end_top_level_elem($outer);
831             }
832             }
833              
834             sub _out_skip_tag {
835             my ($self, $what) = @_;
836              
837             return $self->_out_complete_outer_tag("skip\u${what}s", $what);
838             }
839              
840             sub _out_skip_hours {
841             return shift->_out_skip_tag("hour");
842             }
843              
844             sub _out_skip_days {
845             return shift->_out_skip_tag("day");
846             }
847              
848             sub _get_item_about
849             {
850             my ($self, $item) = @_;
851             return defined($item->{'about'}) ? $item->{'about'} : $item->{'link'};
852             }
853              
854             sub _out_image_dc_elements {
855             }
856              
857             sub _out_modules_elements_if_supported {
858             }
859              
860             sub _out_image_dims {
861             }
862              
863             sub _output_defined_image {
864             my $self = shift;
865              
866             $self->_start_image();
867              
868             $self->_out_image_dims;
869              
870             # image width
871             #$output .= ''.$self->{image}->{width}.''."\n"
872             # if $self->{image}->{width};
873              
874             # image height
875             #$output .= ''.$self->{image}->{height}.''."\n"
876             # if $self->{image}->{height};
877              
878             # description
879             #$output .= ''.$self->{image}->{description}.''."\n"
880             # if $self->{image}->{description};
881              
882             $self->_out_image_dc_elements;
883              
884             $self->_out_modules_elements_if_supported($self->image());
885              
886             $self->_end_image();
887             }
888              
889             sub _is_image_defined {
890             my $self = shift;
891              
892             return defined ($self->image('url'));
893             }
894              
895             sub _output_complete_image {
896             my $self = shift;
897              
898             if ($self->_is_image_defined())
899             {
900             $self->_output_defined_image();
901             }
902             }
903              
904             sub _out_seq_items {
905             my $self = shift;
906              
907             # Seq items
908             $self->_out("\n \n");
909              
910             my $idx = 0;
911             foreach my $item (@{$self->_main->_get_items()}) {
912              
913             my $about_text = $self->_get_item_about($item);
914              
915             if (!defined($about_text)) {
916             die qq/Item No. $idx is missing "about" or "link" fields./;
917             }
918              
919             $self->_out(' 920             $self->_encode($about_text) .
921             '" />' . "\n");
922             }
923             continue {
924             $idx++;
925             }
926              
927             $self->_out(" \n\n");
928             }
929              
930             sub _get_first_rdf_decl_mappings {
931             return ();
932             }
933              
934             sub _get_rdf_decl_mappings
935             {
936             my $self = shift;
937              
938             my $modules = $self->_modules();
939              
940             return
941             [
942             $self->_get_first_rdf_decl_mappings(),
943             sort { $a->[0] cmp $b->[0] } map { [$modules->{$_}, $_] } keys(%$modules)
944             ];
945             }
946              
947             sub _render_xmlns {
948             my ($self, $prefix, $url) = @_;
949              
950             my $pp = defined($prefix) ? ":$prefix" : "";
951              
952             return qq{ xmlns$pp="$url"\n};
953             }
954              
955             sub _get_rdf_xmlnses {
956             my $self = shift;
957              
958             return
959             join("",
960             map { $self->_render_xmlns(@$_) }
961             @{$self->_get_rdf_decl_mappings}
962             );
963             }
964              
965             sub _get_rdf_decl_open_tag {
966             return qq{
967             }
968              
969              
970             sub _get_rdf_decl
971             {
972             my $self = shift;
973             my $base = $self->_main()->{'xml:base'};
974             my $base_decl = (defined $base)? qq{ xml:base="$base"\n} : "";
975             return $self->_get_rdf_decl_open_tag() . $base_decl .
976             $self->_get_rdf_xmlnses() . ">\n\n";
977             }
978              
979             sub _out_rdf_decl
980             {
981             my $self = shift;
982              
983             return $self->_out($self->_get_rdf_decl);
984             }
985              
986             sub _out_guid {
987             my ($self, $item) = @_;
988              
989             # The unique identifier. Use 'permaLink' for an external
990             # identifier, or 'guid' for a internal string.
991             # (I call it permaLink in the hash for purposes of clarity.)
992              
993             for my $guid (qw(permaLink guid)) {
994             if (defined $item->{$guid}) {
995             $self->_out(' 996             . ($guid eq 'permaLink' ? 'true' : 'false') . '">'
997             . $self->_encode($item->{$guid})
998             . '' . "\n");
999             last;
1000             }
1001             }
1002             }
1003              
1004             sub _out_item_source {
1005             my ($self, $item) = @_;
1006              
1007             if (defined $item->{source} && defined $item->{sourceUrl}) {
1008             $self->_out(' 1009             . $self->_encode($item->{sourceUrl}) . '">'
1010             . $self->_encode($item->{source})
1011             . "\n");
1012             }
1013             }
1014              
1015             sub _out_single_item_enclosure {
1016             my ($self, $item, $enc) = @_;
1017              
1018             return
1019             $self->_out(
1020             "
1021             join(' ',
1022             map { "$_=\"" . $self->_encode($enc->{$_}) . '"' } keys(%$enc)
1023             ) .
1024             " />\n"
1025             );
1026             }
1027              
1028             sub _out_item_enclosure {
1029             my ($self, $item) = @_;
1030              
1031             if (my $enc = $item->{enclosure}) {
1032             foreach my $sub (
1033             (ref($enc) eq "ARRAY") ? @$enc : ($enc)
1034             )
1035             {
1036             $self->_out_single_item_enclosure($item, $sub)
1037             }
1038             }
1039             }
1040              
1041             sub _get_items {
1042             return shift->_main->{items};
1043             }
1044              
1045             sub _get_filtered_items {
1046             return shift->_get_items;
1047             }
1048              
1049             sub _out_item_2_0_tags {
1050             }
1051              
1052             sub _out_item_1_0_tags {
1053             }
1054              
1055             sub _output_single_item {
1056             my ($self, $item) = @_;
1057              
1058             $self->_start_item($item);
1059              
1060             $self->_out_item_2_0_tags($item);
1061              
1062             $self->_out_item_1_0_tags($item);
1063              
1064             $self->_out_modules_elements_if_supported($item);
1065              
1066             $self->_end_item($item);
1067             }
1068              
1069             sub _output_items {
1070             my $self = shift;
1071              
1072             $self->_item_idx(0);
1073             foreach my $item (@{$self->_get_filtered_items}) {
1074             $self->_output_single_item($item);
1075             }
1076             continue {
1077             $self->_item_idx($self->_item_idx()+1);
1078             }
1079             }
1080              
1081             sub _output_main_elements {
1082             my $self = shift;
1083              
1084             $self->_output_complete_image();
1085              
1086             $self->_output_items;
1087              
1088             $self->_output_complete_textinput();
1089             }
1090              
1091             # Outputs the last elements - for RSS versions 0.9.1 and 2.0 .
1092             sub _out_last_elements {
1093             my $self = shift;
1094              
1095             $self->_out("\n");
1096              
1097             $self->_output_main_elements;
1098              
1099             $self->_out_skip_hours();
1100              
1101             $self->_out_skip_days();
1102              
1103             $self->_end_channel;
1104             }
1105              
1106             sub _calc_prefer_dc {
1107             return 0;
1108             }
1109              
1110             sub _output_xml_start {
1111             my ($self) = @_;
1112              
1113             $self->_prefer_dc($self->_calc_prefer_dc());
1114              
1115             $self->_output_xml_declaration();
1116              
1117             $self->_out_rdf_decl;
1118              
1119             $self->_start_channel();
1120             }
1121              
1122             sub _get_end_tag {
1123             return "rss";
1124             }
1125              
1126             sub _out_end_tag {
1127             my $self = shift;
1128              
1129             return $self->_out("_get_end_tag() . ">");
1130             }
1131              
1132             sub _out_all_modules_elems {
1133             my $self = shift;
1134              
1135             # Dublin Core module
1136             $self->_out_dc_elements($self->channel(),
1137             {map { $_ => 1 } qw(language creator publisher rights date)},
1138             );
1139              
1140             # Syndication module
1141             foreach my $syn (@{$self->_main->_get_syn_ok_fields}) {
1142             if (defined(my $value = $self->_channel_syn($syn))) {
1143             $self->_out_ns_tag("syn", $syn, $value);
1144             }
1145             }
1146              
1147             # Taxonomy module
1148             $self->_output_taxo_topics($self->channel());
1149              
1150             $self->_out_modules_elements($self->channel());
1151             }
1152              
1153             sub _out_dates {
1154             my $self = shift;
1155              
1156             $self->_out_defined_tag("pubDate", $self->_calc_pubDate());
1157             $self->_out_defined_tag("lastBuildDate", $self->_calc_lastBuildDate());
1158             }
1159              
1160             sub _out_def_chan_tag {
1161             my ($self, $tag) = @_;
1162             return $self->_output_multiple_tags(
1163             {ext => "channel", 'defined' => 1},
1164             [ $tag ],
1165             );
1166             }
1167              
1168             # $self->_render_complete_rss_output($xml_version)
1169             #
1170             # This function is the workhorse of the XML output and does all the work of
1171             # rendering the RSS, delegating the work to specialised functions.
1172             #
1173             # It accepts the requested version number as its argument.
1174              
1175             sub _render_complete_rss_output {
1176             my ($self) = @_;
1177              
1178             $self->_output_xml_start();
1179              
1180             $self->_output_rss_middle;
1181              
1182             $self->_out_end_tag;
1183              
1184             return $self->_flush_output();
1185             }
1186              
1187             ###
1188             ### Delegate the XML::RSS accessors to _main
1189             ###
1190              
1191             sub channel {
1192             return shift->_main->channel(@_);
1193             }
1194              
1195             sub image {
1196             return shift->_main->image(@_);
1197             }
1198              
1199             sub textinput {
1200             return shift->_main->textinput(@_);
1201             }
1202              
1203             sub _modules {
1204             return shift->_main->_modules();
1205             }
1206              
1207             1;
1208             __END__