XML-Declare
view release on metacpan or search on metacpan
SYNOPSIS
my $doc = doc {
element feed => sub {
attr xmlns => 'http://www.w3.org/2005/Atom';
comment "generated using XML::Declare v$XML::Declare::VERSION";
for (1..3) {
element entry => sub {
element title => 'Title', type => 'text';
element content => sub {
attr type => 'text';
cdata 'Desc';
};
element published => '123123-1231-123-123';
element author => sub {
element name => 'Mons';
}
};
}
};
} '1.0','utf-8';
or
element
name => 'TextContent',
attr => value,
attr1 => [qw(more values)];
attr name => values;
text $content;
cdata $content;
comment $content;
EXPORT
doc BLOCK [ $version, $charset ];
Create XML::LibXML::Document;
element $name, sub { ... };
Create XML::LibXML::Element with name $name; everything, called within
"sub { ... }" will be appended as children to this element
element $name, ATTRS
Create XML::LibXML::Element with name $name and set it's attributes.
"ATTRS" is a pairs of "key =" "value">
attr $name, $value
Create XML::LibXML::Attribute with name $name and value $value
text $content
Create XML::LibXML::Text node with content $content
cdata $content
Create XML::LibXML::CDATASection node with content $content
comment $content
Create XML::LibXML::Comment node with content $content
AUTHOR
Mons Anderson <mons@cpan.org>
LICENSE AND COPYRIGHT
Copyright 2009-2010 Mons Anderson.
ex/example.pl view on Meta::CPAN
my $doc = doc {
element feed => sub {
attr xmlns => 'http://www.w3.org/2005/Atom';
comment "generated using XML::Declare v$XML::Declare::VERSION";
for (1..3) {
element entry => sub {
element title => 'Title', type => 'text';
element content => sub {
attr type => 'text';
cdata 'Desc';
};
element published => '123123-1231-123-123';
element author => sub {
element name => 'Mons';
}
};
}
};
} '1.0','utf-8';
lib/XML/Declare.pm view on Meta::CPAN
my $doc = doc {
element feed => sub {
attr xmlns => 'http://www.w3.org/2005/Atom';
comment "generated using XML::Declare v$XML::Declare::VERSION";
for (1..3) {
element entry => sub {
element title => 'Title', type => 'text';
element content => sub {
attr type => 'text';
cdata 'Desc';
};
element published => '123123-1231-123-123';
element author => sub {
element name => 'Mons';
}
};
}
};
} '1.0','utf-8';
lib/XML/Declare.pm view on Meta::CPAN
or
element
name => 'TextContent',
attr => value,
attr1 => [qw(more values)];
attr name => values;
text $content;
cdata $content;
comment $content;
=head1 EXPORT
=head2 doc BLOCK [ $version, $charset ];
Create L<XML::LibXML::Document>;
=head2 element $name, sub { ... };
lib/XML/Declare.pm view on Meta::CPAN
Create L<XML::LibXML::Element> with name C<$name> and set it's attributes. C<ATTRS> is a pairs of C<key => "value">
=head2 attr $name, $value
Create L<XML::LibXML::Attribute> with name C<$name> and value C<$value>
=head2 text $content
Create L<XML::LibXML::Text> node with content C<$content>
=head2 cdata $content
Create L<XML::LibXML::CDATASection> node with content C<$content>
=head2 comment $content
Create L<XML::LibXML::Comment> node with content C<$content>
=cut
use strict;
use XML::LibXML;
sub import {
my $caller = caller;
no strict 'refs';
*{ $caller . '::doc' } = \&doc;
*{ $caller . '::element' } = \&element;
*{ $caller . '::attr' } = \&attr;
*{ $caller . '::text' } = \&text;
*{ $caller . '::cdata' } = \&cdata;
*{ $caller . '::comment' } = \&comment;
}
{
our $is_doc;
our $element;
sub element ($;$@);
sub attr (@);
sub _attr(@) {
eval {
lib/XML/Declare.pm view on Meta::CPAN
1;
} or do {
( my $e = $@ ) =~ s{ at \S+? line \d+\.\s*$}{};
croak $e;
};
}
sub text ($);
sub _text ($) {
$element->appendChild(XML::LibXML::Text->new(shift));
}
sub cdata ($);
sub _cdata ($) {
$element->appendChild(XML::LibXML::CDATASection->new(shift));
}
sub comment ($);
sub _comment ($) {
local $_ = shift;
m{--}s and croak "'--' (double-hyphen) MUST NOT occur within comments";
substr($_,-1,1) eq '-' and croak "comment MUST NOT end with a '-' (hyphen)";
$element->appendChild(XML::LibXML::Comment->new($_));
}
sub element($;$@) {
my $name = shift;
defined $element or
local *attr = \&_attr and
local *text = \&_text and
local *cdata = \&_cdata and
local *comment = \&_comment;
my ($code,$text);
if (@_) {
if (ref $_[-1] eq 'CODE') {
$code = pop;
} else {
$text = shift;
}
}
my $new;
lib/XML/Declare.pm view on Meta::CPAN
my $warn = shift;
substr($warn, rindex($warn, ' at '),-1,'');
chomp $warn;
local $SIG{__WARN__} = $oldwarn if defined $oldwarn;
Carp::carp $warn;
};
local $element = $doc;
no strict 'refs';
local *attr = \&_attr;
local *text = \&_text;
local *cdata = \&_cdata;
local *comment = \&_comment;
local $is_doc = 0;
$code->();
if ($is_doc == 0) {
Carp::carp "Empty document";
}
elsif ($is_doc > 1) {
Carp::carp "More than one root element. All except first are ignored";
}
$doc;
t/01-basic.t view on Meta::CPAN
is
$doc = doc { element test => sub { text 'text'; attr a => 'attrval'; }; },
qq{<?xml version="1.0" encoding="utf-8"?>\n<test a="attrval">text</test>\n},
'doc + element-sub + attr'
or diag $doc;
XML::LibXML->new->parse_string("$doc");
is
$doc = doc { element test => sub { text 'text'; attr a => 'attrval'; comment 'zzzz'; cdata 'something <![CDATA[:)]]>'; }; },
qq{<?xml version="1.0" encoding="utf-8"?>\n<test a="attrval">text<!--zzzz--><![CDATA[something <![CDATA[:)]]]]><![CDATA[>]]></test>\n},
'doc + element-sub + attr,comm,cdata';
XML::LibXML->new->parse_string("$doc");
eval { $doc = doc { element test => sub { comment '--'; } } };
like $@, qr/double-hyphen.* MUST NOT occur within/i, 'comment with --' or diag "No error: $doc";
eval { $doc = doc { element test => sub { comment 'test-'; } } };
like $@, qr/MUST NOT end with .*hyphen/i, 'comment with -' or diag "No error: $doc";
$doc = doc { element test => sub { comment '-B, B+, B, or B- '; }; };
$back = XML::LibXML->new->parse_string("$doc");
is $back->documentElement->firstChild->textContent, "-B, B+, B, or B- ", 'comment parsed back';
$doc = doc { element test => sub { cdata '<![CDATA[:)]]>'; } };
$back = XML::LibXML->new->parse_string("$doc");
is $back->documentElement->firstChild->textContent, '<![CDATA[:)]]>', 'cdata parsed back';
Test::NoWarnings::had_no_warnings();
local $SIG{__WARN__} = sub {
diag "warned: @_";
};
is
$doc = doc { text 'x'; element test => 'root'; text 'x'; },
qq{<?xml version="1.0" encoding="utf-8"?>\n<test>root</test>\n},
( run in 0.622 second using v1.01-cache-2.11-cpan-454fe037f31 )