Name:
	Referer
FullName:
	Backward linking
URI:
	IW:SuikaWiki:WikiPage

Initialize:
	SuikaWiki::Plugin->feature ('SuikaWiki::Markup::XML') or die "Referer: module SuikaWiki::Markup::XML can't be loaded";
	my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
	my $NS_RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#';
	my $NS_RSS = 'http://purl.org/rss/1.0/';
	my $NS_DC = 'http://purl.org/dc/elements/1.1/';

{
Name:
	wikiview/referer-list
FullName:
	List of referers to the page
Format:
	my $page = $o->{page} || $p->{page};
	my %list = get_referer_list ($page);
	my @name = get_site_name_list ();
	$r = SuikaWiki::Markup::XML->new (namespace_uri => $NS_XHTML1, local_name => 'ul');
	for my $uri (sort {$list{$b}<=>$list{$a}||$a cmp $b} keys %list) {
	    my $title;
	    for my $item (@name) {
	      if ($uri =~ /$item->[0]/) {
	        $title = $uri;
	        eval qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e}
	          or die "Referer: referer-list: $@";
	          #. qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e};
	        last;
	      }
	    }
	    my $item = $r->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'li');
	      for ($item->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'span')) {
	        $_->set_attribute (class => 'referer-uri-weight');
	        $_->append_text (qq({$list{$uri}}));
	      }
	      $item->append_text (' ');
	      if ($title) {
	        for ($item->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'a')) {
	          $_->set_attribute (href => $uri);
	          $_->set_attribute (title => qq(URI: <$uri>));
	          $_->append_text ($title);
	        }
	      } else {
	        $item->append_text ('<');
	        for ($item->append_new_node (namespace_uri => $NS_XHTML1, local_name => 'a')) {
	          $_->set_attribute (href => $uri);
	          $_->set_attribute (title => qq(URI: <$uri>));
	          $_->append_text ($uri);
	        }
	        $item->append_text ('>');
	      }
	}
	unless ($r->count) {
	  $r = '';
	}
}

MODULE:
	sub add_uri ($$) {
	  my $page = shift;
	  my $uri = shift;
	  unless (ref $uri) {
	    require URI;
	    $uri = URI->new ($uri);
	    ## Some schemes do not have query part.
	    eval q{ $uri->query (undef) if $uri->query =~ /^[0-9]{6,8}$/ };
	    $uri->fragment (undef);
	  }
	  $uri = $uri->canonical;
	  return unless $uri;
	  for my $regex (get_dont_record_list ()) {
	    return if $uri =~ /$regex/;
	  }
	  my %list = get_referer_list ($page);
	  $list{ $uri }++;
	  set_referer_list ($page, \%list);
	}
	
	sub get_referer_list ($) {
	  split /"/, SuikaWiki::Plugin->_database->meta (Referer => $_[0]);
	}
	sub set_referer_list ($%) {
	  my $page = shift;
	  my $list = shift;
	  SuikaWiki::Plugin->_database->meta (Referer => $page => join '"', %$list);
	}
	
	sub get_dont_record_list () {
	  map {s/\$/\\\$/g; s/\@/\\\@/g; $_}
	  grep !/^#/,
	  split /[\x0D\x0A]+/, $main::database{$main::PageName{RefererDontRecord}};
	}
	sub get_site_name_list () {
	  my @lines = grep /[^#]/, split /[\x0D\x0A]+/, $main::database{$main::PageName{RefererSiteName}};
	  my @item;
	  for (@lines) {
	    next if /^#/;
	    my ($uri, $name) = split /\s+/, $_, 2;
	    $uri =~ s/\$/\\\$/g;  $uri =~ s/\@/\\\@/g;  $uri =~ s/\//\\\//g;
	    $name =~ s!([()/\\])!\\$1!g;  $name =~ s/\$([0-9]+)/).__decode (\${$1}).q(/g;
	    push @item, [$uri, qq(q($name))];
	  }
	  @item;
	}
	
	sub __decode ($) {
	  my $s = shift;
	  $s =~ tr/+/ /;
	  $s =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
	  main::code_convert (\$s);
	}
	
	push @{$SuikaWiki::Plugin::On{WikiDatabaseLoaded}}, sub {
	  SuikaWiki::Plugin::Referer::add_uri ($main::form{mypage}, $main::ENV{HTTP_REFERER});
	};

POD:TO DO:
	- Customizable referer list
	
	- Trackback/pingback
	
	- Message::Util::Formatter text in referer-referring page title
POD:SEE ALSO:
	SuikaWiki::Plugin::Map
POD:LICENSE:
	Copyright 2003 Wakaba <w@suika.fam.cx>
	
	%%GNUGPL2%%