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