view release on metacpan or  search on metacpan

lib/XML/Generator/RSS10.pm  view on Meta::CPAN

        %p,
        state   => {},
        modules => \%mod,
    };

    $self->{state}{indent} = 0;
    $self->{state}{items}  = [];

    $self->_start;

    return $self;
}

sub parse {
    die __PACKAGE__ . " does not implement RSS parsing\n";
}

sub _start {
    my $self = shift;

    $self->start_document;

    $self->processing_instruction(
        { Target => 'xml', Data => 'version="1.0"' } );

    $self->_declare_namespaces;
    $self->_newline_if_pretty;

    $self->_start_element( 'rdf', 'RDF' );
    $self->_newline_if_pretty;
}

use constant ITEM_SPEC => (
    title       => { type => SCALAR },
    link        => { type => SCALAR },
    description => { type => SCALAR, optional => 1 },
);

sub item {
    my $self = shift;
    my %p    = validate(
        @_,
        {
            ITEM_SPEC,
            map { $_ => { optional => 1 } }
                keys %{ $self->{namespace_prefixes} },
        },
    );

    $self->_start_element(
        '', 'item',
        [ 'rdf', 'about' => $p{link} ],
    );
    $self->_newline_if_pretty;

    $self->_contents( \%p, qw( title link ) );

    $self->_call_modules( \%p );

    if ( defined $p{description} ) {
        $self->_element_with_cdata( '', 'description', $p{description} );
        $self->_newline_if_pretty;
    }

    $self->_end_element( '', 'item' );
    $self->_newline_if_pretty;

    push @{ $self->{state}{items} }, $p{link};

}

use constant IMAGE_SPEC => (
    title => { type => SCALAR },
    link  => { type => SCALAR },
    url   => { type => SCALAR },
);

sub image {
    my $self = shift;
    my %p    = validate(
        @_,
        {
            IMAGE_SPEC,
            map { $_ => { optional => 1 } }
                keys %{ $self->{namespace_prefixes} },
        },
    );

    die "Cannot call image() more than once.\n"
        if $self->{state}{image};

    die "Cannot call image() after calling channel().\n"
        if $self->{state}{finished};

    $self->_start_element(
        '', 'image',
        [ 'rdf', 'about' => $p{url} ],
    );
    $self->_newline_if_pretty;

    $self->_contents( \%p, qw( title url link ) );

    $self->_call_modules( \%p );

    $self->{state}{image} = $p{url};

    $self->_end_element( '', 'image' );
    $self->_newline_if_pretty;
}

use constant TEXTINPUT_SPEC => (
    title       => { type => SCALAR },
    description => { type => SCALAR },
    name        => { type => SCALAR },
    url         => { type => SCALAR },
);

sub textinput {
    my $self = shift;
    my %p    = validate(
        @_,
        {
            TEXTINPUT_SPEC,
            map { $_ => { optional => 1 } }
                keys %{ $self->{namespace_prefixes} },
        },
    );

    die "Cannot call textinput() more than once().\n"
        if $self->{state}{textinput};

    die "Cannot call textinput() after calling channel().\n"
        if $self->{state}{finished};

    $self->_start_element(
        '', 'textinput',
        [ 'rdf', 'about' => $p{url} ],
    );
    $self->_newline_if_pretty;

    $self->_contents( \%p, qw( title description name url ) );

    $self->_call_modules( \%p );

    $self->{state}{textinput} = $p{url};

    $self->_end_element( '', 'textinput' );
    $self->_newline_if_pretty;
}

use constant CHANNEL_SPEC => (
    title       => { type => SCALAR },
    link        => { type => SCALAR },
    description => { type => SCALAR },
);

sub channel {
    my $self = shift;
    my %p    = validate(
        @_,
        {
            CHANNEL_SPEC,
            map { $_ => { optional => 1 } }
                keys %{ $self->{namespace_prefixes} },
        },
    );

    die "Cannot call channel() without any items.\n"
        unless @{ $self->{state}{items} };

    die "Cannot call channel() more than once.\n"
        if $self->{state}{finished};

    $self->_start_element(
        '', 'channel',
        [ 'rdf', 'about' => $p{link} ],
    );
    $self->_newline_if_pretty;

    $self->_contents( \%p, qw( title link ) );

    $self->_element_with_cdata( '', 'description', $p{description} );
    $self->_newline_if_pretty;

    foreach my $elt ( grep { $self->{state}{$_} } qw( image textinput ) ) {
        $self->_element(
            '', $elt,
            [ 'rdf', 'resource' => $self->{state}{$elt} ],
        );
        $self->_newline_if_pretty;
    }

    $self->_start_element( '', 'items' );
    $self->_newline_if_pretty;

    $self->_start_element( 'rdf', 'Seq' );
    $self->_newline_if_pretty;

    foreach my $i ( @{ $self->{state}{items} } ) {
        $self->_element(
            'rdf', 'li',
            [ 'rdf', 'resource' => $i ],
        );
        $self->_newline_if_pretty;
    }

    $self->_end_element( 'rdf', 'Seq' );
    $self->_newline_if_pretty;

    $self->_end_element( '', 'items' );
    $self->_newline_if_pretty;

    $self->_call_modules( \%p );

    foreach my $mod ( values %{ $self->{modules} } ) {
        $mod->channel_hook($self) if $mod->can('channel_hook');
    }

    $self->_end_element( '', 'channel' );
    $self->_newline_if_pretty;

    $self->_finish;

    $self->{state}{finished} = 1;
}

sub _finish {
    my $self = shift;

    $self->_end_element( 'rdf', 'RDF' );
    $self->_newline_if_pretty;

    $self->end_document;
}

sub _contents {
    my $self     = shift;
    my $p        = shift;
    my @required = @_;

    for my $elt (@required) {
        $self->_element_with_data( '', $elt, $p->{$elt} );
        $self->_newline_if_pretty;
    }
}

sub _call_modules {
    my $self = shift;
    my $p    = shift;

    foreach my $pre ( sort keys %{ $self->{modules} } ) {
        next unless exists $p->{$pre};

        $self->{modules}{$pre}->contents( $self, $p->{$pre} );
    }
}

sub _element {
    my $self = shift;

    $self->_start_element(@_);
    $self->_end_element(@_);
}

sub _element_with_data {
    my $self = shift;
    my $data = pop;

    $self->_start_element(@_);
    $self->characters( { Data => $data } ) if length $data;
    $self->_end_element(@_);
}

sub _element_with_cdata {
    my $self = shift;
    my $data = pop;

    $self->_start_element(@_);
    if ( length $data ) {
        $self->start_cdata;
        $self->characters( { Data => $data } );
        $self->end_cdata;
    }
    $self->_end_element(@_);
}

sub _start_element {
    my $self = shift;
    my ( $name, $prefix ) = ( shift, shift );

    my %att;
    foreach my $a ( grep { @$_ } @_ ) {
        my ( $k, $v ) = $self->_rss_att(@$a);

        $att{$k} = $v;
    }

    $self->ignorable_whitespace( { Data => ' ' x $self->{state}{indent} } )
        if $self->{pretty} && $self->{state}{indent};

    $self->start_element(
        {
            $self->_rss_name_and_prefix( $name, $prefix ),
            Attributes => \%att,
        }
    );

    $self->{state}{indent}++;
}

sub _end_element {
    my $self = shift;

    if ( $self->{pretty} ) {
        unless ( ( caller(1) )[3] =~ /(?:_element|_element_with_c?data)$/ ) {
            $self->ignorable_whitespace(
                { Data => ' ' x ( $self->{state}{indent} - 1 ) } )
                if $self->{state}{indent} > 1;
        }
    }

    $self->end_element( { $self->_rss_name_and_prefix(@_) } );

    $self->{state}{indent}--;
}

sub _newline_if_pretty {
    $_[0]->ignorable_whitespace( { Data => "\n" } ) if $_[0]->{pretty};
}

{
    my %ns = (
        ''  => 'http://purl.org/rss/1.0/',
        rdf => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#',
    );

    sub _declare_namespaces {
        my $self = shift;

        while ( my ( $p, $uri ) = each %ns ) {
            $self->SUPER::start_prefix_mapping(
                { Prefix => $p, NamespaceURI => $uri } );