#!/usr/bin/perl -w

# Waxy Backlinks v0.04, released June 09, 2002
# Copyright 2002 Andrew Baio, http://www.waxy.org/
#
# 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.


use strict;

# The directory where you want to store the backlink files.
# Note: must be writable by your web server
my $backlinkdir = '/usr/local/apache/htdocs/backlink_cache';

# The total number of links you want to display for a single entry
my $max_links = 10;

# The minimum number of hits before a link is displayed
my $min_hits = 0;

# get the local host, for exclusion from referers
my $localhost = lc( $ENV{HTTP_HOST} );
$localhost =~ s/^www\.//i;

# Optional: the name of your website and any additional domains
# that you don't want counted (e.g. 'www.foo.com', 'foo.com')
my @blacklist = ( $localhost ); 

my $document    = $ENV{DOCUMENT_NAME};
my $referer     = $ENV{HTTP_REFERER};

&start();

sub start {
	my %referers = get_referers();
	
	if ($referer) {
		%referers = save_referer(%referers);
	}

	display_referer(%referers);

}


sub display_referer {
	my (%referers) = @_;

	print "Content-type:text/html\n\n";

	unless (scalar(keys %referers) > 0) {
		return;
	}
	
	# Displayed before the list of backlinks
	print qq[
		<b>Recent Links</b>
		<blockquote>
	];

	my %hosts = ();
	
	my $i = 0;

	foreach my $url (sort {$referers{$b} <=> $referers{$a}} keys %referers) {
		my ($scheme, $host, $rest) = split('//?', $url, 3);
		$host =~ s/^www\.//i;

		my $hits = $referers{$url};
		next if ($hits < $min_hits);
		
		my $visitor = $hits == 1 ? 'visitor' : 'visitors';

		# Controls the formatting of the backlinks		
		print qq[
			<a href="$url">$host</a> ($hits $visitor)<br />
		];
		
		$i++;
		last if ($i >= $max_links);
		
	}

	# Displayed after the list of backlinks
	print qq[
		</blockquote>
	];

}


sub save_referer {
	my (%referers) = @_;

	my ($scheme, $host, $rest) = split('//?', $referer, 3);
	foreach (@blacklist) {
		if ( $host =~ m/$_/i ) {
			return %referers;
		}
	}

	if ($rest eq '' or !$rest) {
		unless ($referer =~ m|/$|) {
			$referer .= '/';		# add trailing slash
		}
	}

	if ( exists($referers{"$scheme//www.$host/$rest"}) ) {
		$referers{"$scheme//www.$host/$rest"} += 1;
	} else {
		$referers{$referer} += 1;
	}

	open (OUT, "> $backlinkdir/$document") or die "Couldn't write file: $!";	
	foreach my $url (keys %referers) {
		print OUT "$url\t$referers{$url}\n";
	}
	close (OUT);
	
	return %referers;
	
}


sub get_referers {
	my %referers = ();
	
	if (-e "$backlinkdir/$document") {
		open (IN, "< $backlinkdir/$document") or die "Couldn't read file: $!";
		while (<IN>) {
			chomp;
			my ($url, $tally) = split(/\t/, $_);
			$referers{$url} = $tally;
		}
		close (IN);
	}
	
	return %referers;
	
}