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