misc/plugins/referer.wp2

#?SuikaWikiConfig/2.0

Plugin:
  @Name: Referer
  @Description:
    @@@: Backward hyperlinking
    @@lang:en
  @License: %%Perl%%
  @Author:
    @@Name:
      @@@@: Wakaba
      @@@lang:ja
      @@@script:Latn
    @@Mail[list]: w@suika.fam.cx
  @Date.RCS:
    $Date: 2004/04/17 04:17:53 $
  @RequiredPlugin[list]: 
    InterWikiCore
    WikiStructure
    WikiLinking
  @RequiredModule[list]:
    URI
  @Use:
    use Message::Util::Error;
    require URI;
    my $INTERWIKICORE;
    my $WIKIRESOURCE;
    my $WIKILINKING;

PluginConst:
  @NS_XHTML1:
    http://www.w3.org/1999/xhtml
  @INTERWIKICORE:
    {($INTERWIKICORE ||= SuikaWiki::Plugin->module_package ('InterWikiCore'))}
  @WIKIRESOURCE:
    {($WIKIRESOURCE ||= SuikaWiki::Plugin->module_package ('WikiResource'))}
  @WIKILINKING:
    {($WIKILINKING ||= SuikaWiki::Plugin->module_package ('WikiLinking'))}

FormattingRule:
  @Category[list]:
    view
    view-resource
    form-input
  @Name: referer-list
  @Parameter:
    @@Name: page
    @@Type: WikiName
    @@Default: (auto)
    @@Description:
      @@@: WikiPage name
      @@lang: en
  @Formatting:
    __ATTRTEXT:%page__;
    my @list;
    try {
      my $ref = $o->{wiki}->{db}->get ('referer',
                                       $o->{wiki}->name ($p->{page} ||
                                       $o->{wiki}->{var}->{page}));
      @list = map {[$_ => $ref->{$_}]} keys %$ref;
    } catch SuikaWiki::DB::Util::Error with {
      # 
    };
  
    if (@list) {
      my $list = $p->{-parent}->append_new_node
                     (type => '#element',
                      namespace_uri => $NS_XHTML1,
                      local_name => 'ol');

      @list = sort {$b->[1] <=> $a->[1] or $a->[0] cmp $b->[0]} @list;

    my $start = length $p->{start} ? $p->{start} :
                $o->{wiki}->{input}->parameter ('ref--range-start') || 0;
    $p->{number} = $o->{wiki}->{input}->parameter ('ref--range-number')
                 unless length $p->{number};
    my $end = $p->{number} ? $start + $p->{number} - 1 : $start + 29;
    $start = 0 if $start > $#list or $start < 0;
    $end = $#list if $end < $start or $end > $#list;
    $end = $start + 255 if $end > $start + 255;
    local $o->{var}->{search__result} = {
      min => 0,
      max => $#list,
      start => $start,
      end => $end,
      number => $p->{number} || 30,
      param_prefix => 'ref',
    };

      my $default_label = $WIKIRESOURCE->get
                             (name => 'Referer:URIReference2Label',
                              o => $o, wiki => $o->{wiki});
      my $li_label = $WIKIRESOURCE->get
                            (name => 'Referer:RefererList:Label',
                             o => $o, wiki => $o->{wiki});

      for my $item (@list[$start..$end]) {
        local $o->{iwc__param}->{uri_reference} = URI->new ($item->[0]);
        my $label;
        try {
          $label = $o->{wiki}->{db}->get (ref__item_template => [$item->[0]])
            or do {
                my $site = $INTERWIKICORE->get_site_entry_by_uri_reference_match
                         (o => $o,
                          page => $o->{wiki}->{config}->{page}->{InterWikiName});
                $label = $site ? $site->get_attribute_value
                                   ('URIReference2Label') || $default_label
                               : $default_label;
                $o->{wiki}->{db}->set (ref__item_template => [$item->[0]]
                                                          => $label);
            };
        } catch SuikaWiki::DB::Util::Error with {};
        $WIKILINKING->to_resource_by_uri_in_html ({
          label => $li_label,
          ref__label => $label,
        } => {
          uri => $o->{iwc__param}->{uri_reference},
        }, {
          o => $o,
          parent => $list->append_new_node
                     (type => '#element',
                      namespace_uri => $NS_XHTML1,
                      local_name => 'li'),
          ref__weight => $item->[1],
        });
      }

      $list->set_attribute (start => $start + 1);
      __ATTRNODE:%post_list->{$p->{-parent}}__;
    }

Function:
  @Name: add_referer
  @Main:
    my (undef, %opt) = @_;
    return unless $opt{wiki}->{db};
    return unless $opt{uri};
    $opt{page} ||= $opt{wiki}->{var}->{page};
    my $o = $opt{o} || {wiki => $opt{wiki}};
    
    ## To be canonical URI reference object
    unless (ref $opt{uri}) {
      $opt{uri} = URI->new ($opt{uri})->canonical;
    } else {
      $opt{uri} = $opt{uri}->canonical;
    }

    local $o->{iwc__param} = {
      uri_reference => $opt{uri},
    };

    ## Check with site definition
    my $site = $INTERWIKICORE->get_site_entry_by_uri_reference_match
                  (o => $o,
                   page => $opt{wiki}->{config}->{page}->{InterWikiName});
    if ($site) {
      my $v = 1;
      my $check = $site->get_attribute_value
                                    ('RefererLog', default => '1');
      try {
        $v = $o->{wiki}->{plugin}
               ->boolean_formatter ('iwc__urireference_operation')
               ->replace ($check, param => $o);
      } catch Message::Util::Formatter::error with {
        my $err = shift;
        if ($err->{-object}->{-category_name} eq 'iwc__urireference_operation') {
          my $wiki = $err->{-option}->{param}->{wiki};
          SuikaWiki::Plugin->module_package ('Error')
                           ->reporting_formatting_template_error
                               ($err, $err->{option}->{param}->{wiki},
                                template => $check);
        } else {
          $err->throw;
        }
      };
      return unless $v;
    }
    
    ## Update referer list
    my $ref = $opt{wiki}->{db}->get ('referer', $opt{page});
    $ref->{$o->{iwc__param}->{uri_reference}}++;
    $opt{wiki}->{db}->set ('referer', $opt{page} => $ref);

FormattingRule:
  @Category[list]: link-to-resource
  @Name: ref--referer-item-weight
  @Formatting:
    $p->{-parent}->append_text ($o->{link}->{option}->{ref__weight});

FormattingRule:
  @Category[list]: link-to-resource
  @Name: ref--referer-item-label
  @Description:
    @@@:
      Label for referer list item, that is taken from InterWikiName database.
    @@lang: en
  @Formatting:
    try {
      $f->replace ($o->{link}->{src}->{ref__label},
                   param => $o,
                   -parent => $p->{-parent});
    } catch Message::Util::Formatter::error with {
      my $err = shift;
      if ($err->{-object}->{-category_name} eq $f->{-category_name}) {
        my $wiki = $err->{option}->{param}->{wiki};
        SuikaWiki::Plugin->module_package ('Error')
                         ->reporting_formatting_template_error
                             ($err, $wiki,
                              template => $o->{link}->{src}->{ref__label});
        undef;
      } else {
        $err->throw;
      }
    };

XViewFragment:
  @Name: ws--post-content
  @Description:
    @@@: After content body -- referer lista
    @@lang:en
  @Order: 150
  @Formatting:
        %section (
          id => referer,
          title => {%res(name=>Referer);}p, heading,
          content => {%referer-list (
            number => 10,
            post-list => {%search--result-navigation (
              fragment => referer,
            );}p,
          );}p,
        );

Resource:
  @Referer:RefererList:Label:
    {%ref--referer-item-weight;} %ref--referer-item-label;
  @Referer:URIReference2Label:
    <%link-to-it (label => {%uri-reference;}p);>
1	wakaba	1.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]: w@suika.fam.cx
15			@Date.RCS:
16	wakaba	1.9	$Date: 2004/04/17 04:17:53 $
17	wakaba	1.1	@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	wakaba	1.8	my $ref = $o->{wiki}->{db}->get ('referer',
58			$o->{wiki}->name ($p->{page} \|\|
59	wakaba	1.1	$o->{wiki}->{var}->{page}));
60	wakaba	1.8	@list = map {[$_ => $ref->{$_}]} keys %$ref;
61	wakaba	1.1	} catch SuikaWiki::DB::Util::Error with {
62			#
63			};
64	wakaba	1.6
65	wakaba	1.1	if (@list) {
66			my $list = $p->{-parent}->append_new_node
67			(type => '#element',
68			namespace_uri => $NS_XHTML1,
69			local_name => 'ol');
70	wakaba	1.7
71			@list = sort {$b->[1] <=> $a->[1] or $a->[0] cmp $b->[0]} @list;
72
73			my $start = length $p->{start} ? $p->{start} :
74			$o->{wiki}->{input}->parameter ('ref--range-start') \|\| 0;
75			$p->{number} = $o->{wiki}->{input}->parameter ('ref--range-number')
76			unless length $p->{number};
77			my $end = $p->{number} ? $start + $p->{number} - 1 : $start + 29;
78			$start = 0 if $start > $#list or $start < 0;
79			$end = $#list if $end < $start or $end > $#list;
80			$end = $start + 255 if $end > $start + 255;
81			local $o->{var}->{search__result} = {
82			min => 0,
83			max => $#list,
84			start => $start,
85			end => $end,
86			number => $p->{number} \|\| 30,
87			param_prefix => 'ref',
88			};
89
90	wakaba	1.2	my $default_label = $WIKIRESOURCE->get
91			(name => 'Referer:URIReference2Label',
92			o => $o, wiki => $o->{wiki});
93			my $li_label = $WIKIRESOURCE->get
94			(name => 'Referer:RefererList:Label',
95			o => $o, wiki => $o->{wiki});
96	wakaba	1.7
97			for my $item (@list[$start..$end]) {
98	wakaba	1.2	local $o->{iwc__param}->{uri_reference} = URI->new ($item->[0]);
99			my $label;
100			try {
101	wakaba	1.4	$label = $o->{wiki}->{db}->get (ref__item_template => [$item->[0]])
102			or do {
103			my $site = $INTERWIKICORE->get_site_entry_by_uri_reference_match
104	wakaba	1.2	(o => $o,
105			page => $o->{wiki}->{config}->{page}->{InterWikiName});
106	wakaba	1.4	$label = $site ? $site->get_attribute_value
107			('URIReference2Label') \|\| $default_label
108			: $default_label;
109			$o->{wiki}->{db}->set (ref__item_template => [$item->[0]]
110			=> $label);
111			};
112	wakaba	1.2	} catch SuikaWiki::DB::Util::Error with {};
113	wakaba	1.1	$WIKILINKING->to_resource_by_uri_in_html ({
114	wakaba	1.2	label => $li_label,
115	wakaba	1.4	ref__label => $label,
116	wakaba	1.1	} => {
117	wakaba	1.2	uri => $o->{iwc__param}->{uri_reference},
118	wakaba	1.1	}, {
119			o => $o,
120			parent => $list->append_new_node
121			(type => '#element',
122			namespace_uri => $NS_XHTML1,
123			local_name => 'li'),
124	wakaba	1.2	ref__weight => $item->[1],
125	wakaba	1.1	});
126			}
127	wakaba	1.7
128			$list->set_attribute (start => $start + 1);
129			__ATTRNODE:%post_list->{$p->{-parent}}__;
130	wakaba	1.1	}
131
132			Function:
133			@Name: add_referer
134			@Main:
135			my (undef, %opt) = @_;
136			return unless $opt{wiki}->{db};
137	wakaba	1.2	return unless $opt{uri};
138	wakaba	1.1	$opt{page} \|\|= $opt{wiki}->{var}->{page};
139			my $o = $opt{o} \|\| {wiki => $opt{wiki}};
140
141			## To be canonical URI reference object
142			unless (ref $opt{uri}) {
143			$opt{uri} = URI->new ($opt{uri})->canonical;
144			} else {
145			$opt{uri} = $opt{uri}->canonical;
146			}
147
148			local $o->{iwc__param} = {
149			uri_reference => $opt{uri},
150			};
151
152			## Check with site definition
153			my $site = $INTERWIKICORE->get_site_entry_by_uri_reference_match
154			(o => $o,
155			page => $opt{wiki}->{config}->{page}->{InterWikiName});
156			if ($site) {
157			my $v = 1;
158			my $check = $site->get_attribute_value
159			('RefererLog', default => '1');
160			try {
161			$v = $o->{wiki}->{plugin}
162			->boolean_formatter ('iwc__urireference_operation')
163			->replace ($check, param => $o);
164			} catch Message::Util::Formatter::error with {
165			my $err = shift;
166			if ($err->{-object}->{-category_name} eq 'iwc__urireference_operation') {
167			my $wiki = $err->{-option}->{param}->{wiki};
168			SuikaWiki::Plugin->module_package ('Error')
169			->reporting_formatting_template_error
170			($err, $err->{option}->{param}->{wiki},
171			template => $check);
172			} else {
173			$err->throw;
174			}
175			};
176			return unless $v;
177			}
178
179			## Update referer list
180	wakaba	1.8	my $ref = $opt{wiki}->{db}->get ('referer', $opt{page});
181			$ref->{$o->{iwc__param}->{uri_reference}}++;
182			$opt{wiki}->{db}->set ('referer', $opt{page} => $ref);
183	wakaba	1.1
184			FormattingRule:
185			@Category[list]: link-to-resource
186			@Name: ref--referer-item-weight
187			@Formatting:
188			$p->{-parent}->append_text ($o->{link}->{option}->{ref__weight});
189
190			FormattingRule:
191			@Category[list]: link-to-resource
192			@Name: ref--referer-item-label
193	wakaba	1.2	@Description:
194			@@@:
195			Label for referer list item, that is taken from InterWikiName database.
196			@@lang: en
197	wakaba	1.1	@Formatting:
198	wakaba	1.2	try {
199			$f->replace ($o->{link}->{src}->{ref__label},
200			param => $o,
201			-parent => $p->{-parent});
202			} catch Message::Util::Formatter::error with {
203			my $err = shift;
204			if ($err->{-object}->{-category_name} eq $f->{-category_name}) {
205			my $wiki = $err->{option}->{param}->{wiki};
206			SuikaWiki::Plugin->module_package ('Error')
207			->reporting_formatting_template_error
208			($err, $wiki,
209			template => $o->{link}->{src}->{ref__label});
210			undef;
211			} else {
212			$err->throw;
213			}
214			};
215	wakaba	1.3
216	wakaba	1.9	XViewFragment:
217	wakaba	1.3	@Name: ws--post-content
218			@Description:
219			@@@: After content body -- referer lista
220			@@lang:en
221			@Order: 150
222			@Formatting:
223			%section (
224			id => referer,
225			title => {%res(name=>Referer);}p, heading,
226	wakaba	1.7	content => {%referer-list (
227			number => 10,
228			post-list => {%search--result-navigation (
229			fragment => referer,
230			);}p,
231			);}p,
232	wakaba	1.3	);
233	wakaba	1.1
234			Resource:
235			@Referer:RefererList:Label:
236			{%ref--referer-item-weight;} %ref--referer-item-label;
237			@Referer:URIReference2Label:
238			<%link-to-it (label => {%uri-reference;}p);>