/[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.4 - (hide annotations) (download)
Fri Jan 16 07:58:28 2004 UTC (20 years, 9 months ago) by wakaba
Branch: MAIN
Changes since 1.3: +847 -117 lines
WikiForm posting implemented

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24