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/14 10:55:21 $
  @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;
    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}) {
            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} = {};
            SuikaWiki::Plugin->module_package ('SuikaWikiConst09')
                             ->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	wakaba	1.1	#?SuikaWikiConfig/2.0
2
3			Plugin:
4			@Name: WikiResource
5			@Description:
6			@@@: Wiki resource text support
7			@@lang:en
8	wakaba	1.5	@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.5	@Date.RCS:
16	wakaba	1.6	$Date: 2004/02/14 10:55:21 $
17	wakaba	1.3	@RequiredPlugin[list]:
18			SuikaWikiConst09
19	wakaba	1.2	@Use:
20			use Message::Util::Error;
21	wakaba	1.4	my $RESOURCE_CACHE;
22	wakaba	1.5	our $NestLevel;
23	wakaba	1.1
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	wakaba	1.3	link-to-resource
34	wakaba	1.1	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	wakaba	1.3	__FUNCPACK__->get (name => $p->{name},
50			wiki => $o->{wiki},
51			formatter_context => 'view_resource',
52			formatter_option => {param => $o,
53			-parent => $p->{-parent}});
54	wakaba	1.1
55	wakaba	1.4	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	wakaba	1.2	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	wakaba	1.3
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	wakaba	1.5	@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	wakaba	1.3	@Name: get
150			@Main:
151			my (undef, %opt) = @_;
152	wakaba	1.5	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	wakaba	1.3
164
165
166			my $text = __FUNCPACK__->temp_get_resource_text
167	wakaba	1.5	(resource_ns => $opt{wiki}->name
168			($opt{ns} \|\| [qw/Wiki Resource/]),
169	wakaba	1.3	name => $opt{name},
170			wiki => $opt{wiki});
171			if (defined $text) {
172			#
173	wakaba	1.5	} elsif (defined $opt{default}) {
174	wakaba	1.3	$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	wakaba	1.4	CORE::die "Buggy implementation: \$opt{wiki} required ".Carp::longmess()
201			unless ref $opt{wiki};
202	wakaba	1.3	$opt{accept_language} \|\|= __FUNCPACK__->temp_get_accept_language (%opt);
203	wakaba	1.4	$opt{resource} \|\|= $RESOURCE_CACHE \|\|= {};
204	wakaba	1.3	my $v;
205			for my $lang (sort {$opt{accept_language}->{$b} <=>
206			$opt{accept_language}->{$a}}
207			grep {$opt{accept_language}->{$_} != 0}
208			keys %{$opt{accept_language}}) {
209			while (length $lang) {
210			unless ($opt{accept_language}->{defined $opt{accept_language}->{$lang}
211			? $lang : '*'} == 0) {
212			## WikiPage defined resource text (SuikaWikiConst/0.9)
213	wakaba	1.4	if (not $opt{resource}->{$lang} and ref $opt{wiki}->{db}) {
214			try {
215			$v = $opt{wiki}->{db}->get (content => [@{$opt{resource_ns}}, $lang]);
216			} catch SuikaWiki::DB::Util::Error with {
217	wakaba	1.6	my $err = shift;
218			$err->throw if $err->{-type} eq 'ERROR_REPORTED';
219	wakaba	1.4	$v = undef;
220			};
221	wakaba	1.3	$opt{resource}->{$lang} = {};
222			SuikaWiki::Plugin->module_package ('SuikaWikiConst09')
223			->text_to_hash (text => \$v,
224			hash => $opt{resource}->{$lang});
225			}
226			$v = $opt{resource}->{$lang}->{$opt{name}};
227			last if defined $v;
228			## WikiPlugin defined resource text (SuikaWiki 3 WikiPlugin)
229			if (defined $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$opt{name}}) {
230			$v = $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$opt{name}};
231			last;
232			}
233			}
234			$lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
235			}
236			last if defined $v;
237			} # Accepted languages
238			if (defined $v) {
239			return $v;
240			} else {
241			## Plugin defined resource text or undef
242			return $SuikaWiki::Plugin::Resource::BaseResource->{und}->{''}->{$opt{name}};
243			}
244	wakaba	1.5
245			Function:
246			@Name: temp_get_language_resource_from_array
247			@Main:
248			my (undef, %opt) = @_;
249			CORE::die "Buggy implementation: \$opt{o} required ".Carp::longmess()
250			unless ref $opt{o};
251			$opt{source} \|\|= [];
252			if (@{$opt{source}} < 2) {
253			return ($opt{source} \|\| [])->[0];
254			}
255			$opt{accept_language} \|\|= __FUNCPACK__->temp_get_accept_language
256			(wiki => $opt{o}->{wiki}, %opt);
257			my $und;
258			for my $lang (sort {$opt{accept_language}->{$b} <=>
259			$opt{accept_language}->{$a}}
260			grep {$opt{accept_language}->{$_} != 0}
261			keys %{$opt{accept_language}}) {
262			while (length $lang) {
263			unless ($opt{accept_language}->{defined $opt{accept_language}->{$lang}
264			? $lang : '*'} == 0) {
265			for (@{$opt{source}}) {
266			if ($_->[1] eq $lang) {
267			return $_; ## TODO: Script support
268			} elsif ($_->[1] eq 'und') {
269			$und = $_;
270			}
271			}
272			}
273			$lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
274			}
275			} # Accepted languages
276			return $und \|\| [];
277
278	wakaba	1.3	Function:
279			@Name: temp_get_accept_language
280			@Main:
281			my (undef, %opt) = @_;
282	wakaba	1.6
283			## Accept language specification
284			my $alang;
285			if ($opt{wiki}->{input}) {
286			$alang = $opt{wiki}->{input}->meta_variable ('HTTP_ACCEPT_LANGUAGE');
287			}
288			$alang \|\|= q<i-default;q=1.0,en;q=0.9,ja;q=0.8,*;q=0.001>;
289
290			## Old user agent support
291	wakaba	1.3	my %alang = (ja => 0.0002, en => 0.0001);
292			if ($opt{wiki}->{var}->{client}->{user_agent_name} =~ m#^Mozilla/0\.#) {
293			$alang{ja} = 0.00001;
294			}
295	wakaba	1.6
296			## Parse accept language specification
297			my $i = 0.1;
298			for (split /\s,\s/, $alang) {
299			tr/\x09\x0A\x0D\x20//d;
300	wakaba	1.3	if (/((?:(?!;q=).)+)(?:;q="?([0-9.]+)"?)?/) {
301			my $l = lc $1; $l =~ tr/\x22\x5C//d;
302			$alang{$l} = (defined $2 ? $2 : 1.000)*1000;
303			$alang{$l} += $i unless $alang{$l} == 0;
304			$i -= 0.001;
305			}
306	wakaba	1.6	}
307	wakaba	1.3	return \%alang;