File Coverage

blib/lib/PRANG/Graph/Meta/Element.pm
Criterion Covered Total %
statement 12 238 5.0
branch 0 142 0.0
condition 0 76 0.0
subroutine 4 10 40.0
pod 0 3 0.0
total 16 469 3.4


line stmt bran cond sub pod time code
1              
2             package PRANG::Graph::Meta::Element;
3             $PRANG::Graph::Meta::Element::VERSION = '0.19';
4 1     1   2040 use Moose::Role;
  1         2  
  1         6  
5 1     1   4888 use PRANG::Util qw(types_of);
  1         2  
  1         7  
6 1     1   219 use MooseX::Params::Validate;
  1         2  
  1         8  
7              
8             has 'xmlns' =>
9             is => "rw",
10             isa => "Str",
11             predicate => "has_xmlns",
12             ;
13              
14             has 'xmlns_attr' =>
15             is => "rw",
16             isa => "Str",
17             predicate => "has_xmlns_attr",
18             ;
19              
20             has 'xml_nodeName' =>
21             is => "rw",
22             isa => "Str|HashRef",
23             predicate => "has_xml_nodeName",
24             ;
25              
26             has 'xml_nodeName_prefix' =>
27             is => "rw",
28             isa => "HashRef[Str]",
29             predicate => "has_xml_nodeName_prefix",
30             ;
31              
32             has 'xml_nodeName_attr' =>
33             is => "rw",
34             isa => "Str",
35             predicate => "has_xml_nodeName_attr",
36             ;
37              
38             has 'xml_required' =>
39             is => "rw",
40             isa => "Bool",
41             predicate => "has_xml_required",
42             ;
43              
44             has 'xml_min' =>
45             is => "rw",
46             isa => "Int",
47             predicate => "has_xml_min",
48             ;
49              
50             has 'xml_max' =>
51             is => "rw",
52             isa => "Int",
53             predicate => "has_xml_max",
54             ;
55              
56             # FIXME: see commitlog, core Moose should get support for this again
57             # (perhaps)
58             #has '+isa' =>
59             # required => 1,
60             # ;
61              
62             has 'graph_node' =>
63             is => "rw",
64             isa => "PRANG::Graph::Node",
65             lazy => 1,
66             required => 1,
67             default => sub {
68             my $self = shift;
69             $self->build_graph_node;
70             },
71             ;
72              
73             has "_item_tc" =>
74             is => "rw",
75             isa => "Moose::Meta::TypeConstraint",
76             ;
77              
78 1         1923 use constant HIGHER_ORDER_TYPE =>
79 1     1   512 "Moose::Meta::TypeConstraint::Parameterized";
  1         2  
80              
81             sub _error {
82 0     0     my $self = shift;
83 0           my ( $message ) = pos_validated_list(
84             \@_,
85             { isa => 'Str' },
86             );
87            
88 0           my $class = $self->associated_class;
89 0           my $context = " (Element: ";
90 0 0         if ($class) {
91 0           $context .= $class->name;
92             }
93             else {
94 0           $context .= "(unassociated)";
95             }
96 0           $context .= "/".$self->name.") ";
97 0           $message.$context;
98             }
99              
100             sub error {
101 0     0 0   my $self = shift;
102 0           my ( $message ) = pos_validated_list(
103             \@_,
104             { isa => 'Str' },
105             );
106            
107 0           confess $self->_error($message);
108             }
109              
110             sub warn_of {
111 0     0 0   my $self = shift;
112 0           my ( $message ) = pos_validated_list(
113             \@_,
114             { isa => 'Str' },
115             );
116            
117 0           warn $self->_error($message)."\n";
118             }
119              
120             sub build_graph_node {
121 0     0 0   my $self = shift;
122            
123 0           my ($expect_one, $expect_many);
124              
125 0 0 0       if ( $self->has_xml_required ) {
    0 0        
126 0           $expect_one = $self->xml_required;
127             }
128             elsif (
129             $self->has_predicate
130             or
131             $self->has_xml_min and !$self->xml_min
132             )
133 0           { $expect_one = 0;
134             }
135             else {
136 0           $expect_one = 1;
137             }
138              
139 0 0         my $t_c = $self->type_constraint
140             or $self->error(
141             "No type constraint on attribute; did you specify 'isa'?",
142             );
143              
144             # check to see whether ArrayRef was specified
145 0 0 0       if ( $t_c->is_a_type_of("ArrayRef") ) {
    0 0        
      0        
146 0           my $is_paramd;
147 0           until ( $t_c->equals("ArrayRef") ) {
148 0 0         if ( $t_c->isa(HIGHER_ORDER_TYPE) ) {
149 0           $is_paramd = 1;
150 0           last;
151             }
152             else {
153 0           $t_c = $t_c->parent;
154             }
155             }
156 0 0         if (not $is_paramd) {
157 0           $self->error("ArrayRef, but not Parameterized");
158             }
159 0           $expect_many = 1;
160              
161 0           $t_c = $t_c->type_parameter;
162             }
163             elsif (
164             $self->has_xml_max and $self->xml_max > 1
165             or
166             $self->has_xml_min and $self->xml_min > 1
167             )
168             {
169 0           $self->error(
170             "min/max specified as >1, but type constraint is not an ArrayRef",
171             );
172             }
173              
174 0           $self->_item_tc($t_c);
175              
176             # ok. now let's walk the type constraint tree, and look for
177             # types
178 0           my ($expect_bool, $expect_simple, @expect_type, @expect_role);
179              
180 0           my @st = $t_c;
181 0           my %t_c;
182 0           while ( my $x = shift @st ) {
183 0           $t_c{$x} = $x;
184 0 0         if ( $x->isa("Moose::Meta::TypeConstraint::Class") ) {
    0          
    0          
    0          
    0          
185 0           push @expect_type, $x->class;
186             }
187             elsif ( $x->isa("Moose::Meta::TypeConstraint::Union") ) {
188 0           push @st, @{ $x->type_constraints };
  0            
189             }
190             elsif ( $x->isa("Moose::Meta::TypeConstraint::Enum") ) {
191 0           push @st, $x->parent;
192             }
193             elsif ( $x->isa("Moose::Meta::TypeConstraint::Role") ) {
194              
195             # likely to be a wildcard.
196 0           push @expect_role, $x->role;
197             }
198             elsif ( ref $x eq "Moose::Meta::TypeConstraint" ) {
199 0 0         if ( $x->equals("Bool") ) {
    0          
200 0           $expect_bool = 1;
201             }
202             elsif ( $x->equals("Value") ) {
203 0           $expect_simple = 1;
204             }
205             else {
206 0           push @st, $x->parent;
207             }
208             }
209             else {
210 0           $self->error(
211             "Sorry, I don't know how to map a "
212             .ref($x)
213             );
214             }
215             }
216              
217 0           my $node;
218 0 0         my $nodeName = $self->has_xml_nodeName
219             ?
220             $self->xml_nodeName
221             : $self->name;
222 0 0         my $nodeName_prefix = $self->has_xml_nodeName_prefix
223             ?
224             $self->xml_nodeName_prefix
225             : {};
226 0           my $nodeName_r_prefix = { reverse %$nodeName_prefix };
227              
228 0   0       my $expect_concrete = ($expect_bool||0) +
      0        
229             ($expect_simple||0) + @expect_type;
230              
231 0 0         if ( $expect_concrete > 1 ) {
232              
233             # multiple or ambiguous types are specified; we *need*
234             # to know
235 0 0         if ( !ref $nodeName ) {
236 0           $self->error(
237             "type union specified, but no nodename map given"
238             );
239             }
240 0           while ( my ($nodeName, $type) = each %$nodeName ) {
241 0 0         if ( not exists $t_c{$type} ) {
242 0           $self->error(
243             "nodeName to type map specifies $nodeName => '$type', but $type is not"
244             ." an acceptable type",
245             );
246             }
247             }
248             }
249              
250 0           my $prefix_xx;
251              
252             # plug-in type classes.
253 0 0         if (@expect_role) {
254 0           my @users = map { $_->name } types_of(@expect_role);
  0            
255 0 0 0       if ( $self->has_xml_nodeName and !ref $self->xml_nodeName ) {
256 0           $self->error(
257             "Str value for xml_nodeName incompatible with specifying a role type "
258             ."constraint"
259             );
260             }
261 0 0         $nodeName = {} if !ref $nodeName;
262 0           for my $user (@users) {
263 0 0         if ( $user->does("PRANG::Graph") ) {
264 0           my $plugin_nodeName = $user->root_element;
265 0           my $xmlns;
266 0 0 0       if ( $xmlns = eval { $user->xmlns }//"" ) {
  0            
267 0 0         if ( not exists $nodeName_r_prefix->{$xmlns} ) {
268 0   0       $prefix_xx ||= "a";
269             $prefix_xx++
270 0           while exists $nodeName_prefix->{$prefix_xx};
271 0           $nodeName_prefix->{$prefix_xx} = $xmlns;
272 0           $nodeName_r_prefix->{$xmlns} = $prefix_xx;
273             }
274             $plugin_nodeName =
275 0           "$nodeName_r_prefix->{$xmlns}:$plugin_nodeName";
276             }
277 0 0         if ( exists $nodeName->{$plugin_nodeName} ) {
278 0 0         $self->error(
279             "Both '$user' and '$nodeName->{$plugin_nodeName}' plug-in type specify nodename $plugin_nodeName"
280             .(
281             $xmlns ? " (xmlns $xmlns)" : ""
282             )
283             .", conflict",
284             );
285             }
286 0           $nodeName->{$plugin_nodeName} = $user;
287             }
288             else {
289 0           $self->error(
290             "Can't use one or more of role(s) @expect_role; "
291             .$user->name
292             ." needs to consume role PRANG::Graph (hint: did you forget to \"with 'PRANG::Graph';\"?)",
293             );
294             }
295 0           push @expect_type, $user;
296 0           $expect_concrete++;
297             }
298 0           $self->xml_nodeName({%$nodeName});
299 0 0 0       if ( !$self->has_xml_nodeName_prefix
300             and keys %$nodeName_prefix )
301 0           { $self->xml_nodeName_prefix($nodeName_prefix);
302             }
303             }
304 0 0         if (!$expect_concrete) {
305 0           $self->error(
306             "no type(s) specified (or, role evaluated to nothing)",
307             )
308             }
309              
310 0 0         if ( !ref $nodeName ) {
311 0 0         my $expected = $expect_bool ? "Bool" :
    0          
312             $expect_simple ? "Str" : $expect_type[0];
313 0           $nodeName = { $nodeName => $expected };
314 0           $self->xml_nodeName($nodeName);
315             }
316              
317             # we will be using 'delete' with nodeName, so copy it
318 0           $nodeName = {%$nodeName};
319              
320             # figure out the XML namespace of this node and set it on the
321             # attribute
322 0           my %xmlns_opts;
323 0 0         if ( $self->has_xmlns ) {
324 0           $xmlns_opts{xmlns} = $self->xmlns;
325             }
326             else {
327 0   0       my $xmlns = eval { $self->associated_class->name->xmlns } // "";
  0            
328 0 0         $xmlns_opts{xmlns} = $xmlns
329             if $xmlns; # FIXME - should *always* set it!
330             }
331 0 0         if ( $self->has_xmlns_attr ) {
332 0           $xmlns_opts{xmlns_attr} = $self->xmlns_attr;
333             }
334             my $prefix_xmlns = sub {
335 0     0     my $name = shift;
336 0 0 0       if ( $nodeName_prefix and $name =~ /^(\w+):(\w+)/ ) {
337 0           my %this_xmlns_opts = %xmlns_opts;
338             my $xmlns = $nodeName_prefix->{$1}
339             or die "unknown prefix '$1' used on attribute "
340             .$self->name." of "
341 0 0         .eval{$self->associated_class->name};
  0            
342 0           $this_xmlns_opts{xmlns} = $xmlns;
343 0           ($2, \%this_xmlns_opts);
344             }
345             else {
346 0           ($name, \%xmlns_opts);
347             }
348 0           };
349              
350 0           my @expect;
351 0           for my $class (@expect_type) {
352 0           my (@names) = grep { $nodeName->{$_} eq $class }
  0            
353             keys %$nodeName;
354              
355             # auto-load the classes now... save problems later
356 0 0         if ( !eval{ $class->meta->can("marshall_in_element") } ) {
  0            
357 0           my $ok = eval "use $class; 1";
358 0 0         if ( !$ok ) {
359 0           die
360             "problem auto-including class '$class'; (hint: did you expect '$class' to be a subtype, but forget to define it before it was used or not use BEGIN { } appropriately?); exception is: $@";
361             }
362             }
363 0 0         if ( !eval{ $class->meta->can("marshall_in_element") } ) {
  0            
364 0           die
365             "'$class' can't marshall in; did you 'use PRANG::Graph'?";
366             }
367              
368 0 0         if ( !@names ) {
369             die "type '$class' specified as allowed on '"
370             .$self->name
371             ."' element of "
372             .$self->associated_class->name
373             .", but which node names indicate that type? You've defined: "
374             .(
375             $self->has_xml_nodeName
376             ? ( ref $self->xml_nodeName
377             ? join(
378             "; ",
379 0           map { "$_ => ".$self->xml_nodeName->{$_} }
380 0 0         sort keys %{$self->xml_nodeName}
  0 0          
381             )
382             : ("(all '".$self->xml_nodeName."')")
383             )
384             : "(nothing)"
385             );
386             }
387              
388 0           for my $name (@names) {
389 0           my ($nn, $xmlns_args) =
390             $prefix_xmlns->($name);
391 0           push @expect, PRANG::Graph::Element->new(
392             %$xmlns_args,
393             attrName => $self->name,
394             nodeClass => $class,
395             nodeName => $nn,
396             );
397 0           delete $nodeName->{$name};
398             }
399             }
400              
401 0 0         if ($expect_bool) {
402             my (@names) = grep {
403 0           !$t_c{$nodeName->{$_}}->is_a_type_of("Object")
  0            
404             } keys %$nodeName;
405              
406             # 'Bool' elements are a shorthand for the element
407             # 'maybe' being there.
408 0           for my $name (@names) {
409 0           my ($nn, $xmlns_args) = $prefix_xmlns->($name);
410 0           push @expect, PRANG::Graph::Element->new(
411             %$xmlns_args,
412             attrName => $self->name,
413             attIsArray => $expect_many,
414             nodeName => $nn,
415             );
416 0           delete $nodeName->{$name};
417             }
418             }
419 0 0         if ($expect_simple) {
420             my (@names) = grep {
421 0           my $t_c = $t_c{$nodeName->{$_}};
  0            
422 0 0         die "dang, "
423             .$self->name." of "
424             .$self->associated_class->name
425             .", no type constraint called $nodeName->{$_} (element $_)"
426             if !$t_c;
427 0           !$t_c->is_a_type_of("Object")
428             } keys %$nodeName;
429 0           for my $name (@names) {
430              
431             # 'Str', 'Int', etc element attributes: this
432             # means an XML data type: <attr>value</attr>
433 0 0         if ( !length($name) ) {
434              
435             # this is for 'mixed' data
436 0           push @expect, PRANG::Graph::Text->new(
437             attrName => $self->name,
438             );
439             }
440             else {
441              
442             # regular XML data style
443 0           my ($nn, $xmlns_args) =
444             $prefix_xmlns->($name);
445 0           push @expect, PRANG::Graph::Element->new(
446             %$xmlns_args,
447             attrName => $self->name,
448             nodeName => $nn,
449             contents => PRANG::Graph::Text->new,
450             );
451             }
452 0           delete $nodeName->{$name};
453             }
454             }
455              
456             # determine if we need explicit attributes to record the
457             # nodename and/or XML namespace.
458              
459             # first rule. If multiple prefix:nodeName entries map to the
460             # same type, then we would have an ambiguous type map, and
461             # therefore need at least one of name_attr and xmlns_attr
462 0           my $have_ambiguous;
463 0           my (%seen_types, %seen_xmlns, %seen_localname);
464 0           my $fixed_xmlns = $self->xmlns;
465 0           my $use_prefixes = $self->has_xml_nodeName_prefix;
466 0 0 0       if ( $fixed_xmlns and $use_prefixes ) {
467 0           $self->error(
468             "specify only one of 'xmlns' / 'xml_nodeName_prefix' (note: latter may be implied by use of roles)"
469             );
470             }
471 0           while ( my ($element_fullname, $class) =
472 0           each %{$self->xml_nodeName})
473 0           { my ($xmlns, $localname);
474 0 0         if ($use_prefixes) {
475 0           (my $prefix, $localname) =
476             ($element_fullname =~ /^(?:(\w+):)?(\w+|\*)/);
477 0   0       $prefix //= "";
478 0   0       $xmlns = $nodeName_prefix->{$prefix}//"";
479             }
480             else {
481 0           $localname = $element_fullname;
482 0   0       $xmlns = $fixed_xmlns//"";
483             }
484              
485 0   0       $localname //= "";
486 0           $seen_localname{$localname}++;
487 0           $seen_xmlns{$xmlns}++;
488              
489 0 0         $have_ambiguous++ if $localname eq "*";
490 0 0         $have_ambiguous++ if $xmlns eq "*";
491              
492 0           my $ent = [ $xmlns, $localname ];
493 0 0         if ( my $aref = $seen_types{$class} ) {
494 0           $have_ambiguous++;
495 0           push @$aref, $ent;
496             }
497             else {
498 0           $seen_types{$class} = [$ent];
499             }
500             }
501              
502             # if all nodes have the same localname, we can use just
503             # xmlns_attr. if all nodes have the same xmlns, we can use
504             # just name_attr
505 0           my @name_attr;
506 0 0 0       if ($have_ambiguous) {
    0          
    0          
507 0 0 0       if ( keys %seen_localname > 1 or $seen_localname{"*"} ) {
508 0 0         if ( !$self->has_xml_nodeName_attr ) {
509 0           $self->error(
510             "xml_nodeName map ambiguities or wildcarding imply need for "
511             ."xml_nodeName_attr, but none given",
512             );
513             }
514             else {
515 0           my $attr = $self->xml_nodeName_attr;
516 0           push @name_attr, name_attr => $attr;
517 0           for my $x (@expect) {
518 0           $x->nodeName_attr($attr);
519             }
520             }
521             }
522             else {
523 0   0       push @name_attr,
524             xml_nodeName => (keys %seen_localname)[0]//"";
525             }
526              
527 0 0 0       if ( keys %seen_xmlns > 1 or $seen_xmlns{"*"} ) {
528 0 0         if ( !$self->has_xmlns_attr ) {
529 0           $self->error(
530             "xml_nodeName map ambiguities or wildcarding imply need for "
531             ."xmlns_attr, but none given",
532             );
533             }
534             else {
535 0           my $attr = $self->xmlns_attr;
536 0           push @name_attr, xmlns_attr => $attr;
537 0           for my $x (@expect) {
538 0           $x->xmlns_attr($attr);
539             }
540             }
541             }
542             else {
543 0   0       push @name_attr, xmlns => (keys %seen_xmlns)[0]//"";
544             }
545             }
546             elsif ( $self->has_xmlns_attr or $self->has_xml_nodeName_attr ) {
547 0           $self->error(
548             "unnecessary use of xmlns_attr / xml_nodeName_attr");
549             }
550             elsif ( $self->has_xml_nodeName ) {
551 0           push @name_attr, type_map => {%{$self->xml_nodeName}};
  0            
552 0 0         if ( $self->has_xml_nodeName_prefix ) {
553             push @name_attr, type_map_prefix =>
554 0           {%{$self->xml_nodeName_prefix}};
  0            
555             }
556             }
557              
558 0 0         if ( @expect > 1 ) {
559 0           $node = PRANG::Graph::Choice->new(
560             choices => \@expect,
561             attrName => $self->name,
562             @name_attr,
563             );
564             }
565             else {
566 0           $node = $expect[0];
567 0 0         if ( $self->has_xml_nodeName_attr ) {
568 0           $node->nodeName_attr($self->xml_nodeName_attr);
569             }
570             }
571              
572 0 0         if ($expect_bool) {
573 0           $expect_one = 0;
574             }
575 0 0 0       if ( $expect_one
      0        
      0        
576             and !$expect_simple
577             and
578             !$self->is_required and !$self->has_default
579             )
580             {
581 0           $self->warn_of(
582             "expected element is not required, this can cause errors on marshall out"
583             );
584              
585             # this is probably a bit harsh.
586             #$self->meta->find_attribute_by_name("required")->set_value(
587             # $self, 1,
588             # );
589             }
590              
591             # deal with limits
592 0 0 0       if ( !$expect_one or $expect_many) {
593 0           my @min_max;
594 0 0 0       if ( $expect_one and !$self->has_xml_min ) {
595 0           $self->xml_min(1);
596             }
597 0 0         if ( $self->has_xml_min ) {
598 0           push @min_max, min => $self->xml_min;
599             }
600 0 0 0       if ( !$expect_many and !$self->has_xml_max ) {
601 0           $self->xml_max(1);
602             }
603 0 0         if ( $self->has_xml_max ) {
604 0           push @min_max, max => $self->xml_max;
605             }
606 0 0         die "no node! fail! processing "
607             .$self->associated_class->name
608             .", element "
609             .$self->name
610             unless $node;
611 0           $node = PRANG::Graph::Quantity->new(
612             @min_max,
613             attrName => $self->name,
614             child => $node,
615             );
616             }
617             else {
618 0           $self->xml_min(1);
619 0           $self->xml_max(1);
620             }
621              
622 0           return $node;
623             }
624              
625             package Moose::Meta::Attribute::Custom::Trait::PRANG::Element;
626             $Moose::Meta::Attribute::Custom::Trait::PRANG::Element::VERSION = '0.19';
627             sub register_implementation {
628 0     0     "PRANG::Graph::Meta::Element";
629             }
630              
631             1;
632              
633             =head1 NAME
634              
635             PRANG::Graph::Meta::Element - metaclass metarole for XML elements
636              
637             =head1 SYNOPSIS
638              
639             use PRANG::Graph;
640              
641             has_element 'somechild' =>
642             is => "rw",
643             isa => "Some::Type",
644             xml_required => 0,
645             ;
646              
647             # equivalent alternative - plays well with others!
648             has 'somechild' =>
649             is => "rw",
650             traits => [qw/PRANG::Element/],
651             isa => "Some::Type",
652             xml_required => 0,
653             ;
654              
655             =head1 DESCRIPTION
656              
657             The PRANG concept is that attributes in your classes are marked to
658             correspond with attributes and elements in your XML. This class is
659             for marking your class' attributes as XML I<elements>. For marking
660             them as XML I<attributes>, see L<PRANG::Graph::Meta::Attr>.
661              
662             Non-trivial elements - and this means elements which contain more than
663             a single TextNode element within - are mapped to Moose classes. The
664             child elements that are allowed within that class correspond to the
665             attributes marked with the C<PRANG::Element> trait, either via
666             C<has_element> or the Moose C<traits> keyword.
667              
668             Where it makes sense, as much as possible is set up from the regular
669             Moose definition of the attribute. This includes the XML node name,
670             the type constraint, and also the predicate.
671              
672             If you like, you can also set the C<xmlns> and C<xml_nodeName>
673             attribute property, to override the default behaviour, which is to
674             assume that the XML element name matches the Moose attribute name, and
675             that the XML namespace of the element is that of the enclosing class
676             (ie, C<$class-E<gt>xmlns>), if defined.
677              
678             The B<order> of declaring element attributes is important. They
679             implicitly define a "sequence". To specify a "choice", you must use a
680             union sub-type - see below. Care must be taken with bundling element
681             attributes into roles as ordering when composing is not defined.
682              
683             The B<predicate> property of the attribute is also important. If you
684             do not define C<predicate>, then the attribute is considered
685             I<required>. This can be overridden by specifying C<xml_required> (it
686             must be defined to be effective).
687              
688             The B<isa> property (B<type constraint>) you set via 'isa' is
689             I<required>. The behaviour for major types is described below. The
690             module knows about sub-typing, and so if you specify a sub-type of one
691             of these types, then the behaviour will be as for the type on this
692             list. Only a limited subset of higher-order/parametric/structured
693             types are permitted as described.
694              
695             =over 4
696              
697             =item B<Bool sub-type>
698              
699             If the attribute is a Bool sub-type (er, or just "Bool", then the
700             element will marshall to the empty element if true, or no element if
701             false. The requirement that C<predicate> be defined is relaxed for
702             C<Bool> sub-types.
703              
704             ie, C<Bool> will serialise to:
705              
706             <object>
707             <somechild />
708             </object>
709              
710             For true and
711              
712             <object>
713             </object>
714              
715             For false.
716              
717             =item B<Scalar sub-type>
718              
719             If it is a Scalar subtype (eg, an enum, a Str or an Int), then the
720             value of the Moose attribute is marshalled to the value of the element
721             as a TextNode; eg
722              
723             <somechild>somevalue</somechild>
724              
725             =item B<Object sub-type>
726              
727             If the attribute is an Object subtype (ie, a Class), then the element
728             is serialised according to the definition of the Class defined.
729              
730             eg, with;
731              
732             {
733             package CD;
734             use Moose; use PRANG::Graph;
735             has_element 'author' => qw( is rw isa Person );
736             has_attr 'name' => qw( is rw isa Str );
737             }
738             {
739             package Person;
740             use Moose; use PRANG::Graph;
741             has_attr 'group' => qw( is rw isa Bool );
742             has_attr 'name' => qw( is rw isa Str );
743             has_element 'deceased' => qw( is rw isa Bool );
744             }
745              
746             Then the object;
747              
748             CD->new(
749             name => "2Pacalypse Now",
750             author => Person->new(
751             group => 0,
752             name => "Tupac Shakur",
753             deceased => 1,
754             )
755             );
756              
757             Would serialise to (assuming that there is a L<PRANG::Graph> document
758             type with C<cd> as a root element):
759              
760             <cd name="2Pacalypse Now">
761             <author group="0" name="Tupac Shakur>
762             <deceased />
763             </author>
764             </cd>
765              
766             =item B<ArrayRef sub-type>
767              
768             An C<ArrayRef> sub-type indicates that the element may occur multiple
769             times at this point. Bounds may be specified directly - the
770             C<xml_min> and C<xml_max> attribute properties.
771              
772             Higher-order types are supported; in fact, to not specify the type of
773             the elements of the array is a big no-no.
774              
775             If C<xml_nodeName> is specified, it refers to the items; no array
776             container node is expected.
777              
778             For example;
779              
780             has_attr 'name' =>
781             is => "rw",
782             isa => "Str",
783             ;
784             has_attr 'releases' =>
785             is => "rw",
786             isa => "ArrayRef[CD]",
787             xml_min => 0,
788             xml_nodeName => "cd",
789             ;
790              
791             Assuming that this property appeared in the definition for 'artist',
792             and that CD C<has_attr 'title'...>, it would let you parse:
793              
794             <artist>
795             <name>The Headless Chickens</name>
796             <cd title="Stunt Clown">...<cd>
797             <cd title="Body Blow">...<cd>
798             <cd title="Greedy">...<cd>
799             </artist>
800              
801             You cannot (currently) Union an ArrayRef type with other simple types.
802              
803             =item B<Union types>
804              
805             Union types are special; they indicate that any one of the types
806             indicated may be expected next. By default, the name of the element
807             is still the name of the Moose attribute, and if the case is that a
808             particular element may just be repeated any number of times, this is
809             fine.
810              
811             However, this can be inconvenient in the typical case where the
812             alternation is between a set of elements which are allowed in the
813             particular context, each corresponding to a particular Moose type.
814             Another one is the case of mixed XML, where there may be text, then
815             XML fragments, more text, more XML, etc.
816              
817             There are two relevant questions to answer. When marshalling OUT, we
818             want to know what element name to use for the attribute in the slot.
819             When marshalling IN, we need to know what element names are allowable,
820             and potentially which sub-type to expect for a particular element
821             name.
822              
823             After applying much DWIMery, the following scenarios arise;
824              
825             =over
826              
827             =item B<1:1 mapping from Type to Element name>
828              
829             This is often the case for message containers that allow any number of
830             a collection of classes inside. For this case, a map must be provided
831             to the C<xml_nodeName> function, which allows marshalling in and out
832             to proceed.
833              
834             has_element 'message' =>
835             is => "rw",
836             isa => "my::unionType",
837             xml_nodeName => {
838             "nodename" => "TypeA",
839             "somenode" => "TypeB",
840             };
841              
842             It is an error if types are repeated in the map. The empty string can
843             be used as a node name for text nodes, otherwise they are not allowed.
844              
845             This case is made of win because no extra attributes are required to
846             help the marshaller; the type of the data is enough.
847              
848             An example of this in practice;
849              
850             subtype "My::XML::Language::choice0"
851             => as join("|", map { "My::XML::Language::$_" }
852             qw( CD Store Person ) );
853              
854             has_element 'things' =>
855             is => "rw",
856             isa => "ArrayRef[My::XML::Language::choice0]",
857             xml_nodeName => +{ map {( lc($_) => $_ )} qw(CD Store Person) },
858             ;
859              
860             This would allow the enclosing class to have a 'things' property,
861             which contains all of the elements at that point, which can be C<cd>,
862             C<store> or C<person> elements.
863              
864             In this case, it may be preferrable to pass a role name as the element
865             type, and let this module evaluate construct the C<xml_nodeName> map
866             itself.
867              
868             =item B<more types than element names>
869              
870             This happens when some of the types have different XML namespaces; the
871             type of the node is indicated by the namespace prefix.
872              
873             In this case, you must supply a namespace map, too.
874              
875             has_element 'message' =>
876             is => "rw",
877             isa => "my::unionType",
878             xml_nodeName => {
879             "trumpery:nodename" => "TypeA",
880             "rubble:nodename" => "TypeB",
881             "claptrap:nodename" => "TypeC",
882             },
883             xml_nodeName_prefix => {
884             "trumpery" => "uri:type:A",
885             "rubble" => "uri:type:B",
886             "claptrap" => "uri:type:C",
887             },
888             ;
889              
890             B<FIXME:> this is currently unimplemented.
891              
892             =item B<more element names than types>
893              
894             This can happen for two reasons: one is that the schema that this
895             element definition comes from is re-using types. Another is that you
896             are just accepting XML without validation (eg, XMLSchema's
897             C<processContents="skip"> property). In this case, there needs to be
898             another attribute which records the names of the node.
899              
900             has_element 'message' =>
901             is => "rw",
902             isa => "my::unionType",
903             xml_nodeName => {
904             "nodename" => "TypeA",
905             "somenode" => "TypeB",
906             "someother" => "TypeB",
907             },
908             xml_nodeName_attr => "message_name",
909             ;
910              
911             If any node name is allowed, then you can simply pass in C<*> as an
912             C<xml_nodeName> value.
913              
914             =item B<more namespaces than types>
915              
916             The principle use of this is L<PRANG::XMLSchema::Whatever>, which
917             converts arbitrarily namespaced XML into objects. In this case,
918             another attribute is needed, to record the XML namespaces of the
919             elements.
920              
921             has 'nodenames' =>
922             is => "rw",
923             isa => "ArrayRef[Maybe[Str]]",
924             ;
925              
926             has 'nodenames_xmlns' =>
927             is => "rw",
928             isa => "ArrayRef[Maybe[Str]]",
929             ;
930              
931             has_element 'contents' =>
932             is => "rw",
933             isa => "ArrayRef[PRANG::XMLSchema::Whatever|Str]",
934             xml_nodeName => { "" => "Str", "*" => "PRANG::XMLSchema::Whatever" },
935             xml_nodeName_attr => "nodenames",
936             xmlns => "*",
937             xmlns_attr => "nodenames_xmlns",
938             ;
939              
940             B<FIXME:> this is currently unimplemented.
941              
942             =item B<unknown/extensible element names and types>
943              
944             These are indicated by specifying a role. At the time that the
945             L<PRANG::Graph::Node> is built for the attribute, the currently
946             available implementors of these roles are checked, which must all
947             implement L<PRANG::Graph>.
948              
949             They Treated as if there is an C<xml_nodeName> entry for the class,
950             from the C<root_element> value for the class to the type. This allows
951             writing extensible schemas.
952              
953             =back
954              
955             =back
956              
957             =head1 SEE ALSO
958              
959             L<PRANG::Graph::Meta::Attr>, L<PRANG::Graph::Meta::Element>,
960             L<PRANG::Graph::Node>
961              
962             =head1 AUTHOR AND LICENCE
963              
964             Development commissioned by NZ Registry Services, and carried out by
965             Catalyst IT - L<http://www.catalyst.net.nz/>
966              
967             Copyright 2009, 2010, NZ Registry Services. This module is licensed
968             under the Artistic License v2.0, which permits relicensing under other
969             Free Software licenses.
970              
971             =cut