UseMod Wiki: ElMoro/GetReferersBar

Save the following into GetReferersBar.pl


# GetReferersBar version 0.2 (December 12, 2001)
#
# A patch/plugin to be used with UseModWiki version 0.92 (April 21, 2001)
# This plugin writes referer's links and saves referer's names every time a valid page
# page is browsed. Availabe at www.usemod.org/wiki.pl?GetReferersBar
#
# see POD below after __END__
#use warnings;

use vars qw($RefeDir %ThisRefereRs %ThisRefereEs $MaxRefs $MaxRefCols $UseRefCss);

$MaxRefs	= 24;					# max number of RefereRs to display in the RefereRs bar
$MaxRefCols = 4;					# max number of columns in the RefereRs table
$RefeDir	= "$DataDir/refe";	    # Stores RefereRs data
$UseRefCss	= 1;					# 1: use css file 0: don't use it


sub GetReferer {	# returns the referer pagename if it is a wiki page but not an action page
	use CGI qw/:standard/;
	my ($RequestedPage)=@_;
	my ($ref);
	$ref=referer();
	if ( !($ref =~ /action=/) && !($ref =~ /search=/) ) {
		if ( $ref =~ /$ScriptName\?/ )  {
           	$ref= $';  # $' means whatever came after
            if ( $ref ne $RequestedPage ) {	#don't want to include reloads
				return $ref; #
            }
   		}
	}
	else {
		return '';
	}
}

sub GetRefeFile {	# returns filename containing referer info about page $id
  my ($id) = @_;
  return $RefeDir . "/" . &GetPageDirectory($id) . "/$id.rf";
}

sub UpdateRefereRs	{   # saves referer info on a file
	my ($page,$fereRslist,$fereEslist)= @_ ;
	my (%allr);
	%allr = ("referer",$fereRslist,"referee",$fereEslist);

	&CreatePageDir($RefeDir, $page);
	$file = $RefeDir . "/" . &GetPageDirectory($page) .  "/$page.rf";
	&WriteStringToFile($file, join($FS1,%allr));
}

sub ReadRefeFile {	 # reads referer info from a file
	my ($file,$type)=@_;
	my ($data,%alldata,%allrefs);
	if (-f $file) {
	    	$data = &ReadFileOrDie($file);
	     	%alldata = split(/$FS1/, $data, -1);
			%allrefs = split(/$FS2/, $alldata{$type},-1);
	}
	return %allrefs;
}

sub GetReferences {	 # browse referer info, puts them on a hash, updates and saves new info
	my ($RequestedPage)=@_;
	my ($ThisPageReferer,$refererfile,$refereefile,%RefRefereEs,%RefRefereRs,$join1,$join2);
	$ThisPageReferer=&GetReferer($RequestedPage);
 	$refererfile = &GetRefeFile($RequestedPage);
	$refereefile = &GetRefeFile($ThisPageReferer);
	%ThisRefereRs = &ReadRefeFile($refererfile,'referer');
	%ThisRefereEs = &ReadRefeFile($refererfile,'referee');
	if  ($ThisPageReferer ne '') {
		$ThisRefereRs{$ThisPageReferer}++; 				#updates this page RefereRs
		$join1=join($FS2,%ThisRefereRs);
		$join2=join($FS2,%ThisRefereEs);
		&UpdateRefereRs($RequestedPage,$join1,$join2);	#saves the update

        %RefRefereEs = &ReadRefeFile($refereefile,'referee');
		%RefRefereRs = &ReadRefeFile($refereefile,'referer');
		$RefRefereEs{$RequestedPage}++;
		$join1=join($FS2,%RefRefereRs);
		$join2=join($FS2,%RefRefereEs);     				#updates RefereRs' refereee
		&UpdateRefereRs($ThisPageReferer,$join1,$join2);  	#saves the update
	}
}

sub RefScriptLink {	 # it would be nicer to update sub ScriptLink to accept the class variable
  my ($action, $text, $class) = @_;
  return "<a class=$class href=\"$ScriptName?$action\">$text</a>";
}

sub RefGetPageLink { # it would be nicer to update sub GetPageLink to accept the class/value variables
  my ($id,$class,$value) = @_;
  my $name = $id;

  $id =~ s|^/|$MainPage/|;
  if ($FreeLinks) {
    $id = &FreeToNormal($id);
    $name =~ s/_/ /g;
	$name .= " ($value)" ;
  }
  return &RefScriptLink($id, $name, $class);
}

sub printcells {	#prints each referer cell
	my ($maxcolors,$reference_to_values)=@_ ;
	my ($i,$html);
	my (%thishash) = %{$reference_to_values}; 		 # this stuff ain't in the lama book
	$i=0;
	foreach $key (sort { $thishash{$b}<=>$thishash{$a} || $a cmp $b } keys %thishash) {
		$html .="<TR><TD>" if ($i != 0 && $i % $MaxRefCols==0) ;
		$i++;
		last if ($i > $maxcolors);
		$html .= "<TD nowrap class=";
		$html .= &class($i,$maxcolors) if ($UseRefCss==1);
		$html .= ">";
		if ($UseRefCss==1) {  #highly recommended for nice visual output
			$html .= &RefGetPageLink($key,&class($i,$maxcolors),$thishash{$key}) .  " \n";
		}
		else  {
			$html .= &RefGetPageLink($key,'',$thishash{$key}) .  " \n";
		}
	}

	return $html;
}

sub class {		# gets the css class to use for shading cells
	my ($i,$nrefs)=@_	;
	my ($min)=0;
	my ($max)=0;
	return 	"ref".int($min+($i-1)*(255-$max)/$nrefs ); #+min-max business to avoid dark black and pure white
}

sub GetReferersBar{	 # draws the Referers table; use css classes for best outcomes
	my ($bartext,$nrefs,$n1,$n2,$i);

	$n1=keys %ThisRefereRs;	  			 #takes the min between $MaxRefs and (the max of n1,n2)
	$n2=keys %ThisRefereEs;   			 #the point of this is to have a consistent shading look
	$i=(sort { $b <=> $a } ($n1,$n2))[0]	;	 #if using css stylesheets
	$nrefs=(sort { $a <=> $b } ($MaxRefs,$i))[0]; # (trust me don't sweat too much around this)

	return if ($nrefs==0); 			     #don't print anything if there are no references
	$bartext .= "<TABLE width=90% border=0>\n";
    $bartext .= "<TR><TD width=2%>\n<B><I>Referers: </B></I>";		#prints RefereRs
	$bartext .= &printcells($nrefs,\%ThisRefereRs);
	$bartext .= "<TR><TD width=2%>\n<B><I>Referees: </B></I>";		#prints RefereRs
	$bartext .= &printcells($nrefs,\%ThisRefereEs);
	$bartext .= "</TABLE><HR>" ;
	return $bartext;
}

__END__

=head1 NAME

getreferersbar.pl

=head1 VERSION

0.2 (beta) (November 12, 2001)

=head1 ABSTRACT

An enhancement patch to be used with UseModWiki version 0.92 (April 21, 2001)
It writes referer's links and saves referer's names every time a valid page
page is browsed. Then prints a table with links to the page referers and to
the pages referred to ("referees").
Availabe at www.usemod.org/wiki.pl?GetReferersBar

=head1 INCLUDED FILES

=item getreferersbar.pl
=item ref.css	(optional but recommended)
=item makeref.pl (definitely optional)

=head1 INSTALLATION

Follow these simple steps. (N.B. this is not guaranteed to be optimal)
=item copy this file in your cgi-bin dir (the same directory where your wiki.pl is)
=item add the following line inside sub DoCacheBrowse after line $idFile = &GetHtmlCacheFile($query);
  &GetReferences($query) ;
=item add the following line right before $BrowseCode is assigned i.e. before the comment # == Normal page-browsing
	do "getreferersbar.pl";
=item add the following line to wiki.pl inside sub BrowsePage, between rows containing $MainPage =~ s|/.*||;
and the row containing $fullHtml = &GetHeader($id, &QuoteHtml($id), $oldId);
  &GetReferences($OpenPageName);
=item place your referer links where desired. For example i place towards
	the end of subroutine &BrowsePage before $fullHtml .= &GetFooterPage the following line:
  $fullHtml .= &GetReferersBar;
=item For best results, you should also add the included stylesheet ref.css to your data directory (or
import its contents to your existing stylesheet. If you choose to do so, you have to indicate the
path to the file in the config file, configuration variable
(e.g. $StyleSheet  = "my_data_dir/ref.css")

This distribution also includes makeref.pl a simple perl file that generates appropriate
usable stylesheets. With appropriate modification you can obtain shades of colors different
than grey.

=head1 HISTORY

0.2 (12/11/2001)
=item Placed all global variables within the file to minimize installation instructions
=item Fixed some sorting problem
=item The code now saves referers when cache is on

0.1
=item First release

=head1 KNOWN PROBLEMS

= when UseCache=1 and the page is pulled from the cache, it will not display an updated list
of referers and referees.
= when UseRefCss=1 The referers "rank" for computing backgrounds is based on number of hits first
then on alphabetical value of the referer pagename. Different referers will display a different
background (depending on such rank) even if they have the same number of hits. A future release will
display rank and background as a function of hits percentage of the total.

=head1 AUTHOR INFORMATION

Andrea Moro <amoro@econ.umn.edu>

=head1 COPYRIGHT

Copyright (C) 2001 Andrea Moro

UseModWiki is under Copyright (C) 2000-2001 Clifford A. Adams
<usemod@usemod.com>
Based on the GPLed AtisWiki 0.3  (C) 1998 Markus Denker
...which was based on
the LGPLed CVWiki CVS-patches (C) 1997 Peter Merel
and The Original WikiWikiWeb  (C) Ward Cunningham
<ward@c2.com> (code reused with permission)
Email and ThinLine options by Jim Mahoney <mahoney@marlboro.edu>

 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
 the Free Software Foundation; either version 2 of the License, or
 (at your option) any later version.

 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.

 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the
    Free Software Foundation, Inc.
    59 Temple Place, Suite 330
    Boston, MA 02111-1307 USA

could be replaced? "?" in regard to Script link Char with &ScriptLinkChar ?

Thanks in advance. --JuanmaMP

sub GetReferer { ...

	- if ( !($ref =~ /action=/) && !($ref =~ /search=/) ) {
	+ if ( !($ref =~ /action=/) && !($ref =~ /search=/) && !($ref =~ /back=/)) {

...

--JuanmaMP