/[pub]/suikawiki/script/lib/SuikaWiki/Markup/SuikaWikiConfig20.pm
Suika

Contents of /suikawiki/script/lib/SuikaWiki/Markup/SuikaWikiConfig20.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations) (download)
Sat Oct 18 07:08:34 2003 UTC (21 years, 8 months ago) by wakaba
Branch: MAIN
Changes since 1.3: +15 -2 lines
Imporoved SuikaWiki 3 implementation

1 wakaba 1.1
2     =head1 NAME
3    
4     SuikaWiki::Markup::SuikaWikiConfig20: SuikaWiki: 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, SuikaWiki::Markup::SuikaWikiConfig20::Parser
14     can be used.
15    
16     This module is part of SuikaWiki.
17    
18     =cut
19    
20     package SuikaWiki::Markup::SuikaWikiConfig20;
21     use strict;
22 wakaba 1.4 our $VERSION = do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
23 wakaba 1.1
24     =head1 METHODS
25    
26     =over 4
27    
28     =item $x = SuikaWiki::Markup::SuikaWikiConfig20->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     for (qw/local_name value/) {
39     if ($self->_is_same_class ($self->{$_})) {
40     $self->{$_}->{parent} = $self;
41     }
42     }
43     $self->{node} ||= [];
44     $self;
45     }
46    
47     =item $x->append_node ($node)
48    
49     Appending given node to the object (as the last child).
50     If the type of given node is C<#fragment>, its all children, not the node
51     itself, are appended.
52    
53     This method returns the appended node unless the type of given node is C<#fragment>.
54     In such cases, this node (C<$x>) is returned.
55    
56     Available options: C<node_or_text>.
57    
58     =cut
59    
60     sub append_node ($$;%) {
61     my $self = shift;
62     my ($new_node, %o) = @_;
63     unless (ref $new_node) {
64     if ($o{node_or_text}) {
65     return $self->append_text ($new_node);
66     } else {
67     die "append_node: Invalid node";
68     }
69     }
70     if ($new_node->{type} eq '#fragment') {
71     for (@{$new_node->{node}}) {
72     push @{$self->{node}}, $_;
73     $_->{parent} = $self;
74     }
75     $self;
76     } else {
77     push @{$self->{node}}, $new_node;
78     $new_node->{parent} = $self;
79     $new_node;
80     }
81     }
82    
83     =item $new_node = $x->append_new_node (%options)
84    
85     Appending a new node. The new node is returned.
86    
87     =cut
88    
89     sub append_new_node ($;%) {
90     my $self = shift;
91     my $new_node = __PACKAGE__->new (@_);
92     push @{$self->{node}}, $new_node;
93     $new_node->{parent} = $self;
94     $new_node;
95     }
96    
97     =item $new_node = $x->append_text ($text)
98    
99     Appending given text as a new text node. The new text node is returned.
100    
101     =cut
102    
103     sub append_text ($$;%) {
104     my $self = shift;
105     my $s = shift;
106 wakaba 1.2 if (ref ($self->{value}) eq 'ARRAY') {
107     push @{$self->{value}}, $s;
108     } else {
109     $self->{value} .= $s;
110     }
111 wakaba 1.1 }
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 wakaba 1.4 =item $attr_val = $x->get_attribute_value ($local_name)
125    
126     Returnes the attribute value whose attribute name is C<$local_name>.
127    
128 wakaba 1.1 =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 wakaba 1.4 sub get_attribute_value ($$;%) {
146     my ($self, $name) = @_;
147     my $node = $self->get_attribute ($name);
148     if (ref $node) {
149     return $node->value;
150     } else {
151     return undef;
152     }
153     }
154 wakaba 1.1
155     =item $attr_node = $x->set_attribute ($local_name => $value, %options)
156    
157     Set the value of the attribute. The attribute node is returned.
158    
159     =cut
160    
161     sub set_attribute ($$$;%) {
162     my ($self, $name, $val, %o) = @_;
163     if ({qw/ARRAY 1 HASH 1 CODE 1/}->{ref ($val)}) {
164     ## TODO: common error handling
165     die "set_attribute: new attribute value must be string or blessed object";
166     }
167     for (@{$self->{node}}) {
168     if ($_->{type} eq '#element'
169     && $_->{local_name} eq $name) {
170     $_->{value} = $val;
171     $_->{node} = [];
172     return $_;
173     }
174     }
175     return $self->append_new_node (type => '#element', local_name => $name,
176     value => $val);
177     }
178    
179     =item \@children = $x->child_nodes
180    
181     Returns an array reference to child nodes.
182    
183     =item $local_name = $x->local_name ([$new_name])
184    
185     Returns or set the local-name.
186    
187     =item $type = $x->node_type
188    
189     Returns the node type.
190    
191     =item $node = $x->parent_node
192    
193     Returns the parent node. If there is no parent node, undef is returned.
194    
195     =cut
196    
197     sub child_nodes ($) { $_[0]->{node} }
198     sub local_name ($;$) {
199     my ($self, $newname) = @_;
200     $self->{local_name} = $newname if $newname;
201     $self->{local_name}
202     }
203     sub node_type ($) { $_[0]->{type} }
204     sub parent_node ($) { $_[0]->{parent} }
205    
206     =item $i = $x->count
207    
208     Returns the number of child nodes.
209    
210     =cut
211    
212     # TODO: support counting by type
213     sub count ($;@) {
214     (defined $_[0]->{value} ? 1 : 0) + scalar @{$_[0]->{node}};
215     }
216    
217     =item $tag = $x->inner_text
218    
219     Returns the text content of the node. (In many case the returned value is same
220     as WinIE DOM C<inner_text ()> function's or XPath C<text()> function's.
221     But some classes that inherits this module might implement to return other
222     value (eg. to return the value of the alt attribute of html:img element).
223    
224     =cut
225    
226     sub inner_text ($;%) {
227     my $self = shift;
228     my %o = @_;
229     my $r = '';
230     if (defined $o{new_value}) {
231     $self->{value} = $o{new_value};
232     }
233 wakaba 1.2 ref ($self->{value}) eq 'ARRAY' ? join "\x0A", @{$self->{value}} :
234     $self->{value};
235 wakaba 1.1 }
236    
237 wakaba 1.3 sub value ($) {
238     shift->{value};
239     }
240    
241 wakaba 1.1 sub stringify ($;%) {
242     my ($self, %opt) = @_;
243     my $r = '';
244     if ($self->{type} eq '#document') {
245     if ($opt{output_header}) {
246     $r = "#?SuikaWiki/0.9\x0A";
247     }
248     my $ptype = '#';
249     for (@{$self->{node}}) {
250     $r .= "\x0A" if $ptype eq '#comment' && $_->{type} eq '#comment';
251     $ptype = $_->{type};
252     $r .= $_->stringify;
253     }
254     } elsif ($self->{type} eq '#element') {
255     $r = $self->inner_text;
256     $r =~ s/(^|\x0A)(?=([\\\@\#\s]))?/$1." ".($2?"\\":"")/ges;
257     if (scalar @{$self->{node}}) {
258 wakaba 1.2 $r = $self->{local_name}
259     . ":\x0A \@\@"
260     . (ref ($self->{value}) eq 'ARRAY' ? '[list]' : '')
261     . ":" . (($r !~ /[\x0D\x0A]/) && (length ($r) < 50) ? '' : "\x0A")
262     . $r . "\x0A";
263 wakaba 1.1 for (@{$self->{node}}) {
264     next unless $_->{type} eq '#element';
265     my $rc = $_->stringify;
266     $rc =~ s/\x0A /\x0A /gs;
267     $rc =~ s/(\x0A +\@)/$1\@/gs;
268     $r .= ' @' . $rc;
269     }
270     } else {
271 wakaba 1.2 $r = $self->{local_name}
272     . (ref ($self->{value}) eq 'ARRAY' ? '[list]' : '')
273     . ":" . ((($r !~ /[\x0D\x0A]/) && (length ($r) < 50)) ? '' : "\x0A")
274     . $r . "\x0A";
275 wakaba 1.1 }
276     $r = "\\" . $r if substr ($r, 0, 1) =~ /[\\\@\#\s]/;
277     } else {
278     $r = $self->inner_text;
279     $r =~ s/\x0A/\x0A#/gs;
280     $r = '#' . $r . "\n";
281     }
282     $r;
283     }
284    
285     sub _is_same_class ($$) {
286     my ($self, $something) = @_;
287     return 0 if {qw/ARRAY 1 HASH 1 CODE 1 :nonref: 1/}->{ref ($something) || ':nonref:'};
288     eval q{$self->_CLASS_NAME eq $something->_CLASS_NAME} ? 1 : 0;
289     }
290    
291     sub root_node ($) {
292     my $self = shift;
293     if ($self->{type} eq '#document') {
294     return $self;
295     } elsif (ref $self->{parent}) {
296     return $self->{parent}->root_node;
297     } else {
298     return $self;
299     }
300     }
301    
302     sub _CLASS_NAME ($) { 'SuikaWiki::Markup::SuikaWikiConfig09' }
303    
304     sub flag ($$;$) {
305     my ($self, $name, $value) = @_;
306     if (defined $value) {
307     $self->{flag}->{$name} = $value;
308     }
309     $self->{flag}->{$name};
310     }
311    
312     sub option ($$;$) {
313     my ($self, $name, $value) = @_;
314     if (defined $value) {
315     $self->{option}->{$name} = $value;
316     }
317     $self->{option}->{$name};
318     }
319    
320     =back
321    
322     =head1 NODE TYPES
323    
324     =over 4
325    
326     =item #comment
327    
328     Comment declarement. <!-- -->
329    
330     =item #element
331    
332     Element. Its XML representation consists of start tag, content and end tag,
333     like <TYPE>content</TYPE>.
334    
335     =item #fragment
336    
337     Fragment of nodes. It's similar to DOM's fragment node.
338    
339     =back
340    
341     =head1 LICENSE
342    
343     Copyright 2003 Wakaba <w@suika.fam.cx>
344    
345     This program is free software; you can redistribute it and/or
346     modify it under the same terms as Perl itself.
347    
348     =cut
349    
350 wakaba 1.4 1; # $Date: 2003/10/05 11:54:35 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24