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/03/19 03:44:15 $
  @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__;
    $p->{-parent}->append_text
           (__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 (10000 < $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{o}->{wiki} || $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/03/19 03:44:15 $
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	$p->{-parent}->append_text
77	(__FUNCPACK__->get (name => $p->{name},
78	wiki => $o->{wiki}));
79
80	Function:
81	@Name: logging_template_error
82	@Description:
83	@@@:
84	Logging formatting-template-text error
85	@@lang:en
86	@Main:
87	my (undef, $err, $wiki, %opt) = @_;
88	my $error = {};
89	my $dl = $error->{description}
90	= new Message::Markup::XML::Node
91	(type => '#element',
92	namespace_uri => $NS_XHTML1,
93	local_name => 'dl');
94	## TODO: Use resource
95	$dl->append_new_node (type => '#element',
96	namespace_uri => $NS_XHTML1,
97	local_name => 'dt')
98	->append_text ('Resource name');
99	$dl->append_new_node (type => '#element',
100	namespace_uri => $NS_XHTML1,
101	local_name => 'dd')
102	->append_text ($opt{resource_name});
103	$dl->append_new_node (type => '#element',
104	namespace_uri => $NS_XHTML1,
105	local_name => 'dt')
106	->append_text ('Error condition');
107	$dl->append_new_node (type => '#element',
108	namespace_uri => $NS_XHTML1,
109	local_name => 'dd')
110	->append_text ($err->text);
111	$dl->append_new_node (type => '#element',
112	namespace_uri => $NS_XHTML1,
113	local_name => 'dt')
114	->append_text ('Formatting context');
115	$dl->append_new_node (type => '#element',
116	namespace_uri => $NS_XHTML1,
117	local_name => 'dd')
118	->append_text (qq($err->{-formatter}->{-category_name}));
119
120	push @{$wiki->{var}->{error}\|\|=[]}, $error;
121
122	Function:
123	@Name: get_text
124	@Main:
125	my (undef, %opt) = @_;
126	__FUNCPACK__->get (%opt);
127	## TODO: Implements formatter.
128
129	Function:
130	@Name: append_node
131	@Main:
132	my (undef, %opt) = @_;
133	__FUNCPACK__->get (%opt, formatter_context => 'view_resource',
134	formatter_option => {param => $opt{param},
135	-parent => $opt{parent}});
136
137	Function:
138	@Name: get_op
139	@Description:
140	@@@: Simple version of "get"
141	@@lang: en
142	@Main:
143	my (undef, $name, $o, $parent, %opt) = @_;
144	__FUNCPACK__->get (%opt, name => $name, o => $o, wiki => $o->{wiki},
145	formatter_context => 'view_resource',
146	formatter_option => {param => $o,
147	-parent => $parent});
148
149	Function:
150	@Name: get
151	@Main:
152	my (undef, %opt) = @_;
153	local $NestLevel = $NestLevel + 1;
154	if (10000 < $NestLevel) {
155	SuikaWiki::Plugin->module_package ('Error')
156	## TODO:
157	->report_error_simple
158	($opt{wiki} \|\| $opt{o}->{wiki},
159	'Condition' => 'Resource nesting too deep',
160	ResourceName => $opt{name},
161	-trace => 1);
162	return defined $opt{default} ? $opt{default} : $opt{name};
163	}
164
165
166
167	my $text = __FUNCPACK__->temp_get_resource_text
168	(resource_ns => ($opt{o}->{wiki} \|\| $opt{wiki})->name
169	($opt{ns} \|\| [qw/Wiki Resource/]),
170	name => $opt{name},
171	wiki => $opt{wiki});
172	if (defined $text) {
173	#
174	} elsif (defined $opt{default}) {
175	$text = $opt{default};
176	} else {
177	$text = $opt{name};
178	}
179
180	return $text unless $opt{formatter_context};
181	try {
182	$text = SuikaWiki::Plugin->formatter ($opt{formatter_context})
183	->replace ($text, %{$opt{formatter_option}});
184	} catch Message::Util::Formatter::error with {
185	my $err = shift;
186	if ($err->{-formatter}->{-category_name} eq $opt{formatter_context}) {
187	__FUNCPACK__->logging_template_error ($err,
188	$err->{-option}->{param}->{wiki},
189	resource_name => $opt{name});
190	undef;
191	} else {
192	$err->throw;
193	}
194	};
195	return $text;
196
197	Function:
198	@Name: temp_get_resource_text
199	@Main:
200	my (undef, %opt) = @_;
201	CORE::die "Buggy implementation: \$opt{wiki} required ".Carp::longmess()
202	unless ref $opt{wiki};
203	$opt{accept_language} \|\|= __FUNCPACK__->temp_get_accept_language (%opt);
204	$opt{resource} \|\|= $RESOURCE_CACHE \|\|= {};
205	my $v;
206	my $SWC09;
207	try {
208	$SWC09 = SuikaWiki::Plugin->module_package ('SuikaWikiConst09');
209	} catch SuikaWiki::Plugin::error with {
210	my $err = shift;
211	$err->raise unless $err->{-type} eq 'PLUGIN_NOT_FOUND';
212	};
213	for my $lang (sort {$opt{accept_language}->{$b} <=>
214	$opt{accept_language}->{$a}}
215	grep {$opt{accept_language}->{$_} != 0}
216	keys %{$opt{accept_language}}) {
217	while (length $lang) {
218	unless ($opt{accept_language}->{defined $opt{accept_language}->{$lang}
219	? $lang : '*'} == 0) {
220	## WikiPage defined resource text (SuikaWikiConst/0.9)
221	if (not $opt{resource}->{$lang} and ref $opt{wiki}->{db} and $SWC09) {
222	try {
223	$v = $opt{wiki}->{db}->get (content => [@{$opt{resource_ns}}, $lang]);
224	} catch SuikaWiki::DB::Util::Error with {
225	my $err = shift;
226	$err->throw if $err->{-type} eq 'ERROR_REPORTED';
227	$v = undef;
228	};
229	$opt{resource}->{$lang} = {};
230	$SWC09->text_to_hash (text => \$v,
231	hash => $opt{resource}->{$lang});
232	}
233	$v = $opt{resource}->{$lang}->{$opt{name}};
234	last if defined $v;
235	## WikiPlugin defined resource text (SuikaWiki 3 WikiPlugin)
236	if (defined $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$opt{name}}) {
237	$v = $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$opt{name}};
238	last;
239	}
240	}
241	$lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
242	}
243	last if defined $v;
244	} # Accepted languages
245	if (defined $v) {
246	return $v;
247	} else {
248	## Plugin defined resource text or undef
249	return $SuikaWiki::Plugin::Resource::BaseResource->{und}->{''}->{$opt{name}};
250	}
251
252	Function:
253	@Name: temp_get_language_resource_from_array
254	@Main:
255	my (undef, %opt) = @_;
256	CORE::die "Buggy implementation: \$opt{o} required ".Carp::longmess()
257	unless ref $opt{o};
258	$opt{source} \|\|= [];
259	if (@{$opt{source}} < 2) {
260	return ($opt{source} \|\| [])->[0];
261	}
262	$opt{accept_language} \|\|= __FUNCPACK__->temp_get_accept_language
263	(wiki => $opt{o}->{wiki}, %opt);
264	my $und;
265	for my $lang (sort {$opt{accept_language}->{$b} <=>
266	$opt{accept_language}->{$a}}
267	grep {$opt{accept_language}->{$_} != 0}
268	keys %{$opt{accept_language}}) {
269	while (length $lang) {
270	unless ($opt{accept_language}->{defined $opt{accept_language}->{$lang}
271	? $lang : '*'} == 0) {
272	for (@{$opt{source}}) {
273	if ($_->[1] eq $lang) {
274	return $_; ## TODO: Script support
275	} elsif ($_->[1] eq 'und') {
276	$und = $_;
277	}
278	}
279	}
280	$lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
281	}
282	} # Accepted languages
283	return $und \|\| [];
284
285	Function:
286	@Name: temp_get_accept_language
287	@Main:
288	my (undef, %opt) = @_;
289
290	## Accept language specification
291	my $alang;
292	if ($opt{wiki}->{input}) {
293	$alang = $opt{wiki}->{input}->meta_variable ('HTTP_ACCEPT_LANGUAGE');
294	}
295	$alang \|\|= q<i-default;q=1.0,en;q=0.9,ja;q=0.8,*;q=0.001>;
296
297	## Old user agent support
298	my %alang = (ja => 0.0002, en => 0.0001);
299	if ($opt{wiki}->{var}->{client}->{user_agent_name} =~ m#^Mozilla/0\.#) {
300	$alang{ja} = 0.00001;
301	}
302
303	## Parse accept language specification
304	my $i = 0.1;
305	for (split /\s,\s/, $alang) {
306	tr/\x09\x0A\x0D\x20//d;
307	if (/((?:(?!;q=).)+)(?:;q="?([0-9.]+)"?)?/) {
308	my $l = lc $1; $l =~ tr/\x22\x5C//d;
309	$alang{$l} = (defined $2 ? $2 : 1.000)*1000;
310	$alang{$l} += $i unless $alang{$l} == 0;
311	$i -= 0.001;
312	}
313	}
314	return \%alang;