/[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.1.2.1 - (hide annotations) (download)
Sun Oct 5 10:26:17 2003 UTC (21 years, 9 months ago) by wakaba
Branch: branch-suikawiki-1
Changes since 1.1: +18 -10 lines
Backport latest version

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.1.2.1 our $VERSION = do{my @r=(q$Revision: 1.2 $=~/\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.1.2.1 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     =cut
125    
126     sub get_attribute ($$;%) {
127     my ($self, $name, %o) = @_;
128     for (@{$self->{node}}) {
129     if ($_->{type} eq '#element'
130     && $_->{local_name} eq $name) {
131     return $_;
132     }
133     }
134     ## Node is not exist
135     if ($o{make_new_node}) {
136     return $self->append_new_node (type => '#element', local_name => $name);
137     } else {
138     return undef;
139     }
140     }
141    
142     =item $attr_node = $x->set_attribute ($local_name => $value, %options)
143    
144     Set the value of the attribute. The attribute node is returned.
145    
146     =cut
147    
148     sub set_attribute ($$$;%) {
149     my ($self, $name, $val, %o) = @_;
150     if ({qw/ARRAY 1 HASH 1 CODE 1/}->{ref ($val)}) {
151     ## TODO: common error handling
152     die "set_attribute: new attribute value must be string or blessed object";
153     }
154     for (@{$self->{node}}) {
155     if ($_->{type} eq '#element'
156     && $_->{local_name} eq $name) {
157     $_->{value} = $val;
158     $_->{node} = [];
159     return $_;
160     }
161     }
162     return $self->append_new_node (type => '#element', local_name => $name,
163     value => $val);
164     }
165    
166     =item \@children = $x->child_nodes
167    
168     Returns an array reference to child nodes.
169    
170     =item $local_name = $x->local_name ([$new_name])
171    
172     Returns or set the local-name.
173    
174     =item $type = $x->node_type
175    
176     Returns the node type.
177    
178     =item $node = $x->parent_node
179    
180     Returns the parent node. If there is no parent node, undef is returned.
181    
182     =cut
183    
184     sub child_nodes ($) { $_[0]->{node} }
185     sub local_name ($;$) {
186     my ($self, $newname) = @_;
187     $self->{local_name} = $newname if $newname;
188     $self->{local_name}
189     }
190     sub node_type ($) { $_[0]->{type} }
191     sub parent_node ($) { $_[0]->{parent} }
192    
193     =item $i = $x->count
194    
195     Returns the number of child nodes.
196    
197     =cut
198    
199     # TODO: support counting by type
200     sub count ($;@) {
201     (defined $_[0]->{value} ? 1 : 0) + scalar @{$_[0]->{node}};
202     }
203    
204     =item $tag = $x->inner_text
205    
206     Returns the text content of the node. (In many case the returned value is same
207     as WinIE DOM C<inner_text ()> function's or XPath C<text()> function's.
208     But some classes that inherits this module might implement to return other
209     value (eg. to return the value of the alt attribute of html:img element).
210    
211     =cut
212    
213     sub inner_text ($;%) {
214     my $self = shift;
215     my %o = @_;
216     my $r = '';
217     if (defined $o{new_value}) {
218     $self->{value} = $o{new_value};
219     }
220 wakaba 1.1.2.1 ref ($self->{value}) eq 'ARRAY' ? join "\x0A", @{$self->{value}} :
221     $self->{value};
222 wakaba 1.1 }
223    
224     sub stringify ($;%) {
225     my ($self, %opt) = @_;
226     my $r = '';
227     if ($self->{type} eq '#document') {
228     if ($opt{output_header}) {
229     $r = "#?SuikaWiki/0.9\x0A";
230     }
231     my $ptype = '#';
232     for (@{$self->{node}}) {
233     $r .= "\x0A" if $ptype eq '#comment' && $_->{type} eq '#comment';
234     $ptype = $_->{type};
235     $r .= $_->stringify;
236     }
237     } elsif ($self->{type} eq '#element') {
238     $r = $self->inner_text;
239     $r =~ s/(^|\x0A)(?=([\\\@\#\s]))?/$1." ".($2?"\\":"")/ges;
240     if (scalar @{$self->{node}}) {
241 wakaba 1.1.2.1 $r = $self->{local_name}
242     . ":\x0A \@\@"
243     . (ref ($self->{value}) eq 'ARRAY' ? '[list]' : '')
244     . ":" . (($r !~ /[\x0D\x0A]/) && (length ($r) < 50) ? '' : "\x0A")
245     . $r . "\x0A";
246 wakaba 1.1 for (@{$self->{node}}) {
247     next unless $_->{type} eq '#element';
248     my $rc = $_->stringify;
249     $rc =~ s/\x0A /\x0A /gs;
250     $rc =~ s/(\x0A +\@)/$1\@/gs;
251     $r .= ' @' . $rc;
252     }
253     } else {
254 wakaba 1.1.2.1 $r = $self->{local_name}
255     . (ref ($self->{value}) eq 'ARRAY' ? '[list]' : '')
256     . ":" . ((($r !~ /[\x0D\x0A]/) && (length ($r) < 50)) ? '' : "\x0A")
257     . $r . "\x0A";
258 wakaba 1.1 }
259     $r = "\\" . $r if substr ($r, 0, 1) =~ /[\\\@\#\s]/;
260     } else {
261     $r = $self->inner_text;
262     $r =~ s/\x0A/\x0A#/gs;
263     $r = '#' . $r . "\n";
264     }
265     $r;
266     }
267    
268     sub _is_same_class ($$) {
269     my ($self, $something) = @_;
270     return 0 if {qw/ARRAY 1 HASH 1 CODE 1 :nonref: 1/}->{ref ($something) || ':nonref:'};
271     eval q{$self->_CLASS_NAME eq $something->_CLASS_NAME} ? 1 : 0;
272     }
273    
274     sub root_node ($) {
275     my $self = shift;
276     if ($self->{type} eq '#document') {
277     return $self;
278     } elsif (ref $self->{parent}) {
279     return $self->{parent}->root_node;
280     } else {
281     return $self;
282     }
283     }
284    
285     sub _CLASS_NAME ($) { 'SuikaWiki::Markup::SuikaWikiConfig09' }
286    
287     sub flag ($$;$) {
288     my ($self, $name, $value) = @_;
289     if (defined $value) {
290     $self->{flag}->{$name} = $value;
291     }
292     $self->{flag}->{$name};
293     }
294    
295     sub option ($$;$) {
296     my ($self, $name, $value) = @_;
297     if (defined $value) {
298     $self->{option}->{$name} = $value;
299     }
300     $self->{option}->{$name};
301     }
302    
303     =back
304    
305     =head1 NODE TYPES
306    
307     =over 4
308    
309     =item #comment
310    
311     Comment declarement. <!-- -->
312    
313     =item #element
314    
315     Element. Its XML representation consists of start tag, content and end tag,
316     like <TYPE>content</TYPE>.
317    
318     =item #fragment
319    
320     Fragment of nodes. It's similar to DOM's fragment node.
321    
322     =back
323    
324     =head1 LICENSE
325    
326     Copyright 2003 Wakaba <w@suika.fam.cx>
327    
328     This program is free software; you can redistribute it and/or
329     modify it under the same terms as Perl itself.
330    
331     =cut
332    
333 wakaba 1.1.2.1 1; # $Date: 2003/09/21 04:53:27 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24