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/01 12:19:16 $
  @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 {
              $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) = @_;
    my %alang = (ja => 0.0002, en => 0.0001);
    if ($opt{wiki}->{var}->{client}->{user_agent_name} =~ m#^Mozilla/0\.#) {
            $alang{ja} = 0.00001;
    }
          my $i = 0.1;
          for (split /\s*,\s*/, $opt{wiki}->{input}->meta_variable ('HTTP_ACCEPT_LANGUAGE')) {
            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			$Date: 2004/02/01 12:19:16 $
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			$v = undef;
218			};
219	wakaba	1.3	$opt{resource}->{$lang} = {};
220			SuikaWiki::Plugin->module_package ('SuikaWikiConst09')
221			->text_to_hash (text => \$v,
222			hash => $opt{resource}->{$lang});
223			}
224			$v = $opt{resource}->{$lang}->{$opt{name}};
225			last if defined $v;
226			## WikiPlugin defined resource text (SuikaWiki 3 WikiPlugin)
227			if (defined $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$opt{name}}) {
228			$v = $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$opt{name}};
229			last;
230			}
231			}
232			$lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
233			}
234			last if defined $v;
235			} # Accepted languages
236			if (defined $v) {
237			return $v;
238			} else {
239			## Plugin defined resource text or undef
240			return $SuikaWiki::Plugin::Resource::BaseResource->{und}->{''}->{$opt{name}};
241			}
242	wakaba	1.5
243			Function:
244			@Name: temp_get_language_resource_from_array
245			@Main:
246			my (undef, %opt) = @_;
247			CORE::die "Buggy implementation: \$opt{o} required ".Carp::longmess()
248			unless ref $opt{o};
249			$opt{source} \|\|= [];
250			if (@{$opt{source}} < 2) {
251			return ($opt{source} \|\| [])->[0];
252			}
253			$opt{accept_language} \|\|= __FUNCPACK__->temp_get_accept_language
254			(wiki => $opt{o}->{wiki}, %opt);
255			my $und;
256			for my $lang (sort {$opt{accept_language}->{$b} <=>
257			$opt{accept_language}->{$a}}
258			grep {$opt{accept_language}->{$_} != 0}
259			keys %{$opt{accept_language}}) {
260			while (length $lang) {
261			unless ($opt{accept_language}->{defined $opt{accept_language}->{$lang}
262			? $lang : '*'} == 0) {
263			for (@{$opt{source}}) {
264			if ($_->[1] eq $lang) {
265			return $_; ## TODO: Script support
266			} elsif ($_->[1] eq 'und') {
267			$und = $_;
268			}
269			}
270			}
271			$lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
272			}
273			} # Accepted languages
274			return $und \|\| [];
275
276	wakaba	1.3	Function:
277			@Name: temp_get_accept_language
278			@Main:
279			my (undef, %opt) = @_;
280			my %alang = (ja => 0.0002, en => 0.0001);
281			if ($opt{wiki}->{var}->{client}->{user_agent_name} =~ m#^Mozilla/0\.#) {
282			$alang{ja} = 0.00001;
283			}
284			my $i = 0.1;
285			for (split /\s,\s/, $opt{wiki}->{input}->meta_variable ('HTTP_ACCEPT_LANGUAGE')) {
286			tr/\x09\x0A\x0D\x20//d;
287			if (/((?:(?!;q=).)+)(?:;q="?([0-9.]+)"?)?/) {
288			my $l = lc $1; $l =~ tr/\x22\x5C//d;
289			$alang{$l} = (defined $2 ? $2 : 1.000)*1000;
290			$alang{$l} += $i unless $alang{$l} == 0;
291			$i -= 0.001;
292			}
293			}
294			return \%alang;