view release on metacpan or  search on metacpan

lib/XML/RSS.pm  view on Meta::CPAN

    my ($self, $el) = @_;

    my $ns = $self->_parser->namespace($el);

    return (defined($ns) ? $ns : "");
}

sub _get_elem_namespace {
    my $self = shift;

    my ($el) = @_;

    my $ns = $self->_get_elem_namespace_helper(@_);

    my $verdict = (!$ns && !$self->{rss_namespace})
      || ($ns eq $self->{rss_namespace});

    return ($ns, $verdict);
}

sub _current_element {
    my $self = shift;

    return $self->_parser->current_element;
}

sub _get_current_namespace {
    my $self = shift;

    return $self->_get_elem_namespace($self->_current_element);
}

sub _is_rdf_resource {
    my $self = shift;
    my $el   = shift;

    my $ns = shift;
    if (!defined($ns)) {
        $ns = $self->_parser->namespace($el);
    }

    return ( exists($self->_rdf_resource_fields->{$ns})
          && exists($self->_rdf_resource_fields->{$ns}{$el}));
}

sub _get_ns_arrayity {
    my ($self, $ns) = @_;

    my $is_array = $self->_parse_options()->{'modules_as_arrays'}
      && (!exists($self->_get_default_modules()->{$ns}))

      # RDF
      && ($ns ne "http://www.w3.org/1999/02/22-rdf-syntax-ns#");

    my $default_ref = sub { $is_array ? [] : {} };

    return ($is_array, $default_ref);
}

sub _append_text_to_elem_struct {
    my ($self, $struct, $cdata, $mapping_sub, $is_array_sub) = @_;

    my $elem = $self->_current_element;

    my ($ns, $verdict) = $self->_get_current_namespace;

    # If it's in the default namespace
    if ($verdict) {
        $self->_append_struct(
            $struct,
            scalar($mapping_sub->($struct, $elem)),
            scalar($is_array_sub->($struct, $elem)), $cdata
        );
    }
    else {
        my $prefix = $self->{modules}->{$ns};

        my ($is_array, $default_ref) = $self->_get_ns_arrayity($ns);

        $self->_append_struct(
            ($struct->{$ns} ||= $default_ref->()), $elem,
            (defined($prefix) && $prefix eq "dc"), $cdata
        );

        # If it's in a module namespace, provide a friendlier prefix duplicate
        if ($prefix) {
            $self->_append_struct(($struct->{$prefix} ||= $default_ref->()),
                $elem, ($prefix eq "dc"), $cdata);
        }
    }

    return;
}

{
    my @_ITEM_KEYS_ELEM_STACK = ("rss", "channel", "item", "link");

    sub _should_skip_item_keys_in_custom_tags {
        my ($self, $struct, $key) = @_;

        if (length $struct->{$key}) {
            if ($self->{_internal}->{version} eq "2.0") {
                if ($key eq "link") {
                    my @context = $self->_parser->context();
                    if (@context > @_ITEM_KEYS_ELEM_STACK) {
                        return 1;
                    }
                }
            }
        }
        return;
    }
}


sub _append_struct {
    my ($self, $struct, $key, $can_be_array, $cdata) = @_;

    if (ref($struct) eq 'ARRAY') {
        $struct->[-1]->{'val'} .= $cdata;
        return;
    }
    elsif (defined $struct->{$key}) {
        if (ref($struct->{$key}) eq 'HASH') {
            $struct->{$key}->{content} .= $cdata;
            return;
        }
        elsif ($can_be_array && ref($struct->{$key}) eq 'ARRAY') {
            $struct->{$key}->[-1] .= $cdata;
            return;
        }
    }

    # Somewhat sympotamtic cure for item/link nested inside
    # custom tags:
    #
    # https://github.com/shlomif/perl-XML-RSS/issues/7
    #
    # Thanks to @jkramer .
    if ($self->_should_skip_item_keys_in_custom_tags($struct, $key)) {
        return;
    }

    $struct->{$key} .= $cdata;
    return;
}

sub _return_elem {
    my ($struct, $elem) = @_;
    return $elem;
}

sub _return_elem_is_array {
    my ($struct, $elem) = @_;

    # Always return false because no element should be an array.
    return;
}

sub _append_text_to_elem {
    my ($self, $ext_tag, $cdata) = @_;

    return $self->_append_text_to_elem_struct($self->$ext_tag(),
        $cdata, \&_return_elem, \&_return_elem_is_array,);
}

sub _within_topics {
    my $self = shift;

    my $parser = $self->_parser;

    return $parser->within_element(
        $parser->generate_ns_name("topics", 'http://purl.org/rss/1.0/modules/taxonomy/'));
}

sub _return_item_elem {
    my ($item, $elem) = @_;
    if ($elem eq "guid") {
        return $item->{isPermaLink} ? "permaLink" : "guid";
    }
    else {
        return $elem;
    }
}

sub _return_item_elem_is_array {
    my ($item, $elem) = @_;

    return ($elem eq "category");
}

sub _append_text_to_item {
    my ($self, $cdata) = @_;

    if (@{$self->{'items'}} < $self->{num_items}) {
        push @{$self->{items}}, {};
    }

    $self->_append_text_to_elem_struct($self->_last_item,
        $cdata, \&_return_item_elem, \&_return_item_elem_is_array);
}

sub _append_to_array_elem {
    my ($self, $category, $cdata) = @_;

    if (!$self->_my_in_element($category)) {
        return;
    }

    my $el = $self->_current_element;

    if (ref($self->{$category}->{$el}) eq "ARRAY") {
        $self->{$category}->{$el}->[-1] .= $cdata;
    }
    else {
        $self->{$category}->{$el} .= $cdata;
    }

    return 1;
}

sub _handle_char {
    my ($self, $cdata) = (@_);

    # image element
    if ($self->_my_in_element("image")) {
        $self->_append_text_to_elem("image", $cdata);
    }

    # item element
    elsif (defined($self->{_inside_item_elem})) {
        return if $self->_within_topics;

        $self->_append_text_to_item($cdata);
    }

    # textinput element
    elsif ($self->_my_in_element("textinput") || $self->_my_in_element("textInput")) {
        $self->_append_text_to_elem("textinput", $cdata);
    }

    # skipHours element
    elsif ($self->_append_to_array_elem("skipHours", $cdata)) {

        # Do nothing - already done in the predicate.
    }
    elsif ($self->_append_to_array_elem("skipDays", $cdata)) {

        # Do nothing - already done in the predicate.
    }

    # channel element
    elsif ($self->_my_in_element("channel")) {
        if ($self->_within_topics() || $self->_my_in_element("items")) {
            return;
        }

        if ($self->_current_element eq "category") {
            $self->_append_to_array_elem("channel", $cdata);
        }
        else {
            $self->_append_text_to_elem("channel", $cdata);
        }
    }
}

sub _handle_dec {
    my ($self, $version, $encoding, $standalone) = (@_);
    $self->{encoding} = $encoding;

    #print "ENCODING: $encoding\n";
}

sub _should_be_hashref {
    my ($self, $el) = @_;

    return (
        $empty_ok_elements{$el} || ($self->_parse_options()->{'hashrefs_instead_of_strings'}
            && $hashref_ok_elements{$el})
    );
}

sub _start_array_element_in_struct {
    my ($self, $input_struct, $el, $prefix) = @_;

    my ($el_ns, $el_verdict) = $self->_get_elem_namespace($el);

    my ($is_array, $default_ref) = $self->_get_ns_arrayity($el_ns);

    my @structs =
      (!$el_verdict)
      ? (
        (   exists($self->{modules}->{$el_ns})
            ? ($input_struct->{$self->{modules}->{$el_ns}} ||= $default_ref->())
            : ()
        ),
        ($input_struct->{$el_ns} ||= $default_ref->()),
      )
      : ($input_struct);

    foreach my $struct (@structs) {
        if (ref($struct) eq 'ARRAY') {
            push @$struct, {el => $el, val => "",};
        }

        # If it's an array - append a new empty element because a new one
        # was started.
        elsif (ref($struct->{$el}) eq "ARRAY") {
            push @{$struct->{$el}}, "";
        }

        # If it's not an array but still full (i.e: it's only the second
        # element), then turn it into an array
        elsif (defined($struct->{$el}) && length($struct->{$el})) {
            $struct->{$el} = [$struct->{$el}, ""];
        }

        # Else - do nothing and let the function append to the new value
        #
    }
    return 1;
}

lib/XML/RSS.pm  view on Meta::CPAN

    elsif (ref($old) ne 'ARRAY') {
        $old = [$old];
    }
    push @$old, $new;
    return $old;
}

sub _allow_multiple {
    my $self = shift;
    my $el   = shift;

    $self->{_allow_multiple} ||= {map { $_ => 1 } @{$self->_parse_options->{allow_multiple} || []}};

    return $self->{_allow_multiple}->{$el};
}

sub _handle_end {
    my ($self, $el) = @_;

    if (defined($self->{_inside_item_elem})
        && $self->{_inside_item_elem} == $self->_parser->depth())
    {
        delete($self->{_inside_item_elem});
    }
}

sub _auto_add_modules {
    my $self = shift;

    for my $ns (keys %{$self->{namespaces}}) {

        # skip default namespaces
        next
          if $ns eq "rdf"
          || $ns eq "#default"
          || exists $self->{modules}{$self->{namespaces}{$ns}};
        $self->add_module(prefix => $ns, uri => $self->{namespaces}{$ns});
    }

    $self;
}

sub _parser {
    my $self = shift;

    if (@_) {
        $self->{_parser} = shift;
    }
    return $self->{_parser};
}

sub _get_parser {
    my $self = shift;

    return XML::Parser->new(
        Namespaces    => 1,
        NoExpand      => 1,
        ParseParamEnt => 0,
        Handlers      => {
            Char => sub {
                my ($parser, $cdata) = @_;
                $self->_parser($parser);
                $self->_handle_char($cdata);

                # Detach the parser to avoid reference loops.
                $self->_parser(undef);
            },
            XMLDecl => sub {
                my $parser = shift;
                $self->_parser($parser);
                $self->_handle_dec(@_);

                # Detach the parser to avoid reference loops.
                $self->_parser(undef);
            },
            Start => sub {
                my $parser = shift;
                $self->_parser($parser);
                $self->_handle_start(@_);

                # Detach the parser to avoid reference loops.
                $self->_parser(undef);
            },
            End => sub {
                my $parser = shift;
                $self->_parser($parser);
                $self->_handle_end(@_);

                # Detach the parser to avoid reference loops.
                $self->_parser(undef);
            },
            ExternEnt => sub {
                return '';
            },
        }
    );
}

sub _parse_options {
    my $self = shift;

    if (@_) {
        $self->{_parse_options} = shift;
    }

    return $self->{_parse_options};
}

sub _empty { }

sub _generic_parse {
    my $self    = shift;
    my $method  = shift;
    my $arg     = shift;
    my $options = shift;

    $self->_reset;

    $self->_parse_options($options || {});

    # patch to allow a parse-time option for elements to be empty
    foreach my $el (@{$self->_parse_options()->{'allow_empty'}}) {
        $empty_ok_elements{$el} = 1;