Context Navigation

Changeset 17248

Timestamp:

08/08/08 15:41:52 (5 years ago)

Author:

daisuke

Message:

Add has_dom_children

Location:

lang/perl/MooseX-DOM/trunk

Files:

r17247	r17248
61	61	=head2 has_dom_child $name[, %opts]
62	62
63		Specifies that the object should contain a single child by the given name
	63	Specifies that the object should contain a single child by the given name.
	64	Will generate accessor that can handle set/get
	65
	66	has_dom_child 'foo';
	67
	68	$obj->foo(); # get the value of child element foo
	69	$obj->foo("bar"); # set the value of child element foo to bar
	70
	71	=head2 has_dom_children
	72
	73	Specifies that the object should contain possibly multiple children by the
	74	given name
	75
	76	has_dom_children 'foo';
	77
	78	$obj->foo(); # Returns a list of values for each child element foo
	79	$obj->foo(qw(1 2 3)); # Discards old values of foo, and create new nodes
64	80
65	81	=cut

r17247	r17248
56	56
57	57	my %exports = (
	58	has_dom_children => sub {
	59	return Class::MOP::subname($subname->('has_dom_children') => sub ($;%) {
	60	my $caller = caller();
	61	my($name, %args) = @_;
	62	my $namespace = $args{namespace} \|\|= DEFAULT_NAMESPACE_PREFIX;
	63	my $tagname = $args{tag} \|\| $name;
	64	my $filter = $args{filter} \|\| sub {
	65	my $self = shift;
	66	return map { $_->textContent } @_;
	67	};
	68
	69	my $method = $subname->($name, $caller);
	70	$subassign->($method => sub {
	71	my $self = shift;
	72	my $node = $self->node;
	73	my $nsuri = $self->namespaces->{ $namespace };
	74	my @children = ($nsuri) ?
	75	$node->getChildrenByTagNameNS($nsuri, $tagname):
	76	$node->getChildrenByTagName($tagname)
	77	;
	78
	79	if (@_) {
	80	$node->removeChild($_) for @children;
	81	my $document = $node->ownerDocument;
	82	foreach my $data (@_) {
	83	my $child = ($nsuri) ?
	84	$document->createElementNS($nsuri, $tagname) :
	85	$document->createElement($tagname)
	86	;
	87	$child->appendTextNode($data);
	88	push @children, $child;
	89	$node->appendChild($child);
	90	}
	91	}
	92
	93	return $filter->($self, @children);
	94	});
	95	});
	96	},
58	97	has_dom_child => sub {
59	98	return Class::MOP::subname($subname->('has_dom_child') => sub ($;%) {
…	…
102	141	goto &$export;
103	142	}
	143	}
104	144
	145	sub as_xml {
	146	my $self = shift;
	147	$self->node->toString(1);
105	148	}
106	149

r17247	r17248
1	1	use strict;
2	2	use lib "t/lib";
3		use Test::More (tests => 5);
	3	use Test::More (tests => 7);
4	4
5	5	BEGIN
…	…
12	12	<feed xmlns="http://www.w3.org/2005/Atom">
13	13	<title>Hoge</title>
	14	<multi>multi1</multi>
	15	<multi>multi2</multi>
	16	<multi>multi3</multi>
	17	<multi>multi4</multi>
14	18	</feed>
15	19	EOXML
…	…
18	22	ok($obj);
19	23	isa_ok($obj, 'Test::MxD::Simple');
	24
20	25	is( $obj->title, "Hoge" );
21	26
…	…
23	28
24	29	is( $obj->title, "Wee" );
	30
	31	my @multi = $obj->multi;
	32	is_deeply(\@multi,[ 'multi1', 'multi2', 'multi3', 'multi4' ] );
	33
	34	$obj->multi('multi5', 'multi6');
	35	@multi = $obj->multi;
	36	is_deeply(\@multi,[ 'multi5', 'multi6' ]);
25	37	}