| 1 |
wakaba |
1.1 |
Name: |
| 2 |
|
|
Referer |
| 3 |
|
|
FullName: |
| 4 |
|
|
Backward linking |
| 5 |
|
|
URI: |
| 6 |
|
|
IW:SuikaWiki:WikiPage |
| 7 |
|
|
|
| 8 |
|
|
Initialize: |
| 9 |
|
|
SuikaWiki::Plugin->feature ('SuikaWiki::Markup::XML') or die "Referer: module SuikaWiki::Markup::XML can't be loaded"; |
| 10 |
|
|
my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml'; |
| 11 |
|
|
my $NS_RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; |
| 12 |
|
|
my $NS_RSS = 'http://purl.org/rss/1.0/'; |
| 13 |
|
|
my $NS_DC = 'http://purl.org/dc/elements/1.1/'; |
| 14 |
|
|
|
| 15 |
|
|
{ |
| 16 |
|
|
Name: |
| 17 |
|
|
wikiview/referer-list |
| 18 |
|
|
FullName: |
| 19 |
|
|
List of referers to the page |
| 20 |
|
|
Format: |
| 21 |
|
|
my $page = $o->{page} || $p->{page}; |
| 22 |
|
|
my %list = get_referer_list ($page); |
| 23 |
|
|
my @name = get_site_name_list (); |
| 24 |
|
|
$r = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'ul'); |
| 25 |
|
|
for my $uri (sort {$list{$b}<=>$list{$a}||$a cmp $b} keys %list) { |
| 26 |
|
|
my $title; |
| 27 |
|
|
for my $item (@name) { |
| 28 |
|
|
if ($uri =~ /$item->[0]/) { |
| 29 |
|
|
$title = $uri; |
| 30 |
|
|
eval qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e} |
| 31 |
|
|
or die "Referer: referer-list: $@"; |
| 32 |
|
|
#. qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e}; |
| 33 |
|
|
last; |
| 34 |
|
|
} |
| 35 |
|
|
} |
| 36 |
|
|
my $item = $r->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'li'); |
| 37 |
|
|
for ($item->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'span')) { |
| 38 |
|
|
$_->set_attribute (class => 'referer-uri-weight'); |
| 39 |
|
|
$_->append_text (qq({$list{$uri}})); |
| 40 |
|
|
} |
| 41 |
|
|
$item->append_text (' '); |
| 42 |
|
|
if ($title) { |
| 43 |
|
|
for ($item->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'a')) { |
| 44 |
|
|
$_->set_attribute (href => $uri); |
| 45 |
|
|
$_->set_attribute (title => qq(URI: <$uri>)); |
| 46 |
|
|
$_->append_text ($title); |
| 47 |
|
|
} |
| 48 |
|
|
} else { |
| 49 |
|
|
$item->append_text ('<'); |
| 50 |
|
|
for ($item->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'a')) { |
| 51 |
|
|
$_->set_attribute (href => $uri); |
| 52 |
|
|
$_->set_attribute (title => qq(URI: <$uri>)); |
| 53 |
|
|
$_->append_text ($uri); |
| 54 |
|
|
} |
| 55 |
|
|
$item->append_text ('>'); |
| 56 |
|
|
} |
| 57 |
|
|
} |
| 58 |
|
|
unless ($r->count) { |
| 59 |
|
|
$r = ''; |
| 60 |
|
|
} |
| 61 |
|
|
} |
| 62 |
|
|
|
| 63 |
|
|
MODULE: |
| 64 |
|
|
sub add_uri ($$) { |
| 65 |
|
|
my $page = shift; |
| 66 |
|
|
my $uri = shift; |
| 67 |
|
|
unless (ref $uri) { |
| 68 |
|
|
require URI; |
| 69 |
|
|
$uri = URI->new ($uri); |
| 70 |
|
|
## Some schemes do not have query part. |
| 71 |
|
|
eval q{ $uri->query (undef) if $uri->query =~ /^[0-9]{6,8}$/ }; |
| 72 |
|
|
$uri->fragment (undef); |
| 73 |
|
|
} |
| 74 |
|
|
$uri = $uri->canonical; |
| 75 |
|
|
return unless $uri; |
| 76 |
|
|
for my $regex (get_dont_record_list ()) { |
| 77 |
|
|
return if $uri =~ /$regex/; |
| 78 |
|
|
} |
| 79 |
|
|
my %list = get_referer_list ($page); |
| 80 |
|
|
$list{ $uri }++; |
| 81 |
|
|
set_referer_list ($page, \%list); |
| 82 |
|
|
} |
| 83 |
|
|
|
| 84 |
|
|
sub get_referer_list ($) { |
| 85 |
|
|
split /"/, SuikaWiki::Plugin->_database->meta (Referer => $_[0]); |
| 86 |
|
|
} |
| 87 |
|
|
sub set_referer_list ($%) { |
| 88 |
|
|
my $page = shift; |
| 89 |
|
|
my $list = shift; |
| 90 |
|
|
SuikaWiki::Plugin->_database->meta (Referer => $page => join '"', %$list); |
| 91 |
|
|
} |
| 92 |
|
|
|
| 93 |
|
|
sub get_dont_record_list () { |
| 94 |
|
|
map {s/\$/\\\$/g; s/\@/\\\@/g; $_} |
| 95 |
|
|
grep !/^#/, |
| 96 |
|
|
split /[\x0D\x0A]+/, $main::database{$main::PageName{RefererDontRecord}}; |
| 97 |
|
|
} |
| 98 |
|
|
sub get_site_name_list () { |
| 99 |
|
|
my @lines = grep /[^#]/, split /[\x0D\x0A]+/, $main::database{$main::PageName{RefererSiteName}}; |
| 100 |
|
|
my @item; |
| 101 |
|
|
for (@lines) { |
| 102 |
|
|
next if /^#/; |
| 103 |
|
|
my ($uri, $name) = split /\s+/, $_, 2; |
| 104 |
|
|
$uri =~ s/\$/\\\$/g; $uri =~ s/\@/\\\@/g; $uri =~ s/\//\\\//g; |
| 105 |
|
|
$name =~ s!([()/\\])!\\$1!g; $name =~ s/\$([0-9]+)/).__decode (\${$1}).q(/g; |
| 106 |
|
|
push @item, [$uri, qq(q($name))]; |
| 107 |
|
|
} |
| 108 |
|
|
@item; |
| 109 |
|
|
} |
| 110 |
|
|
|
| 111 |
|
|
sub __decode ($) { |
| 112 |
|
|
my $s = shift; |
| 113 |
|
|
$s =~ tr/+/ /; |
| 114 |
|
|
$s =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge; |
| 115 |
|
|
main::code_convert (\$s); |
| 116 |
|
|
} |
| 117 |
|
|
|
| 118 |
|
|
push @{$SuikaWiki::Plugin::On{WikiDatabaseLoaded}}, sub { |
| 119 |
|
|
SuikaWiki::Plugin::Referer::add_uri ($main::form{mypage}, $main::ENV{HTTP_REFERER}); |
| 120 |
|
|
}; |
| 121 |
|
|
|
| 122 |
|
|
POD:TO DO: |
| 123 |
|
|
- Customizable referer list |
| 124 |
|
|
|
| 125 |
|
|
- Trackback/pingback |
| 126 |
|
|
|
| 127 |
|
|
- Message::Util::Formatter text in referer-referring page title |
| 128 |
|
|
POD:SEE ALSO: |
| 129 |
|
|
SuikaWiki::Plugin::Map |
| 130 |
|
|
POD:LICENSE: |
| 131 |
|
|
Copyright 2003 Wakaba <w@suika.fam.cx> |
| 132 |
|
|
|
| 133 |
|
|
%%GNUGPL2%% |
Parent Directory
| 
Revision Log