SuikaWiki/Plugin/WikiResource.wps

Name:
        WikiResource
FullName:
        WikiResource interface
URI:
        IW:SuikaWiki:"Wiki//Resource"
Description:
        This module provides "WikiResource" support.  A resource is a record data
        in the resource database.  Using resource database, human readable text
        is easily customizable and multilingualizationable (With conneg,
        user preferred language can be automatically selected).
Require:
        SuikaWiki::Plugin::WikiConst main
Initialize:
        my $HAS_XML = SuikaWiki::Plugin->feature ('SuikaWiki::Markup::XML');
        my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';

{
Name:
        wikiform_input/res
FullName:
        Get text from resource
Format:
        $r = $o->resource ($p->{name},escape=>1);
}
{
Name:
        wikiview/res
        wikiview-resource/res
        wikipage_list_item/res
        wikipage-link/res
        wikiwe--edit/res
FullName:
        Get text from resource
Format:
        $r = $o->formatter('view-resource')->replace ($o->resource ($p->{name}), $o);
        $r = SuikaWiki::Markup::XML->new (type => '#text', value => $r) unless ref $r;
}

{
Name:
        wikiview-resource/-bare_text
FullName:
        HTML escape for bare text
Format:
        if ($HAS_XML) {
          $r = SuikaWiki::Markup::XML->new (type => '#text', value => $p->{-bare_text});
        } else {
          $r = $o->escape ($p->{-bare_text});
        }
}
{
Name:
        wikiview-resource/span
        wikipage-link/span
FullName:
        Give class name
Format:
        $r = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'span');
          $r->set_attribute (class => $p->{class});
          $r->append_node ($p->{content}, node_or_text => 1);
}

{
Name:
        wikiview-resource/text
FullName:
        Give class name
Format:
        $r = SuikaWiki::Markup::XML->new (type => '#text', value => $p->{cdata});
}

MODULE:
        my %_Resource;
        my $default_ns = $main::PageName{ResourceNS};
        sub get_resource ($$;%) {
          my (undef, $s, %o) = @_;
          $o{ns} ||= $default_ns;
          unless (defined $_Resource{$o{ns}}->{$s}) {
            $_Resource{'.//option'}->{$o{ns}}->{resource_ns} = $o{ns};
            $_Resource{$o{ns}}->{$s} = wiki::resource::get ($s, $_Resource{'.//option'}->{$o{ns}});
          }
          return $_Resource{$o{ns}}->{$s};
        }
        ## TODO: implement inherit default_ns ??
        sub SuikaWiki::Plugin::resource ($$;%) {
          my (undef, $s, %o) = @_;
          my $s = __PACKAGE__->get_resource ($s, %o);
          $o{escape} ? SuikaWiki::Plugin->escape ($s) : $s;
        }
        
        sub main::Resource ($;%) {
          my ($s, %o) = @_;
          unless (defined $_Resource{$default_ns}->{$s}) {
            $_Resource{$default_ns}->{$_[0]} = &wiki::resource::get ($s, $_Resource{'.//option'}->{$default_ns});
          }
          $o{escape} ? SuikaWiki::Plugin->escape ($_Resource{$default_ns}->{$s}) : $_Resource{$default_ns}->{$s};
        }
        sub wiki::resource::get ($;$) {
          my ($resname, $option) = @_;
          $option->{accept_language} ||= &wiki::conneg::get_accept_lang ();
          $option->{resource} ||= {};
          $option->{resource_ns} ||= $default_ns;
          my $v;
          for my $lang (sort {$option->{accept_language}->{$b} <=> $option->{accept_language}->{$a}} grep {$option->{accept_language}->{$_}!=0} keys %{$option->{accept_language}}) {
            while (length $lang) {
              unless ($option->{accept_language}->{defined $option->{accept_language}->{$lang} ? $lang : '*'} == 0) {
                $option->{resource}->{$lang} ||= SuikaWiki::Plugin::WikiConst::to_hash ($main::database{$option->{resource_ns}.$lang});
                $v = $option->{resource}->{$lang}->{$resname};
                last if defined $v;
                if (defined $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$resname}) {
                  $v = $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$resname};
                  last;
                }
              }
              $lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
            }
            last if defined $v;
          }
          if (defined $v) {
            return $v;
          } elsif (defined $SuikaWiki::Plugin::Resource::BaseResource->{und}->{''}->{$resname}) {
            return $SuikaWiki::Plugin::Resource::BaseResource->{und}->{''}->{$resname};
          } else {
            return $resname;
          }
        }
        
        package wiki::conneg;
        ## BUG: this parser isn't strict.
        sub get_accept_lang (;$) {
          my $alang = shift || $main::ENV{HTTP_ACCEPT_LANGUAGE};
          my %alang = (ja => 0.0002, en => 0.0001);
          if ($main::UA =~ m#Mozilla/0\.#) {
            $alang{ja} = 0.00001;
          }
          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;
            }
          }
          \%alang;
        }

POD:TO DO:
        - Refine wiki::* functions.
        
        - Separate conneg functions.
        
        - Persistent caching of retrived resource.

POD:LICENSE:
        Copyright 2002-2003 Wakaba <w@suika.fam.cx>
        
        %%GNUGPL2%%
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.5	Require:
13			SuikaWiki::Plugin::WikiConst main
14	wakaba	1.2	Initialize:
15			my $HAS_XML = SuikaWiki::Plugin->feature ('SuikaWiki::Markup::XML');
16	wakaba	1.4	my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
17	wakaba	1.1
18			{
19			Name:
20			wikiform_input/res
21			FullName:
22			Get text from resource
23			Format:
24			$r = $o->resource ($p->{name},escape=>1);
25			}
26			{
27			Name:
28			wikiview/res
29			wikiview-resource/res
30			wikipage_list_item/res
31	wakaba	1.4	wikipage-link/res
32	wakaba	1.6	wikiwe--edit/res
33	wakaba	1.1	FullName:
34			Get text from resource
35			Format:
36	wakaba	1.4	$r = $o->formatter('view-resource')->replace ($o->resource ($p->{name}), $o);
37			$r = SuikaWiki::Markup::XML->new (type => '#text', value => $r) unless ref $r;
38	wakaba	1.1	}
39
40			{
41			Name:
42			wikiview-resource/-bare_text
43			FullName:
44			HTML escape for bare text
45			Format:
46	wakaba	1.2	if ($HAS_XML) {
47			$r = SuikaWiki::Markup::XML->new (type => '#text', value => $p->{-bare_text});
48			} else {
49			$r = $o->escape ($p->{-bare_text});
50			}
51	wakaba	1.1	}
52			{
53			Name:
54			wikiview-resource/span
55	wakaba	1.4	wikipage-link/span
56			FullName:
57			Give class name
58			Format:
59			$r = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'span');
60			$r->set_attribute (class => $p->{class});
61			$r->append_node ($p->{content}, node_or_text => 1);
62			}
63
64			{
65			Name:
66			wikiview-resource/text
67	wakaba	1.1	FullName:
68			Give class name
69			Format:
70	wakaba	1.4	$r = SuikaWiki::Markup::XML->new (type => '#text', value => $p->{cdata});
71	wakaba	1.1	}
72	wakaba	1.3
73			MODULE:
74			my %_Resource;
75	wakaba	1.5	my $default_ns = $main::PageName{ResourceNS};
76			sub get_resource ($$;%) {
77			my (undef, $s, %o) = @_;
78			$o{ns} \|\|= $default_ns;
79			unless (defined $_Resource{$o{ns}}->{$s}) {
80			$_Resource{'.//option'}->{$o{ns}}->{resource_ns} = $o{ns};
81			$_Resource{$o{ns}}->{$s} = wiki::resource::get ($s, $_Resource{'.//option'}->{$o{ns}});
82			}
83			return $_Resource{$o{ns}}->{$s};
84			}
85			## TODO: implement inherit default_ns ??
86			sub SuikaWiki::Plugin::resource ($$;%) {
87			my (undef, $s, %o) = @_;
88			my $s = __PACKAGE__->get_resource ($s, %o);
89			$o{escape} ? SuikaWiki::Plugin->escape ($s) : $s;
90			}
91
92	wakaba	1.3	sub main::Resource ($;%) {
93			my ($s, %o) = @_;
94	wakaba	1.5	unless (defined $_Resource{$default_ns}->{$s}) {
95			$_Resource{$default_ns}->{$_[0]} = &wiki::resource::get ($s, $_Resource{'.//option'}->{$default_ns});
96	wakaba	1.3	}
97	wakaba	1.5	$o{escape} ? SuikaWiki::Plugin->escape ($_Resource{$default_ns}->{$s}) : $_Resource{$default_ns}->{$s};
98	wakaba	1.3	}
99	wakaba	1.6	sub wiki::resource::get ($;$) {
100	wakaba	1.3	my ($resname, $option) = @_;
101			$option->{accept_language} \|\|= &wiki::conneg::get_accept_lang ();
102			$option->{resource} \|\|= {};
103	wakaba	1.5	$option->{resource_ns} \|\|= $default_ns;
104	wakaba	1.3	my $v;
105			for my $lang (sort {$option->{accept_language}->{$b} <=> $option->{accept_language}->{$a}} grep {$option->{accept_language}->{$_}!=0} keys %{$option->{accept_language}}) {
106			while (length $lang) {
107			unless ($option->{accept_language}->{defined $option->{accept_language}->{$lang} ? $lang : '*'} == 0) {
108	wakaba	1.5	$option->{resource}->{$lang} \|\|= SuikaWiki::Plugin::WikiConst::to_hash ($main::database{$option->{resource_ns}.$lang});
109	wakaba	1.3	$v = $option->{resource}->{$lang}->{$resname};
110			last if defined $v;
111	wakaba	1.6	if (defined $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$resname}) {
112			$v = $SuikaWiki::Plugin::Resource::BaseResource->{$lang}->{''}->{$resname};
113			last;
114			}
115	wakaba	1.3	}
116			$lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;
117			}
118			last if defined $v;
119			}
120	wakaba	1.6	if (defined $v) {
121			return $v;
122			} elsif (defined $SuikaWiki::Plugin::Resource::BaseResource->{und}->{''}->{$resname}) {
123			return $SuikaWiki::Plugin::Resource::BaseResource->{und}->{''}->{$resname};
124			} else {
125			return $resname;
126			}
127	wakaba	1.3	}
128
129			package wiki::conneg;
130			## BUG: this parser isn't strict.
131			sub get_accept_lang (;$) {
132			my $alang = shift \|\| $main::ENV{HTTP_ACCEPT_LANGUAGE};
133			my %alang = (ja => 0.0002, en => 0.0001);
134			if ($main::UA =~ m#Mozilla/0\.#) {
135			$alang{ja} = 0.00001;
136			}
137			my $i = 0.1;
138			for (split /\s,\s/, $alang) {
139			tr/\x09\x0A\x0D\x20//d;
140			if (/((?:(?!;q=).)+)(?:;q="?([0-9.]+)"?)?/) {
141			my $l = lc $1; $l =~ tr/\x22\x5C//d;
142			$alang{$l} = (defined $2 ? $2 : 1.000)*1000;
143			$alang{$l} += $i unless $alang{$l} == 0;
144			$i -= 0.001;
145			}
146			}
147			\%alang;
148			}
149
150			POD:TO DO:
151			- Refine wiki::* functions.
152
153			- Separate conneg functions.
154
155			- Persistent caching of retrived resource.
156	wakaba	1.1
157			POD:LICENSE:
158	wakaba	1.2	Copyright 2002-2003 Wakaba <w@suika.fam.cx>
159	wakaba	1.1
160			%%GNUGPL2%%