/[pub]/suikawiki/script/misc/plugins/SuikaWiki09.wp2
Suika

Contents of /suikawiki/script/misc/plugins/SuikaWiki09.wp2

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.19 - (hide annotations) (download)
Sun Feb 6 12:58:27 2005 UTC (19 years, 8 months ago) by wakaba
Branch: MAIN
Changes since 1.18: +41 -14 lines 
CSECTION and QN element types supported
1 wakaba 1.1 #?SuikaWikiConfig/2.0
2    
3     Plugin:
4     @Name: SuikaWiki09
5     @Description:
6 wakaba 1.16 @@@: SuikaWiki/0.9 and SuikaWiki/0.10 document formats
7 wakaba 1.1 @@lang:en
8 wakaba 1.8 @License: %%Perl%%
9 wakaba 1.1 @Author:
10     @@Name:
11     @@@@: Wakaba
12     @@@lang:ja
13     @@@script:Latn
14     @@Mail[list]: w@suika.fam.cx
15 wakaba 1.7 @Date.RCS:
16 wakaba 1.19 $Date: 2005/01/30 12:32:09 $
17 wakaba 1.1 @RequiredPlugin[list]:
18 wakaba 1.4 Edit
19     WikiFormCore
20 wakaba 1.2 WikiLinking
21 wakaba 1.4 WikiStruct
22 wakaba 1.1 @Use:
23     use Message::Markup::XML::QName qw/NS_xml_URI/;
24     my $Reg_Form_Content_M = qr{
25     \ \#form
26     \ (?:
27     \ \( (\w+) \) ## id
28     \ )?
29     \ : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' ## input
30 wakaba 1.9 \ (?> : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' ## template
31     \ (?> : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' )? )? ## option
32 wakaba 1.1 }x;
33     my $Reg_Embed_Content_M = qr{
34     \ \#([a-z-]+)
35     \ (?>
36     \ \( (\w+) \) ## id
37     \ )?
38     \ (?>
39     \ : ( \w+ (?> : \w+ )* ) ## parameter
40     \ )?
41     }x;
42     my $Reg_URI_Opaque = qr{
43     \ (?>[^<>"]*)
44     \ (?>
45     \ (?>
46     \ [^<>"]+
47     \ | "(?>[^"\\]*)(?>(?>[^"\\]+|\\.)*)"
48     \ )*
49     \ )
50     }x;
51 wakaba 1.9
52     my ($WIKIRESOURCE, $WIKISTRUCT, $WIKIFORMCORE, $WIKILINKING);
53 wakaba 1.1
54 wakaba 1.2 PluginConst:
55 wakaba 1.19 @NS_AA:
56     http://pc5.2ch.net/test/read.cgi/hp/1096723178/aavocab#
57 wakaba 1.2 @NS_SW09:
58     urn:x-suika-fam-cx:markup:suikawiki:0:9:
59 wakaba 1.16 @NS_SW010:
60     urn:x-suika-fam-cx:markup:suikawiki:0:10:
61 wakaba 1.2 @NS_HTML3:
62     urn:x-suika-fam-cx:markup:ietf:html:3:draft:00:
63     @NS_XHTML1:
64     http://www.w3.org/1999/xhtml
65     @NS_XHTML2:
66     http://www.w3.org/2002/06/xhtml2
67 wakaba 1.9 @WIKIFORMCORE:
68     {($WIKIFORMCORE ||= SuikaWiki::Plugin->module_package ('WikiFormCore'))}
69     @WIKILINKING:
70     {($WIKILINKING ||= SuikaWiki::Plugin->module_package ('WikiLinking'))}
71 wakaba 1.5 @WIKIRESOURCE:
72     {($WIKIRESOURCE ||= SuikaWiki::Plugin->module_package ('WikiResource'))}
73 wakaba 1.9 @WIKISTRUCT:
74     {($WIKISTRUCT ||= SuikaWiki::Plugin->module_package ('WikiStruct'))}
75    
76    
77 wakaba 1.2
78 wakaba 1.1 Format:
79     @ModuleName:
80     SuikaWiki::V0
81     @Description:
82     @@@: Dummy base format for SuikaWiki/0.*
83     @@lang:en
84     @Inherit[list]:
85     Text::Plain
86    
87     Format:
88     @Name: SuikaWiki
89 wakaba 1.16 @Version: 0.10
90     @Type:
91     @@@: text/x-suikawiki
92     @@version: 0.10
93     @ModuleName:
94     SuikaWiki::V0_10
95     @Inherit[list]:
96     SuikaWiki::V0_9
97     @Description:
98     @@@: SuikaWiki/0.10 document format (SuikaWiki/0.9 with minor additions)
99     @@lang: en
100    
101     Format:
102     @Name: SuikaWiki
103 wakaba 1.1 @Version: 0.9
104     @Type:
105     @@@: text/x-suikawiki
106     @@version: 0.9
107     @ModuleName:
108     SuikaWiki::V0_9
109     @Inherit[list]:
110     SuikaWiki::V0
111     @Description:
112     @@@: SuikaWiki/0.9 document format (Standard document format for SuikaWiki 2)
113     @@lang:en
114 wakaba 1.2
115     @Use:
116     use Message::Markup::XML::QName qw/NS_xml_URI/;
117 wakaba 1.4 use Message::Util::Error;
118 wakaba 1.1
119     @Converter:
120     @@Type: text/html
121     @@IsFragment: 1
122     @@Description:
123     @@@@: Converting SuikaWiki/0.9 to Hypertext Markup Language fragment
124     @@@lang:en
125     @@Main:
126 wakaba 1.4 $opt->{o}->{wiki} ||= $self->{wiki};
127    
128 wakaba 1.2 ## Text format -> XML format
129 wakaba 1.4 my $xml = __FUNCPACK__->get_xml_tree (text => $source, opt => $opt,
130     wiki => $self->{wiki});
131    
132     ## SuikaWiki/0.9 -> XHTML 1
133 wakaba 1.6 __FUNCPACK__->sw09_to_xhtml1 (source => $xml, parent => $opt->{-parent},
134     o => $opt->{o}, page => $opt->{page});
135    
136     if ($opt->{-with_annotation_input}) {
137     SuikaWiki::Plugin->module_package ('WikiFormCore')
138     ->make_content_form_in_html
139     ($opt->{-parent},
140     $WIKIRESOURCE->get
141     (name => 'SuikaWiki/0.9:form:footannotate:input',
142     o => $opt->{o}, wiki => $opt->{o}->{wiki}),
143     option => $WIKIRESOURCE->get
144     (name => 'SuikaWiki/0.9:form:footannotate:option',
145     o => $opt->{o}, wiki => $opt->{o}->{wiki}),
146     o => $opt->{o},
147     wiki => $opt->{o}->{wiki},
148     output => {
149     page => $opt->{page},
150     });
151     }
152    
153    
154     @Converter:
155     @@Type:
156     @@@@: application/x-suikawiki+xml
157     @@@version: 0.9
158     @@Description:
159     @@@@: Converting SuikaWiki/0.9 text format to XML format
160     @@@lang: en
161     @@Main:
162     my $xml = __FUNCPACK__->get_xml_tree (text => $source, opt => $opt,
163     wiki => $self->{wiki});
164     ## TODO: Make a clone
165     $opt->{-parent}->append_node ($xml);
166    
167     @NextIndex:
168     @@Name: anchor
169     @@Main:
170     my $xml = __FUNCPACK__->get_xml_tree (text => $source, opt => \%opt,
171     wiki => $self->{wiki});
172     (__FUNCPACK__->get_last_anchor_index ($xml)) + 1;
173    
174     @WikiForm:
175     @@Main:
176     ## Text format -> XML format
177     my $xml = __FUNCPACK__->get_xml_tree (text => $source, opt => \%opt,
178     wiki => $self->{wiki});
179     local $opt{o}->{var}->{sw09__anchor_index};
180     local $opt{o}->{var}->{sw09__document_tree} = $xml;
181    
182     my $form;
183     if ($opt{o}->{form}->{output}->{id}) {
184     $form = __FUNCPACK__->get_element_by_id
185     ($xml, $opt{o}->{form}->{output}->{id});
186     undef $form unless ref $form and
187     $form->namespace_uri eq $NS_SW09 and
188     $form->local_name eq 'form';
189     } else {
190     $form = __FUNCPACK__->get_nth_element
191     ($xml, $NS_SW09 => 'form',
192     $opt{o}->{form}->{output}->{index});
193     }
194    
195     my $ref;
196     if (ref $form) {
197     $ref = $form->get_attribute_value ('ref', default => 'form');
198     } else {
199     $ref = '#footannotate';
200     }
201    
202    
203     ## WikiForm Option
204     if ($ref eq 'form') {
205     $opt{option} ||= $form->get_attribute_value ('option');
206     } elsif ($ref eq 'comment') {
207     $opt{option} ||= $WIKIRESOURCE->get
208     (name => 'SuikaWiki/0.9:form:comment:option',
209     o => $opt{o}, wiki => $opt{o}->{wiki});
210     } elsif ($ref eq '#footannotate') {
211     $opt{option} ||= $WIKIRESOURCE->get
212     (name => 'SuikaWiki/0.9:form:footannotate:option',
213     o => $opt{o}, wiki => $opt{o}->{wiki});
214     } else {
215     ## TODO:
216     }
217 wakaba 1.11 $WIKIFORMCORE->set_option ($opt{option} => $opt{o}) if $opt{option};
218    
219     my @missing;
220     for (keys %{$opt{o}->{form}->{require}->{id}}) {
221     unless (length $opt{o}->{wiki}->{input}->parameter
222     ($WIKIFORMCORE->control_id ($opt{o}, local_id => $_,
223     local_id_prefix => 'wikiform__')
224     ->{local_id})) {
225     push @missing, $_;
226     }
227     }
228     if (@missing) {
229     return [{
230     type => 'required_param_missing',
231     missing_id => \@missing,
232     }];
233     }
234 wakaba 1.6
235     ## Replace Output Template
236     my $result;
237     if ($ref eq 'form') {
238     $opt{template} ||= $form->get_attribute_value
239     ('template', default => '');
240     } elsif ($ref eq 'comment') {
241     $opt{template} ||= $WIKIRESOURCE->get
242     (name => 'SuikaWiki/0.9:form:comment:template',
243     o => $opt{o}, wiki => $opt{o}->{wiki});
244     } elsif ($ref eq '#footannotate') {
245     $opt{template} ||= $WIKIRESOURCE->get
246     (name => 'SuikaWiki/0.9:form:footannotate:template',
247     o => $opt{o}, wiki => $opt{o}->{wiki});
248     }
249     try {
250     $result = SuikaWiki::Plugin->text_formatter ('form_template')
251     ->replace ($opt{template}, param => $opt{o});
252     } catch Message::Util::Formatter::error with {
253     my $err = shift;
254     SuikaWiki::Plugin->module_package ('Error')
255     ->reporting_formatting_template_error
256     ($err, $err->{option}->{param}->{wiki});
257     ##TODO:
258     throw SuikaWiki::View::Implementation::error -type => 'ERROR_REPORTED';
259     };
260    
261     ## Insert
262     if (length $result) {
263     if ($ref eq '#footannotate') {
264     my $parent;
265     for (@{$xml->child_nodes}) {
266     if ($_->node_type eq '#element' and
267     $_->local_name eq 'document') {
268     for (@{$_->child_nodes}) {
269     if ($_->node_type eq '#element' and
270     $_->local_name eq 'body') {
271     $parent = $_;
272     last;
273     }
274     }
275     }
276     }
277 wakaba 1.9 CORE::die "Buggy implementation: no body element".$xml
278     unless ref $parent;
279 wakaba 1.6
280     $parent->append_new_node (type => '#element',
281     namespace_uri => $NS_SW09,
282     local_name => 'text')
283     ->append_text ($result);
284     } else {
285     my $parent = $form->parent_node;
286     CORE::die "Byggy implementation: No parent of form" unless ref $parent;
287     my $children = $parent->child_nodes;
288    
289     $result .= "\x0A" unless substr ($result, -1) eq "\x0A";
290     $parent->append_new_node (type => '#element',
291     namespace_uri => $NS_SW09,
292     local_name => 'text')
293     ->append_text ($result);
294     my $node = pop @{$children};
295     my $form_str = overload::StrVal ($form);
296     my $i = 0;
297     for (@{$children}) {
298     last if overload::StrVal ($_) eq $form_str;
299     $i++;
300     }
301     if ($opt{o}->{form}->{output}->{reverse}) {
302     splice @{$children}, $i + 1, 0, $node;
303     } else {
304     splice @{$children}, $i, 0, $node;
305     }
306     }
307     } else {
308     ## TODO:
309     }
310    
311     ## XML format -> Text format
312     my $text = __FUNCPACK__->xml_to_text ($xml, {%opt});
313    
314     my %fragment = (fragment => $opt{o}->{form}->{output}->{id}
315     || 'wikiform-'.$opt{o}->{form}->{output}->{index});
316     if (not $opt{o}->{form}->{output}->{reverse} and
317     $opt{o}->{var}->{sw09__anchor_index}) {
318     %fragment = (anchor_no => $opt{o}->{var}->{sw09__anchor_index});
319     }
320    
321     my $action = [
322     {
323     type => 'write',
324     content => $text,
325     update_lastmodified => time,
326     },
327     {
328 wakaba 1.11 type => 'ok',
329 wakaba 1.6 %fragment,
330     },
331     ];
332    
333     @HeadSummary:
334     @@Main:
335     my $xml = __FUNCPACK__->get_xml_tree (text => $source, opt => \%opt,
336     wiki => $self->{wiki});
337     return $xml->inner_text;
338    
339     FormattingRule:
340     @Category[list]:form-template
341     @Name: index
342     @Description:
343     @@@: Next anchor index number
344     @@lang:en
345     @After:
346     if ($o->{var}->{sw09__anchor_index}) {
347     ++$o->{var}->{sw09__anchor_index};
348     } else {
349     $o->{var}->{sw09__anchor_index}
350     = 1 + __FUNCPACK__->get_last_anchor_index
351     ($o->{var}->{sw09__document_tree});
352     }
353     $p->{-result} .= $o->{var}->{sw09__anchor_index};
354    
355     Function:
356     @Name: get_last_anchor_index
357     @Main:
358     my (undef, $xml) = @_;
359     my $anchor = 0;
360     my $get_anchor_no;
361     $get_anchor_no = sub {
362     my $node = shift;
363     for my $child (@{$node->child_nodes}) {
364 wakaba 1.9 my $nt = $child->node_type;
365     if ($nt eq '#element') {
366 wakaba 1.6 if ($child->namespace_uri => $NS_SW09 and
367     $child->local_name eq 'anchor-end') {
368     my $a = $child->get_attribute_value ('anchor', default => 0,
369     namespace_uri => $NS_SW09);
370     $anchor = 0+$a if $anchor < 0+$a;
371     } else {
372     $get_anchor_no->($child);
373     }
374 wakaba 1.9 } elsif ($nt eq '#document' or $nt eq '#fragment') {
375 wakaba 1.6 $get_anchor_no->($child);
376     }
377     }
378     };
379     $get_anchor_no->($xml);
380     $anchor;
381    
382    
383     Function:
384     @Name: get_xml_tree
385     @Main:
386     my (undef, %opt) = @_;
387     if ($opt{opt}->{page}) {
388 wakaba 1.17
389 wakaba 1.8 ## TODO:
390 wakaba 1.6 unless ($__FUNCPACK__::DBLoaded) {
391     $opt{wiki}->{db}->_set_prop_db (sw09__xml_tree => {-db_open => sub {
392     require SuikaWiki::DB::Hash;
393     new SuikaWiki::DB::Hash;
394     }});
395     $__FUNCPACK__::DBLoaded++;
396     }
397    
398 wakaba 1.19 my $xml = new Message::Markup::XML::Node type => '#fragment';
399 wakaba 1.6 __FUNCPACK__->text_to_xml (${$opt{text}}, {%{$opt{opt}}, -parent => $xml});
400    
401     $opt{wiki}->{db}->set (sw09__xml_tree => $opt{opt}->{page} => $xml);
402     $xml;
403     } else {
404     my $xml = new Message::Markup::XML::Node type => '#fragment';
405     __FUNCPACK__->text_to_xml (${$opt{text}}, {%{$opt{opt}}, -parent => $xml});
406     $xml;
407     }
408    
409     Function:
410     @Name: sw09_to_xhtml1
411 wakaba 1.16 @Description:
412     @@lang:en
413     @@@: Transform a SuikaWiki/0.9 or SuikaWiki/0.10 XML tree to an XHTML tree.
414 wakaba 1.6 @Main:
415     my (undef, %opt) = @_;
416    
417 wakaba 1.2 my ($apply_template, $apply_template_children);
418     $apply_template_children = sub {
419 wakaba 1.9 for (@{$_[0]->child_nodes}) {
420     $apply_template->($_ => $_[1]) unless $_->node_type eq '#attribute';
421 wakaba 1.2 }
422     };
423     $apply_template = sub {
424     my ($source, $result) = @_;
425     my $ln = $source->local_name;
426     if ($source->node_type eq '#text') {
427     $result->append_text ($source->inner_text);
428 wakaba 1.16 } elsif ({qw/code 1 samp 1 var 1 dfn 1 kbd 1 sub 1 sup 1
429     cite 1/ ## SuikaWiki/0.10
430     }->{$ln}) {
431 wakaba 1.2 my $node = $result->append_new_node
432     (type => '#element',
433     namespace_uri => $NS_XHTML1,
434     local_name => $ln);
435     my $class = $source->get_attribute_value ('class', default => '');
436     $node->set_attribute (class => $class) if $class;
437     $apply_template_children->($source => $node);
438 wakaba 1.4 } elsif ({qw/ins 1 del 1 insert 1 delete 1/}->{$ln}) {
439 wakaba 1.2 my $node = $result->append_new_node
440     (type => '#element',
441     namespace_uri => $NS_XHTML1,
442 wakaba 1.4 local_name => {qw/ins ins insert ins
443     delete del del del/}->{$ln});
444 wakaba 1.2 my $class = $source->get_attribute_value ('class', default => '');
445     $node->set_attribute (class => $class) if $class;
446     ## TODO: cite
447     $apply_template_children->($source => $node);
448     } elsif ({qw/table 1 tbody 1 tr 1 td 1 blockquote 1 ul 1 ol 1
449     li 1 pre 1 dl 1 dt 1 dd 1 em 1 strong 1/}->{$ln}) {
450     my $node = $result->append_new_node
451     (type => '#element',
452     namespace_uri => $NS_XHTML1,
453     local_name => $ln);
454     if ($ln eq 'td') {
455     my $colspan = $source->get_attribute_value ('colspan', default => 0);
456     $node->set_attribute (colspan => $colspan) if $colspan;
457     } elsif ($ln eq 'pre') {
458     $node->set_attribute (space => 'preserve',
459     namespace_uri => NS_xml_URI);
460 wakaba 1.10 my $class = $source->get_attribute_value ('class', default => '');
461     $node->set_attribute (class => $class) if length $class;
462 wakaba 1.2 }
463 wakaba 1.6 $apply_template_children->($source => $node);
464     } elsif ($ln eq 'anchor') {
465     local $opt{o}->{var}->{sw09__anchor_content} = sub {
466     $apply_template_children->($source => shift);
467     };
468     SuikaWiki::Plugin->module_package ('WikiLinking')
469     ->to_wikipage_in_html ({
470 wakaba 1.9 label => $WIKIRESOURCE->get_text
471 wakaba 1.6 (name =>
472     'Link:SuikaWiki/0.9:toWikiPage:SourceLabel',
473     param => $opt{o},
474     wiki => $opt{o}->{wiki}),
475     } => {
476     base => $opt{o}->{wiki}->{var}->{page},
477 wakaba 1.14 page_name => $opt{o}->{wiki}->name ($source->inner_text)
478     ->absolute (wiki => $opt{o}->{wiki},
479     nearest => 'content',
480     base => $opt{o}->{wiki}
481     ->{var}->{page}),
482 wakaba 1.6 page_anchor_no => $source->get_attribute_value
483     ('anchor',
484     namespace_uri => $NS_SW09),
485     }, {
486     o => $opt{o},
487     parent => $result,
488     });
489     } elsif ($ln eq 'p') {
490     $apply_template_children->($source => $result->append_new_node
491 wakaba 1.2 (type => '#element',
492     namespace_uri => $NS_XHTML1,
493 wakaba 1.6 local_name => 'p'));
494     } elsif ($ln eq 'h') {
495     my $node;
496     if ($opt{o}->{var}->{ws__section_depth} > 6) {
497     $node = $result->append_new_node
498 wakaba 1.2 (type => '#element',
499     namespace_uri => $NS_XHTML1,
500 wakaba 1.6 local_name => 'div');
501     $node->set_attribute (class => 'heading h'.$opt{o}->{var}
502     ->{ws__section_depth});
503     } else {
504     $node = $result->append_new_node
505 wakaba 1.2 (type => '#element',
506     namespace_uri => $NS_XHTML1,
507 wakaba 1.6 local_name => 'h'.$opt{o}->{var}
508     ->{ws__section_depth});
509 wakaba 1.2 }
510     $apply_template_children->($source => $node);
511 wakaba 1.9 $WIKISTRUCT->set_section_id ($result, undef, $opt{o}->{wiki},
512 wakaba 1.6 title => $source->inner_text);
513     } elsif ($ln eq 'ruby' or $ln eq 'rubyb') {
514     my @child;
515     for (@{$source->child_nodes}) {
516     if ({qw/rb 1 rt 1/}->{$_->local_name}) {
517     push @child, $_;
518     }
519     }
520     for ($result->append_new_node (type => '#element',
521     namespace_uri => $NS_XHTML1,
522     local_name => 'ruby')) {
523     if ($ln eq 'rubyb') {
524     my $class = join ' ',
525     'descriptive',
526     split /\s+/, $source->get_attribute_value
527     ('class', default => '');
528     $_->set_attribute (class => $class) if $class;
529     } else {
530     my $class = $source->get_attribute_value ('class', default => '');
531     $_->set_attribute (class => $class) if $class;
532     }
533     $apply_template_children->($child[0]
534     => $_->append_new_node (type => '#element',
535     namespace_uri => $NS_XHTML1,
536     local_name => 'rb'));
537     $_->append_new_node (type => '#element',
538     namespace_uri => $NS_XHTML1,
539     local_name => 'rp')
540     ->append_text ('(');
541     if ($child[1]) {
542     $apply_template_children->($child[1]
543     => $_->append_new_node (type => '#element',
544     namespace_uri => $NS_XHTML1,
545     local_name => 'rt'));
546     } else {
547     $_->append_new_node (type => '#element',
548     namespace_uri => $NS_XHTML1,
549     local_name => 'rt');
550     }
551     if ($child[2]) {
552     $_->append_new_node (type => '#element',
553     namespace_uri => $NS_XHTML1,
554     local_name => 'rp')
555     ->append_text ('/');
556     $apply_template_children->($child[2]
557     => $_->append_new_node (type => '#element',
558     namespace_uri => $NS_XHTML1,
559     local_name => 'rt'));
560 wakaba 1.5 }
561 wakaba 1.6 $_->append_new_node (type => '#element',
562     namespace_uri => $NS_XHTML1,
563     local_name => 'rp')
564     ->append_text (')');
565 wakaba 1.5 }
566 wakaba 1.6 } elsif ($ln eq 'abbr') {
567     my (@b);
568     for (@{$source->child_nodes}) {
569     push @b, $_ if {qw/rb 1 rt 1/}->{$_->local_name};
570 wakaba 1.5 }
571 wakaba 1.6 my $node = $result->append_new_node
572     (type => '#element',
573     namespace_uri => $NS_XHTML1,
574     local_name => 'abbr');
575     $node->set_attribute (title => $b[1]->inner_text) if $b[1];
576     $apply_template_children->($b[0] => $node);
577 wakaba 1.19 } elsif ($ln eq 'qn') {
578     my (@b);
579     for (@{$source->child_nodes}) {
580     push @b, $_ if {qw/qname 1 nsuri 1/}->{$_->local_name};
581     }
582     my $node = $result->append_new_node
583     (type => '#element',
584     namespace_uri => $NS_XHTML1,
585     local_name => 'code');
586     $node->set_attribute (class => 'qname');
587     $node->set_attribute (title => '{<'.$b[1]->inner_text.'>}') if $b[1];
588     $apply_template_children->($b[0] => $node);
589 wakaba 1.6 } elsif ($ln eq 'q') {
590     my $node = $result->append_new_node
591     (type => '#element',
592     namespace_uri => $NS_XHTML1,
593     local_name => 'q');
594     ## TODO: cite
595     $apply_template_children->($source => $node);
596 wakaba 1.16 } elsif ($ln eq 'weak' or
597     $ln eq 'aa' ## SuikaWiki/0.10
598     ) {
599 wakaba 1.6 my $node = $result->append_new_node
600     (type => '#element',
601     namespace_uri => $NS_XHTML1,
602     local_name => 'span');
603 wakaba 1.16 my @class = split /\s+/,
604     $source->get_attribute_value ('class', default => '');
605     $node->set_attribute (class => join ' ', $ln, @class);
606     $apply_template_children->($source => $node);
607 wakaba 1.19 } elsif ($ln eq 'src' or $ln eq 'csection') { ## SuikaWiki/0.10
608 wakaba 1.16 my $node = $result->append_new_node
609     (type => '#element',
610     namespace_uri => $NS_XHTML1,
611     local_name => 'cite');
612     my @class = split /\s+/,
613     $source->get_attribute_value ('class', default => '');
614     $node->set_attribute (class => join ' ', $ln, @class);
615     $node->append_text ("[");
616     $apply_template_children->($source => $node);
617     $node->append_text ("]");
618     } elsif ($ln eq 'key') { ## SuikaWiki/0.10
619     my $node = $result->append_new_node
620     (type => '#element',
621     namespace_uri => $NS_XHTML1,
622     local_name => 'kbd');
623     my @class = split /\s+/,
624     $source->get_attribute_value ('class', default => '');
625     $node->set_attribute (class => join ' ', $ln, @class);
626 wakaba 1.6 $apply_template_children->($source => $node);
627     } elsif ({qw/section 1 bodytext 1/}->{$ln}) {
628     my $node = $result->append_new_node
629     (type => '#element',
630     namespace_uri => $NS_XHTML1,
631     local_name => 'div');
632     $node->set_attribute (class => $ln);
633     local $opt{o}->{var}->{ws__section_depth}
634     = $opt{o}->{var}->{ws__section_depth} + 1;
635     $apply_template_children->($source => $node);
636     } elsif ($ln eq 'anchor-end') {
637     my $node = $result->append_new_node
638     (type => '#element',
639     namespace_uri => $NS_XHTML1,
640     local_name => 'a');
641     $node->set_attribute (id => 'anchor-'.$source->get_attribute_value
642     ('anchor', default => '0',
643     namespace_uri => $NS_SW09));
644 wakaba 1.8 $node->set_attribute (name => 'anchor-'.$source->get_attribute_value
645     ('anchor', default => '0',
646     namespace_uri => $NS_SW09))
647     if $opt{o}->{wiki}->{var}->{client}->{downgrade}->{html_no_id};
648 wakaba 1.12 $node->set_attribute (class => 'anchor');
649 wakaba 1.6 $node->append_text ($source->inner_text);
650     } elsif ($ln eq 'anchor-internal') {
651     my $node = $result->append_new_node
652     (type => '#element',
653     namespace_uri => $NS_XHTML1,
654     local_name => 'a');
655     $node->set_attribute (href => '#anchor-'.$source->get_attribute_value
656     ('anchor',
657     namespace_uri => $NS_SW09, default => '0'));
658     $node->set_attribute (class => 'wiki-anchor');
659     $node->append_text ($source->inner_text);
660     } elsif ($ln eq 'anchor-external') {
661     local $opt{o}->{var}->{sw09__anchor_content} = sub {
662     $apply_template_children->($source => shift);
663     };
664 wakaba 1.9 $WIKILINKING
665 wakaba 1.6 ->to_resource_in_html (
666     {
667 wakaba 1.9 label => $WIKIRESOURCE
668 wakaba 1.6 ->get_text (name =>
669     'Link:SuikaWiki/0.9:toResource:SourceLabel',
670     param => $opt{o},
671     wiki => $opt{o}->{wiki}),
672     }, {
673     resource_scheme =>
674     $source->get_attribute_value ('resScheme',
675     namespace_uri => $NS_SW09,
676     default => 'URI'),
677     resource_parameter =>
678     $source->get_attribute_value ('resParameter',
679     namespace_uri => $NS_SW09,
680     default => ''),
681     }, {
682     o => $opt{o},
683     parent => $result,
684     });
685     } elsif ($ln eq 'form') {
686     my $ref = $source->get_attribute_value ('ref', default => 'form');
687     if ($ref eq 'form') {
688 wakaba 1.9 $WIKIFORMCORE->make_content_form_in_html
689 wakaba 1.6 ($result,
690     $source->get_attribute_value
691     ('input', default => ''),
692     option => $source->get_attribute_value
693     ('option'),
694     name => $source->get_attribute_value ('id'),
695     o => $opt{o},
696     wiki => $opt{o}->{wiki},
697     output => {
698     page => $opt{page},
699     });
700     } elsif ($ref eq 'comment') {
701 wakaba 1.9 $WIKIFORMCORE->make_content_form_in_html
702 wakaba 1.6 ($result,
703     $WIKIRESOURCE->get
704     (name => 'SuikaWiki/0.9:form:comment:input',
705     o => $opt{o}, wiki => $opt{o}->{wiki}),
706     option => $WIKIRESOURCE->get
707     (name => 'SuikaWiki/0.9:form:comment:option',
708     o => $opt{o}, wiki => $opt{o}->{wiki}),
709     name => $source->get_attribute_value ('id'),
710     o => $opt{o},
711     wiki => $opt{o}->{wiki},
712     output => {
713     page => $opt{page},
714     });
715 wakaba 1.5 } else {
716 wakaba 1.14 ## TODO: Warning
717     $WIKIFORMCORE->make_content_form_in_html
718     ($result,
719     '',
720     option => '',
721     o => $opt{o},
722     wiki => $opt{o}->{wiki},
723     output => {
724     page => $opt{page},
725     });
726 wakaba 1.6 }
727     } elsif ($ln eq 'dr') {
728     $apply_template_children->($source => $result);
729     } elsif ($ln eq 'document') {
730     my $body;
731     for (@{$source->child_nodes}) {
732     $body = $_ and last if $_->local_name eq 'body';
733 wakaba 1.5 }
734 wakaba 1.6 my $body_block = $result->append_new_node
735     (type => '#element',
736     namespace_uri => $NS_XHTML1,
737     local_name => 'div');
738     $body_block->set_attribute (class => 'block SuikaWiki-0-9');
739     $apply_template_children->($body => $body_block);
740     } else {
741     my $node = $result->append_new_node
742     (type => '#element',
743     namespace_uri => $NS_XHTML1,
744     local_name => 'span');
745     $node->set_attribute (class => 'warn');
746     for ($node->append_new_node
747     (type => '#element',
748     namespace_uri => $NS_XHTML1,
749     local_name => 'ins')
750     ->append_new_node
751     (type => '#element',
752     namespace_uri => $NS_XHTML1,
753     local_name => 'code')) {
754     $_->set_attribute (class => 'XML element');
755     $_->append_text ("<".$source->namespace_uri.">:$ln");
756 wakaba 1.4 }
757 wakaba 1.6 $apply_template_children->($source => $node);
758 wakaba 1.4 }
759     };
760 wakaba 1.6
761     $apply_template_children->($opt{source} => $opt{parent});
762 wakaba 1.4
763    
764     Function:
765     @Name: xml_to_text
766     @Main:
767     my (undef, $src, $opt) = @_;
768    
769    
770     my %is_block = (
771     qw/p 1 blockquote 1 pre 1 ul 1 ol 1 dl 1 section 1 h 1
772     bodytext 1 document 1 head 1 body 1 table 1 text 1 form 1
773     insert 1 delete 1/
774     );
775    
776     my %x2t;
777     %x2t = (
778     anchor => sub {
779     my $source = shift;
780     my $result = '[['
781     . $x2t{'#inline'}->($source, no_newline => 1)
782     . ']';
783     my $anchor = $source->get_attribute_value
784     ('anchor',
785     namespace_uri => $NS_SW09,
786     default => '');
787     if (length $anchor) {
788     $result .= '>>'.(0+$anchor);
789     } else {
790     $anchor = $source->get_attribute_value
791     ('resScheme',
792     namespace_uri => $NS_SW09);
793     if ($anchor) {
794     my $param = $source->get_attribute_value
795     ('resParameter',
796     namespace_uri => $NS_SW09);
797     if ($anchor eq 'URI' and $param =~ /^[0-9A-Za-z_+.%-]+:/) {
798     $result .= '<' . $param . '>';
799     } else {
800     $result .= '<' . $anchor . ':' . $param . '>';
801     }
802     }
803     }
804     $result . ']';
805     },
806     li => sub {
807     my $source = shift;
808     my $result = ({qw/ul - ol =/}->{$opt->{o}->{var}->{sw09__list_type}}
809     x $opt->{o}->{var}->{sw09__list_depth})
810     . ' ' . $x2t{'#flow'}->($source);
811     $result;
812     },
813     dt => sub {
814     ':' . $x2t{'#inline'}->(return, no_newline => 1) . ':';
815     },
816     h => sub {
817     ("*" x ($opt->{o}->{var}->{ws__section_depth} - 1))
818     . " "
819     . $x2t{'#inline'}->(shift, no_newline => 1);
820     },
821     'anchor-end' => sub {
822     return shift->inner_text;
823     },
824     'anchor-internal' => sub {
825     return shift->inner_text;
826     },
827     'anchor-external' => sub {
828     return '<'.shift->inner_text.'>';
829     },
830     form => sub {
831     my $source = shift;
832     my $ref = $source->get_attribute_value ('ref', default => 'form');
833     my $result = '[[#'.$ref;
834     my $name = $source->get_attribute_value ('id');
835     $name =~ s/([()\\])/\\$1/g;
836     $result .= '(' . $name . ')' if $name;
837     ## General WikiForm
838     if ($ref eq 'form') {
839     $result .= ":'";
840     my $input = $source->get_attribute_value ('input', default => '');
841     $input =~ s/(['\\])/\\$1/g;
842     $result .= $input . "':'";
843     my $template = $source->get_attribute_value ('template', default => '');
844     $template =~ s/(['\\])/\\$1/g;
845     $result .= $template . "'";
846     my $option = $source->get_attribute_value ('option');
847     if ($option) {
848     $option =~ s/(['\\])/\\$1/g;
849     $result .= ":'" . $option . "'";
850     }
851     ## Specific WikiForm
852     } else {
853     my $param = $source->get_attribute_value ('parameter');
854     if ($param) {
855     $result .= ':' . $param;
856     }
857     }
858     $result .= ']]';
859     },
860     pre => sub {
861     my $source = shift;
862     my $result = '[PRE';
863     my $class = $source->get_attribute_value ('class');
864     if ($class) {
865     $class =~ s/([\\()])/\\$1/g;
866     $result .= '(' . $class . ')';
867     }
868     $result .= "[\x0A"
869     . $x2t{'#inline'}->($source);
870     $result .= "\x0A" unless substr ($result, -1) eq "\x0A";
871     $result .= "]PRE]\x0A";
872     },
873     insert => sub {
874     my $source = shift;
875     my $result = '[INS';
876     my $class = $source->get_attribute_value ('class');
877     if ($class) {
878     $class =~ s/([\\()])/\\$1/g;
879     $result .= '(' . $class . ')';
880     }
881     local $opt->{o}->{var}->{sw09__list_depth} = 0;
882     $result .= "[\x0A"
883     . $x2t{'#block'}->($source);
884     $result .= "\x0A" unless substr ($result, -1) eq "\x0A";
885     $result .= "]INS]\x0A";
886     },
887     delete => sub {
888     my $source = shift;
889     my $result = '[DEL';
890     my $class = $source->get_attribute_value ('class');
891     if ($class) {
892     $class =~ s/([\\()])/\\$1/g;
893     $result .= '(' . $class . ')';
894     }
895     local $opt->{o}->{var}->{sw09__list_depth} = 0;
896     $result .= "[\x0A"
897     . $x2t{'#block'}->($source);
898     $result .= "\x0A" unless substr ($result, -1) eq "\x0A";
899     $result .= "]DEL]\x0A";
900     },
901     document => sub {
902     my $source = shift;
903 wakaba 1.16 my $result = '';
904     #$result = '#?'
905     # . $source->get_attribute_value
906     # ('Name', namespace_uri => $NS_SW09,
907     # default => 'SuikaWiki')
908     # . '/'
909     # . $source->get_attribute_value
910     # ('Version', namespace_uri => $NS_SW09,
911     # default => '0.9');
912 wakaba 1.4 for (@{$source->child_nodes}) {
913     $result .= ($x2t{$_->local_name} or $x2t{'#undef'})->($_)
914     if $_->node_type eq '#element';
915     }
916     $result;
917     },
918     head => sub {
919     my $source = shift;
920 wakaba 1.6 my $result = '';
921 wakaba 1.19 ## ISSUE: '#?SuikaWiki/0.9 ' required...
922 wakaba 1.4 for (@{$source->child_nodes}) {
923     if ($_->node_type eq '#element' and
924     $_->local_name eq 'parameter') {
925     $result .= ' '.$x2t{parameter}->($_);
926     }
927     }
928     $result . "\x0A";
929     },
930     parameter => sub {
931     my $source = shift;
932     my $result = $source->get_attribute_value ('name', default => '')
933     . '="';
934     my @v;
935     for (@{$source->child_nodes}) {
936     push @v, $x2t{value}->($_) if $_->node_type eq '#element' and
937     $_->local_name eq 'value';
938     }
939     $result .= join ',', @v;
940     $result . '"';
941     },
942     value => sub {
943     my $value = $x2t{'#inline'}->(shift, no_newline => 1);
944     $value =~ s/(["\\])/\\$1/g;
945     $value =~ tr/\x0A\x0D/ /;
946     $value;
947     },
948     section => sub {
949     local $opt->{o}->{var}->{ws__section_depth}
950     = $opt->{o}->{var}->{ws__section_depth} + 1;
951     $x2t{'#block'}->(shift);
952     },
953     body => sub {
954     local $opt->{o}->{var}->{ws__section_depth} = 1;
955     $x2t{'#block'}->(shift);
956     },
957     text => sub {
958     my ($source, %opt) = @_;
959     my $result .= '';
960     for (@{$source->child_nodes}) {
961     if ($_->node_type eq '#text') {
962     $result .= $_->inner_text;
963     } elsif ($_->node_type eq '#element') {
964     $result .= ($x2t{$_->local_name} or $x2t{'#undef'})->($_);
965     }
966     }
967     $result;
968     },
969     dr => sub {
970     my $result = $x2t{'#list'}->(shift);
971     if ($result) {
972     $result . "\x0A";
973     } else {
974     "::\x0A";
975     }
976     },
977     dt => sub {
978     ':' . $x2t{'#inline'}->(shift, no_newline => 1) . ':';
979     },
980     dd => sub {
981     $x2t{'#inline'}->(shift);
982     },
983     tr => sub {
984     my $result = $x2t{'#list'}->(shift);
985     if ($result) {
986     substr ($result, 1) . "\x0A";
987     } else {
988     "',\x0A";
989     }
990     },
991     td => sub {
992     my $source = shift;
993     my $result = $x2t{'#inline'}->($source, no_newline => 1);
994     if ($result =~ /[,"\\]/ or $result =~ /==/) {
995     $result =~ s/(["\\])/\\$1/g;
996     $result = '"' . $result . '"';
997     }
998     my $colspan = $source->get_attribute_value ('colspan', default => 1);
999     $result .= ("\t,==" x ($colspan - 1)) if $colspan > 1;
1000     "\t," . $result;
1001     },
1002     em => sub {
1003     "''" . $x2t{'#inline'}->($_, no_newline => 1) . "''";
1004     },
1005     strong => => sub {
1006     "'''" . $x2t{'#inline'}->($_, no_newline => 1) . "'''";
1007     },
1008     rb => sub {
1009     $x2t{'#inline'}->(shift, no_newline => 1);
1010     },
1011 wakaba 1.19 qname => sub {
1012     $x2t{'#inline'}->(shift, no_newline => 1);
1013     },
1014 wakaba 1.4 rt => sub {
1015     '] [' . $x2t{'#inline'}->(shift, no_newline => 1);
1016     },
1017 wakaba 1.19 nsuri => sub {
1018     '] [' . $x2t{'#inline'}->(shift, no_newline => 1);
1019     },
1020 wakaba 1.4 replace => sub {
1021     '__&&' . shift->get_attribute_value ('by', default => '') . '&&__';
1022     },
1023     bodytext => sub {
1024     my ($source, %opt) = @_;
1025     local $opt->{o}->{var}->{sw09__bq_depth}
1026     = $opt->{o}->{var}->{sw09__bq_depth} + 1;
1027     my @result;
1028     for (@{$source->child_nodes}) {
1029     if ($_->node_type eq '#element') {
1030     my $ln = $_->local_name;
1031     push @result, [($x2t{$ln} or $x2t{'#undef'})->($_),
1032     $ln];
1033     }
1034     }
1035     my $result = '';
1036     my $prev = '';
1037     for (@result) {
1038     my $s = $_->[0];
1039     if ($_->[1] eq 'p') {
1040     $result .= "\x0A" if length $result and
1041     substr ($result, -1) ne "\x0A";
1042     $result .= ('>' x $opt->{o}->{var}->{sw09__bq_depth}) . ' ';
1043     } elsif ($_->[1] eq 'form' or $_->[1] eq 'replace') {
1044     $result .= "\x0A" if length $result and
1045     substr ($result, -1) ne "\x0A";
1046     $result .= ('>' x $opt->{o}->{var}->{sw09__bq_depth})."\x0A";
1047     } elsif ($_->[1] eq 'blockquote' or $_->[1] eq 'text') {
1048     $result .= "\x0A" if length $result and
1049     substr ($result, -1) ne "\x0A";
1050     } else {
1051     unless ($prev eq 'text') {
1052     $result .= "\x0A" if length $result and
1053     substr ($result, -1) ne "\x0A";
1054     }
1055     $result .= ('>' x $opt->{o}->{var}->{sw09__bq_depth})."\x0A";
1056     }
1057     $result .= $s;
1058     $prev = $_->[1];
1059     }
1060     $result;
1061     },
1062 wakaba 1.6 ## Note: This element will be interpreted as a paragraph
1063     ## unless format is SuikaWikiImage/0.9.
1064     image => sub {
1065     my ($source, %opt) = @_;
1066     return "\x0A__IMAGE__\x0A" . $source->inner_text . "\x0A";
1067     },
1068 wakaba 1.4 '#block' => sub {
1069     my ($source, %opt) = @_;
1070     my @result;
1071     for (@{$source->child_nodes}) {
1072     if ($_->node_type eq '#element') {
1073     my $ln = $_->local_name;
1074     push @result, [($x2t{$ln} or $x2t{'#undef'})->($_),
1075     $ln];
1076     }
1077     }
1078     my $result = '';
1079     my $prev = '';
1080     for (@result) {
1081     my $s = $_->[0];
1082     if ($_->[1] eq 'form') {
1083     $result .= "\x0A" if length $result and
1084     substr ($result, -1) ne "\x0A";
1085     $result .= "\x0A";
1086     } elsif ($_->[1] eq 'replace') {
1087     $result .= "\x0A" if length $result and
1088     substr ($result, -1) ne "\x0A";
1089     } elsif ($_->[1] eq 'text') {
1090     $result .= "\x0A" if length $result and
1091     substr ($result, -1) ne "\x0A";
1092     $result .= "\x0A" if $prev eq 'p';
1093     } else {
1094     if ($prev ne 'text' and $prev ne 'replace') {
1095     $result .= "\x0A" if length $result and
1096     substr ($result, -1) ne "\x0A";
1097     $result .= "\x0A";
1098     }
1099     }
1100     $result .= $s;
1101     $prev = $_->[1];
1102     }
1103     $result;
1104     },
1105     '#flow' => sub {
1106     my ($source, %opt) = @_;
1107     my @result;
1108     for (@{$source->child_nodes}) {
1109     if ($_->node_type eq '#element') {
1110     my $ln = $_->local_name;
1111     if ($is_block{$ln}) {
1112     push @result, [($x2t{$ln} or $x2t{'#undef'})->($_),
1113     $ln];
1114     } else {
1115     if (@result and ($result[$#result]->[1] eq '#inline')) {
1116     $result[$#result]->[0]
1117     .= ($x2t{$ln} or $x2t{'#undef'})->($_);
1118     } else {
1119     push @result, [($x2t{$ln} or $x2t{'#undef'})->($_),
1120     '#inline'];
1121     }
1122     }
1123     } elsif ($_->node_type eq '#text') {
1124     if (@result and ($result[$#result]->[1] eq '#inline')) {
1125     $result[$#result]->[0] .= $_->inner_text;
1126     } else {
1127     push @result, [$_->inner_text, '#inline'];
1128     }
1129     }
1130     }
1131     my $result = '';
1132     my $prev = '';
1133     for (@result) {
1134     my $s = $_->[0];
1135     if ($_->[1] eq '#inline') {
1136     if ($prev ne 'text' and $prev ne 'form' and $prev ne 'replace') {
1137     $result .= "\x0A" if length $result and
1138     substr ($result, -1) ne "\x0A";
1139     }
1140     $s =~ s/\x0D\x0A/\x0A/g;
1141     $s =~ s/\x0D/\x0A/g;
1142     $s =~ s/\x0A\x0A+/\x0A/g;
1143     $s =~ s/\x0A/\x20/g if $opt{no_newline};
1144     } elsif ($_->[1] eq 'form' or $_->[1] eq 'replace') {
1145     if ($prev ne '#inline') {
1146     $result .= "\x0A" if length $result and
1147     substr ($result, -1) ne "\x0A";
1148     }
1149     } elsif ($_->[1] eq 'text') {
1150     $result .= "\x0A" if length $result and
1151     substr ($result, -1) ne "\x0A";
1152     } else {
1153     unless ($prev eq 'text') {
1154     $result .= "\x0A" if length $result and
1155     substr ($result, -1) ne "\x0A";
1156     }
1157     }
1158     $result .= $s;
1159     $prev = $_->[1];
1160     }
1161     $result;
1162     },
1163     '#inline' => sub {
1164     my ($source, %opt) = @_;
1165     my $result .= '';
1166     for (@{$source->child_nodes}) {
1167     if ($_->node_type eq '#text') {
1168     $result .= $_->inner_text;
1169     } elsif ($_->node_type eq '#element') {
1170     $result .= ($x2t{$_->local_name} or $x2t{'#undef'})->($_);
1171     }
1172     }
1173     $result =~ s/\x0D\x0A/\x0A/g;
1174     $result =~ s/\x0D/\x0A/g;
1175     $result =~ s/\x0A\x0A+/\x0A/g;
1176     $result =~ s/\x0A/\x20/g if $opt{no_newline};
1177     $result;
1178     },
1179     '#list' => sub {
1180     my ($source, %opt) = @_;
1181     my $result .= '';
1182     for (@{$source->child_nodes}) {
1183     if ($_->node_type eq '#element') {
1184     $result .= ($x2t{$_->local_name} or $x2t{'#undef'})->($_);
1185     }
1186     }
1187     $result;
1188     },
1189     '#undef' => sub {
1190     my $source = shift;
1191     ## TODO:
1192     "<".$source->namespace_uri.">:".$source->local_name
1193     . $x2t{'#inline'}->($source);
1194     },
1195     );
1196     for (qw/blockquote dl tbody table/) {
1197     $x2t{$_} = sub { $x2t{'#list'}->(shift) };
1198     }
1199     for (qw/p dd/) {
1200     $x2t{$_} = sub { $x2t{'#flow'}->(shift) };
1201     }
1202     for my $type (qw/ul ol/) {
1203     $x2t{$type} = sub {
1204     my $source = shift;
1205     local $opt->{o}->{var}->{sw09__list_type} = $type;
1206     local $opt->{o}->{var}->{sw09__list_depth}
1207     = $opt->{o}->{var}->{sw09__list_depth} + 1;
1208     my @result;
1209     for (@{$source->child_nodes}) {
1210     push @result, $x2t{$_->local_name}->($_)
1211     if $_->node_type eq '#element';
1212     }
1213     my $result = '';
1214     for (@result) {
1215     $result .= "\x0A" unless substr ($result, -1) eq "\x0A";
1216     $result .= $_;
1217     }
1218     substr ($result, 1);
1219     };
1220     }
1221     for my $type (qw/code samp var dfn kbd sub sup weak q ruby rubyb
1222 wakaba 1.19 abbr ins del aa src cite key qn csection/) {
1223 wakaba 1.4 $x2t{$type} = sub {
1224     my $source = shift;
1225     my $result = '['.uc $type;
1226     my $class = $source->get_attribute_value ('class', default => '');
1227     if ($class) {
1228     $class =~ s/([()\\])/\\$1/g;
1229     $result .= '(' . $class . ')';
1230     }
1231     $result .= '['
1232     . $x2t{'#inline'}->($source, no_newline => 1)
1233     . ']';
1234     my $anchor = $source->get_attribute_value
1235     ('anchor',
1236     namespace_uri => $NS_SW09,
1237     default => '');
1238     if (length $anchor) {
1239     $result .= '>>'.(0+$anchor);
1240     } else {
1241     $anchor = $source->get_attribute_value
1242     ('resScheme',
1243     namespace_uri => $NS_SW09);
1244     if ($anchor) {
1245     my $param = $source->get_attribute_value
1246     ('resParameter',
1247     namespace_uri => $NS_SW09);
1248     if ($anchor eq 'URI' and $param =~ /^[0-9A-Za-z_+.%-]+:/) {
1249     $result .= '<' . $param . '>';
1250     } else {
1251     $result .= '<' . $anchor . ':' . $param . '>';
1252     }
1253     }
1254     }
1255     $result .= ']';
1256     $result;
1257     };
1258     }
1259    
1260     $x2t{'#list'}->($src);
1261    
1262     Function:
1263     @Name: get_nth_element
1264     @Main:
1265     my (undef, $node, $ns => $ln, $n) = @_;
1266     return $n if $n < 1;
1267     if ($node->node_type eq '#element' and
1268     $node->namespace_uri eq $ns and
1269     $node->local_name eq $ln) {
1270     return $node unless --$n;
1271     }
1272     for (@{$node->child_nodes}) {
1273     if ($_->node_type eq '#element') {
1274     if ($_->namespace_uri eq $ns and
1275     $_->local_name eq $ln) {
1276     return $_ unless --$n;
1277     } else {
1278     $n = __FUNCPACK__->get_nth_element ($_, $ns => $ln, $n);
1279     return $n if ref $n;
1280     }
1281     } elsif ($_->node_type eq '#fragment' or $_->node_type eq '#document') {
1282     $n = __FUNCPACK__->get_nth_element ($_, $ns => $ln, $n);
1283     return $n if ref $n;
1284     }
1285     }
1286     return $n;
1287    
1288     Function:
1289     @Name: get_element_by_id
1290     @Main:
1291     my (undef, $node, $id) = @_;
1292     return $node if $node->node_type eq '#element'
1293     and $node->get_attribute_value ('id', default_value => '')
1294     eq $id;
1295     for (@{$node->child_nodes}) {
1296     if ({'#element'=>1, '#fragment'=>1, '#document'=>1}->{$_->node_type}) {
1297     my $r = __FUNCPACK__->get_element_by_id ($_, $id);
1298     return $r if $r;
1299     }
1300     }
1301 wakaba 1.1
1302     Function:
1303     @Name: text_to_xml
1304     @Description:
1305     @@@:
1306     Converting SuikaWiki/0.9 text format to XML representation
1307     @@lang: en
1308     @Main:
1309     my (undef, $source, $opt) = @_;
1310     $source =~ s/\x0D\x0A/\x0A/g;
1311     $source =~ tr/\x0D/\x0A/;
1312     $source .= "\x0A";
1313     my $root = $opt->{-parent}
1314     ->append_new_node (type => '#element',
1315     namespace_uri => $NS_SW09,
1316     local_name => 'document');
1317     my $head = $root->append_new_node (type => '#element',
1318     namespace_uri => $NS_XHTML2,
1319     local_name => 'head');
1320 wakaba 1.6 $root->append_text ("\x0A");
1321     my $body = $root->append_new_node (type => '#element',
1322     namespace_uri => $NS_XHTML2,
1323     local_name => 'body');
1324     $root->append_text ("\x0A");
1325    
1326     if ($source =~ s#^\#\?(SuikaWiki(?:Image)?)/0\.9\b((?>.*))\s*##) {
1327     my $type = $1;
1328     my $param = $2;
1329     $root->set_attribute (Name => $type, namespace_uri => $NS_SW09);
1330     $root->set_attribute (Version => '0.9', namespace_uri => $NS_SW09);
1331 wakaba 1.1 while ($param =~ /\G\s+([a-z-]+)="((?>[^"\\]*)(?>(?>[^"\\]+|\\.)*))"/g) {
1332     my ($name, $value) = ($1, $2);
1333     $value =~ s/\\(.)/$1/g;
1334     for ($head->append_new_node (type => '#element',
1335     namespace_uri => $NS_SW09,
1336 wakaba 1.4 local_name => 'parameter')) {
1337 wakaba 1.1 $_->set_attribute (name => $name);
1338     for my $value (split /,/, $value) {
1339     $_->append_new_node (type => '#element',
1340     namespace_uri => $NS_SW09,
1341     local_name => 'value')
1342     ->append_text ($value);
1343     }
1344     }
1345     $head->append_text ("\x0A");
1346     }
1347 wakaba 1.6
1348     if ($type eq 'SuikaWikiImage') {
1349     $source =~ s/\x0A__IMAGE__\x0A(.*)$//s;
1350     if (my $image = $1) {
1351     $image =~ s/^\s+//;
1352     $image =~ s/\s+$//;
1353     $root->append_new_node
1354     (type => '#element',
1355     namespace_uri => $NS_SW09,
1356     local_name => 'image')
1357     ->append_text ($image);
1358     $root->append_text ("\x0A");
1359     }
1360     }
1361 wakaba 1.1 } else {
1362 wakaba 1.16 #$root->set_attribute (Name => 'SuikaWiki', namespace_uri => $NS_SW09);
1363     #$root->set_attribute (Version => '0.9', namespace_uri => $NS_SW09);
1364 wakaba 1.1 }
1365    
1366 wakaba 1.4 __FUNCPACK__->block_text_to_xml (\$source => $body, opt => $opt);
1367 wakaba 1.1
1368     Function:
1369     @Name:block_text_to_xml
1370     @Description:
1371     @@@:
1372     SuikaWiki/0.9 text format to XML representation convertion - block
1373     level elements
1374     @@lang:en
1375     @Main:
1376     my (undef, $source, $current, %opt) = @_;
1377 wakaba 1.4 my %depth = %{$opt{depth} || {}};
1378 wakaba 1.1 my $back_to_section = sub {
1379     my $cur_type = $current->local_name;
1380     while (not (
1381     $cur_type eq 'section'
1382     or $cur_type eq 'body'
1383     or $cur_type eq 'bodytext'
1384 wakaba 1.4 or $cur_type eq 'insert'
1385     or $cur_type eq 'delete'
1386 wakaba 1.1 )
1387     ) {
1388     $current = $current->parent_node;
1389     $cur_type = $current->local_name;
1390     }
1391     delete $depth{list};
1392     };
1393     my $back_to_real_section = sub {
1394     my $cur_type = $current->local_name;
1395     while (not (
1396     $cur_type eq 'section'
1397     or $cur_type eq 'body'
1398 wakaba 1.4 or $cur_type eq 'insert'
1399     or $cur_type eq 'delete'
1400 wakaba 1.1 )
1401     ) {
1402     $current = $current->parent_node;
1403     $cur_type = $current->local_name;
1404     }
1405     delete $depth{bq};
1406     delete $depth{list};
1407     };
1408     while ($$source =~ /\G([^\x0A]*)\x0A/gc) {
1409     my $line = $1;
1410     if ($line eq '') {
1411     $back_to_real_section->();
1412     } elsif ($line =~ s/^([-=]+)\s*//) {
1413     my $list_type = substr ($1, -1) eq '-' ? 'ul' : 'ol';
1414     my $depth = length $1;
1415     my $parent_type = $current->parent_node->local_name;
1416     ## Parent node is list element
1417     if ($parent_type eq 'ul' or $parent_type eq 'ol') {
1418     if ($depth{list} == $depth) {
1419     if ($parent_type eq $list_type) {
1420     $current = $current->parent_node;
1421     } else {
1422     $current = $current->parent_node
1423     ->parent_node
1424     ->append_new_node
1425     (type => '#element',
1426     namespace_uri => $NS_XHTML2,
1427     local_name => $list_type);
1428     }
1429     } elsif ($depth < $depth{list}) {
1430     for ($depth+1..$depth{list}) {
1431     $current = $current->parent_node->parent_node;
1432     }
1433     $current = $current->parent_node;
1434     if ($current->local_name ne $list_type) {
1435     $current = $current->parent_node
1436     ->append_new_node
1437     (type => '#element',
1438     namespace_uri => $NS_XHTML2,
1439     local_name => $list_type);
1440     }
1441     $depth{list} = $depth;
1442     } else { # $depth{list} < $depth
1443     $current = $current->append_new_node
1444     (type => '#element',
1445     namespace_uri => $NS_XHTML2,
1446     local_name => $list_type);
1447     $depth{list}++;
1448     }
1449     ## Parent node is non-list element
1450     } else {
1451     $current = $current->append_new_node (type => '#element',
1452     namespace_uri => $NS_XHTML2,
1453     local_name => $list_type);
1454     $depth{list} = 1;
1455     }
1456     $current->append_text ("\x0A".(" " x $depth{list}));
1457     $current = $current->append_new_node (type => '#element',
1458     namespace_uri => $NS_XHTML2,
1459     local_name => 'li');
1460 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $current, %opt);
1461 wakaba 1.1 } elsif ($line =~ s/^(\*+)\s*//) {
1462     my $depth = length $1;
1463     $back_to_real_section->();
1464     if ($depth <= $depth{section}) {
1465     for ($depth..$depth{section}) {
1466     $back_to_real_section->();
1467     $current = $current->parent_node;
1468     }
1469     $depth{section} = $depth;
1470     } else { # $depth{section} < $depth
1471     for ($depth{section}+2..$depth) {
1472     $current = $current->append_new_node
1473     (type => '#element',
1474     namespace_uri => $NS_XHTML2,
1475     local_name => 'section');
1476     }
1477     $depth{section} = $depth;
1478     }
1479     $current = $current->append_new_node
1480     (type => '#element',
1481     namespace_uri => $NS_XHTML2,
1482     local_name => 'section');
1483     __FUNCPACK__->inline_text_to_xml (\$line =>
1484     $current->append_new_node (type => '#element',
1485     namespace_uri => $NS_XHTML2,
1486 wakaba 1.4 local_name => 'h'), %opt,
1487 wakaba 1.1 );
1488     } elsif ($line =~ s/^(?!>>[0-9])(>+)\s*//) {
1489     my $depth = length $1;
1490     if ($depth <= $depth{bq}) {
1491     for ($depth+1..$depth{bq}) {
1492     $back_to_section->();
1493     $current = $current->parent_node->parent_node;
1494     }
1495     $back_to_section->();
1496     $current->append_text ("\x0A");
1497     $depth{bq} = $depth;
1498     } else { # $depth{bq} < $depth
1499     $back_to_section->();
1500     for ($depth{bq}+1..$depth) {
1501     $current = $current->append_new_node
1502     (type => '#element',
1503     namespace_uri => $NS_XHTML2,
1504     local_name => 'blockquote')
1505     ->append_new_node
1506     (type => '#element',
1507     namespace_uri => $NS_HTML3,
1508     local_name => 'bodytext');
1509     $current->append_text ("\x0A");
1510     }
1511     $depth{bq} = $depth;
1512     }
1513     if (length $line) {
1514     $current = $current->append_new_node
1515     (type => '#element',
1516     namespace_uri => $NS_XHTML2,
1517     local_name => 'p');
1518 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $current, %opt);
1519 wakaba 1.1 }
1520     } elsif ($line =~ s/^(?>:\s*)([^:]+?)\s*:\s*//) {
1521     my $parent_type = $current->local_name;
1522     if ($parent_type eq 'dd') {
1523     $current = $current->parent_node->parent_node;
1524     $current->append_text ("\x0A");
1525     } else { #if ($parent_type ne 'dl') {
1526     $current = $current->append_new_node (type => '#element',
1527     namespace_uri => $NS_XHTML2,
1528     local_name => 'dl');
1529     }
1530     $current = $current->append_new_node
1531     (type => '#element',
1532     namespace_uri => $NS_SW09,
1533     local_name => 'dr');
1534     __FUNCPACK__->inline_text_to_xml (\"$1" =>
1535     $current->append_new_node (type => '#element',
1536     namespace_uri => $NS_XHTML2,
1537 wakaba 1.4 local_name => 'dt'), %opt,
1538 wakaba 1.1 );
1539     $current->append_text ("\x0A");
1540     $current = $current->append_new_node (type => '#element',
1541     namespace_uri => $NS_XHTML2,
1542     local_name => 'dd');
1543 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $current, %opt);
1544 wakaba 1.9 } elsif ($line =~ /^\[(INS|DEL)(?>(\([^()\\]*\))?)\[\s*$/) {
1545 wakaba 1.1 $current->append_text ("\x0A");
1546 wakaba 1.4 my $mod = $current->append_new_node
1547     (type => '#element',
1548     namespace_uri => $NS_SW09,
1549     local_name => {qw/INS insert DEL delete/}->{$1});
1550 wakaba 1.1 $mod->set_attribute (class => $2) if $2;
1551 wakaba 1.4 __FUNCPACK__->block_text_to_xml ($source => $mod, %opt,
1552     'return_by_'.$1 => 1,
1553     depth => \%depth);
1554 wakaba 1.1 } elsif ($line =~ /^\](INS|DEL)\]\s*$/) {
1555     if ($opt{'return_by_'.$1}) {
1556     return;
1557     } else {
1558     ## TODO: warn
1559     }
1560 wakaba 1.10 } elsif ($line =~ /^\[PRE(?>(?>\(((?>[^()\\]*)(?>(?>[^()\\]+|\\.)*))\))?)\[\s*$/) {
1561 wakaba 1.1 $current->append_text ("\x0A");
1562     my $pre = $current->append_new_node (type => '#element',
1563     namespace_uri => $NS_XHTML1,
1564     local_name => 'pre');
1565     $pre->set_attribute (class => $1) if $1;
1566     $pre->set_attribute (space => 'preserve', namespace_uri => NS_xml_URI);
1567     my $f = 1;
1568     while ($$source =~ /\G([^\x0A]*)\x0A/gc) {
1569     my $line = $1;
1570     if ($line =~ /^\]PRE\]\s*$/) {
1571     undef $pre;
1572     last;
1573     } else {
1574     $f ? undef $f : $pre->append_text ("\x0A");
1575 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $pre, %opt);
1576 wakaba 1.1 }
1577     }
1578     if (ref $pre) {
1579     # warn unmatched start-tag
1580     }
1581     } elsif ($line =~ /^\s/) {
1582     $current->append_text ("\x0A");
1583     my $pre = $current->append_new_node (type => '#element',
1584     namespace_uri => $NS_XHTML1,
1585     local_name => 'pre');
1586     $pre->set_attribute (space => 'preserve', namespace_uri => NS_xml_URI);
1587 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $pre, %opt);
1588 wakaba 1.1 while ($$source =~ /\G([^\x0A]*)\x0A/gc) {
1589     my $line = $1;
1590     if (length $line == 0) {
1591     pos ($$source) -= 1;
1592     last;
1593 wakaba 1.4 } elsif ($opt{return_by_INS} and $line =~ /^\]INS\]\s*$/) {
1594     return;
1595     } elsif ($opt{return_by_DEL} and $line =~ /^\]DEL\]\s*$/) {
1596     return;
1597 wakaba 1.1 } else {
1598     $pre->append_text ("\x0A");
1599 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $pre, %opt);
1600 wakaba 1.1 }
1601     }
1602     } elsif ($line =~ /^,/) {
1603     $current->append_text ("\x0A");
1604     my $tbody = $current->append_new_node (type => '#element',
1605     namespace_uri => $NS_XHTML2,
1606     local_name => 'table')
1607     ->append_new_node (type => '#element',
1608     namespace_uri => $NS_XHTML2,
1609     local_name => 'tbody');
1610 wakaba 1.4 __FUNCPACK__->tablerow_text_to_xml (\$line => $tbody, %opt);
1611 wakaba 1.1 while ($$source =~ /\G(,[^\x0A]*)\x0A/gc) {
1612 wakaba 1.4 __FUNCPACK__->tablerow_text_to_xml (\"$1" => $tbody, %opt);
1613 wakaba 1.1 }
1614     } else {
1615     my $current_type = $current->local_name;
1616     if ($current_type eq 'section'
1617     or $current_type eq 'body'
1618     or $current_type eq 'bodytext'
1619 wakaba 1.4 or $current_type eq 'insert'
1620     or $current_type eq 'delete') {
1621 wakaba 1.1 $current->append_text ("\x0A");
1622     if ($line =~ s/^__&&([^&]+)&&__//) {
1623     $current->append_new_node (type => '#element',
1624     namespace_uri => $NS_SW09,
1625     local_name => 'replace')
1626     ->set_attribute (by => $1);
1627     } elsif ($line =~ s/^\[\[$Reg_Form_Content_M\]\]//o) {
1628     for ($current->append_new_node (type => '#element',
1629     namespace_uri => $NS_SW09,
1630     local_name => 'form')) {
1631     $_->set_attribute (id => $1) if $1;
1632     my ($i, $t, $o) = ($2, $3 || '', $4 || '');
1633 wakaba 1.4 s/\\(.)/$1/g for ($i, $t, $o);
1634 wakaba 1.1 $_->set_attribute (input => $i);
1635     $_->set_attribute (template => $t);
1636     $_->set_attribute (option => $o);
1637     }
1638     } elsif ($line =~ s/^\[\[$Reg_Embed_Content_M\]\]//o) {
1639     for ($current->append_new_node (type => '#element',
1640     namespace_uri => $NS_SW09,
1641     local_name => 'form')) {
1642     $_->set_attribute (ref => $1);
1643     $_->set_attribute (id => $2) if $2;
1644     $_->set_attribute (parameter => $3) if defined $3;
1645     }
1646     }
1647 wakaba 1.4 if (length $line) {
1648     $current = $current->append_new_node
1649     (type => '#element',
1650     namespace_uri => $NS_XHTML2,
1651     local_name => 'p');
1652     __FUNCPACK__->inline_text_to_xml (\$line => $current, %opt);
1653     }
1654 wakaba 1.1 } else {
1655 wakaba 1.4 $current->append_text ("\x0A"); # replacement of prev.line's \n
1656     __FUNCPACK__->inline_text_to_xml (\$line => $current, %opt);
1657 wakaba 1.1 }
1658     }
1659     }
1660    
1661     if ($opt{return_by_INS} or $opt{return_by_DEL}) {
1662     # warn
1663     }
1664    
1665     Function:
1666     @Name: tablerow_text_to_xml
1667     @Description:
1668     @@@:
1669     SuikaWiki/0.9 text format to XML representation - table row
1670     @@lang:en
1671     @Main:
1672     my (undef, $source => $current, %opt) = @_;
1673     $current->append_text ("\x0A");
1674     $current = $current->append_new_node (type => '#element',
1675     namespace_uri => $NS_XHTML2,
1676     local_name => 'tr');
1677     my $prev_cell;
1678     while ($$source =~ /\G,\s*/gc) {
1679 wakaba 1.4 $$source =~ /\G([^,"][^,]*|"(?>[^"\\]*)(?>(?>[^"\\]+|\\.)*)"\s*)/gc;
1680 wakaba 1.1 my $cell = $1;
1681     if ($cell =~ s/^"//) {
1682     $cell =~ s/"\s*$//g;
1683     $cell =~ s/\\(.)/$1/g;
1684     } else {
1685     $cell =~ s/\s+$//g;
1686     if ($cell eq '==') {
1687     if (ref $prev_cell) {
1688     $prev_cell->set_attribute (colspan =>
1689     $prev_cell->get_attribute_value ('colspan', default => 1)
1690     + 1);
1691     next;
1692     } else {
1693     # TODO: warn
1694     }
1695     }
1696     }
1697     $prev_cell = $current->append_new_node
1698     (type => '#element',
1699     namespace_uri => $NS_XHTML2,
1700     local_name => 'td');
1701 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$cell => $prev_cell, %opt);
1702 wakaba 1.1 }
1703     # TODO: warn
1704    
1705     Function:
1706     @Name: inline_text_to_xml
1707     @Description:
1708     @@@:
1709     SuikaWiki/0.9 text format to XML representation - inline level elements
1710     @@lang:en
1711     @Main:
1712 wakaba 1.9 my (undef, $source => $current, %opt) = @_;
1713    
1714 wakaba 1.1 my $ElementDef = {
1715 wakaba 1.5 ABBR => {ln => 'abbr', ns_uri => $NS_XHTML2},
1716 wakaba 1.1 CODE => {ln => 'code', ns_uri => $NS_XHTML2},
1717     DEL => {ln => 'del', ns_uri => $NS_XHTML1},
1718     DFN => {ln => 'dfn', ns_uri => $NS_XHTML2},
1719     INS => {ln => 'ins', ns_uri => $NS_XHTML1},
1720     KBD => {ln => 'kbd', ns_uri => $NS_XHTML2},
1721     Q => {ln => 'q', ns_uri => $NS_XHTML1},
1722     RUBY => {ln => 'ruby', ns_uri => $NS_XHTML2},
1723     RUBYB => {ln => 'rubyb', ns_uri => $NS_SW09},
1724     SAMP => {ln => 'samp', ns_uri => $NS_XHTML2},
1725     SUB => {ln => 'sub', ns_uri => $NS_XHTML2},
1726     SUP => {ln => 'sup', ns_uri => $NS_XHTML2},
1727 wakaba 1.16 VAR => {ln => 'var', ns_uri => $NS_XHTML2},
1728 wakaba 1.1 WEAK => {ln => 'weak', ns_uri => $NS_SW09},
1729 wakaba 1.19 AA => {ln => 'aa', ns_uri => $NS_AA}, ## SuikaWiki/0.10
1730 wakaba 1.16 CITE => {ln => 'cite', ns_uri => $NS_XHTML2}, ## SuikaWiki/0.10
1731 wakaba 1.19 CSECTION => {ln => 'csection', ns_uri => $NS_SW010}, ## SuikaWiki/0.10
1732 wakaba 1.16 KEY => {ln => 'key', ns_uri => $NS_SW010}, ## SuikaWiki/0.10
1733 wakaba 1.19 QN => {ln => 'qn', ns_uri => $NS_SW010}, ## SuikaWiki/0.10
1734 wakaba 1.16 SRC => {ln => 'src', ns_uri => $NS_SW010}, ## SuikaWiki/0.10
1735 wakaba 1.1 anchor => {ln => 'anchor', ns_uri => $NS_SW09, has_fragment_no => 1},
1736     del => {has_cite => 1},
1737     ins => {has_cite => 1},
1738 wakaba 1.19 nsuri => {ln => 'nsuri', ns_uri => $NS_SW010}, ## SuikaWiki/0.10
1739 wakaba 1.1 q => {has_cite => 1},
1740 wakaba 1.19 qname => {ln => 'qname', ns_uri => $NS_SW010}, ## SuikaWiki/0.10
1741 wakaba 1.1 rb => {ln => 'rb', ns_uri => $NS_XHTML2, is_nested => 1},
1742     rt => {ln => 'rt', ns_uri => $NS_XHTML2, is_nested => 1},
1743     };
1744    
1745     if ($$source =~ /\G\[([0-9]+)\]/gc) {
1746     for ($current->append_new_node (type => '#element',
1747     namespace_uri => $NS_SW09,
1748     local_name => 'anchor-end')) {
1749 wakaba 1.4 $_->set_attribute (anchor => 0+$1,
1750     namespace_uri => $NS_SW09);
1751 wakaba 1.1 $_->append_text ('['.$1.']');
1752     }
1753     }
1754     my $depth = 0;
1755     while (pos $$source < length $$source) {
1756     if ($$source =~ /\G\[\[(?=\#)/gc) {
1757     my $form = $current->append_new_node (type => '#element',
1758     namespace_uri => $NS_SW09,
1759     local_name => 'form');
1760     if ($$source =~ /\G$Reg_Form_Content_M\]\]/ogc) {
1761     $form->set_attribute (id => $1) if $1;
1762 wakaba 1.4 my ($i, $t, $o) = ($2, $3, $4);
1763     s/\\(.)/$1/g for ($i, $t, $o);
1764     $form->set_attribute (input => $i);
1765     $form->set_attribute (template => $t);
1766     $form->set_attribute (option => $o);
1767 wakaba 1.1 } elsif ($$source =~ /\G$Reg_Embed_Content_M\]\]/ogc) {
1768     $form->set_attribute (ref => $1);
1769     $form->set_attribute (id => $2) if $2;
1770     $form->set_attribute (parameter => $3) if defined $3;
1771     } else {
1772     ## TODO: error
1773 wakaba 1.4 SuikaWiki::Plugin->module_package('Error')->report_error_simple ($opt{opt}->{o}->{wiki}, InvalidForm => substr ($$source, pos ($$source)));
1774 wakaba 1.1 }
1775 wakaba 1.10 } elsif ($$source =~ /\G\[(?>([A-Z]+)(?>\(((?>[^()\\]*)(?>(?>[^()\\]+|\\.)*))\))?)?\[/gc) {
1776 wakaba 1.1 my $type = $1 || 'anchor';
1777     my $param = $2;
1778     my $def = $ElementDef->{ $type };
1779     unless ($def) {
1780     ## TODO: error
1781 wakaba 1.4 $def = $ElementDef->{CODE};
1782 wakaba 1.1 }
1783     $current = $current->append_new_node (type => '#element',
1784     namespace_uri => $def->{ns_uri},
1785     local_name => $def->{ln});
1786     $current->set_attribute (class => $param) if $param;
1787     if ($type eq 'RUBY' or $type eq 'RUBYB'
1788     or $type eq 'ABBR') {
1789     $current = $current->append_new_node
1790     (type => '#element',
1791     namespace_uri => $ElementDef->{rb}->{ns_uri},
1792     local_name => $ElementDef->{rb}->{ln});
1793 wakaba 1.19 } elsif ($type eq 'QN') {
1794     $current = $current->append_new_node
1795     (type => '#element',
1796     namespace_uri => $ElementDef->{qname}->{ns_uri},
1797     local_name => $ElementDef->{qname}->{ln});
1798 wakaba 1.1 }
1799     $depth++;
1800     } elsif ($$source =~ /\G\](?> <([0-9A-Za-z_+.%-]+):($Reg_URI_Opaque)>
1801     \ | >>([0-9]+) )?
1802     \ \]/gcox) {
1803     my ($scheme, $opaque, $anchor) = ($1, $2, $3);
1804     unless ($depth) {
1805     $current->append_text (substr ($$source, $-[0], $+[0]-$-[0]));
1806     next;
1807     }
1808     my $def = $ElementDef->{$current->local_name} || {};
1809     if (defined $anchor) {
1810 wakaba 1.4 $current->set_attribute (anchor => $anchor + 0,
1811     namespace_uri => $NS_SW09);
1812     } elsif (defined $scheme) {
1813     if ($scheme =~ /[A-Z]/) {
1814     $current->set_attribute (resScheme => $scheme,
1815     namespace_uri => $NS_SW09);
1816     $current->set_attribute (resParameter => $opaque,
1817     namespace_uri => $NS_SW09);
1818 wakaba 1.1 } else {
1819 wakaba 1.4 $current->set_attribute (resScheme => 'URI',
1820 wakaba 1.1 namespace_uri => $NS_SW09);
1821 wakaba 1.4 $current->set_attribute (resParameter => "$scheme:$opaque",
1822 wakaba 1.1 namespace_uri => $NS_SW09);
1823     }
1824     }
1825     $current = $current->parent_node;
1826     $current = $current->parent_node if $def->{is_nested};
1827     $depth--;
1828 wakaba 1.4 } elsif ($$source =~ /\G\]\s*\[/gc) {
1829 wakaba 1.1 if ($current->local_name eq 'rb' or $current->local_name eq 'rt') {
1830     $current = $current->parent_node
1831     ->append_new_node
1832     (type => '#element',
1833     namespace_uri => $ElementDef->{rt}->{ns_uri},
1834     local_name => $ElementDef->{rt}->{ln});
1835 wakaba 1.19 } elsif ($current->local_name eq 'qname') {
1836     $current = $current->parent_node
1837     ->append_new_node
1838     (type => '#element',
1839     namespace_uri => $ElementDef->{nsuri}->{ns_uri},
1840     local_name => $ElementDef->{nsuri}->{ln});
1841 wakaba 1.1 } else {
1842 wakaba 1.10 $current->append_text (substr ($$source, $-[0], $+[0]-$-[0]-1));
1843     pos ($$source)--;
1844 wakaba 1.1 }
1845     } elsif ($$source =~ /\G'''?/gc) {
1846     my $type = $+[0] - $-[0] == 3 ? 'strong' : 'em';
1847     if ($current->local_name eq $type) {
1848     $current = $current->parent_node;
1849     } else {
1850     $current = $current->append_new_node
1851     (type => '#element',
1852     namespace_uri => $NS_XHTML2,
1853     local_name => $type);
1854     }
1855 wakaba 1.9 } elsif ($$source =~ /\G<([0-9A-Za-z_+.%-]+):($Reg_URI_Opaque)>/gco) {
1856 wakaba 1.1 my ($scheme, $data) = ($1, $2);
1857     my $link = $current->append_new_node
1858     (type => '#element',
1859     namespace_uri => $NS_SW09,
1860 wakaba 1.2 local_name => 'anchor-external');
1861 wakaba 1.1 if (substr ($scheme, 0, 1) =~ /[A-Z]/) {
1862 wakaba 1.4 $link->set_attribute (resScheme => $scheme,
1863     namespace_uri => $NS_SW09);
1864     $link->set_attribute (resParameter => $data,
1865     namespace_uri => $NS_SW09);
1866 wakaba 1.1 } else { # URI Reference
1867 wakaba 1.4 $link->set_attribute (resScheme => 'URI',
1868     namespace_uri => $NS_SW09);
1869     $link->set_attribute (resParameter => $scheme.':'.$data,
1870     namespace_uri => $NS_SW09);
1871 wakaba 1.1 }
1872 wakaba 1.3 $link->append_text ($scheme.':'.$data);
1873 wakaba 1.1 } elsif ($$source =~ /\G__&&/gc) {
1874     if ($$source =~ /\G([^&]+)&&__/gc) {
1875     $current->append_new_node
1876     (type => '#element',
1877     namespace_uri => $NS_SW09,
1878 wakaba 1.2 local_name => 'replace')
1879 wakaba 1.1 ->set_attribute (by => $1);
1880     } else {
1881 wakaba 1.2 $current->append_text ('__&&');
1882 wakaba 1.1 }
1883     } elsif ($$source =~ /\G((?>
1884 wakaba 1.4 [^'\[\]<>_]+
1885 wakaba 1.1 | ' (?!')
1886 wakaba 1.4 | \[ (?!\[|[A-Z]+(?>\([^()\\]*
1887     (?>[^()\\]+|\\.)*\))?\[)
1888 wakaba 1.1 | \] (?! \]
1889     | >>[0-9]+\]
1890     | <[0-9A-Za-z_+.%-]+:$Reg_URI_Opaque>\]
1891     | \s*\[ )
1892     | < (?![0-9A-Za-z_+.%-]+:$Reg_URI_Opaque>)
1893     | > (?!>[0-9])
1894     | _ (?!_&&)
1895     )+)/oxgc) {
1896     $current->append_text ($1);
1897     } elsif ($$source =~ /\G>>([0-9]+)/gc) {
1898     for ($current->append_new_node (type => '#element',
1899     namespace_uri => $NS_SW09,
1900 wakaba 1.2 local_name => 'anchor-internal')) {
1901 wakaba 1.4 $_->set_attribute (anchor => 0+$1,
1902     namespace_uri => $NS_SW09);
1903 wakaba 1.1 $_->append_text ('>>'.$1);
1904     }
1905     } else {
1906 wakaba 1.4 CORE::die "Implementation buggy: ", substr ($$source, pos $$source);
1907 wakaba 1.1 }
1908     }
1909    
1910 wakaba 1.2 FormattingRule:
1911 wakaba 1.3 @Category[list]:
1912     page-link
1913     link-to-resource
1914 wakaba 1.2 @Name: sw09--link-anchor-content
1915     @Description:
1916     @@@:
1917     Output content of the anchor element
1918     @@lang:en
1919     @Formatting:
1920     if ($o->{var}->{sw09__anchor_content}) {
1921     $o->{var}->{sw09__anchor_content}->($p->{-parent});
1922     } else {
1923 wakaba 1.9 $WIKIRESOURCE->append_tree
1924 wakaba 1.4 (name => 'Link:SuikaWiki/0.9:link-anchor-content:InvalidContext',
1925     param => $o,
1926     -parent => $p->{-parent},
1927     wiki => $o->{wiki});
1928 wakaba 1.2 }
1929    
1930     Resource:
1931     @Link:SuikaWiki/0.9:link-anchor-content:InvalidContext:
1932 wakaba 1.4 @@@: %percent;sw09--link-anchor-content; cannot be used in this context.
1933 wakaba 1.2 @@lang:en
1934 wakaba 1.3 @Link:SuikaWiki/0.9:toResource:SourceLabel:
1935     @@@:
1936     %select_link_resource_scheme (
1937     URI => {<%link-to-it(
1938     label=>{%link-resource-parameters;}p,
1939     );>},
1940 wakaba 1.15 IW => {%iw--source-label (default => {<%link-to-it (
1941     label => {%link-resource-scheme;:%link-resource-parameters;}p,
1942     );});},
1943 wakaba 1.3 MAIL => {<%link-to-it(
1944     label => {%link-resource-parameters;}p,
1945     description
1946     => {%res (name=>{Link:MailAddress=});<%link-resource-parameters;>}p,
1947     );>},
1948     otherwise => {<%link-to-it(
1949     label => {%sw09--link-anchor-content;}p,
1950     description => {%res (name=>{Link:URIReference=});<%uri-reference;>}p,
1951     );>},
1952     );
1953     @@lang:en
1954 wakaba 1.2 @Link:SuikaWiki/0.9:toWikiPage:SourceLabel:
1955     @@@:
1956     %link-to-it(
1957     label=>{%sw09--link-anchor-content;%if-linked-wikipage-exist(
1958     true=>{%if-link-has-dest-anchor-no(true=>{>>%link-dest-anchor-no;});},
1959     false=>{%res(name=>{Link:toWikiPage:NotExist:Mark});}
1960     );}p,
1961     description=>{%page-name(absolute);; %if-linked-wikipage-exist(
1962     true=>{%page-headline;},
1963     false=>{(%res(name=>{Link:toWikiPage:NotExist:Description});)},
1964     );}p,
1965     class=>{%if-linked-wikipage-exist(false=>{not-exist});}p,
1966     );
1967 wakaba 1.5 @SuikaWiki/0.9:form:comment:input:
1968     %line (content => {%textarea (id=>msg,size=>20,lines=>3);}p);
1969     %line (content => {
1970     (%text (description => {%res (name => {Form:Description:HumanName});}p,
1971     id => name, size => 6);
1972     [%text (description =>
1973     {%res (name => {Form:Description:MailAddress});}p,
1974     id => mail, size => 5);]
1975     %check (default, id => record-date,
1976     label => {%res (name => {Form:Label:LogDate});}p,
1977     description => {%res (name => {Form:Description:LogDate});}p);)
1978     %submit (label => {%res (name => {Form:Label:Add});}p,
1979     description => {%res (name => {Form:Description:Add});}p);
1980     %we--update-lastmodified-datetime;
1981     }p);
1982     @SuikaWiki/0.9:form:comment:template:
1983     %n
1984     ;[%index;]%n
1985     ;%text(source=>msg);%n;(%name;%text(source=>mail,prefix=>" [",suffix=>"]");%iif(source=>record-date,true=>" [WEAK[%date;]]");)%n;
1986     @SuikaWiki/0.9:form:comment:option:
1987     %require (msg);
1988     @SuikaWiki/0.9:form:footannotate:input:
1989     %line (content => {%textarea (id=>msg,size=>20,lines=>3);}p);
1990     %line (content => {
1991     (%text (description => {%res (name => {Form:Description:HumanName});}p,
1992     id => name, size => 6);
1993     [%text (description =>
1994     {%res (name => {Form:Description:MailAddress});}p,
1995     id => mail, size => 5);]
1996     %check (default, id => record-date,
1997     label => {%res (name => {Form:Label:LogDate});}p,
1998     description => {%res (name => {Form:Description:LogDate});}p);)
1999     %submit (label => {%res (name => {Form:Label:Add});}p,
2000     description => {%res (name => {Form:Description:Add});}p);
2001     %we--update-lastmodified-datetime;
2002     }p);
2003     @SuikaWiki/0.9:form:footannotate:template:
2004     %n
2005     ;[%index;]%n
2006     ;%text(source=>msg);%n
2007     ;(%name;%text(source=>mail,prefix=>" [",suffix=>"]");%iif(source=>record-date,true=>" [WEAK[%date;]]");)%n;
2008     @SuikaWiki/0.9:form:footannotate:option:
2009     %require (msg);
2010 wakaba 1.13 @WikiFormat:MediaType:Description:IMT:text/x-suikawiki;version="0.9"##:
2011     @@@: SuikaWiki/0.9 (text format), as used in SuikaWiki 2
2012     @@lang: en
2013 wakaba 1.16 @WikiFormat:MediaType:Description:IMT:text/x-suikawiki;version="0.10"##:
2014     @@@: SuikaWiki/0.10 (text format)
2015     @@lang: en
2016 wakaba 1.13 @WikiFormat:MediaType:Label:IMT:text/x-suikawiki;version="0.9"##:
2017 wakaba 1.16 @@@: SuikaWiki/0.9 (text)
2018     @@lang: en
2019     @WikiFormat:MediaType:Label:IMT:text/x-suikawiki;version="0.10"##:
2020     @@@: SuikaWiki/0.10 (text)
2021 wakaba 1.13 @@lang: en
2022     @WikiFormat:MediaType:Description:MAGIC:SuikaWiki/0.9##:
2023     @@@: SuikaWiki/0.9 (text format), as used in SuikaWiki 2
2024     @@lang: en
2025 wakaba 1.16 @WikiFormat:MediaType:Description:MAGIC:SuikaWiki/0.10##:
2026     @@@: SuikaWiki/0.10 (text format)
2027     @@lang: en
2028 wakaba 1.13 @WikiFormat:MediaType:Label:MAGIC:SuikaWiki/0.9##:
2029     @@@: SuikaWiki/0.9 (text format)
2030 wakaba 1.16 @@lang: en
2031     @WikiFormat:MediaType:Label:MAGIC:SuikaWiki/0.10##:
2032     @@@: SuikaWiki/0.10 (text)
2033 wakaba 1.13 @@lang: en
2034    
2035 wakaba 1.3
2036 wakaba 1.4 Error:
2037     @Name: text_parse
2038     @Definition:
2039     @@INLINE_NO_CLOSE_TAG:
2040     @@@description:
2041     Close tag of element "%t (name => element_type);" not found.
2042     @@@level: non-fatal
2043     @@BLOCK_NO_CLOSE_TAG:
2044     @@@description:
2045     Close tag of element "%t (name => element_type);" not found.
2046     @@@level: non-fatal
2047     @@INVALID_FORM:
2048     @@@description:
2049     Invalid syntax of WikiForm
2050     @@@level: non-fatal
2051    
2052     Error:
2053     @Name: xml_to_text
2054     @IsA[list]:
2055     ::SuikaWiki::Format::
2056     @Definition:
2057     @@
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24