local-lib5/lib/perl5/XML/RSS/Private/Output/Base.pm

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