SuikaWiki/Plugin/WikiResource.wp2

#?SuikaWikiConfig/2.0

Plugin:
  @Name: WikiResource
  @Description:
    @@@: Wiki resource text support
    @@lang:en
  @License: %%Perl%%
  @Author:
    @@Name:
      @@@@: Wakaba
      @@@lang:ja
      @@@script:Latn
    @@Mail[list]: w@suika.fam.cx
  @Date.RCS:
    $Date: 2004/02/18 07:18:30 $
  @RequiredPlugin[list]:
    SuikaWikiConst09
  @Use:
    use Message::Util::Error;
    my $RESOURCE_CACHE;
    our $NestLevel;

PluginConst:
  @NS_XHTML1:
    http://www.w3.org/1999/xhtml

FormattingRule:
  @Category[list]:
    view
    view-resource
    page-link
    link-to-resource
    form-input
    form-template
  @Name: res
  @Description:
    @@@: Resource
    @@lang: en
  @Parameter:
    @@Name: name
    @@Type: CDATA
    @@Default: #REQUIRED
    @@Description:
      @@@@: Resource name
      @@@lang:en
  @Formatting:
    __ATTRTEXT:%name__;
    __FUNCPACK__->get (name => $p->{name},
                       wiki => $o->{wiki},
                       formatter_context => 'view_resource',
                       formatter_option => {param => $o,
                                            -parent => $p->{-parent}});

FormattingRule:
  @Category[list]:
    view
    view-resource
    page-link
    link-to-resource
    form-input
    form-template
  @Name: resource-as-plain-text
  @Description:
    @@@: Resource
    @@lang: en
  @Parameter:
    @@Name: name
    @@Type: CDATA
    @@Default: #REQUIRED
    @@Description:
      @@@@: Resource name
      @@@lang:en
  @Formatting:
    __ATTRTEXT:%name__;
    __FUNCPACK__->get (name => $p->{name},
                       wiki => $o->{wiki});

Function:
  @Name: logging_template_error
  @Description:
    @@@:
      Logging formatting-template-text error
    @@lang:en
  @Main:
    my (undef, $err, $wiki, %opt) = @_;
    my $error = {};
    my $dl = $error->{description}
           = new Message::Markup::XML::Node
               (type => '#element',
                namespace_uri => $NS_XHTML1,
                local_name => 'dl');
## TODO: Use resource
    $dl->append_new_node (type => '#element',
                          namespace_uri => $NS_XHTML1,
                          local_name => 'dt')
       ->append_text ('Resource name');
    $dl->append_new_node (type => '#element',
                          namespace_uri => $NS_XHTML1,
                          local_name => 'dd')
       ->append_text ($opt{resource_name});
    $dl->append_new_node (type => '#element',
                          namespace_uri => $NS_XHTML1,
                          local_name => 'dt')
       ->append_text ('Error condition');
    $dl->append_new_node (type => '#element',
                          namespace_uri => $NS_XHTML1,
                          local_name => 'dd')
       ->append_text ($err->text);
    $dl->append_new_node (type => '#element',
                          namespace_uri => $NS_XHTML1,
                          local_name => 'dt')
       ->append_text ('Formatting context');
    $dl->append_new_node (type => '#element',
                          namespace_uri => $NS_XHTML1,
                          local_name => 'dd')
       ->append_text (qq($err->{-formatter}->{-category_name}));

    push @{$wiki->{var}->{error}||=[]}, $error;

Function:
  @Name: get_text
  @Main:
    my (undef, %opt) = @_;
    __FUNCPACK__->get (%opt);
## TODO: Implements formatter.

Function:
  @Name: append_node
  @Main:
    my (undef, %opt) = @_;
    __FUNCPACK__->get (%opt, formatter_context => 'view_resource',
                             formatter_option => {param => $opt{param},
                                                  -parent => $opt{parent}});

Function:
  @Name: get_op
  @Description:
    @@@: Simple version of "get"
    @@lang: en
  @Main:
    my (undef, $name, $o, $parent, %opt) = @_;
    __FUNCPACK__->get (%opt, name => $name, o => $o, wiki => $o->{wiki},
                       formatter_context => 'view_resource',
                       formatter_option => {param => $o,
                                            -parent => $parent});

Function:
  @Name: get
  @Main:
    my (undef, %opt) = @_;
    local $NestLevel = $NestLevel + 1;
    if (1000 < $NestLevel) {
      SuikaWiki::Plugin->module_package ('Error')
 ## TODO:
                       ->report_error_simple
                           ($opt{wiki} || $opt{o}->{wiki},
                            'Condition' => 'Resource nesting too deep',
                            ResourceName => $opt{name},
                            -trace => 1);
      return defined $opt{default} ? $opt{default} : $opt{name};
    }
    

    my $text = __FUNCPACK__->temp_get_resource_text
                               (resource_ns => $opt{wiki}->name
                                  ($opt{ns} || [qw/Wiki Resource/]),
                                name => $opt{name},
                                wiki => $opt{wiki});
    if (defined $text) {
      # 
    } elsif (defined $opt{default}) {
      $text = $opt{default};
    } else {
      $text = $opt{name};
    }
    
    return $text unless $opt{formatter_context};
    try {
      $text = SuikaWiki::Plugin->formatter ($opt{formatter_context})
                               ->replace ($text, %{$opt{formatter_option}});
    } catch Message::Util::Formatter::error with {
      my $err = shift;
      if ($err->{-formatter}->{-category_name} eq $opt{formatter_context}) {
        __FUNCPACK__->logging_template_error ($err,
                                              $err->{-option}->{param}->{wiki},
                                              resource_name => $opt{name});
        undef;
      } else {
        $err->throw;
      }
    };
    return $text;

Function:
  @Name: temp_get_resource_text
  @Main:
    my (undef, %opt) = @_;
    CORE::die "Buggy implementation: \$opt{wiki} required ".Carp::longmess()
      unless ref $opt{wiki};
    $opt{accept_language} ||= __FUNCPACK__->temp_get_accept_language (%opt);
    $opt{resource} ||= $RESOURCE_CACHE ||= {};
    my $v;
    my $SWC09;
    try {
      $SWC09 = SuikaWiki::Plugin->module_package ('SuikaWikiConst09');
    } catch SuikaWiki::Plugin::error with {
      my $err = shift;
      $err->raise unless $err->{-type} eq 'PLUGIN_NOT_FOUND';
    };
    for my $lang (sort {$opt{accept_language}->{$b} <=>
                        $opt{accept_language}->{$a}}
                  grep {$opt{accept_language}->{$_} != 0}
                  keys %{$opt{accept_language}}) {
      while (length $lang) {
        unless ($opt{accept_language}->{defined $opt{accept_language}->{$lang}
                                          ? $lang : '*'} == 0) {
          ## WikiPage defined resource text (SuikaWikiConst/0.9)
          if (not $opt{resource}->{$lang} and ref $opt{wiki}->{db} and $SWC09) {
            try {
              $v = $opt{wiki}->{db}->get (content => [@{$opt{resource_ns}}, $lang]);
            } catch SuikaWiki::DB::Util::Error with {
              my $err = shift;
              $err->throw if $err->{-type} eq 'ERROR_REPORTED';
              $v = undef;
            };
            $opt{resource}->{$lang} = {};
            $SWC09->text_to_hash (text => \$v,
                                             hash => $opt{resource}->{$lang});
          }
          $v = $opt{resource}->{$lang}->{$opt{name}};
          last if defined $v;
          ## WikiPlugin defined resource text (SuikaWiki 3 WikiPlugin)
          if (defined $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$opt{name}}) {
            $v = $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$opt{name}};
            last;
          }
        }
        $lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
      }
      last if defined $v;
    } # Accepted languages
    if (defined $v) {
      return $v;
    } else {
      ## Plugin defined resource text or undef
      return $SuikaWiki::Plugin::Resource::BaseResource->{und}->{''}->{$opt{name}};
    }

Function:
  @Name: temp_get_language_resource_from_array
  @Main:
    my (undef, %opt) = @_;
    CORE::die "Buggy implementation: \$opt{o} required ".Carp::longmess()
      unless ref $opt{o};
    $opt{source} ||= [];
    if (@{$opt{source}} < 2) {
      return ($opt{source} || [])->[0];
    }
    $opt{accept_language} ||= __FUNCPACK__->temp_get_accept_language
                                              (wiki => $opt{o}->{wiki}, %opt);
    my $und;
    for my $lang (sort {$opt{accept_language}->{$b} <=>
                        $opt{accept_language}->{$a}}
                  grep {$opt{accept_language}->{$_} != 0}
                  keys %{$opt{accept_language}}) {
      while (length $lang) {
        unless ($opt{accept_language}->{defined $opt{accept_language}->{$lang}
                                          ? $lang : '*'} == 0) {
          for (@{$opt{source}}) {
            if ($_->[1] eq $lang) {
              return $_; ## TODO: Script support
            } elsif ($_->[1] eq 'und') {
              $und = $_;
            }
          }
        }
        $lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
      }
    } # Accepted languages
    return $und || [];

Function:
  @Name: temp_get_accept_language
  @Main:
    my (undef, %opt) = @_;

    ## Accept language specification
    my $alang;
    if ($opt{wiki}->{input}) {
      $alang = $opt{wiki}->{input}->meta_variable ('HTTP_ACCEPT_LANGUAGE');
    }
    $alang ||= q<i-default;q=1.0,en;q=0.9,ja;q=0.8,*;q=0.001>;
    
    ## Old user agent support
    my %alang = (ja => 0.0002, en => 0.0001);
    if ($opt{wiki}->{var}->{client}->{user_agent_name} =~ m#^Mozilla/0\.#) {
            $alang{ja} = 0.00001;
    }
    
    ## Parse accept language specification
    my $i = 0.1;
    for (split /\s*,\s*/, $alang) {
      tr/\x09\x0A\x0D\x20//d;
            if (/((?:(?!;q=).)+)(?:;q="?([0-9.]+)"?)?/) {
              my $l = lc $1; $l =~ tr/\x22\x5C//d;
              $alang{$l} = (defined $2 ? $2 : 1.000)*1000;
              $alang{$l} += $i unless $alang{$l} == 0;
              $i -= 0.001;
            }
    }
    return \%alang;
1	#?SuikaWikiConfig/2.0
2
3	Plugin:
4	@Name: WikiResource
5	@Description:
6	@@@: Wiki resource text support
7	@@lang:en
8	@License: %%Perl%%
9	@Author:
10	@@Name:
11	@@@@: Wakaba
12	@@@lang:ja
13	@@@script:Latn
14	@@Mail[list]: w@suika.fam.cx
15	@Date.RCS:
16	$Date: 2004/02/18 07:18:30 $
17	@RequiredPlugin[list]:
18	SuikaWikiConst09
19	@Use:
20	use Message::Util::Error;
21	my $RESOURCE_CACHE;
22	our $NestLevel;
23
24	PluginConst:
25	@NS_XHTML1:
26	http://www.w3.org/1999/xhtml
27
28	FormattingRule:
29	@Category[list]:
30	view
31	view-resource
32	page-link
33	link-to-resource
34	form-input
35	form-template
36	@Name: res
37	@Description:
38	@@@: Resource
39	@@lang: en
40	@Parameter:
41	@@Name: name
42	@@Type: CDATA
43	@@Default: #REQUIRED
44	@@Description:
45	@@@@: Resource name
46	@@@lang:en
47	@Formatting:
48	__ATTRTEXT:%name__;
49	__FUNCPACK__->get (name => $p->{name},
50	wiki => $o->{wiki},
51	formatter_context => 'view_resource',
52	formatter_option => {param => $o,
53	-parent => $p->{-parent}});
54
55	FormattingRule:
56	@Category[list]:
57	view
58	view-resource
59	page-link
60	link-to-resource
61	form-input
62	form-template
63	@Name: resource-as-plain-text
64	@Description:
65	@@@: Resource
66	@@lang: en
67	@Parameter:
68	@@Name: name
69	@@Type: CDATA
70	@@Default: #REQUIRED
71	@@Description:
72	@@@@: Resource name
73	@@@lang:en
74	@Formatting:
75	__ATTRTEXT:%name__;
76	__FUNCPACK__->get (name => $p->{name},
77	wiki => $o->{wiki});
78
79	Function:
80	@Name: logging_template_error
81	@Description:
82	@@@:
83	Logging formatting-template-text error
84	@@lang:en
85	@Main:
86	my (undef, $err, $wiki, %opt) = @_;
87	my $error = {};
88	my $dl = $error->{description}
89	= new Message::Markup::XML::Node
90	(type => '#element',
91	namespace_uri => $NS_XHTML1,
92	local_name => 'dl');
93	## TODO: Use resource
94	$dl->append_new_node (type => '#element',
95	namespace_uri => $NS_XHTML1,
96	local_name => 'dt')
97	->append_text ('Resource name');
98	$dl->append_new_node (type => '#element',
99	namespace_uri => $NS_XHTML1,
100	local_name => 'dd')
101	->append_text ($opt{resource_name});
102	$dl->append_new_node (type => '#element',
103	namespace_uri => $NS_XHTML1,
104	local_name => 'dt')
105	->append_text ('Error condition');
106	$dl->append_new_node (type => '#element',
107	namespace_uri => $NS_XHTML1,
108	local_name => 'dd')
109	->append_text ($err->text);
110	$dl->append_new_node (type => '#element',
111	namespace_uri => $NS_XHTML1,
112	local_name => 'dt')
113	->append_text ('Formatting context');
114	$dl->append_new_node (type => '#element',
115	namespace_uri => $NS_XHTML1,
116	local_name => 'dd')
117	->append_text (qq($err->{-formatter}->{-category_name}));
118
119	push @{$wiki->{var}->{error}\|\|=[]}, $error;
120
121	Function:
122	@Name: get_text
123	@Main:
124	my (undef, %opt) = @_;
125	__FUNCPACK__->get (%opt);
126	## TODO: Implements formatter.
127
128	Function:
129	@Name: append_node
130	@Main:
131	my (undef, %opt) = @_;
132	__FUNCPACK__->get (%opt, formatter_context => 'view_resource',
133	formatter_option => {param => $opt{param},
134	-parent => $opt{parent}});
135
136	Function:
137	@Name: get_op
138	@Description:
139	@@@: Simple version of "get"
140	@@lang: en
141	@Main:
142	my (undef, $name, $o, $parent, %opt) = @_;
143	__FUNCPACK__->get (%opt, name => $name, o => $o, wiki => $o->{wiki},
144	formatter_context => 'view_resource',
145	formatter_option => {param => $o,
146	-parent => $parent});
147
148	Function:
149	@Name: get
150	@Main:
151	my (undef, %opt) = @_;
152	local $NestLevel = $NestLevel + 1;
153	if (1000 < $NestLevel) {
154	SuikaWiki::Plugin->module_package ('Error')
155	## TODO:
156	->report_error_simple
157	($opt{wiki} \|\| $opt{o}->{wiki},
158	'Condition' => 'Resource nesting too deep',
159	ResourceName => $opt{name},
160	-trace => 1);
161	return defined $opt{default} ? $opt{default} : $opt{name};
162	}
163
164
165
166	my $text = __FUNCPACK__->temp_get_resource_text
167	(resource_ns => $opt{wiki}->name
168	($opt{ns} \|\| [qw/Wiki Resource/]),
169	name => $opt{name},
170	wiki => $opt{wiki});
171	if (defined $text) {
172	#
173	} elsif (defined $opt{default}) {
174	$text = $opt{default};
175	} else {
176	$text = $opt{name};
177	}
178
179	return $text unless $opt{formatter_context};
180	try {
181	$text = SuikaWiki::Plugin->formatter ($opt{formatter_context})
182	->replace ($text, %{$opt{formatter_option}});
183	} catch Message::Util::Formatter::error with {
184	my $err = shift;
185	if ($err->{-formatter}->{-category_name} eq $opt{formatter_context}) {
186	__FUNCPACK__->logging_template_error ($err,
187	$err->{-option}->{param}->{wiki},
188	resource_name => $opt{name});
189	undef;
190	} else {
191	$err->throw;
192	}
193	};
194	return $text;
195
196	Function:
197	@Name: temp_get_resource_text
198	@Main:
199	my (undef, %opt) = @_;
200	CORE::die "Buggy implementation: \$opt{wiki} required ".Carp::longmess()
201	unless ref $opt{wiki};
202	$opt{accept_language} \|\|= __FUNCPACK__->temp_get_accept_language (%opt);
203	$opt{resource} \|\|= $RESOURCE_CACHE \|\|= {};
204	my $v;
205	my $SWC09;
206	try {
207	$SWC09 = SuikaWiki::Plugin->module_package ('SuikaWikiConst09');
208	} catch SuikaWiki::Plugin::error with {
209	my $err = shift;
210	$err->raise unless $err->{-type} eq 'PLUGIN_NOT_FOUND';
211	};
212	for my $lang (sort {$opt{accept_language}->{$b} <=>
213	$opt{accept_language}->{$a}}
214	grep {$opt{accept_language}->{$_} != 0}
215	keys %{$opt{accept_language}}) {
216	while (length $lang) {
217	unless ($opt{accept_language}->{defined $opt{accept_language}->{$lang}
218	? $lang : '*'} == 0) {
219	## WikiPage defined resource text (SuikaWikiConst/0.9)
220	if (not $opt{resource}->{$lang} and ref $opt{wiki}->{db} and $SWC09) {
221	try {
222	$v = $opt{wiki}->{db}->get (content => [@{$opt{resource_ns}}, $lang]);
223	} catch SuikaWiki::DB::Util::Error with {
224	my $err = shift;
225	$err->throw if $err->{-type} eq 'ERROR_REPORTED';
226	$v = undef;
227	};
228	$opt{resource}->{$lang} = {};
229	$SWC09->text_to_hash (text => \$v,
230	hash => $opt{resource}->{$lang});
231	}
232	$v = $opt{resource}->{$lang}->{$opt{name}};
233	last if defined $v;
234	## WikiPlugin defined resource text (SuikaWiki 3 WikiPlugin)
235	if (defined $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$opt{name}}) {
236	$v = $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$opt{name}};
237	last;
238	}
239	}
240	$lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
241	}
242	last if defined $v;
243	} # Accepted languages
244	if (defined $v) {
245	return $v;
246	} else {
247	## Plugin defined resource text or undef
248	return $SuikaWiki::Plugin::Resource::BaseResource->{und}->{''}->{$opt{name}};
249	}
250
251	Function:
252	@Name: temp_get_language_resource_from_array
253	@Main:
254	my (undef, %opt) = @_;
255	CORE::die "Buggy implementation: \$opt{o} required ".Carp::longmess()
256	unless ref $opt{o};
257	$opt{source} \|\|= [];
258	if (@{$opt{source}} < 2) {
259	return ($opt{source} \|\| [])->[0];
260	}
261	$opt{accept_language} \|\|= __FUNCPACK__->temp_get_accept_language
262	(wiki => $opt{o}->{wiki}, %opt);
263	my $und;
264	for my $lang (sort {$opt{accept_language}->{$b} <=>
265	$opt{accept_language}->{$a}}
266	grep {$opt{accept_language}->{$_} != 0}
267	keys %{$opt{accept_language}}) {
268	while (length $lang) {
269	unless ($opt{accept_language}->{defined $opt{accept_language}->{$lang}
270	? $lang : '*'} == 0) {
271	for (@{$opt{source}}) {
272	if ($_->[1] eq $lang) {
273	return $_; ## TODO: Script support
274	} elsif ($_->[1] eq 'und') {
275	$und = $_;
276	}
277	}
278	}
279	$lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
280	}
281	} # Accepted languages
282	return $und \|\| [];
283
284	Function:
285	@Name: temp_get_accept_language
286	@Main:
287	my (undef, %opt) = @_;
288
289	## Accept language specification
290	my $alang;
291	if ($opt{wiki}->{input}) {
292	$alang = $opt{wiki}->{input}->meta_variable ('HTTP_ACCEPT_LANGUAGE');
293	}
294	$alang \|\|= q<i-default;q=1.0,en;q=0.9,ja;q=0.8,*;q=0.001>;
295
296	## Old user agent support
297	my %alang = (ja => 0.0002, en => 0.0001);
298	if ($opt{wiki}->{var}->{client}->{user_agent_name} =~ m#^Mozilla/0\.#) {
299	$alang{ja} = 0.00001;
300	}
301
302	## Parse accept language specification
303	my $i = 0.1;
304	for (split /\s,\s/, $alang) {
305	tr/\x09\x0A\x0D\x20//d;
306	if (/((?:(?!;q=).)+)(?:;q="?([0-9.]+)"?)?/) {
307	my $l = lc $1; $l =~ tr/\x22\x5C//d;
308	$alang{$l} = (defined $2 ? $2 : 1.000)*1000;
309	$alang{$l} += $i unless $alang{$l} == 0;
310	$i -= 0.001;
311	}
312	}
313	return \%alang;