WikiPatches/AutomaticLinkBack

Documentation: http://www.emacswiki.org/cgi-bin/oddmuse.pl?Automatic_Link_Back

Discussion: MeatBall:AutomaticLinkBack

Example: http://www.emacswiki.org/cgi-bin/alex.pl

New Variables

Add the following variables at the beginning: $RefererDir $RefererTracking $RefererTimeLimit $RefererLimit %Referers.

Initialize them as follows:

$RefererTracking = 0;      # Keep track of referrals to your pages
$RefererTimeLimit = 60 * 60 * 24; # How long referrals shall be remembered
$RefererLimit = 15;        # How many different referer shall be remembered

$RefererDir  = "$DataDir/referer";  # Stores referer data

Changes

In BrowsePage, at the end:

if ($RefererTracking && !&GetParam('embed', $EmbedWiki)) {
    print &RefererTrack($id);
  }
  print &GetFooterText($id, $goodRevision);
}

Change ForceReleaseLock? to deal with globbing:

sub ForceReleaseLock {
  my ($pattern) = @_;
  my $forced;
  foreach my $name (glob $pattern) {
    # First try to obtain lock (in case of normal edit lock)
    # 5 tries, 3 second wait, do not die on error
    # return 1 if any of the globs was forced
    $forced = 1 if !&RequestLockDir($name, 5, 3, 0);
    &ReleaseLockDir($name);  # Release the lock, even if we didn't get it.
  }
  return $forced;
}

New Stuff

sub RequestRefererLock {
  # 4 tries, 2 second wait, do not die on error
  my $id = shift;
  return &RequestLockDir('refer_' . $id, 4, 2, 0);
}

sub ReleaseRefererLock {
  my $id = shift;
  &ReleaseLockDir('refer_' . $id);
}

sub GetRefererFile {
  my ($id) = @_;
  return $RefererDir . '/' . &GetPageDirectory($id) . "/$id.rb";
}

sub ReadReferers {
  my ($id) = @_;
  my $file = &GetRefererFile($id);
  %Referers = ();
  if (-f $file) {
    my ($status, $data) = &ReadFile($file);
    %Referers = split(/$FS1/, $data, -1) if $status;
  }
}

sub GetReferers {
  my $result = join(' ', map { $q->a({-href=>$_}, $_) } keys %Referers);
  $result = $q->div({-class=>'refer'}, $q->p(T('Referers') . ': ' . $result)) if $result;
  return $result;
}

sub UpdateReferers {
  my ($id) = @_;
  my $self = $q->url();
  my $referer = $q->referer();
  if ($referer and $referer !~ /$self/) {
    my $data = &GetRaw($referer);
    if ($data =~ /$self/) {
      $Referers{$referer} = $Now;
      if ($RefererTimeLimit) {
	foreach (keys %Referers) {
	  if ($Now - $Referers{$_} > $RefererTimeLimit) {
	    delete $Referers{$_};
	  }
	}
      }
      if ($RefererLimit) {
	my @list = sort {$Referers{$a} cmp $Referers{$b}} keys %Referers;
	@list = @list[$RefererLimit .. @list-1];
	foreach (@list) {
	  delete $Referers{$_};
	}
      }
      return 1;
    }
  }
}

sub WriteReferers {
  my ($id) = @_;
  my $data = join($FS1, map { $_ . $FS1 . $Referers{$_} } keys %Referers);
  my $file = &GetRefererFile($id);
  &RequestRefererLock($id);
  &CreatePageDir($RefererDir, $id);
  &WriteStringToFile($file, $data);
  &ReleaseRefererLock($id);
}

sub RefererTrack {
  my ($id) = @_;
  &ReadReferers($id);
  if (&UpdateReferers($id)) {
    &WriteReferers($id);
  }
  return &GetReferers();
  }
 
sub GetRaw {
  require LWP::UserAgent;
  my ($uri) = @_;
  my $ua = LWP::UserAgent->new;
  # consider setting $ua->max_size(50000);
  # consider setting $ua->timeout(20);
  my $request = HTTP::Request->new('GET', $uri);
  my $response = $ua->request($request);
  my $data = $response->content;
  return $data;
}

---

WikiPatches