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