local-lib5/lib/perl5/XML/RSS.pm

   1 package XML::RSS;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp;
   7 use XML::Parser;
   8
   9 use XML::RSS::Private::Output::Base;
  10 use XML::RSS::Private::Output::V0_9;
  11 use XML::RSS::Private::Output::V0_91;
  12 use XML::RSS::Private::Output::V1_0;
  13 use XML::RSS::Private::Output::V2_0;
  14
  15 use vars qw($VERSION $AUTOLOAD @ISA $AUTO_ADD);
  16
  17 require 5.008;
  18
  19 $VERSION = '1.46';
  20
  21 $AUTO_ADD = 0;
  22
  23 sub _get_ok_fields {
  24     return {
  25         "0.9" => {
  26             channel => {
  27                 title       => undef,
  28                 description => undef,
  29                 link        => undef,
  30             },
  31             image => {
  32                 title => undef,
  33                 url   => undef,
  34                 link  => undef,
  35             },
  36             textinput => {
  37                 title       => undef,
  38                 description => undef,
  39                 name        => undef,
  40                 link        => undef,
  41             },
  42         },
  43         "0.91" => {
  44             channel => {
  45                 title          => undef,
  46                 copyright      => undef,
  47                 description    => undef,
  48                 docs           => undef,
  49                 language       => undef,
  50                 lastBuildDate  => undef,
  51                 'link'         => undef,
  52                 managingEditor => undef,
  53                 pubDate        => undef,
  54                 rating         => undef,
  55                 webMaster      => undef,
  56             },
  57             image => {
  58                 title       => undef,
  59                 url         => undef,
  60                 'link'      => undef,
  61                 width       => undef,
  62                 height      => undef,
  63                 description => undef,
  64             },
  65             skipDays  => {day  => undef,},
  66             skipHours => {hour => undef,},
  67             textinput => {
  68                 title       => undef,
  69                 description => undef,
  70                 name        => undef,
  71                 'link'      => undef,
  72             },
  73         },
  74         "2.0" => {
  75             channel => {
  76                 title          => undef,
  77                 'link'         => undef,
  78                 description    => undef,
  79                 language       => undef,
  80                 copyright      => undef,
  81                 managingEditor => undef,
  82                 webMaster      => undef,
  83                 pubDate        => undef,
  84                 lastBuildDate  => undef,
  85                 category       => undef,
  86                 generator      => undef,
  87                 docs           => undef,
  88                 cloud          => '',
  89                 ttl            => undef,
  90                 image          => '',
  91                 textinput      => '',
  92                 skipHours      => '',
  93                 skipDays       => '',
  94             },
  95             image => {
  96                 title       => undef,
  97                 url         => undef,
  98                 'link'      => undef,
  99                 width       => undef,
 100                 height      => undef,
 101                 description => undef,
 102             },
 103             skipDays  => {day  => undef,},
 104             skipHours => {hour => undef,},
 105             textinput => {
 106                 title       => undef,
 107                 description => undef,
 108                 name        => undef,
 109                 'link'      => undef,
 110             },
 111         },
 112         'default' => {
 113             channel => {
 114                 title       => undef,
 115                 description => undef,
 116                 link        => undef,
 117             },
 118             image => {
 119                 title => undef,
 120                 url   => undef,
 121                 link  => undef,
 122             },
 123             textinput => {
 124                 title       => undef,
 125                 description => undef,
 126                 name        => undef,
 127                 link        => undef,
 128             },
 129         },
 130     };
 131 }
 132
 133 # define required elements for RSS 0.9
 134 my $_REQ_v0_9 = {
 135     channel => {
 136         "title"       => [1, 40],
 137         "description" => [1, 500],
 138         "link"        => [1, 500]
 139     },
 140     image => {
 141         "title" => [1, 40],
 142         "url"   => [1, 500],
 143         "link"  => [1, 500]
 144     },
 145     item => {
 146         "title" => [1, 100],
 147         "link"  => [1, 500]
 148     },
 149     textinput => {
 150         "title"       => [1, 40],
 151         "description" => [1, 100],
 152         "name"        => [1, 500],
 153         "link"        => [1, 500]
 154     }
 155 };
 156
 157 # define required elements for RSS 0.91
 158 my $_REQ_v0_9_1 = {
 159     channel => {
 160         "title"          => [1, 100],
 161         "description"    => [1, 500],
 162         "link"           => [1, 500],
 163         "language"       => [1, 5],
 164         "rating"         => [0, 500],
 165         "copyright"      => [0, 100],
 166         "pubDate"        => [0, 100],
 167         "lastBuildDate"  => [0, 100],
 168         "docs"           => [0, 500],
 169         "managingEditor" => [0, 100],
 170         "webMaster"      => [0, 100],
 171     },
 172     image => {
 173         "title"       => [1, 100],
 174         "url"         => [1, 500],
 175         "link"        => [0, 500],
 176         "width"       => [0, 144],
 177         "height"      => [0, 400],
 178         "description" => [0, 500]
 179     },
 180     item => {
 181         "title"       => [1, 100],
 182         "link"        => [1, 500],
 183         "description" => [0, 500]
 184     },
 185     textinput => {
 186         "title"       => [1, 100],
 187         "description" => [1, 500],
 188         "name"        => [1, 20],
 189         "link"        => [1, 500]
 190     },
 191     skipHours => {"hour" => [1, 23]},
 192     skipDays  => {"day"  => [1, 10]}
 193 };
 194
 195 # define required elements for RSS 2.0
 196 my $_REQ_v2_0 = {
 197     channel => {
 198         "title"          => [1, 100],
 199         "description"    => [1, 500],
 200         "link"           => [1, 500],
 201         "language"       => [0, 5],
 202         "rating"         => [0, 500],
 203         "copyright"      => [0, 100],
 204         "pubDate"        => [0, 100],
 205         "lastBuildDate"  => [0, 100],
 206         "docs"           => [0, 500],
 207         "managingEditor" => [0, 100],
 208         "webMaster"      => [0, 100],
 209     },
 210     image => {
 211         "title"       => [1, 100],
 212         "url"         => [1, 500],
 213         "link"        => [0, 500],
 214         "width"       => [0, 144],
 215         "height"      => [0, 400],
 216         "description" => [0, 500]
 217     },
 218     item => {
 219         "title"       => [1, 100],
 220         "link"        => [1, 500],
 221         "description" => [0, 500]
 222     },
 223     textinput => {
 224         "title"       => [1, 100],
 225         "description" => [1, 500],
 226         "name"        => [1, 20],
 227         "link"        => [1, 500]
 228     },
 229     skipHours => {"hour" => [1, 23]},
 230     skipDays  => {"day"  => [1, 10]}
 231 };
 232
 233 my $namespace_map = {
 234     rss10 => 'http://purl.org/rss/1.0/',
 235     rss09 => 'http://my.netscape.com/rdf/simple/0.9/',
 236
 237     # rss091 => 'http://purl.org/rss/1.0/modules/rss091/',
 238     rss20 => 'http://backend.userland.com/blogChannelModule',
 239 };
 240
 241 sub _rdf_resource_fields {
 242     return {
 243         'http://webns.net/mvcb/' => {
 244             'generatorAgent' => 1,
 245             'errorReportsTo' => 1
 246         },
 247         'http://purl.org/rss/1.0/modules/annotate/' => {'reference' => 1},
 248         'http://my.theinfo.org/changed/1.0/rss/'    => {'server'    => 1}
 249     };
 250 }
 251
 252 my %empty_ok_elements = (enclosure => 1);
 253 my %hashref_ok_elements = (description => 1);
 254
 255 sub _get_default_modules {
 256     return {
 257         'http://purl.org/rss/1.0/modules/syndication/' => 'syn',
 258         'http://purl.org/dc/elements/1.1/'             => 'dc',
 259         'http://purl.org/rss/1.0/modules/taxonomy/'    => 'taxo',
 260         'http://webns.net/mvcb/'                       => 'admin',
 261         'http://purl.org/rss/1.0/modules/content/'     => 'content',
 262     };
 263 }
 264
 265 sub _get_default_rss_2_0_modules {
 266     return {'http://backend.userland.com/blogChannelModule' => 'blogChannel',};
 267 }
 268
 269 sub _get_syn_ok_fields {
 270     return [qw(updateBase updateFrequency updatePeriod)];
 271 }
 272
 273 sub _get_dc_ok_fields {
 274     return [qw(
 275         contributor
 276         coverage
 277         creator
 278         date
 279         description
 280         format
 281         identifier
 282         language
 283         publisher
 284         relation
 285         rights
 286         source
 287         subject
 288         title
 289         type
 290     )];
 291 }
 292
 293 sub new {
 294     my $class = shift;
 295
 296     my $self = {};
 297
 298     bless $self, $class;
 299
 300     $self->_initialize(@_);
 301
 302     return $self;
 303 }
 304
 305 sub _get_init_default_key_assignments {
 306     return [
 307         {key => "version",       default => '1.0',},
 308         {key => "encode_output", default => 1,},
 309         {key => "output",        default => "",},
 310         {key => "encoding",      default => "UTF-8",},
 311         {key => "encode_cb",     default => undef(),},
 312         {key => "xml:base",      default => undef(),},
 313     ];
 314 }
 315
 316 # This method resets the contents of the instance to an empty one (with no
 317 # items, empty keys, etc.). Useful before parsing or during initialization.
 318
 319 sub _reset {
 320     my $self = shift;
 321
 322     # internal hash
 323     $self->{_internal} = {};
 324
 325     # init num of items to 0
 326     $self->{num_items} = 0;
 327
 328     # initialize items
 329     $self->{items} = [];
 330
 331     delete $self->{_allow_multiple};
 332
 333     my $ok_fields = $self->_get_ok_fields();
 334
 335     my $ver_ok_fields =
 336       exists($ok_fields->{$self->{version}})
 337       ? $ok_fields->{$self->{version}}
 338       : $ok_fields->{default};
 339
 340     while (my ($k, $v) = each(%$ver_ok_fields)) {
 341         $self->{$k} = +{%{$v}};
 342     }
 343
 344     return;
 345 }
 346
 347 sub _initialize {
 348     my $self = shift;
 349     my %hash = @_;
 350
 351     # adhere to Netscape limits; no by default
 352     $self->{'strict'} = 0;
 353
 354     # namespaces
 355     $self->{namespaces}    = {};
 356     $self->{rss_namespace} = '';
 357     foreach my $k (@{$self->_get_init_default_key_assignments()})
 358     {
 359         my $key = $k->{key};
 360         $self->{$key} = exists($hash{$key}) ? $hash{$key} : $k->{default};
 361     }
 362
 363     # modules
 364     $self->{modules} = (
 365         ($self->{version} eq "2.0")
 366         ? $self->_get_default_rss_2_0_modules()
 367         : $self->_get_default_modules()
 368     );
 369
 370     # stylesheet
 371     if (exists($hash{stylesheet})) {
 372         $self->{stylesheet} = $hash{stylesheet};
 373     }
 374
 375     if ($self->{version} eq "2.0") {
 376         $self->{namespaces}->{'blogChannel'} = "http://backend.userland.com/blogChannelModule";
 377     }
 378
 379     $self->_reset;
 380
 381     return;
 382 }
 383
 384 sub add_module {
 385     my $self = shift;
 386     my $hash = {@_};
 387
 388     $hash->{prefix} =~ /^[a-z_][a-z0-9.\-_]*$/i
 389       or croak "a namespace prefix should look like [A-Za-z_][A-Za-z0-9.\\-_]*";
 390
 391     $hash->{uri}
 392       or croak "a URI must be provided in a namespace declaration";
 393
 394     $self->{modules}->{$hash->{uri}} = $hash->{prefix};
 395 }
 396
 397 sub add_item {
 398     my $self = shift;
 399     my $hash = {@_};
 400
 401     # strict Netscape Netcenter length checks
 402     if ($self->{'strict'}) {
 403
 404         # make sure we have a title and link
 405         croak "title and link elements are required"
 406           unless ($hash->{title} && $hash->{'link'});
 407
 408         # check string lengths
 409         croak "title cannot exceed 100 characters in length"
 410           if (length($hash->{title}) > 100);
 411         croak "link cannot exceed 500 characters in length"
 412           if (length($hash->{'link'}) > 500);
 413         croak "description cannot exceed 500 characters in length"
 414           if (exists($hash->{description})
 415             && length($hash->{description}) > 500);
 416
 417         # make sure there aren't already 15 items
 418         croak "total items cannot exceed 15 " if (@{$self->{items}} >= 15);
 419     }
 420
 421     # add the item to the list
 422     if (defined($hash->{mode}) && $hash->{mode} eq 'insert') {
 423         unshift(@{$self->{items}}, $hash);
 424     }
 425     else {
 426         push(@{$self->{items}}, $hash);
 427     }
 428
 429     # return reference to the list of items
 430     return $self->{items};
 431 }
 432
 433
 434 # $self->_render_complete_rss_output($xml_version)
 435 #
 436 # This function is the workhorse of the XML output and does all the work of
 437 # rendering the RSS, delegating the work to specialised functions.
 438 #
 439 # It accepts the requested version number as its argument.
 440
 441 sub _get_rendering_class {
 442     my ($self, $ver) = @_;
 443
 444     if ($ver eq "1.0")
 445     {
 446         return "XML::RSS::Private::Output::V1_0";
 447     }
 448     elsif ($ver eq "0.9")
 449     {
 450         return "XML::RSS::Private::Output::V0_9";
 451     }
 452     elsif ($ver eq "0.91")
 453     {
 454         return "XML::RSS::Private::Output::V0_91";
 455     }
 456     else
 457     {
 458         return "XML::RSS::Private::Output::V2_0";
 459     }
 460 }
 461
 462 sub _get_encode_cb_params
 463 {
 464     my $self = shift;
 465
 466     return
 467         defined($self->{encode_cb}) ?
 468             ("encode_cb" => $self->{encode_cb}) :
 469             ()
 470             ;
 471 }
 472
 473 sub _get_rendering_obj {
 474     my ($self, $ver) = @_;
 475
 476     return $self->_get_rendering_class($ver)->new(
 477         {
 478             main => $self,
 479             version => $ver,
 480             $self->_get_encode_cb_params(),
 481         }
 482     );
 483 }
 484
 485 sub _render_complete_rss_output {
 486     my ($self, $ver) = @_;
 487
 488     return $self->_get_rendering_obj($ver)->_render_complete_rss_output();
 489 }
 490
 491 sub as_rss_0_9 {
 492     return shift->_render_complete_rss_output("0.9");
 493 }
 494
 495 sub as_rss_0_9_1 {
 496     return shift->_render_complete_rss_output("0.91");
 497 }
 498
 499 sub as_rss_1_0 {
 500     return shift->_render_complete_rss_output("1.0");
 501 }
 502
 503 sub as_rss_2_0 {
 504     return shift->_render_complete_rss_output("2.0");
 505 }
 506
 507
 508
 509 sub _get_output_methods_map {
 510     return {
 511         '0.9'  => "as_rss_0_9",
 512         '0.91' => "as_rss_0_9_1",
 513         '2.0'  => "as_rss_2_0",
 514         '1.0'  => "as_rss_1_0",
 515     };
 516 }
 517
 518 sub _get_default_output_method {
 519     return "as_rss_1_0";
 520 }
 521
 522 sub _get_output_method {
 523     my ($self, $version) = @_;
 524
 525     if (my $output_method = $self->_get_output_methods_map()->{$version}) {
 526         return $output_method;
 527     }
 528     else {
 529         return $self->_get_default_output_method();
 530     }
 531 }
 532
 533 sub _get_output_version {
 534     my $self = shift;
 535     return ($self->{output} =~ /\d/) ? $self->{output} : $self->{version};
 536 }
 537
 538 # This is done to preserve backwards compatibility with older versions
 539 # of XML-RSS that had the channel/{link,description,title} as the empty
 540 # string by default.
 541 sub _output_env {
 542     my $self = shift;
 543     my $callback = shift;
 544
 545     local $self->{channel}->{'link'} = $self->{channel}->{'link'};
 546     local $self->{channel}->{'description'} = $self->{channel}->{'description'};
 547     local $self->{channel}->{'title'} = $self->{channel}->{'title'};
 548
 549     foreach my $field (qw(link description title))
 550     {
 551         if (!defined($self->{channel}->{$field}))
 552         {
 553             $self->{channel}->{$field} = '';
 554         }
 555     }
 556
 557     return $callback->();
 558 }
 559
 560 sub as_string {
 561     my $self = shift;
 562
 563     my $version = $self->_get_output_version();
 564
 565     my $output_method = $self->_get_output_method($version);
 566
 567     return $self->_output_env(
 568         sub { return $self->$output_method(); }
 569     );
 570 }
 571
 572 # Checks if inside a possibly namespaced element
 573 # TODO : After increasing test coverage convert all such conditionals to this
 574 # method.
 575 sub _my_in_element {
 576     my ($self, $elem) = @_;
 577
 578     my $parser = $self->_parser;
 579
 580     return $parser->within_element($elem)
 581         || $parser->within_element(
 582             $parser->generate_ns_name($elem, $self->{rss_namespace})
 583         );
 584 }
 585
 586 sub _get_elem_namespace_helper {
 587     my ($self, $el) = @_;
 588
 589     my $ns = $self->_parser->namespace($el);
 590
 591     return (defined($ns) ? $ns : "");
 592 }
 593
 594 sub _get_elem_namespace {
 595     my $self = shift;
 596
 597     my ($el) = @_;
 598
 599     my $ns = $self->_get_elem_namespace_helper(@_);
 600
 601     my $verdict = (!$ns && !$self->{rss_namespace})
 602       || ($ns eq $self->{rss_namespace});
 603
 604     return ($ns, $verdict);
 605 }
 606
 607 sub _current_element {
 608     my $self = shift;
 609
 610     return $self->_parser->current_element;
 611 }
 612
 613 sub _get_current_namespace {
 614     my $self = shift;
 615
 616     return $self->_get_elem_namespace($self->_current_element);
 617 }
 618
 619 sub _is_rdf_resource {
 620     my $self = shift;
 621     my $el = shift;
 622
 623     my $ns = shift;
 624     if (!defined($ns))
 625     {
 626         $ns = $self->_parser->namespace($el);
 627     }
 628
 629     return (
 630            exists($self->_rdf_resource_fields->{ $ns })
 631         && exists($self->_rdf_resource_fields->{ $ns }{ $el })
 632     );
 633 }
 634
 635 sub _get_ns_arrayity {
 636     my ($self, $ns) = @_;
 637
 638     my $is_array =
 639            $self->_parse_options()->{'modules_as_arrays'}
 640         && (!exists($self->_get_default_modules()->{$ns}))
 641         # RDF
 642         && ($ns ne "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
 643         ;
 644
 645     my $default_ref = sub { $is_array ? [] : {} };
 646
 647     return ($is_array, $default_ref);
 648 }
 649
 650 sub _append_text_to_elem_struct {
 651     my ($self, $struct, $cdata, $mapping_sub, $is_array_sub) = @_;
 652
 653     my $elem = $self->_current_element;
 654
 655     my ($ns, $verdict) = $self->_get_current_namespace;
 656
 657     # If it's in the default namespace
 658     if ($verdict) {
 659         $self->_append_struct(
 660             $struct,
 661             scalar($mapping_sub->($struct, $elem)),
 662             scalar($is_array_sub->($struct, $elem)),
 663             $cdata
 664         );
 665     }
 666     else {
 667         my $prefix = $self->{modules}->{$ns};
 668
 669         my ($is_array, $default_ref) = $self->_get_ns_arrayity($ns);
 670
 671         $self->_append_struct(
 672             ($struct->{$ns} ||= $default_ref->()),
 673             $elem,
 674             (defined($prefix) && $prefix eq "dc"),
 675             $cdata
 676         );
 677
 678         # If it's in a module namespace, provide a friendlier prefix duplicate
 679         if ($prefix) {
 680             $self->_append_struct(
 681                 ($struct->{$prefix} ||= $default_ref->()),
 682                 $elem,
 683                 ($prefix eq "dc"),
 684                 $cdata
 685             );
 686         }
 687     }
 688
 689     return;
 690 }
 691
 692 sub _append_struct {
 693     my ($self, $struct, $key, $can_be_array, $cdata) = @_;
 694
 695     if (ref($struct) eq 'ARRAY') {
 696         $struct->[-1]->{'val'} .= $cdata;
 697         return;
 698     }
 699     elsif (defined $struct->{$key}) {
 700         if (ref($struct->{$key}) eq 'HASH') {
 701             $struct->{$key}->{content} .= $cdata;
 702             return;
 703         }
 704         elsif ($can_be_array && ref($struct->{$key}) eq 'ARRAY') {
 705             $struct->{$key}->[-1] .= $cdata;
 706             return;
 707         }
 708     }
 709
 710     $struct->{$key} .= $cdata;
 711     return;
 712 }
 713
 714 sub _return_elem {
 715     my ($struct, $elem) = @_;
 716     return $elem;
 717 }
 718
 719 sub _return_elem_is_array {
 720     my ($struct, $elem) = @_;
 721
 722     # Always return false because no element should be an array.
 723     return;
 724 }
 725
 726 sub _append_text_to_elem {
 727     my ($self, $ext_tag, $cdata) = @_;
 728
 729     return $self->_append_text_to_elem_struct(
 730         $self->$ext_tag(),
 731         $cdata,
 732         \&_return_elem,
 733         \&_return_elem_is_array,
 734     );
 735 }
 736
 737 sub _within_topics {
 738     my $self = shift;
 739
 740     my $parser = $self->_parser;
 741
 742     return $parser->within_element(
 743         $parser->generate_ns_name(
 744             "topics", 'http://purl.org/rss/1.0/modules/taxonomy/'
 745         )
 746     );
 747 }
 748
 749 sub _return_item_elem {
 750     my ($item, $elem) = @_;
 751     if ($elem eq "guid") {
 752         return $item->{isPermaLink} ? "permaLink" : "guid";
 753     }
 754     else {
 755         return $elem;
 756     }
 757 }
 758
 759 sub _return_item_elem_is_array {
 760     my ($item, $elem) = @_;
 761
 762     return ($elem eq "category");
 763 }
 764
 765 sub _append_text_to_item {
 766     my ($self, $cdata) = @_;
 767
 768     if (@{$self->{'items'}} < $self->{num_items}) {
 769         push @{$self->{items}}, {};
 770     }
 771
 772     $self->_append_text_to_elem_struct(
 773         $self->_last_item,
 774         $cdata,
 775         \&_return_item_elem,
 776         \&_return_item_elem_is_array
 777     );
 778 }
 779
 780 sub _append_to_array_elem {
 781     my ($self, $category, $cdata) = @_;
 782
 783     if (! $self->_my_in_element($category))
 784     {
 785         return;
 786     }
 787
 788     my $el = $self->_current_element;
 789
 790     if (ref($self->{$category}->{$el}) eq "ARRAY") {
 791         $self->{$category}->{$el}->[-1] .= $cdata;
 792     }
 793     else {
 794         $self->{$category}->{$el} .= $cdata;
 795     }
 796
 797     return 1;
 798 }
 799
 800 sub _handle_char {
 801     my ($self, $cdata) = (@_);
 802
 803     # image element
 804     if ($self->_my_in_element("image")) {
 805         $self->_append_text_to_elem("image", $cdata);
 806     }
 807     # item element
 808     elsif (defined($self->{_inside_item_elem})) {
 809         return if $self->_within_topics;
 810
 811         $self->_append_text_to_item($cdata);
 812     }
 813     # textinput element
 814     elsif (
 815         $self->_my_in_element("textinput") || $self->_my_in_element("textInput")
 816       )
 817     {
 818         $self->_append_text_to_elem("textinput", $cdata);
 819     }
 820     # skipHours element
 821     elsif ($self->_append_to_array_elem("skipHours", $cdata)) {
 822         # Do nothing - already done in the predicate.
 823     }
 824     elsif ($self->_append_to_array_elem("skipDays", $cdata)) {
 825         # Do nothing - already done in the predicate.
 826     }
 827     # channel element
 828     elsif ($self->_my_in_element("channel")) {
 829         if ($self->_within_topics() || $self->_my_in_element("items")) {
 830             return;
 831         }
 832
 833         if ($self->_current_element eq "category") {
 834             $self->_append_to_array_elem("channel", $cdata);
 835         }
 836         else {
 837             $self->_append_text_to_elem("channel", $cdata);
 838         }
 839     }
 840 }
 841
 842 sub _handle_dec {
 843     my ($self, $version, $encoding, $standalone) = (@_);
 844     $self->{encoding} = $encoding;
 845
 846     #print "ENCODING: $encoding\n";
 847 }
 848
 849 sub _should_be_hashref {
 850     my ($self, $el) = @_;
 851
 852     return
 853     (
 854         $empty_ok_elements{$el}
 855         || ($self->_parse_options()->{'hashrefs_instead_of_strings'}
 856             && $hashref_ok_elements{$el}
 857         )
 858     );
 859 }
 860
 861 sub _start_array_element_in_struct {
 862     my ($self, $input_struct, $el, $prefix) = @_;
 863
 864     my ($el_ns, $el_verdict) = $self->_get_elem_namespace($el);
 865
 866     my ($is_array, $default_ref) = $self->_get_ns_arrayity($el_ns);
 867
 868     my @structs = (!$el_verdict)
 869         ? (
 870             (exists($self->{modules}->{$el_ns})
 871                 ? ($input_struct->{$self->{modules}->{$el_ns}} ||= $default_ref->())
 872                 : ()
 873             ),
 874             ($input_struct->{$el_ns} ||= $default_ref->()),
 875         )
 876         : ($input_struct)
 877         ;
 878
 879     foreach my $struct (@structs)
 880     {
 881         if (ref($struct) eq 'ARRAY') {
 882             push @$struct, { el => $el, val => "", };
 883         }
 884         # If it's an array - append a new empty element because a new one
 885         # was started.
 886         elsif (ref($struct->{$el}) eq "ARRAY") {
 887             push @{$struct->{$el}}, "";
 888         }
 889         # If it's not an array but still full (i.e: it's only the second
 890         # element), then turn it into an array
 891         elsif (defined($struct->{$el}) && length($struct->{$el})) {
 892             $struct->{$el} = [$struct->{$el}, ""];
 893         }
 894         # Else - do nothing and let the function append to the new value
 895         #
 896     }
 897     return 1;
 898 }
 899
 900 sub _start_array_element {
 901     my ($self, $cat, $el) = @_;
 902
 903     if (!$self->_my_in_element($cat)) {
 904         return;
 905     }
 906
 907     $self->_start_array_element_in_struct($self->{$cat}, $el);
 908     return 1;
 909 }
 910
 911 sub _last_item {
 912     my $self = shift;
 913
 914     return ($self->{'items'}->[$self->{num_items} - 1] ||= {});
 915 }
 916
 917 sub _handle_start {
 918     my $self    = shift;
 919     my $el      = shift;
 920     my %attribs = @_;
 921
 922     my $parser = $self->_parser;
 923
 924     my ($el_ns, $el_verdict) = $self->_get_elem_namespace($el);
 925
 926     if ($el eq "image")
 927     {
 928         if (exists($attribs{'resource'}))
 929         {
 930             $self->image("rdf:resource", $attribs{'resource'});
 931         }
 932     }
 933
 934     # beginning of RSS 0.91
 935     if ($el eq 'rss') {
 936         if (exists($attribs{version})) {
 937             $self->{_internal}->{version} = $attribs{version};
 938         }
 939         else {
 940             croak "Malformed RSS: invalid version\n";
 941         }
 942
 943         # handle xml:base
 944         $self->{'xml:base'} = $attribs{'base'} if exists $attribs{'base'};
 945
 946     # beginning of RSS 1.0 or RSS 0.9
 947     }
 948     elsif ($el eq 'RDF') {
 949         my @prefixes = $parser->new_ns_prefixes;
 950         foreach my $prefix (@prefixes) {
 951             my $uri = $parser->expand_ns_prefix($prefix);
 952             $self->{namespaces}->{$prefix} = $uri;
 953
 954             #print "$prefix = $uri\n";
 955         }
 956
 957         # removed assumption that RSS is the default namespace - kellan, 11/5/02
 958         #
 959         foreach my $uri (values %{$self->{namespaces}}) {
 960             if ($namespace_map->{'rss10'} eq $uri) {
 961                 $self->{_internal}->{version} = '1.0';
 962                 $self->{rss_namespace} = $uri;
 963                 last;
 964             }
 965             elsif ($namespace_map->{'rss09'} eq $uri) {
 966                 $self->{_internal}->{version} = '0.9';
 967                 $self->{rss_namespace} = $uri;
 968                 last;
 969             }
 970         }
 971
 972         # failed to match a namespace
 973         if (!defined($self->{_internal}->{version})) {
 974             croak "Malformed RSS: invalid version\n";
 975         }
 976
 977         #if ($self->expand_ns_prefix('#default') =~ /\/1.0\//) {
 978         #    $self->{_internal}->{version} = '1.0';
 979         #} elsif ($self->expand_ns_prefix('#default') =~ /\/0.9\//) {
 980         #    $self->{_internal}->{version} = '0.9';
 981         #} else {
 982         #    croak "Malformed RSS: invalid version\n";
 983         #}
 984
 985         # handle xml:base
 986         $self->{'xml:base'} = $attribs{'base'} if exists $attribs{'base'};
 987
 988     # beginning of item element
 989     }
 990     elsif ($self->_start_array_element("skipHours", $el)) {
 991         # Do nothing - already done in the predicate.
 992     }
 993     elsif ($self->_start_array_element("skipDays", $el)) {
 994         # Do nothing - already done in the predicate.
 995     }
 996     elsif ($el eq 'item') {
 997
 998         # deal with trouble makers who use mod_content :)
 999
1000         my ($ns, $verdict) = $self->_get_elem_namespace($el);
1001
1002         if ($verdict) {
1003
1004             # Sanity check to make sure we don't have nested elements that
1005             # can confuse the parser.
1006             if (!defined($self->{_inside_item_elem})) {
1007
1008                 # increment item count
1009                 $self->{num_items}++;
1010                 $self->{_inside_item_elem} = $parser->depth();
1011             }
1012         }
1013         # handle xml:base
1014         $self->_last_item->{'xml:base'} = $attribs{'base'} if exists $attribs{'base'};
1015
1016
1017         # guid element is a permanent link unless isPermaLink attribute is set to false
1018     }
1019     elsif ($el eq 'guid') {
1020         $self->_last_item->{'isPermaLink'} =
1021           (exists($attribs{'isPermaLink'}) &&
1022               (lc($attribs{'isPermaLink'}) eq 'true')
1023           );
1024
1025         # beginning of taxo li element in item element
1026         #'http://purl.org/rss/1.0/modules/taxonomy/' => 'taxo'
1027     }
1028     elsif (
1029            $self->_current_element eq "item"
1030         && (($el eq "category") ||
1031             (
1032                    exists($self->{modules}->{$el_ns})
1033                 && ($self->{modules}->{$el_ns} eq "dc")
1034             )
1035         )
1036     ) {
1037         $self->_start_array_element_in_struct($self->_last_item, $el);
1038     }
1039     elsif (
1040         $parser->within_element(
1041             $parser->generate_ns_name("topics", 'http://purl.org/rss/1.0/modules/taxonomy/')
1042         )
1043         && $parser->within_element($parser->generate_ns_name("item", $namespace_map->{'rss10'}))
1044         && $self->_current_element eq 'Bag'
1045         && $el                    eq 'li'
1046       )
1047     {
1048
1049         #print "taxo: ", $attribs{'resource'},"\n";
1050         push(@{$self->_last_item->{'taxo'}}, $attribs{'resource'});
1051         $self->{'modules'}->{'http://purl.org/rss/1.0/modules/taxonomy/'} = 'taxo';
1052
1053         # beginning of taxo li in channel element
1054     }
1055     elsif (
1056         $parser->within_element(
1057             $parser->generate_ns_name("topics", 'http://purl.org/rss/1.0/modules/taxonomy/')
1058         )
1059         && $parser->within_element($parser->generate_ns_name("channel", $namespace_map->{'rss10'}))
1060         && $self->_current_element eq 'Bag'
1061         && $el                    eq 'li'
1062       )
1063     {
1064         push(@{$self->{'channel'}->{'taxo'}}, $attribs{'resource'});
1065         $self->{'modules'}->{'http://purl.org/rss/1.0/modules/taxonomy/'} = 'taxo';
1066     }
1067
1068     # beginning of a channel element that stores its info in rdf:resource
1069     elsif ( $parser->namespace($el)
1070         && $self->_is_rdf_resource($el)
1071         && $self->_current_element eq 'channel')
1072     {
1073         my $ns = $parser->namespace($el);
1074
1075         # Commented out by shlomif - the RSS namespaces are not present
1076         # in the 'rdf_resource_fields' so this condition always evaluates
1077         # to false.
1078         # if ( $ns eq $self->{rss_namespace} ) {
1079         #     $self->{channel}->{$el} = $attribs{resource};
1080         # }
1081         # else
1082
1083         {
1084             $self->{channel}->{$ns}->{$el} = $attribs{resource};
1085
1086             # add short cut
1087             #
1088             if (exists($self->{modules}->{$ns})) {
1089                 $ns = $self->{modules}->{$ns};
1090                 $self->{channel}->{$ns}->{$el} = $attribs{resource};
1091             }
1092         }
1093     }
1094     # beginning of an item element that stores its info in rdf:resource
1095     elsif ( $parser->namespace($el)
1096         && $self->_is_rdf_resource($el)
1097         && $self->_current_element eq 'item')
1098     {
1099         my $ns = $parser->namespace($el);
1100
1101         # Commented out by shlomif - the RSS namespaces are not present
1102         # in the 'rdf_resource_fields' so this condition always evaluates
1103         # to false.
1104         # if ( $ns eq $self->{rss_namespace} ) {
1105         #   $self->_last_item->{ $el } = $attribs{resource};
1106         # }
1107         # else
1108         {
1109             $self->_last_item->{$ns}->{$el} = $attribs{resource};
1110
1111             # add short cut
1112             #
1113             if (exists($self->{modules}->{$ns})) {
1114                 $ns = $self->{modules}->{$ns};
1115                 $self->_last_item->{$ns}->{$el} = $attribs{resource};
1116             }
1117         }
1118     }
1119     elsif ($self->_should_be_hashref($el) and $self->_current_element eq 'item') {
1120         if (defined $attribs{base}) {
1121             $attribs{'xml:base'} = delete $attribs{base};
1122         }
1123         if (keys(%attribs)) {
1124             if ($el_verdict) {
1125                 $self->_last_item->{$el} =
1126                   $self->_make_array($el, $self->_last_item->{$el}, \%attribs);
1127             }
1128             else {
1129                 $self->_last_item->{$el_ns}->{$el} =
1130                   $self->_make_array($el, $self->_last_item->{$el_ns}->{$el}, \%attribs);
1131
1132                 my $prefix = $self->{modules}->{$el_ns};
1133
1134                 if ($prefix) {
1135                     $self->_last_item->{$prefix}->{$el} =
1136                       $self->_make_array($el, $self->_last_item->{$prefix}->{$el}, \%attribs);
1137                 }
1138             }
1139         }
1140     }
1141     elsif ($self->_start_array_element("image", $el)) {
1142         # Do nothing - already done in the predicate.
1143     }
1144     elsif (($el eq "category") &&
1145         (!$parser->within_element("item")) &&
1146         $self->_start_array_element("channel", $el)) {
1147         # Do nothing - already done in the predicate.
1148     }
1149     elsif (($self->_current_element eq 'channel') &&
1150            ($el_verdict))
1151            {
1152         # Make sure an opening tag signifies that the element has been
1153         # encountered.
1154         if (   exists($self->{'channel'}->{$el})
1155             && (!defined($self->{'channel'}->{$el})))
1156         {
1157             $self->{'channel'}->{$el} = "";
1158         }
1159     }
1160 }
1161
1162 sub _make_array {
1163     my $self = shift;
1164     my $el   = shift;
1165     my $old  = shift;
1166     my $new  = shift;
1167
1168     if (!$self->_allow_multiple($el)) {
1169       return $new;
1170     }
1171
1172     if (!defined $old) {
1173         $old = [];
1174     } elsif (ref($old) ne 'ARRAY') {
1175         $old = [$old];
1176     }
1177     push @$old, $new;
1178     return $old;
1179 }
1180
1181 sub _allow_multiple {
1182     my $self = shift;
1183     my $el   = shift;
1184
1185     $self->{_allow_multiple} ||=
1186         {
1187             map { $_ => 1 }
1188             @{$self->_parse_options->{allow_multiple} || []}
1189         };
1190
1191     return $self->{_allow_multiple}->{$el};
1192 }
1193
1194 sub _handle_end {
1195     my ($self, $el) = @_;
1196
1197     if (defined($self->{_inside_item_elem})
1198         && $self->{_inside_item_elem} == $self->_parser->depth())
1199     {
1200         delete($self->{_inside_item_elem});
1201     }
1202 }
1203
1204 sub _auto_add_modules {
1205     my $self = shift;
1206
1207     for my $ns (keys %{$self->{namespaces}}) {
1208
1209         # skip default namespaces
1210         next
1211           if $ns eq "rdf"
1212           || $ns eq "#default"
1213           || exists $self->{modules}{$self->{namespaces}{$ns}};
1214         $self->add_module(prefix => $ns, uri => $self->{namespaces}{$ns});
1215     }
1216
1217     $self;
1218 }
1219
1220 sub _parser {
1221     my $self = shift;
1222
1223     if (@_) {
1224         $self->{_parser} = shift;
1225     }
1226     return $self->{_parser};
1227 }
1228
1229 sub _get_parser {
1230     my $self = shift;
1231
1232     return XML::Parser->new(
1233         Namespaces    => 1,
1234         NoExpand      => 1,
1235         ParseParamEnt => 0,
1236         Handlers      => {
1237             Char    => sub {
1238                 my ($parser, $cdata) = @_;
1239                 $self->_parser($parser);
1240                 $self->_handle_char($cdata);
1241                 # Detach the parser to avoid reference loops.
1242                 $self->_parser(undef);
1243             },
1244             XMLDecl => sub {
1245                 my $parser = shift;
1246                 $self->_parser($parser);
1247                 $self->_handle_dec(@_);
1248                 # Detach the parser to avoid reference loops.
1249                 $self->_parser(undef);
1250             },
1251             Start   => sub {
1252                 my $parser = shift;
1253                 $self->_parser($parser);
1254                 $self->_handle_start(@_);
1255                 # Detach the parser to avoid reference loops.
1256                 $self->_parser(undef);
1257             },
1258             End     => sub {
1259                 my $parser = shift;
1260                 $self->_parser($parser);
1261                 $self->_handle_end(@_);
1262                 # Detach the parser to avoid reference loops.
1263                 $self->_parser(undef);
1264             },
1265         }
1266     );
1267 }
1268
1269 sub _parse_options {
1270     my $self = shift;
1271
1272     if (@_) {
1273         $self->{_parse_options} = shift;
1274     }
1275
1276     return $self->{_parse_options};
1277 }
1278
1279 sub _empty {}
1280
1281 sub _generic_parse {
1282     my $self = shift;
1283     my $method = shift;
1284     my $arg = shift;
1285     my $options = shift;
1286
1287     $self->_reset;
1288
1289     $self->_parse_options($options || {});
1290
1291     # Workaround to make sure that if we were defined with version => "2.0"
1292     # then we can still parse 1.0 and 0.9.x feeds correctly.
1293     if ($self->{version} eq "2.0") {
1294         $self->{modules} = +{%{$self->_get_default_modules()}, %{$self->{modules}}};
1295     }
1296
1297     {
1298         my $parser = $self->_get_parser();
1299
1300         eval {
1301             $parser->$method($arg);
1302         };
1303
1304         if ($@)
1305         {
1306             my $err = $@;
1307
1308             # Cleanup so perl-5.6.2 will be happy.
1309             $parser->setHandlers(
1310                 map { ($_ => \&_empty) } (qw(Char XMLDecl Start End))
1311             );
1312             $self->_parser(0);
1313
1314             undef($parser);
1315
1316             die $err;
1317         }
1318     }
1319
1320     $self->_auto_add_modules if $AUTO_ADD;
1321     $self->{version} = $self->{_internal}->{version};
1322
1323     return $self;
1324 }
1325
1326 sub parse {
1327     my $self = shift;
1328     my $text_to_parse = shift;
1329     my $options = shift;
1330
1331     return $self->_generic_parse("parse", $text_to_parse, $options);
1332 }
1333
1334 sub parsefile {
1335     my $self = shift;
1336     my $file_to_parse = shift;
1337     my $options = shift;
1338
1339     return $self->_generic_parse("parsefile", $file_to_parse, $options);
1340 }
1341
1342 sub _get_save_output_mode {
1343     my $self = shift;
1344
1345     return (">:encoding(" . $self->_encoding() . ")");
1346 }
1347
1348 sub save {
1349     my ($self, $file) = @_;
1350
1351     local (*OUT);
1352
1353     open(OUT, $self->_get_save_output_mode(), "$file")
1354       or croak "Cannot open file $file for write: $!";
1355     print OUT $self->as_string;
1356     close OUT;
1357 }
1358
1359 sub strict {
1360     my ($self, $value) = @_;
1361     $self->{'strict'} = $value;
1362 }
1363
1364 sub _handle_accessor {
1365     my $self = shift;
1366     my $name = shift;
1367
1368     my $type = ref($self);
1369
1370     croak "Unregistered entity: Can't access $name field in object of class $type"
1371       unless (exists $self->{$name});
1372
1373     # return reference to RSS structure
1374     if (@_ == 1) {
1375         return $self->{$name}->{$_[0]};
1376
1377         # we're going to set values here
1378     }
1379     elsif (@_ > 1) {
1380         my %hash = @_;
1381         my $_REQ;
1382
1383         # make sure we have required elements and correct lengths
1384         if ($self->{'strict'}) {
1385             ($self->{version} eq '0.9')
1386               ? ($_REQ = $_REQ_v0_9)
1387               : ($_REQ = $_REQ_v0_9_1);
1388         }
1389
1390         # store data in object
1391         foreach my $key (keys(%hash)) {
1392             if ($self->{'strict'}) {
1393                 my $req_element = $_REQ->{$name}->{$key};
1394                 confess "$key cannot exceed " . $req_element->[1] . " characters in length"
1395                   if defined $req_element->[1] && length($hash{$key}) > $req_element->[1];
1396             }
1397             $self->{$name}->{$key} = $hash{$key};
1398         }
1399
1400         # return value
1401         return $self->{$name};
1402
1403         # otherwise, just return a reference to the whole thing
1404     }
1405     else {
1406         return $self->{$name};
1407     }
1408
1409     # make sure we have all required elements
1410     #foreach my $key (keys(%{$_REQ->{$name}})) {
1411     #my $element = $_REQ->{$name}->{$key};
1412     #croak "$key is required in $name"
1413     #if ($element->[0] == 1) && (!defined($hash{$key}));
1414     #croak "$key cannot exceed ".$element->[1]." characters in length"
1415     #unless length($hash{$key}) <= $element->[1];
1416     #}
1417 }
1418
1419 sub _modules {
1420     my $self = shift;
1421     return $self->_handle_accessor("modules", @_);;
1422 }
1423
1424 sub channel {
1425     my $self = shift;
1426
1427     return $self->_handle_accessor("channel", @_);
1428 }
1429
1430 sub image {
1431     my $self = shift;
1432
1433     return $self->_handle_accessor("image", @_);
1434 }
1435
1436 sub textinput {
1437     my $self = shift;
1438
1439     return $self->_handle_accessor("textinput", @_);
1440 }
1441
1442 sub skipDays {
1443     my $self = shift;
1444
1445     return $self->_handle_accessor("skipDays", @_);
1446 }
1447
1448 sub skipHours {
1449     my $self = shift;
1450
1451     return $self->_handle_accessor("skipHours", @_);
1452 }
1453
1454 ### Read only, scalar accessors
1455
1456 sub _encode_output {
1457     my $self = shift;
1458
1459     return $self->{'encode_output'};
1460 }
1461
1462 sub _encoding {
1463     my $self = shift;
1464
1465     return $self->{'encoding'};
1466 }
1467
1468 sub _stylesheet {
1469     my $self = shift;
1470
1471     return $self->{'stylesheet'};
1472 }
1473
1474 sub _get_items {
1475     my $self = shift;
1476
1477     return $self->{items};
1478 }
1479
1480 1;
1481 __END__
1482
1483 =head1 NAME
1484
1485 XML::RSS - creates and updates RSS files
1486
1487 =head1 SYNOPSIS
1488
1489  # create an RSS 1.0 file (http://purl.org/rss/1.0/)
1490  use XML::RSS;
1491  my $rss = XML::RSS->new(version => '1.0');
1492  $rss->channel(
1493    title        => "freshmeat.net",
1494    link         => "http://freshmeat.net",
1495    description  => "the one-stop-shop for all your Linux software needs",
1496    dc => {
1497      date       => '2000-08-23T07:00+00:00',
1498      subject    => "Linux Software",
1499      creator    => 'scoop@freshmeat.net',
1500      publisher  => 'scoop@freshmeat.net',
1501      rights     => 'Copyright 1999, Freshmeat.net',
1502      language   => 'en-us',
1503    },
1504    syn => {
1505      updatePeriod     => "hourly",
1506      updateFrequency  => "1",
1507      updateBase       => "1901-01-01T00:00+00:00",
1508    },
1509    taxo => [
1510      'http://dmoz.org/Computers/Internet',
1511      'http://dmoz.org/Computers/PC'
1512    ]
1513  );
1514
1515  $rss->image(
1516    title  => "freshmeat.net",
1517    url    => "http://freshmeat.net/images/fm.mini.jpg",
1518    link   => "http://freshmeat.net",
1519    dc => {
1520      creator  => "G. Raphics (graphics at freshmeat.net)",
1521    },
1522  );
1523
1524  $rss->add_item(
1525    title       => "GTKeyboard 0.85",
1526    link        => "http://freshmeat.net/news/1999/06/21/930003829.html",
1527    description => "GTKeyboard is a graphical keyboard that ...",
1528    dc => {
1529      subject  => "X11/Utilities",
1530      creator  => "David Allen (s2mdalle at titan.vcu.edu)",
1531    },
1532    taxo => [
1533      'http://dmoz.org/Computers/Internet',
1534      'http://dmoz.org/Computers/PC'
1535    ]
1536  );
1537
1538  $rss->textinput(
1539    title        => "quick finder",
1540    description  => "Use the text input below to search freshmeat",
1541    name         => "query",
1542    link         => "http://core.freshmeat.net/search.php3",
1543  );
1544
1545  # Optionally mixing in elements of a non-standard module/namespace
1546
1547  $rss->add_module(prefix=>'my', uri=>'http://purl.org/my/rss/module/');
1548
1549  $rss->add_item(
1550    title       => "xIrc 2.4pre2",
1551    link        => "http://freshmeat.net/projects/xirc/",
1552    description => "xIrc is an X11-based IRC client which ...",
1553    my => {
1554      rating    => "A+",
1555      category  => "X11/IRC",
1556    },
1557  );
1558
1559   $rss->add_item (title=>$title, link=>$link, slash=>{ topic=>$topic });
1560
1561  # create an RSS 2.0 file
1562  use XML::RSS;
1563  my $rss = XML::RSS->new (version => '2.0');
1564  $rss->channel(title          => 'freshmeat.net',
1565                link           => 'http://freshmeat.net',
1566                language       => 'en',
1567                description    => 'the one-stop-shop for all your Linux software needs',
1568                rating         => '(PICS-1.1 "http://www.classify.org/safesurf/" 1 r (SS~~000 1))',
1569                copyright      => 'Copyright 1999, Freshmeat.net',
1570                pubDate        => 'Thu, 23 Aug 1999 07:00:00 GMT',
1571                lastBuildDate  => 'Thu, 23 Aug 1999 16:20:26 GMT',
1572                docs           => 'http://www.blahblah.org/fm.cdf',
1573                managingEditor => 'scoop@freshmeat.net',
1574                webMaster      => 'scoop@freshmeat.net'
1575                );
1576
1577  $rss->image(title       => 'freshmeat.net',
1578              url         => 'http://freshmeat.net/images/fm.mini.jpg',
1579              link        => 'http://freshmeat.net',
1580              width       => 88,
1581              height      => 31,
1582              description => 'This is the Freshmeat image stupid'
1583              );
1584
1585  $rss->add_item(title => "GTKeyboard 0.85",
1586         # creates a guid field with permaLink=true
1587         permaLink  => "http://freshmeat.net/news/1999/06/21/930003829.html",
1588         # alternately creates a guid field with permaLink=false
1589         # guid     => "gtkeyboard-0.85"
1590         enclosure   => { url=>$url, type=>"application/x-bittorrent" },
1591         description => 'blah blah'
1592 );
1593
1594  $rss->textinput(title => "quick finder",
1595                  description => "Use the text input below to search freshmeat",
1596                  name  => "query",
1597                  link  => "http://core.freshmeat.net/search.php3"
1598                  );
1599
1600  # create an RSS 0.9 file
1601  use XML::RSS;
1602  my $rss = XML::RSS->new( version => '0.9' );
1603  $rss->channel(title => "freshmeat.net",
1604                link  => "http://freshmeat.net",
1605                description => "the one-stop-shop for all your Linux software needs",
1606                );
1607
1608  $rss->image(title => "freshmeat.net",
1609              url   => "http://freshmeat.net/images/fm.mini.jpg",
1610              link  => "http://freshmeat.net"
1611              );
1612
1613  $rss->add_item(title => "GTKeyboard 0.85",
1614                 link  => "http://freshmeat.net/news/1999/06/21/930003829.html"
1615                 );
1616
1617  $rss->textinput(title => "quick finder",
1618                  description => "Use the text input below to search freshmeat",
1619                  name  => "query",
1620                  link  => "http://core.freshmeat.net/search.php3"
1621                  );
1622
1623  # print the RSS as a string
1624  print $rss->as_string;
1625
1626  # or save it to a file
1627  $rss->save("fm.rdf");
1628
1629  # insert an item into an RSS file and removes the oldest ones if
1630  # there are already 15 items or more
1631  my $rss = XML::RSS->new;
1632  $rss->parsefile("fm.rdf");
1633
1634  while (@{$rss->{'items'}} >= 15)
1635  {
1636      pop(@{$rss->{'items'});
1637  }
1638
1639  $rss->add_item(title => "MpegTV Player (mtv) 1.0.9.7",
1640                 link  => "http://freshmeat.net/news/1999/06/21/930003958.html",
1641                 mode  => 'insert'
1642                 );
1643
1644  # parse a string instead of a file
1645  $rss->parse($string);
1646
1647  # print the title and link of each RSS item
1648  foreach my $item (@{$rss->{'items'}}) {
1649      print "title: $item->{'title'}\n";
1650      print "link: $item->{'link'}\n\n";
1651  }
1652
1653  # output the RSS 0.9 or 0.91 file as RSS 1.0
1654  $rss->{output} = '1.0';
1655  print $rss->as_string;
1656
1657 =head1 DESCRIPTION
1658
1659 This module provides a basic framework for creating and maintaining
1660 RDF Site Summary (RSS) files. This distribution also contains many
1661 examples that allow you to generate HTML from an RSS, convert between
1662 0.9, 0.91, and 1.0 version, and other nifty things.
1663 This might be helpful if you want to include news feeds on your Web
1664 site from sources like Slashdot and Freshmeat or if you want to syndicate
1665 your own content.
1666
1667 XML::RSS currently supports 0.9, 0.91, and 1.0 versions of RSS.
1668 See http://backend.userland.com/rss091 for information on RSS 0.91.
1669 See http://www.purplepages.ie/RSS/netscape/rss0.90.html for RSS 0.9.
1670 See http://web.resource.org/rss/1.0/ for RSS 1.0.
1671
1672 RSS was originally developed by Netscape as the format for
1673 Netscape Netcenter channels, however, many Web sites have since
1674 adopted it as a simple syndication format. With the advent of RSS 1.0,
1675 users are now able to syndication many different kinds of content
1676 including news headlines, threaded measages, products catalogs, etc.
1677
1678 B<Note:> In order to parse and generate dates (such as C<pubDate>
1679 and C<dc:date>) it is recommended to use L<DateTime::Format::Mail> and
1680 L<DateTime::Format::W3CDTF> , which is what L<XML::RSS> uses internally
1681 and requires.
1682
1683 =head1 METHODS
1684
1685 =over 4
1686
1687 =item XML::RSS->new(version=>$version, encoding=>$encoding, output=>$output, stylesheet=>$stylesheet_url, 'xml:base'=>$base)
1688
1689 Constructor for XML::RSS. It returns a reference to an XML::RSS object.
1690 You may also pass the RSS version and the XML encoding to use. The default
1691 B<version> is 1.0. The default B<encoding> is UTF-8. You may also specify
1692 the B<output> format regardless of the input version. This comes in handy
1693 when you want to convert RSS between versions. The XML::RSS modules
1694 will convert between any of the formats.  If you set <encode_output> XML::RSS
1695 will make sure to encode any entities in generated RSS.  This is now on by
1696 default.
1697
1698 You can also pass an optional URL to an XSL stylesheet that can be used to
1699 output an C<<< <?xsl-stylesheet ... ?> >>> meta-tag in the header that will
1700 allow some browsers to render the RSS file as HTML.
1701
1702 You can also set C<encode_cb> to a reference to a subroutine that will
1703 encode the output in a custom way. This subroutine accepts two parameters:
1704 a reference to the C<XML::RSS::Private::Output::Base>-derived object (which
1705 should normally not concern you) and the text to encode. It should return
1706 the text to encode. If not set, then the module will encode using its
1707 custom encoding routine.
1708
1709 xml:base will set an C<xml:base> property as per
1710
1711     http://www.w3.org/TR/xmlbase/
1712
1713 Note that in order to encode properly, you need to handle "CDATA" sections
1714 properly. Look at L<XML::RSS::Private::Output::Base>'s C<_default_encode()>
1715 method for how to do it properly.
1716
1717 =item add_item (title=>$title, link=>$link, description=>$desc, mode=>$mode)
1718
1719 Adds an item to the XML::RSS object. B<mode> and B<description> are optional.
1720 The default B<mode>
1721 is append, which adds the item to the end of the list. To insert an item, set the mode
1722 to B<insert>.
1723
1724 The items are stored in the array @{$obj->{'items'}} where
1725 B<$obj> is a reference to an XML::RSS object.
1726
1727 =item as_string;
1728
1729 Returns a string containing the RSS for the XML::RSS object.  This
1730 method will also encode special characters along the way.
1731
1732 =item channel (title=>$title, link=>$link, description=>$desc, language=>$language, rating=>$rating, copyright=>$copyright, pubDate=>$pubDate, lastBuildDate=>$lastBuild, docs=>$docs, managingEditor=>$editor, webMaster=>$webMaster)
1733
1734 Channel information is required in RSS. The B<title> cannot
1735 be more the 40 characters, the B<link> 500, and the B<description>
1736 500 when outputting RSS 0.9. B<title>, B<link>, and B<description>,
1737 are required for RSS 1.0. B<language> is required for RSS 0.91.
1738 The other parameters are optional for RSS 0.91 and 1.0.
1739
1740 To retreive the values of the channel, pass the name of the value
1741 (title, link, or description) as the first and only argument
1742 like so:
1743
1744 $title = channel('title');
1745
1746 =item image (title=>$title, url=>$url, link=>$link, width=>$width, height=>$height, description=>$desc)
1747
1748 Adding an image is not required. B<url> is the URL of the
1749 image, B<link> is the URL the image is linked to. B<title>, B<url>,
1750 and B<link> parameters are required if you are going to
1751 use an image in your RSS file. The remaining image elements are used
1752 in RSS 0.91 or optionally imported into RSS 1.0 via the rss091 namespace.
1753
1754 The method for retrieving the values for the image is the same as it
1755 is for B<channel()>.
1756
1757 =item parse ($string, \%options)
1758
1759 Parses an RDF Site Summary which is passed into B<parse()> as the first
1760 parameter. Returns the instance of the object so one can say
1761 C<<$rss->parse($string)->other_method()>>.
1762
1763 See the add_module() method for instructions on automatically adding
1764 modules as a string is parsed.
1765
1766 %options is a list of options that specify how parsing is to be done. The
1767 available options are:
1768
1769 =over 4
1770
1771 =item * allow_multiple
1772
1773 Takes an array ref of names which indicates which elements should
1774 be allowed to have multiple occurrences. So, for example, to parse
1775 feeds with multiple enclosures
1776
1777    $rss->parse($xml, { allow_multiple => ['enclosure'] });
1778
1779 =item * hashrefs_instead_of_strings
1780
1781 If true, then some items (so far "C<description>") will become hash-references
1782 instead of strings (with a B<content> key containing their content , B<if>
1783 they have XML attributes. Without this key, the attributes will be ignored
1784 and there will only be a string. Thus, specifying this option may break
1785 compatibility.
1786
1787 =item * modules_as_arrays
1788
1789 This option when true, will parse the modules key-value-pairs as an arrayref of
1790 C<<< { el => $key_name, value => $value, } >>> hash-refs to gracefully
1791 handle duplicate items (see below). It will not affect the known modules such
1792 as dc ("Dublin Core").
1793
1794 =back
1795
1796 =item parsefile ($file, \%options)
1797
1798 Same as B<parse()> except it parses a file rather than a string.
1799
1800 See the add_module() method for instructions on automatically adding
1801 modules as a string is parsed.
1802
1803 =item save ($file)
1804
1805 Saves the RSS to a specified file.
1806
1807 =item skipDays (day => $day)
1808
1809 Populates the skipDays element with the day $day.
1810
1811 =item skipHours (hour => $hour)
1812
1813 Populates the skipHours element, with the hour $hour.
1814
1815 =item strict ($boolean)
1816
1817 If it's set to 1, it will adhere to the lengths as specified
1818 by Netscape Netcenter requirements. It's set to 0 by default.
1819 Use it if the RSS file you're generating is for Netcenter.
1820 strict will only work for RSS 0.9 and 0.91. Do not use it for
1821 RSS 1.0.
1822
1823 =item textinput (title=>$title, description=>$desc, name=>$name, link=>$link);
1824
1825 This RSS element is also optional. Using it allows users to submit a Query
1826 to a program on a Web server via an HTML form. B<name> is the HTML form name
1827 and B<link> is the URL to the program. Content is submitted using the GET
1828 method.
1829
1830 Access to the B<textinput> values is the the same as B<channel()> and
1831 B<image()>.
1832
1833 =item add_module(prefix=>$prefix, uri=>$uri)
1834
1835 Adds a module namespace declaration to the XML::RSS object, allowing you
1836 to add modularity outside of the the standard RSS 1.0 modules.  At present,
1837 the standard modules Dublin Core (dc) and Syndication (syn) are predefined
1838 for your convenience. The Taxonomy (taxo) module is also internally supported.
1839
1840 The modules are stored in the hash %{$obj->{'modules'}} where
1841 B<$obj> is a reference to an XML::RSS object.
1842
1843 If you want to automatically add modules that the parser finds in
1844 namespaces, set the $XML::RSS::AUTO_ADD variable to a true value.  By
1845 default the value is false. (N.B. AUTO_ADD only updates the
1846 %{$obj->{'modules'}} hash.  It does not provide the other benefits
1847 of using add_module.)
1848
1849 =back
1850
1851 =head2 RSS 1.0 MODULES
1852
1853 XML-Namespace-based modularization affords RSS 1.0 compartmentalized
1854 extensibility.  The only modules that ship "in the box" with RSS 1.0
1855 are Dublin Core (http://purl.org/rss/1.0/modules/dc/), Syndication
1856 (http://purl.org/rss/1.0/modules/syndication/), and Taxonomy
1857 (http://purl.org/rss/1.0/modules/taxonomy/).  Consult the appropriate
1858 module's documentation for further information.
1859
1860 Adding items from these modules in XML::RSS is as simple as adding other
1861 attributes such as title, link, and description.  The only difference
1862 is the compartmentalization of their key/value paris in a second-level
1863 hash.
1864
1865   $rss->add_item (title=>$title, link=>$link, dc=>{ subject=>$subject, creator=>$creator, date=>$date });
1866
1867 For elements of the Dublin Core module, use the key 'dc'.  For elements
1868 of the Syndication module, 'syn'.  For elements of the Taxonomy module,
1869 'taxo'. These are the prefixes used in the RSS XML document itself.
1870 They are associated with appropriate URI-based namespaces:
1871
1872   syn:  http://purl.org/rss/1.0/modules/syndication/
1873   dc:   http://purl.org/dc/elements/1.1/
1874   taxo: http://purl.org/rss/1.0/modules/taxonomy/
1875
1876 The Dublin Core ('dc') hash keys may be point to an array
1877 reference, which in turn will specify multiple such keys, and render them
1878 one after the other. For example:
1879
1880     $rss->add_item (
1881         title => $title,
1882         link => $link,
1883         dc => {
1884             subject=> ["Jungle", "Desert", "Swamp"],
1885             creator=>$creator,
1886             date=>$date
1887         },
1888     );
1889
1890 Dublin Core elements may occur in channel, image, item(s), and textinput
1891 -- albeit uncomming to find them under image and textinput.  Syndication
1892 elements are limited to the channel element. Taxonomy elements can occur
1893 in the channel or item elements.
1894
1895 Access to module elements after parsing an RSS 1.0 document using
1896 XML::RSS is via either the prefix or namespace URI for your convenience.
1897
1898   print $rss->{items}->[0]->{dc}->{subject};
1899
1900   or
1901
1902   print $rss->{items}->[0]->{'http://purl.org/dc/elements/1.1/'}->{subject};
1903
1904 XML::RSS also has support for "non-standard" RSS 1.0 modularization at
1905 the channel, image, item, and textinput levels.  Parsing an RSS document
1906 grabs any elements of other namespaces which might appear.  XML::RSS
1907 also allows the inclusion of arbitrary namespaces and associated elements
1908 when building  RSS documents.
1909
1910 For example, to add elements of a made-up "My" module, first declare the
1911 namespace by associating a prefix with a URI:
1912
1913   $rss->add_module(prefix=>'my', uri=>'http://purl.org/my/rss/module/');
1914
1915 Then proceed as usual:
1916
1917   $rss->add_item (title=>$title, link=>$link, my=>{ rating=>$rating });
1918
1919 You can also set the value of the module's prefix to an array reference
1920 of C<<< { el => , val => } >>> hash-references, in which case duplicate
1921 elements are possible:
1922
1923   $rss->add_item(title=>$title, link=>$link, my=> [
1924     {el => "rating", value => $rating1, }
1925     {el => "rating", value => $rating2, },
1926   ]
1927
1928 Non-standard namespaces are not, however, currently accessible via a simple
1929 prefix; access them via their namespace URL like so:
1930
1931   print $rss->{items}->[0]->{'http://purl.org/my/rss/module/'}->{rating};
1932
1933 XML::RSS will continue to provide built-in support for standard RSS 1.0
1934 modules as they appear.
1935
1936 =head1 Non-API Methods
1937
1938 =head2 $rss->as_rss_0_9()
1939
1940 B<WARNING>: this function is not an API function and should not be called
1941 directly. It is kept as is for backwards compatibility with legacy code. Use
1942 the following code instead:
1943
1944     $rss->{output} = "0.9";
1945     my $text = $rss->as_string();
1946
1947 This function renders the data in the object as an RSS version 0.9 feed,
1948 and returns the resultant XML as text.
1949
1950 =head2 $rss->as_rss_0_9_1()
1951
1952 B<WARNING>: this function is not an API function and should not be called
1953 directly. It is kept as is for backwards compatibility with legacy code. Use
1954 the following code instead:
1955
1956     $rss->{output} = "0.91";
1957     my $text = $rss->as_string();
1958
1959 This function renders the data in the object as an RSS version 0.91 feed,
1960 and returns the resultant XML as text.
1961
1962 =head2 $rss->as_rss_1_0()
1963
1964 B<WARNING>: this function is not an API function and should not be called
1965 directly. It is kept as is for backwards compatibility with legacy code. Use
1966 the following code instead:
1967
1968     $rss->{output} = "1.0";
1969     my $text = $rss->as_string();
1970
1971 This function renders the data in the object as an RSS version 1.0 feed,
1972 and returns the resultant XML as text.
1973
1974 =head2 $rss->as_rss_2_0()
1975
1976 B<WARNING>: this function is not an API function and should not be called
1977 directly. It is kept as is for backwards compatibility with legacy code. Use
1978 the following code instead:
1979
1980     $rss->{output} = "2.0";
1981     my $text = $rss->as_string();
1982
1983 This function renders the data in the object as an RSS version 2.0 feed,
1984 and returns the resultant XML as text.
1985
1986 =head2 $rss->handle_char()
1987
1988 Needed for XML::Parser. Don't use this directly.
1989
1990 =head2 $rss->handle_dec()
1991
1992 Needed for XML::Parser. Don't use this directly.
1993
1994 =head2 $rss->handle_start()
1995
1996 Needed for XML::Parser. Don't use this directly.
1997
1998 =head1 BUGS
1999
2000 Please use rt.cpan.org for tracking bugs.  The list of current open
2001 bugs is at
2002     L<http://rt.cpan.org/Dist/Display.html?Queue=XML-RSS>.
2003
2004 To report a new bug, go to
2005     L<http://rt.cpan.org/Ticket/Create.html?Queue=XML-RSS>
2006
2007 Please include a failing test in your bug report.  I'd much rather
2008 have a well written test with the bug report than a patch.
2009
2010 When you create diffs (for tests or patches), please use the C<-u>
2011 parameter to diff.
2012
2013 =head1 SOURCE AVAILABILITY
2014
2015 The source is available from the perl.org Subversion server:
2016
2017 L<http://svn.perl.org/modules/XML-RSS/>
2018
2019
2020 =head1 AUTHOR
2021
2022 Original code: Jonathan Eisenzopf <eisen@pobox.com>
2023
2024 Further changes: Rael Dornfest <rael@oreilly.com>, Ask Bjoern Hansen
2025 <ask@develooper.com>
2026
2027 Currently: Shlomi Fish <shlomif@cpan.org>
2028
2029 =head1 COPYRIGHT
2030
2031 Copyright (c) 2001 Jonathan Eisenzopf <eisen@pobox.com> and Rael
2032 Dornfest <rael@oreilly.com>, Copyright (C) 2006-2007 Ask Bjoern Hansen
2033 <ask@develooper.com>.
2034
2035 =head1 LICENSE
2036
2037 XML::RSS is free software. You can redistribute it and/or
2038 modify it under the same terms as Perl itself.
2039
2040 =head1 CREDITS
2041
2042  Wojciech Zwiefka <wojtekz@cnt.pl>
2043  Chris Nandor <pudge@pobox.com>
2044  Jim Hebert <jim@cosource.com>
2045  Randal Schwartz <merlyn@stonehenge.com>
2046  rjp@browser.org
2047  Kellan Elliott-McCrea <kellan@protest.net>
2048  Rafe Colburn <rafe@rafe.us>
2049  Adam Trickett <atrickett@cpan.org>
2050  Aaron Straup Cope <asc@vineyard.net>
2051  Ian Davis <iand@internetalchemy.org>
2052  rayg@varchars.com
2053  Shlomi Fish <shlomif@iglu.org.il>
2054
2055 =head1 SEE ALSO
2056
2057 perl(1), XML::Parser(3).
2058
2059 =cut