#! /bin/perl

# redirect.pl
# Version: 1.0
# Date:    13 August 1996
# Author:  Ian Graham <ian.graham@utoronto.ca>
#
# ------------------------------------------------------------
# Program to redirect users to new home pages, and to give them
# The URL they should correct. This is used as a server-side
# include, and returns a document that redirects the user
# to the new location. If refered here from another document,
# This program also returns text informing the reader of this
# fact, and suggesting that they contact the referring page 
# maintainers, and ask them to update the reference.
# ------------------------------------------------------------


require 'utils.pl';
require 'countries.pl';    # check country codes to make sure they
			   # are valid

# STEP ONE:  MODIFY THE FOLLOWING THREE LINES:
# ============================================

# 1) Original Base URL for the documents: 

$orig_base_url = "http://www.hprc.utoronto.ca"; 

# 2)  New Base URL for the documents (where they are now located)

$new_base_url  = "http://www.utoronto.ca/webdocs"; # New Base URL for docs.

# 3) Directory that will contain the DBM refer data (log of referers)

$db_directory  = "/path/to/directory";   

# STEP TWO:  LOCALIZATION MODIFICATIONS
# =====================================

# You need to edit the utils.pl file, and change the date to 
# the correct date at which the documents were moved (line 24) and
# to change the mailto URL for the local system webmaster (line 99).
#

# ------------------------ NO CHANGES BELOW HERE --------------


if( defined ($ENV{"HTTP_REFERER"})) {
   $referer = $ENV{"HTTP_REFERER"};
}

$doc_url  = $ENV{"DOCUMENT_URI"};

$orig_url = $orig_base_url.$doc_url;            # Original document URL
$new_url  = $new_base_url.$doc_url;             # New document URL

&print_top($new_url, $orig_url);                # print page header
if( defined($referer)) {
   &print_referer($referer);                    # referer info, if defined
}
&print_bot;                                     # print document bottom 

# Ok, now that this is printed, now try logging refers 
# ONly log referers that reference full domains -- thus
# truncate URL to give only last string, and test this
# against known list of country/domain codes.
#
if( defined($referer)) {
   $tmp = $referer;
   $tmp =~ s/.*\.//;         # delete all but last part of domain name
   if( &is_country_code_match(*tmp) ) {
       &save_referer($db_directory, $referer, $orig_url, $new_url);
   }

}

# This is the function that actually saves the referer informatoin
# in a DBM database.

sub save_referer  {
  local ($db_directory, $referer, $orig_url, $new_url) = @_;
  $referer_log_db = $db_directory."/referer_log";
  $referer_tst    = $db_directory."/referer_log.lock";
  open(TEST, "< $referer_tst") ||
    &f_error("Unable to open database lockfile $referer_tst\n ",
	        __LINE__,__FILE__);
  if( !flock(TEST, 2) ) {
      &f_error("Unable to lock database $referer_log_db\n ",
	        __LINE__,__FILE__);
  }
  dbmopen(%db_array, $referer_log_db, 0666);
  if( !defined ($db_array{$referer}) )  {
      $db_array{$referer} = "$orig_url $new_url";
  }
  dbmclose(%db_array);
  flock(TEST, 8);
  close(TEST);
}