Markup/SuikaWikiConfig20/Node.pm


=head1 NAME

Message::Markup::SuikaWikiConfig20::Node: manakai --- SuikaWikiConfig/2.0 data object and serialization

=head1 DESCRIPTION

This module provides modeled object tree handling for SuikaWikiConfig/2.0 data
format.  It also provides a mean of serializing object data tree in
SuikaWikiConfig/2.0 format.

Note that to parse plain SuikaWikiConfig/2.0 data and compose object
tree for it, Message::Markup::SuikaWikiConfig20::Parser
can be used.

This module is part of manakai.

=cut

package Message::Markup::SuikaWikiConfig20::Node;
use strict;
our $VERSION = do{my @r=(q$Revision: 1.7 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

=head1 METHODS

=over 4

=item $x = Message::Markup::SuikaWikiConfig20::Node->new (%options)

Returns new instance of the module.  It is itself a node.

=cut

sub new ($;%) {
  my $class = shift;
  my $self = bless {@_}, $class;
  $self->{type} ||= '#element';
  $self->{node} ||= [];
  $self;
}

=item $x->append_node ($node)

Appending given node to the object (as the last child).
If the type of given node is C<#fragment>, its all children, not the node
itself, are appended.

This method returns the appended node unless the type of given node is C<#fragment>.
In such cases, this node (C<$x>) is returned.

Available options: C<node_or_text>.

=cut

sub append_node ($$;%) {
  my $self = shift;
  my ($new_node, %o) = @_;
  unless (ref $new_node) {
    if ($o{node_or_text}) {
      return $self->append_text ($new_node);
    } else {
      die "append_node: Invalid node";
    }
  }
  if ($new_node->{type} eq '#fragment') {
    for (@{$new_node->{node}}) {
      push @{$self->{node}}, $_;
      $_->{parent} = $self;
    }
    $self;
  } else {
    push @{$self->{node}}, $new_node;
    $new_node->{parent} = $self;
    $new_node;
  }
}

=item $new_node = $x->append_new_node (%options)

Appending a new node.  The new node is returned.

=cut

sub append_new_node ($;%) {
  my $self = shift;
  my $new_node = __PACKAGE__->new (@_);
  push @{$self->{node}}, $new_node;
  $new_node->{parent} = $self;
  $new_node;
}

=item $new_node = $x->append_text ($text)

Appending given text as a new text node.  The new text node is returned.

=cut

sub append_text ($$;%) {
  my $self = shift;
  my $s = shift;
  unless (defined $s) {
    require Carp;
    Carp::carp (q<Use of uninitialized value in "append_text">);
  } elsif (ref ($self->{value}) eq 'ARRAY') {
    push @{$self->{value}}, $s;
  } elsif (defined $self->{value}) {
    $self->{value} .= $s;
  } else {
    $self->{value} = $s;
  }
}

sub remove_child_node ($$) {
  my ($self, $node) = @_;
  return unless ref $node;
  $node = overload::StrVal ($node);
  $self->{node} = [grep { overload::StrVal ($_) ne $node } @{$self->{node}}];
}

=item $attr_node = $x->get_attribute ($local_name, %options)

Returns the attribute node whose local-name is C<$local_name>.

=item $attr_val = $x->get_attribute_value ($local_name)

Returnes the attribute value whose attribute name is C<$local_name>.

=cut

sub get_attribute ($$;%) {
  my ($self, $name, %o) = @_;
  for (@{$self->{node}}) {
    if ($_->{type} eq '#element'
        && $_->{local_name} eq $name) {
      return $_;
    }
  }
  ## Node is not exist
  if ($o{make_new_node}) {
    return $self->append_new_node (type => '#element', local_name => $name);
  } else {
    return undef;
  }
}
sub get_attribute_value ($$;%) {
  my ($self, $name, %opt) = @_;
  my $node = $self->get_attribute ($name);
  if (ref $node) {
    my $val = $node->value (%opt);
    if ($opt{default_list} and ref $val eq 'ARRAY' and @$val == 0) {
      return $opt{default_list};
    } else {
      return $val;
    }
  } else {
    return $opt{default_list} || $opt{default};
  }
}

sub get_element_by ($$;%) {
  my ($self, $code, %opt) = @_;
  for (@{$self->{node}}) {
    if ($_->{type} eq '#element' and
        $code->($self, $_, %opt)) {
      return $_;
    }
  }
  ## Node is not exist
  if ($opt{make_new_node}) {
    my $n = $self->append_new_node (type => '#element', local_name => 'Node');
    $opt{make_new_node}->($self, $n, %opt)
      if ref $opt{make_new_node} eq 'CODE';
    return $n;
  } else {
    return undef;
  }
}
=item $attr_node = $x->set_attribute ($local_name => $value, %options)

Set the value of the attribute.  The attribute node is returned.

=cut

sub set_attribute ($$$;%) {
  my ($self, $name, $val, %o) = @_;
  if ({qw/HASH 1 CODE 1/}->{ref ($val)}) {
  ## TODO: common error handling
    require Carp;
    Carp::croak ("set_attribute: @{[ref $val]}: new attribute value must be a string, an array reference or a blessed object");
  }
  for (@{$self->{node}}) {
    if ($_->{type} eq '#element'
        && $_->{local_name} eq $name) {
      $_->{value} = $val;
      $_->{node} = [];
      return $_;
    }
  }
  return $self->append_new_node (type => '#element', local_name => $name,
                                 value => $val);
}

=item $x->remove_attribute ($local_name, %options)

Removes an attribute node.

=cut

sub remove_attribute ($$;%) {
  my ($self, $name, %opt) = @_;
  $self->{node} = [grep {
    if ($_->{type} eq '#element' and
        $_->{local_name} eq $name) {
      delete $_->{parent};
      0;
    } else {
      1;
    }
  } @{$self->{node}}];
  1;
}

=item \@children = $x->child_nodes

Returns an array reference to child nodes.

=item $local_name = $x->local_name ([$new_name])

Returns or set the local-name.

=item $type = $x->node_type

Returns the node type.

=item $node = $x->parent_node

Returns the parent node.  If there is no parent node, undef is returned.

=cut

sub child_nodes ($) { $_[0]->{node} }
sub local_name ($;$) {
  my ($self, $newname) = @_;
  $self->{local_name} = $newname if $newname;
  $self->{local_name}
}
sub node_type ($) { $_[0]->{type} }
sub parent_node ($) { $_[0]->{parent} }

=item $i = $x->count

Returns the number of child nodes.

=cut

# TODO: support counting by type
sub count ($;@) {
  (defined $_[0]->{value} ? 1 : 0) + scalar @{$_[0]->{node}};
}

=item $tag = $x->inner_text

Returns the text content of the node.  (In many case the returned value is same
as WinIE DOM C<inner_text ()> function's or XPath C<text()> function's.
But some classes that inherits this module might implement to return other
value (eg. to return the value of the alt attribute of html:img element).

=cut

sub inner_text ($;%) {
  my $self = shift;
  my %o = @_;
  my $r = '';
  if (defined $o{new_value}) {
    $self->{value} = $o{new_value};
  }
  ref ($self->{value}) eq 'ARRAY' ? join "\x0A", @{$self->{value}} :
                                    $self->{value};
}

sub value ($;%) {
  my ($self, %opt) = @_;
  if ($opt{as_array} and ref $self->{value} ne 'ARRAY') {
    defined $self->{value} ? [$self->{value}] : [];
  } else {
    $self->{value};
  }
}

sub stringify ($;%) {
  my ($self, %opt) = @_;
  my $r = '';
  if ($self->{type} eq '#document') {
    if ($opt{output_header}) {
      $r = "#?SuikaWikiConfig/2.0\x0A";
    }
    my $ptype = '#';
    for (@{$self->{node}}) {
      $r .= "\x0A" if $ptype eq '#comment' && $_->{type} eq '#comment';
      $ptype = $_->{type};
      $r .= $_->stringify;
    }
  } elsif ($self->{type} eq '#element') {
    $r = $self->inner_text;
    if (scalar @{$self->{node}}) {
      if (defined $r) {
        $r =~ s/(^|\x0A)(?=([\\\@\#\s]|$))?/$1."  ".(defined $2?"\\":"")/ges;
        $r = $self->{local_name}
           . ":\x0A  \@\@"
           . (ref ($self->{value}) eq 'ARRAY' ? '[list]' : '')
           . ":" . (($r !~ /[\x0D\x0A:]/) && (length ($r) < 50) ? '' : "\x0A")
           . (length $r ? $r : '\\') . "\x0A";
      } else {
        $r = $self->{local_name}
           . ":\x0A";
      }
      for (@{$self->{node}}) {
        next unless $_->{type} eq '#element';
        my $rc = $_->stringify;
        $rc =~ s/\x0A  /\x0A     /gs;
        $rc =~ s/(\x0A +\@)/$1\@/gs;
        $r .= '  @' . $rc;
      }
    } else {
      $r = '' unless defined $r;
      $r =~ s/(^|\x0A)(?=([\\\@\#\s]|$))?/$1."  ".(defined $2?"\\":"")/ges;
      $r = $self->{local_name}
         . (ref ($self->{value}) eq 'ARRAY' ? '[list]' : '')
         . ":" . ((($r !~ /[\x0D\x0A:]/) && (length ($r) < 50)) ? '' : "\x0A")
         . (length $r ? $r : '\\') . "\x0A";
    }
    $r = "\\" . $r if substr ($r, 0, 1) =~ /[\\\@\#\s]/;
  } else {
    $r = $self->inner_text;
    $r =~ s/\x0A/\x0A#/gs;
    $r = '#' . $r . "\n";
  }
  $r;
}

sub root_node ($) {
  my $self = shift;
  if ($self->{type} eq '#document') {
    return $self;
  } elsif (ref $self->{parent}) {
    return $self->{parent}->root_node;
  } else {
    return $self;
  }
}

=item $node->node_path (key => attr-name)

Represent position in the tree in informal XPath-like expression.

Note: In current implementation, the format of expressions
is insufficient to identify a node uniquely and it is
not XPath compatible.

Options:

=over 4

=item key => ( attr-name | [attr-name1, attr-name2, ...] )

An attribute name or an array reference of attribute names that 
are used as 'key's.

=back

=cut

sub node_path ($;%) {
  my ($self, %opt) = @_;
  my $r;
  if ($self->{parent}) {
    $r = $self->{parent}->node_path (%opt);
  } else {
    $r = '';
  }
  if ($self->node_type eq '#element') {
    $r .= '/' . $self->local_name;
    if ($opt{key}) {
      for (ref $opt{key} eq 'ARRAY' ? @{$opt{key}} : $opt{key}) {
        my $key = $self->get_attribute_value ($_);
        if (defined $key) {
          $r .= '[@' . $_ . '=' . $key . ']';
        }
      }
    }
  } elsif ($self->node_type eq '#comment') {
    $r .= q</comment ()>;
  } elsif ($self->node_type eq '#document') {
    $r .= '/document ()';
  } elsif ($self->node_type eq '#fragment') {
    $r .= '/fragment ()';
  }
  $r;
}


sub flag ($$;$%) {
  my ($self, $name, $value, %opt) = @_;
  if (defined $value) {
    $self->{flag}->{$name} = $value;
  }
  defined $self->{flag}->{$name} ?
    $self->{flag}->{$name} : $opt{default};
}

sub option ($$;$) {
  my ($self, $name, $value) = @_;
  if (defined $value) {
    $self->{option}->{$name} = $value;
  }
  $self->{option}->{$name};
}

sub clone ($;%) {
  my $self = shift;
  my $clone = bless {node => []}, ref $self;
  ## TODO: Cloning recursively
  $clone->{flag} = {%{$self->{flag}||{}}};
  $clone->{option} = {%{$self->{option}||{}}};
  for (qw/local_name value type/) {
    $clone->{$_} = $self->{$_};
  }
  for (@{$self->{node}}) {
    push @{$clone->{node}}, $_->clone;
  }
  $_->{parent} = $clone for @{$clone->{node}};
  $clone;
}

=back

=head1 NODE TYPES

This module uses three types of node.

=over 4 

=item #comment

Comment.  Only #document (root) node and #fragment node
in well-formed tree can contain this type of node as children.

Comment has a value, but no child.

=item #document

Document.  This type of node must be the root node.

Document can have any number of #element and #comment, in any order,
but no value.

=item #element

Element.

Element can have any number of children.  Children must also be #element's.
Element has a value, which can be C<undef> (that is different from
empty) in case the element has one or more children (cannot be
C<undef> if it does not have child).

A value is either a scalar or a list.  List is represented as a reference
to an array in this module.  Note that list with some multiple-line strings
cannot be serialized, since SuikaWikiConfig/2.0 text format
does not allow it.

=item #fragment

Fragment of nodes.  It's similar to DOM's fragment node.

=back

=head1 SEE ALSO

C<Message::Markup::SuikaWikiConfig20::Parser>:
Perl module that parses SuikaWikiConfig/2.0 text format
document and constructs C<Message::Markup::SuikaWikiConfig20::Node>
tree instance.

SuikaWikiConfig/2.0 
<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWikiConfig/2.0>:
Formal specification and informal descriptions of 
the SuikaWikiConfig/2.0 format.

Latest version of this module is available at the
manakai CVS repository
<http://suika.fam.cx/gate/cvs/messaging/manakai/lib/Message/Markup/SuikaWikiConfig20/Parser.pm>.

=head1 HISTORY

SuikaWikiConfig/2.0 format was originally defined
for SuikaWiki <http://suika.fam.cx/~wakaba/-temp/wiki?SuikaWiki>.

This module, formally known as C<SuikaWiki::Markup::SuikaWikiConfig20>,
was part of SuikaWiki distribution.

=head1 LICENSE

Copyright 2003-2004 Wakaba <[email protected]>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: 2004/11/27 10:59:09 $
1	wakaba	1.1
2			=head1 NAME
3
4			Message::Markup::SuikaWikiConfig20::Node: manakai --- SuikaWikiConfig/2.0 data object and serialization
5
6			=head1 DESCRIPTION
7
8			This module provides modeled object tree handling for SuikaWikiConfig/2.0 data
9			format. It also provides a mean of serializing object data tree in
10			SuikaWikiConfig/2.0 format.
11
12			Note that to parse plain SuikaWikiConfig/2.0 data and compose object
13			tree for it, Message::Markup::SuikaWikiConfig20::Parser
14			can be used.
15
16			This module is part of manakai.
17
18			=cut
19
20			package Message::Markup::SuikaWikiConfig20::Node;
21			use strict;
22	wakaba	1.8	our $VERSION = do{my @r=(q$Revision: 1.7 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
23	wakaba	1.1
24			=head1 METHODS
25
26			=over 4
27
28			=item $x = Message::Markup::SuikaWikiConfig20::Node->new (%options)
29
30			Returns new instance of the module. It is itself a node.
31
32			=cut
33
34			sub new ($;%) {
35			my $class = shift;
36			my $self = bless {@_}, $class;
37			$self->{type} \|\|= '#element';
38			$self->{node} \|\|= [];
39			$self;
40			}
41
42			=item $x->append_node ($node)
43
44			Appending given node to the object (as the last child).
45			If the type of given node is C<#fragment>, its all children, not the node
46			itself, are appended.
47
48			This method returns the appended node unless the type of given node is C<#fragment>.
49			In such cases, this node (C<$x>) is returned.
50
51			Available options: C<node_or_text>.
52
53			=cut
54
55			sub append_node ($$;%) {
56			my $self = shift;
57			my ($new_node, %o) = @_;
58			unless (ref $new_node) {
59			if ($o{node_or_text}) {
60			return $self->append_text ($new_node);
61			} else {
62			die "append_node: Invalid node";
63			}
64			}
65			if ($new_node->{type} eq '#fragment') {
66			for (@{$new_node->{node}}) {
67			push @{$self->{node}}, $_;
68			$_->{parent} = $self;
69			}
70			$self;
71			} else {
72			push @{$self->{node}}, $new_node;
73			$new_node->{parent} = $self;
74			$new_node;
75			}
76			}
77
78			=item $new_node = $x->append_new_node (%options)
79
80			Appending a new node. The new node is returned.
81
82			=cut
83
84			sub append_new_node ($;%) {
85			my $self = shift;
86			my $new_node = __PACKAGE__->new (@_);
87			push @{$self->{node}}, $new_node;
88			$new_node->{parent} = $self;
89			$new_node;
90			}
91
92			=item $new_node = $x->append_text ($text)
93
94			Appending given text as a new text node. The new text node is returned.
95
96			=cut
97
98			sub append_text ($$;%) {
99			my $self = shift;
100			my $s = shift;
101	wakaba	1.6	unless (defined $s) {
102			require Carp;
103			Carp::carp (q<Use of uninitialized value in "append_text">);
104			} elsif (ref ($self->{value}) eq 'ARRAY') {
105	wakaba	1.1	push @{$self->{value}}, $s;
106	wakaba	1.4	} elsif (defined $self->{value}) {
107			$self->{value} .= $s;
108	wakaba	1.1	} else {
109	wakaba	1.4	$self->{value} = $s;
110	wakaba	1.1	}
111			}
112
113			sub remove_child_node ($$) {
114			my ($self, $node) = @_;
115			return unless ref $node;
116			$node = overload::StrVal ($node);
117			$self->{node} = [grep { overload::StrVal ($_) ne $node } @{$self->{node}}];
118			}
119
120			=item $attr_node = $x->get_attribute ($local_name, %options)
121
122			Returns the attribute node whose local-name is C<$local_name>.
123
124			=item $attr_val = $x->get_attribute_value ($local_name)
125
126			Returnes the attribute value whose attribute name is C<$local_name>.
127
128			=cut
129
130			sub get_attribute ($$;%) {
131			my ($self, $name, %o) = @_;
132			for (@{$self->{node}}) {
133			if ($_->{type} eq '#element'
134			&& $_->{local_name} eq $name) {
135			return $_;
136			}
137			}
138			## Node is not exist
139			if ($o{make_new_node}) {
140			return $self->append_new_node (type => '#element', local_name => $name);
141			} else {
142			return undef;
143			}
144			}
145			sub get_attribute_value ($$;%) {
146	wakaba	1.3	my ($self, $name, %opt) = @_;
147	wakaba	1.1	my $node = $self->get_attribute ($name);
148			if (ref $node) {
149	wakaba	1.5	my $val = $node->value (%opt);
150			if ($opt{default_list} and ref $val eq 'ARRAY' and @$val == 0) {
151			return $opt{default_list};
152			} else {
153			return $val;
154			}
155	wakaba	1.1	} else {
156	wakaba	1.5	return $opt{default_list} \|\| $opt{default};
157	wakaba	1.1	}
158			}
159
160	wakaba	1.4	sub get_element_by ($$;%) {
161			my ($self, $code, %opt) = @_;
162			for (@{$self->{node}}) {
163			if ($_->{type} eq '#element' and
164			$code->($self, $_, %opt)) {
165			return $_;
166			}
167			}
168			## Node is not exist
169			if ($opt{make_new_node}) {
170			my $n = $self->append_new_node (type => '#element', local_name => 'Node');
171			$opt{make_new_node}->($self, $n, %opt)
172			if ref $opt{make_new_node} eq 'CODE';
173			return $n;
174			} else {
175			return undef;
176			}
177			}
178	wakaba	1.1	=item $attr_node = $x->set_attribute ($local_name => $value, %options)
179
180			Set the value of the attribute. The attribute node is returned.
181
182			=cut
183
184			sub set_attribute ($$$;%) {
185			my ($self, $name, $val, %o) = @_;
186	wakaba	1.3	if ({qw/HASH 1 CODE 1/}->{ref ($val)}) {
187	wakaba	1.1	## TODO: common error handling
188	wakaba	1.4	require Carp;
189			Carp::croak ("set_attribute: @{[ref $val]}: new attribute value must be a string, an array reference or a blessed object");
190	wakaba	1.1	}
191			for (@{$self->{node}}) {
192			if ($_->{type} eq '#element'
193			&& $_->{local_name} eq $name) {
194			$_->{value} = $val;
195			$_->{node} = [];
196			return $_;
197			}
198			}
199			return $self->append_new_node (type => '#element', local_name => $name,
200			value => $val);
201			}
202
203	wakaba	1.3	=item $x->remove_attribute ($local_name, %options)
204
205			Removes an attribute node.
206
207			=cut
208
209			sub remove_attribute ($$;%) {
210			my ($self, $name, %opt) = @_;
211			$self->{node} = [grep {
212			if ($_->{type} eq '#element' and
213			$_->{local_name} eq $name) {
214			delete $_->{parent};
215			0;
216			} else {
217			1;
218			}
219			} @{$self->{node}}];
220			1;
221			}
222
223	wakaba	1.1	=item \@children = $x->child_nodes
224
225			Returns an array reference to child nodes.
226
227			=item $local_name = $x->local_name ([$new_name])
228
229			Returns or set the local-name.
230
231			=item $type = $x->node_type
232
233			Returns the node type.
234
235			=item $node = $x->parent_node
236
237			Returns the parent node. If there is no parent node, undef is returned.
238
239			=cut
240
241			sub child_nodes ($) { $_[0]->{node} }
242			sub local_name ($;$) {
243			my ($self, $newname) = @_;
244			$self->{local_name} = $newname if $newname;
245			$self->{local_name}
246			}
247			sub node_type ($) { $_[0]->{type} }
248			sub parent_node ($) { $_[0]->{parent} }
249
250			=item $i = $x->count
251
252			Returns the number of child nodes.
253
254			=cut
255
256			# TODO: support counting by type
257			sub count ($;@) {
258			(defined $_[0]->{value} ? 1 : 0) + scalar @{$_[0]->{node}};
259			}
260
261			=item $tag = $x->inner_text
262
263			Returns the text content of the node. (In many case the returned value is same
264			as WinIE DOM C<inner_text ()> function's or XPath C<text()> function's.
265			But some classes that inherits this module might implement to return other
266			value (eg. to return the value of the alt attribute of html:img element).
267
268			=cut
269
270			sub inner_text ($;%) {
271			my $self = shift;
272			my %o = @_;
273			my $r = '';
274			if (defined $o{new_value}) {
275			$self->{value} = $o{new_value};
276			}
277			ref ($self->{value}) eq 'ARRAY' ? join "\x0A", @{$self->{value}} :
278			$self->{value};
279			}
280
281	wakaba	1.5	sub value ($;%) {
282			my ($self, %opt) = @_;
283			if ($opt{as_array} and ref $self->{value} ne 'ARRAY') {
284			defined $self->{value} ? [$self->{value}] : [];
285			} else {
286			$self->{value};
287			}
288	wakaba	1.1	}
289
290			sub stringify ($;%) {
291			my ($self, %opt) = @_;
292			my $r = '';
293			if ($self->{type} eq '#document') {
294			if ($opt{output_header}) {
295	wakaba	1.8	$r = "#?SuikaWikiConfig/2.0\x0A";
296	wakaba	1.1	}
297			my $ptype = '#';
298			for (@{$self->{node}}) {
299			$r .= "\x0A" if $ptype eq '#comment' && $_->{type} eq '#comment';
300			$ptype = $_->{type};
301			$r .= $_->stringify;
302			}
303			} elsif ($self->{type} eq '#element') {
304			$r = $self->inner_text;
305			if (scalar @{$self->{node}}) {
306	wakaba	1.4	if (defined $r) {
307	wakaba	1.5	$r =~ s/(^\|\x0A)(?=([\\\@\#\s]\|$))?/$1." ".(defined $2?"\\":"")/ges;
308	wakaba	1.4	$r = $self->{local_name}
309			. ":\x0A \@\@"
310			. (ref ($self->{value}) eq 'ARRAY' ? '[list]' : '')
311			. ":" . (($r !~ /[\x0D\x0A:]/) && (length ($r) < 50) ? '' : "\x0A")
312	wakaba	1.5	. (length $r ? $r : '\\') . "\x0A";
313	wakaba	1.4	} else {
314			$r = $self->{local_name}
315			. ":\x0A";
316			}
317	wakaba	1.1	for (@{$self->{node}}) {
318			next unless $_->{type} eq '#element';
319			my $rc = $_->stringify;
320			$rc =~ s/\x0A /\x0A /gs;
321			$rc =~ s/(\x0A +\@)/$1\@/gs;
322			$r .= ' @' . $rc;
323			}
324			} else {
325	wakaba	1.4	$r = '' unless defined $r;
326	wakaba	1.5	$r =~ s/(^\|\x0A)(?=([\\\@\#\s]\|$))?/$1." ".(defined $2?"\\":"")/ges;
327	wakaba	1.1	$r = $self->{local_name}
328			. (ref ($self->{value}) eq 'ARRAY' ? '[list]' : '')
329	wakaba	1.2	. ":" . ((($r !~ /[\x0D\x0A:]/) && (length ($r) < 50)) ? '' : "\x0A")
330	wakaba	1.5	. (length $r ? $r : '\\') . "\x0A";
331	wakaba	1.1	}
332			$r = "\\" . $r if substr ($r, 0, 1) =~ /[\\\@\#\s]/;
333			} else {
334			$r = $self->inner_text;
335			$r =~ s/\x0A/\x0A#/gs;
336			$r = '#' . $r . "\n";
337			}
338			$r;
339			}
340
341			sub root_node ($) {
342			my $self = shift;
343			if ($self->{type} eq '#document') {
344			return $self;
345			} elsif (ref $self->{parent}) {
346			return $self->{parent}->root_node;
347			} else {
348			return $self;
349			}
350			}
351
352	wakaba	1.7	=item $node->node_path (key => attr-name)
353	wakaba	1.5
354			Represent position in the tree in informal XPath-like expression.
355
356			Note: In current implementation, the format of expressions
357			is insufficient to identify a node uniquely and it is
358			not XPath compatible.
359
360	wakaba	1.7	Options:
361
362			=over 4
363
364			=item key => ( attr-name \| [attr-name1, attr-name2, ...] )
365
366			An attribute name or an array reference of attribute names that
367			are used as 'key's.
368
369			=back
370
371	wakaba	1.5	=cut
372
373			sub node_path ($;%) {
374			my ($self, %opt) = @_;
375			my $r;
376			if ($self->{parent}) {
377			$r = $self->{parent}->node_path (%opt);
378			} else {
379			$r = '';
380			}
381			if ($self->node_type eq '#element') {
382			$r .= '/' . $self->local_name;
383			if ($opt{key}) {
384	wakaba	1.7	for (ref $opt{key} eq 'ARRAY' ? @{$opt{key}} : $opt{key}) {
385			my $key = $self->get_attribute_value ($_);
386			if (defined $key) {
387			$r .= '[@' . $_ . '=' . $key . ']';
388			}
389	wakaba	1.5	}
390			}
391			} elsif ($self->node_type eq '#comment') {
392			$r .= q</comment ()>;
393			} elsif ($self->node_type eq '#document') {
394			$r .= '/document ()';
395			} elsif ($self->node_type eq '#fragment') {
396			$r .= '/fragment ()';
397			}
398			$r;
399			}
400
401
402	wakaba	1.4	sub flag ($$;$%) {
403			my ($self, $name, $value, %opt) = @_;
404	wakaba	1.1	if (defined $value) {
405			$self->{flag}->{$name} = $value;
406			}
407	wakaba	1.4	defined $self->{flag}->{$name} ?
408			$self->{flag}->{$name} : $opt{default};
409	wakaba	1.1	}
410
411			sub option ($$;$) {
412			my ($self, $name, $value) = @_;
413			if (defined $value) {
414			$self->{option}->{$name} = $value;
415			}
416			$self->{option}->{$name};
417			}
418
419	wakaba	1.2	sub clone ($;%) {
420			my $self = shift;
421			my $clone = bless {node => []}, ref $self;
422			## TODO: Cloning recursively
423			$clone->{flag} = {%{$self->{flag}\|\|{}}};
424			$clone->{option} = {%{$self->{option}\|\|{}}};
425			for (qw/local_name value type/) {
426			$clone->{$_} = $self->{$_};
427			}
428			for (@{$self->{node}}) {
429			push @{$clone->{node}}, $_->clone;
430			}
431			$_->{parent} = $clone for @{$clone->{node}};
432			$clone;
433			}
434
435	wakaba	1.1	=back
436
437			=head1 NODE TYPES
438
439	wakaba	1.4	This module uses three types of node.
440
441	wakaba	1.1	=over 4
442
443			=item #comment
444
445	wakaba	1.4	Comment. Only #document (root) node and #fragment node
446			in well-formed tree can contain this type of node as children.
447
448			Comment has a value, but no child.
449
450			=item #document
451
452			Document. This type of node must be the root node.
453
454			Document can have any number of #element and #comment, in any order,
455			but no value.
456	wakaba	1.1
457			=item #element
458
459	wakaba	1.4	Element.
460
461			Element can have any number of children. Children must also be #element's.
462			Element has a value, which can be C<undef> (that is different from
463			empty) in case the element has one or more children (cannot be
464			C<undef> if it does not have child).
465
466			A value is either a scalar or a list. List is represented as a reference
467			to an array in this module. Note that list with some multiple-line strings
468			cannot be serialized, since SuikaWikiConfig/2.0 text format
469			does not allow it.
470	wakaba	1.1
471			=item #fragment
472
473			Fragment of nodes. It's similar to DOM's fragment node.
474
475			=back
476
477			=head1 SEE ALSO
478
479	wakaba	1.4	C<Message::Markup::SuikaWikiConfig20::Parser>:
480			Perl module that parses SuikaWikiConfig/2.0 text format
481			document and constructs C<Message::Markup::SuikaWikiConfig20::Node>
482			tree instance.
483
484	wakaba	1.1	SuikaWikiConfig/2.0
485	wakaba	1.4	<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWikiConfig/2.0>:
486			Formal specification and informal descriptions of
487			the SuikaWikiConfig/2.0 format.
488
489			Latest version of this module is available at the
490			manakai CVS repository
491			<http://suika.fam.cx/gate/cvs/messaging/manakai/lib/Message/Markup/SuikaWikiConfig20/Parser.pm>.
492	wakaba	1.1
493			=head1 HISTORY
494
495	wakaba	1.4	SuikaWikiConfig/2.0 format was originally defined
496			for SuikaWiki <http://suika.fam.cx/~wakaba/-temp/wiki?SuikaWiki>.
497
498			This module, formally known as C<SuikaWiki::Markup::SuikaWikiConfig20>,
499			was part of SuikaWiki distribution.
500	wakaba	1.1
501			=head1 LICENSE
502
503	wakaba	1.4	Copyright 2003-2004 Wakaba <[email protected]>
504	wakaba	1.1
505			This program is free software; you can redistribute it and/or
506			modify it under the same terms as Perl itself.
507
508			=cut
509
510	wakaba	1.8	1; # $Date: 2004/11/27 10:59:09 $