| 1 |
wakaba |
1.1 |
Name: |
| 2 |
|
|
WikiResource |
| 3 |
|
|
FullName: |
| 4 |
|
|
WikiResource interface |
| 5 |
|
|
URI: |
| 6 |
|
|
IW:SuikaWiki:"Wiki//Resource" |
| 7 |
wakaba |
1.3 |
Description: |
| 8 |
|
|
This module provides "WikiResource" support. A resource is a record data |
| 9 |
|
|
in the resource database. Using resource database, human readable text |
| 10 |
|
|
is easily customizable and multilingualizationable (With conneg, |
| 11 |
|
|
user preferred language can be automatically selected). |
| 12 |
wakaba |
1.2 |
Initialize: |
| 13 |
|
|
my $HAS_XML = SuikaWiki::Plugin->feature ('SuikaWiki::Markup::XML'); |
| 14 |
wakaba |
1.1 |
|
| 15 |
|
|
{ |
| 16 |
|
|
Name: |
| 17 |
|
|
wikiform_input/res |
| 18 |
|
|
FullName: |
| 19 |
|
|
Get text from resource |
| 20 |
|
|
Format: |
| 21 |
|
|
$r = $o->resource ($p->{name},escape=>1); |
| 22 |
|
|
} |
| 23 |
|
|
{ |
| 24 |
|
|
Name: |
| 25 |
|
|
wikiview/res |
| 26 |
|
|
wikiview-resource/res |
| 27 |
|
|
wikipage_list_item/res |
| 28 |
|
|
FullName: |
| 29 |
|
|
Get text from resource |
| 30 |
|
|
Format: |
| 31 |
wakaba |
1.2 |
if ($HAS_XML) { |
| 32 |
|
|
$r = $o->formatter('view-resource')->replace ($o->resource ($p->{name}), $o); |
| 33 |
|
|
unless (ref $r) { |
| 34 |
|
|
$r = SuikaWiki::Markup::XML->new (type => '#text', value => $r); |
| 35 |
|
|
} |
| 36 |
wakaba |
1.1 |
} else { |
| 37 |
|
|
$r = $o->formatter('view-resource')->replace ($o->resource ($p->{name}), $o); |
| 38 |
|
|
} |
| 39 |
|
|
} |
| 40 |
|
|
|
| 41 |
|
|
{ |
| 42 |
|
|
Name: |
| 43 |
|
|
wikiview-resource/-bare_text |
| 44 |
|
|
FullName: |
| 45 |
|
|
HTML escape for bare text |
| 46 |
|
|
Format: |
| 47 |
wakaba |
1.2 |
if ($HAS_XML) { |
| 48 |
|
|
$r = SuikaWiki::Markup::XML->new (type => '#text', value => $p->{-bare_text}); |
| 49 |
|
|
} else { |
| 50 |
|
|
$r = $o->escape ($p->{-bare_text}); |
| 51 |
|
|
} |
| 52 |
wakaba |
1.1 |
} |
| 53 |
|
|
{ |
| 54 |
|
|
Name: |
| 55 |
|
|
wikiview-resource/span |
| 56 |
|
|
FullName: |
| 57 |
|
|
Give class name |
| 58 |
|
|
Format: |
| 59 |
|
|
$r = qq(<span class="@{[$o->escape($p->{class})]}">) . $o->escape($p->{content}) . '</span>'; |
| 60 |
|
|
} |
| 61 |
wakaba |
1.3 |
|
| 62 |
|
|
MODULE: |
| 63 |
|
|
my %_Resource; |
| 64 |
|
|
sub main::Resource ($;%) { |
| 65 |
|
|
my ($s, %o) = @_; |
| 66 |
|
|
unless (defined $_Resource{$s}) { |
| 67 |
|
|
$_Resource{$_[0]} = &wiki::resource::get ($s, $_Resource{__option}); |
| 68 |
|
|
} |
| 69 |
|
|
$o{escape} ? SuikaWiki::Plugin->escape ($_Resource{$s}) : $_Resource{$s}; |
| 70 |
|
|
} |
| 71 |
|
|
sub SuikaWiki::Plugin::resource ($$;%) { shift; &main::Resource (@_) } |
| 72 |
|
|
package wiki::resource; |
| 73 |
|
|
sub get ($;\%) { |
| 74 |
|
|
my ($resname, $option) = @_; |
| 75 |
|
|
$option->{accept_language} ||= &wiki::conneg::get_accept_lang (); |
| 76 |
|
|
$option->{resource} ||= {}; |
| 77 |
|
|
my $v; |
| 78 |
|
|
for my $lang (sort {$option->{accept_language}->{$b} <=> $option->{accept_language}->{$a}} grep {$option->{accept_language}->{$_}!=0} keys %{$option->{accept_language}}) { |
| 79 |
|
|
while (length $lang) { |
| 80 |
|
|
unless ($option->{accept_language}->{defined $option->{accept_language}->{$lang} ? $lang : '*'} == 0) { |
| 81 |
|
|
$option->{resource}->{$lang} ||= &wiki::suikawikiconst::to_hash ($main::database{$main::PageName{ResourceNS}.$lang}); |
| 82 |
|
|
$v = $option->{resource}->{$lang}->{$resname}; |
| 83 |
|
|
last if defined $v; |
| 84 |
|
|
} |
| 85 |
|
|
$lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//; |
| 86 |
|
|
} |
| 87 |
|
|
last if defined $v; |
| 88 |
|
|
} |
| 89 |
|
|
defined $v ? $v : $resname; |
| 90 |
|
|
} |
| 91 |
|
|
|
| 92 |
|
|
package wiki::conneg; |
| 93 |
|
|
## BUG: this parser isn't strict. |
| 94 |
|
|
sub get_accept_lang (;$) { |
| 95 |
|
|
my $alang = shift || $main::ENV{HTTP_ACCEPT_LANGUAGE}; |
| 96 |
|
|
my %alang = (ja => 0.0002, en => 0.0001); |
| 97 |
|
|
if ($main::UA =~ m#Mozilla/0\.#) { |
| 98 |
|
|
$alang{ja} = 0.00001; |
| 99 |
|
|
} |
| 100 |
|
|
my $i = 0.1; |
| 101 |
|
|
for (split /\s*,\s*/, $alang) { |
| 102 |
|
|
tr/\x09\x0A\x0D\x20//d; |
| 103 |
|
|
if (/((?:(?!;q=).)+)(?:;q="?([0-9.]+)"?)?/) { |
| 104 |
|
|
my $l = lc $1; $l =~ tr/\x22\x5C//d; |
| 105 |
|
|
$alang{$l} = (defined $2 ? $2 : 1.000)*1000; |
| 106 |
|
|
$alang{$l} += $i unless $alang{$l} == 0; |
| 107 |
|
|
$i -= 0.001; |
| 108 |
|
|
} |
| 109 |
|
|
} |
| 110 |
|
|
\%alang; |
| 111 |
|
|
} |
| 112 |
|
|
|
| 113 |
|
|
POD:TO DO: |
| 114 |
|
|
- Refine wiki::* functions. |
| 115 |
|
|
|
| 116 |
|
|
- Separate conneg functions. |
| 117 |
|
|
|
| 118 |
|
|
- Persistent caching of retrived resource. |
| 119 |
wakaba |
1.1 |
|
| 120 |
|
|
POD:LICENSE: |
| 121 |
wakaba |
1.2 |
Copyright 2002-2003 Wakaba <w@suika.fam.cx> |
| 122 |
wakaba |
1.1 |
|
| 123 |
|
|
%%GNUGPL2%% |
Parent Directory
| 
Revision Log