view release on metacpan or  search on metacpan

lib/XML/NewsML_G2/Writer.pm  view on Meta::CPAN

    if ( $self->_root_item->doc_version > 1 ) {
        $im->appendChild( my $s = $self->create_element('signal') );
        $self->scheme_manager->add_qcode( $s, 'sig', 'correction' );
    }

    foreach ( @{ $self->_root_item->indicators } ) {
        $im->appendChild( my $s = $self->create_element('signal') );
        $self->scheme_manager->add_qcode( $s, 'ind', lc );
    }

    foreach
        my $attr (qw(see_alsos derived_froms processed_froms evolved_froms)) {
        if ( $self->_root_item->$attr ) {
            my $arrayref = $self->_root_item->$attr;
            for my $v (@$arrayref) {
                ( my $rel = $attr ) =~ s/_(\w)/uc $1/ge;
                $rel =~ s/s$//;
                my $linkelem = $self->create_element(
                    'link',
                    rel     => "irel:$rel",
                    version => $v->version
                );
                for my $attribute (qw/residref href/) {
                    next unless $v->$attribute;
                    $linkelem->setAttribute( $attribute => $v->$attribute );
                }

                $im->appendChild($linkelem);
            }
        }
    }

    $root->appendChild($im);
    return;
}

sub _import_iptc_catalog {
    my $self = shift;

    while ( my ( $attr, $alias ) = each %{ $self->g2_catalog_schemes } ) {
        $alias ||= $attr;
        my $getter_setter = $self->scheme_manager->can($attr)
            or die "Unknown scheme '$attr'\n";
        next
            if ( $getter_setter->( $self->scheme_manager ) )
            ;    # attribute ist already set by user
        my $scheme = XML::NewsML_G2::Scheme->new(
            alias   => $alias,
            catalog => $self->g2_catalog_url
        );
        $getter_setter->( $self->scheme_manager, $scheme );
    }
    return;
}

# public methods

sub create_element {
    my ( $self, $name, %attrs ) = @_;
    my $text      = delete $attrs{_text};
    my $cdata     = delete $attrs{_cdata};
    my $name_text = delete $attrs{_name_text};
    my $ns        = delete $attrs{_ns} || $self->g2_ns;
    my $elem      = $self->doc->createElementNS( $ns, $name );
    for my $attr_name ( sort keys %attrs ) {
        $elem->setAttribute( $attr_name, $attrs{$attr_name} );
    }
    if ($text) {
        $elem->appendChild( $self->doc->createTextNode($text) );
    }
    elsif ($cdata) {
        $elem->appendChild( $self->doc->createCDATASection($cdata) );
    }
    elsif ($name_text) {
        $name_text = $name_text->name
            if ( ref $name_text and $name_text->can('name') );
        $elem->appendChild(
            $self->create_element( 'name', _text => $name_text ) );
    }
    return $elem;
}

sub create_dom {
    my $self = shift;

    $self->_import_iptc_catalog();
    my $root = $self->_create_root_element();
    $self->_create_catalogs($root);
    $self->_create_rights_info($root);
    $self->_create_item_meta($root);
    $self->_create_content_meta($root);
    $self->_create_content($root);
    return $self->doc;

}

__PACKAGE__->meta->make_immutable;

1;
__END__

=head1 NAME

XML::NewsML_G2::Writer - base class for XML DOM tree creation
conforming to NewsML-G2 News Items, Package Items and News Messages

=for test_synopsis
    my ($ni, $sm);

=head1 SYNOPSIS

    my $w = XML::NewsML_G2::Writer::News_Item->new
        (news_item => $ni, scheme_manager => $sm, g2_version => 2.18);

    my $p = $w->create_element('p', class => 'main', _text => 'blah');

    my $dom = $w->create_dom();

=head1 DESCRIPTION

This module acts as a NewsML-G2 version-independent base class for all
writer classes. Depending on whether you want to create output for a
News Item, Package Item or News Message, use one of the subclasses
L<XML::NewsML_G2::Writer::News_Item>,
L<XML::NewsML_G2::Writer::Package_Item> or
L<XML::NewsML_G2::Writer::News_Message> instead.

=head1 ATTRIBUTES

=over 4

=item news_item