/[pub]/suikawiki/script/misc/plugins/referer.wp2
Suika

Contents of /suikawiki/script/misc/plugins/referer.wp2

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations) (download)
Thu Mar 11 08:06:09 2004 UTC (22 years, 4 months ago) by wakaba
Branch: MAIN
Changes since 1.1: +49 -19 lines
Some optimization

1 #?SuikaWikiConfig/2.0
2
3 Plugin:
4 @Name: Referer
5 @Description:
6 @@@: Backward hyperlinking
7 @@lang:en
8 @License: %%Perl%%
9 @Author:
10 @@Name:
11 @@@@: Wakaba
12 @@@lang:ja
13 @@@script:Latn
14 @@Mail[list]: [email protected]
15 @Date.RCS:
16 $Date: 2004/03/10 06:57:25 $
17 @RequiredPlugin[list]:
18 InterWikiCore
19 WikiStructure
20 WikiLinking
21 @RequiredModule[list]:
22 URI
23 @Use:
24 use Message::Util::Error;
25 require URI;
26 my $INTERWIKICORE;
27 my $WIKIRESOURCE;
28 my $WIKILINKING;
29
30 PluginConst:
31 @NS_XHTML1:
32 http://www.w3.org/1999/xhtml
33 @INTERWIKICORE:
34 {($INTERWIKICORE ||= SuikaWiki::Plugin->module_package ('InterWikiCore'))}
35 @WIKIRESOURCE:
36 {($WIKIRESOURCE ||= SuikaWiki::Plugin->module_package ('WikiResource'))}
37 @WIKILINKING:
38 {($WIKILINKING ||= SuikaWiki::Plugin->module_package ('WikiLinking'))}
39
40 FormattingRule:
41 @Category[list]:
42 view
43 view-resource
44 form-input
45 @Name: referer-list
46 @Parameter:
47 @@Name: page
48 @@Type: WikiName
49 @@Default: (auto)
50 @@Description:
51 @@@: WikiPage name
52 @@lang: en
53 @Formatting:
54 __ATTRTEXT:%page__;
55 my @list;
56 try {
57 @list = map {[split /\x09/, $_, 2]}
58 split /\x0A/,
59 $o->{wiki}->{db}->get ('referer',
60 $o->{wiki}->name ($p->{page} ||
61 $o->{wiki}->{var}->{page}));
62 } catch SuikaWiki::DB::Util::Error with {
63 #
64 };
65
66 if (@list) {
67 my $list = $p->{-parent}->append_new_node
68 (type => '#element',
69 namespace_uri => $NS_XHTML1,
70 local_name => 'ol');
71 my $default_label = $WIKIRESOURCE->get
72 (name => 'Referer:URIReference2Label',
73 o => $o, wiki => $o->{wiki});
74 my $li_label = $WIKIRESOURCE->get
75 (name => 'Referer:RefererList:Label',
76 o => $o, wiki => $o->{wiki});
77 for my $item (sort {$b->[1] <=> $a->[1] or $a->[0] cmp $b->[0]} @list) {
78 local $o->{iwc__param}->{uri_reference} = URI->new ($item->[0]);
79 my $label;
80 try {
81 if ($o->{wiki}->{db}->exist (ref__item_template => [$item->[0]])) {
82 $label = $o->{wiki}->{db}->get (ref__item_template => [$item->[0]]);
83 } else {
84 my $site = $INTERWIKICORE->get_site_entry_by_uri_reference_match
85 (o => $o,
86 page => $o->{wiki}->{config}->{page}->{InterWikiName});
87 $label = $site ? $site->get_attribute_value ('URIReference2Label')
88 : $default_label;
89 $o->{wiki}->{db}->set (ref__item_template => [$item->[0]]
90 => $label);
91 }
92 } catch SuikaWiki::DB::Util::Error with {};
93 $WIKILINKING->to_resource_by_uri_in_html ({
94 label => $li_label,
95 ref__label => $label || $default_label,
96 } => {
97 uri => $o->{iwc__param}->{uri_reference},
98 }, {
99 o => $o,
100 parent => $list->append_new_node
101 (type => '#element',
102 namespace_uri => $NS_XHTML1,
103 local_name => 'li'),
104 ref__weight => $item->[1],
105 });
106 }
107 }
108
109 Function:
110 @Name: add_referer
111 @Main:
112 my (undef, %opt) = @_;
113 return unless $opt{wiki}->{db};
114 return unless $opt{uri};
115 $opt{page} ||= $opt{wiki}->{var}->{page};
116 my $o = $opt{o} || {wiki => $opt{wiki}};
117
118 ## To be canonical URI reference object
119 unless (ref $opt{uri}) {
120 $opt{uri} = URI->new ($opt{uri})->canonical;
121 } else {
122 $opt{uri} = $opt{uri}->canonical;
123 }
124
125 local $o->{iwc__param} = {
126 uri_reference => $opt{uri},
127 };
128
129 ## Check with site definition
130 my $site = $INTERWIKICORE->get_site_entry_by_uri_reference_match
131 (o => $o,
132 page => $opt{wiki}->{config}->{page}->{InterWikiName});
133 if ($site) {
134 my $v = 1;
135 my $check = $site->get_attribute_value
136 ('RefererLog', default => '1');
137 try {
138 $v = $o->{wiki}->{plugin}
139 ->boolean_formatter ('iwc__urireference_operation')
140 ->replace ($check, param => $o);
141 } catch Message::Util::Formatter::error with {
142 my $err = shift;
143 if ($err->{-object}->{-category_name} eq 'iwc__urireference_operation') {
144 my $wiki = $err->{-option}->{param}->{wiki};
145 SuikaWiki::Plugin->module_package ('Error')
146 ->reporting_formatting_template_error
147 ($err, $err->{option}->{param}->{wiki},
148 template => $check);
149 } else {
150 $err->throw;
151 }
152 };
153 return unless $v;
154 }
155
156 ## Update referer list
157 my %referer;
158 for (split /\x0A/, $opt{wiki}->{db}->get ('referer', $opt{page})) {
159 my ($n, $t) = split /\x09/, $_, 2;
160 $referer{$n} = $t + 0;
161 }
162 $referer{$o->{iwc__param}->{uri_reference}}++;
163 $opt{wiki}->{db}->set ('referer', $opt{page}
164 => join "\x0A", map {$_ . "\x09" . $referer{$_}} keys %referer);
165
166 FormattingRule:
167 @Category[list]: link-to-resource
168 @Name: ref--referer-item-weight
169 @Formatting:
170 $p->{-parent}->append_text ($o->{link}->{option}->{ref__weight});
171
172 FormattingRule:
173 @Category[list]: link-to-resource
174 @Name: ref--referer-item-label
175 @Description:
176 @@@:
177 Label for referer list item, that is taken from InterWikiName database.
178 @@lang: en
179 @Formatting:
180 try {
181 $f->replace ($o->{link}->{src}->{ref__label},
182 param => $o,
183 -parent => $p->{-parent});
184 } catch Message::Util::Formatter::error with {
185 my $err = shift;
186 if ($err->{-object}->{-category_name} eq $f->{-category_name}) {
187 my $wiki = $err->{option}->{param}->{wiki};
188 SuikaWiki::Plugin->module_package ('Error')
189 ->reporting_formatting_template_error
190 ($err, $wiki,
191 template => $o->{link}->{src}->{ref__label});
192 undef;
193 } else {
194 $err->throw;
195 }
196 };
197
198 Resource:
199 @Referer:RefererList:Label:
200 {%ref--referer-item-weight;} %ref--referer-item-label;
201 @Referer:URIReference2Label:
202 <%link-to-it (label => {%uri-reference;}p);>

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24