#!/usr/bin/perl
############################################################################
# Last revision: 27.04.1999
##########################  DESCRIPTION  ###################################
# HTML URL Redirector
#
############################################################################

############################################################################
# Copyright 1999 by AltBlue [IRL: Marius Feraru]                           #
# All rights reserved                                                      #
#                                                                          #
# Distribute freely, except:                                               #
# * don't remove my name from the source or documentation                  #
#    (don't take credit for my work)                                       #
# * mark your changes                                                      #
#    (don't get me blamed for your possible bugs)                          #
# * don't alter or remove this notice.                                     #
#                                                                          #
# May be sold if buildable source is provided to buyer.                    #
# No warrantee of any kind, express or implied, is included with this sw.  #
# Use at your own risk, responsibility for damages (if any) to anyone      #
# resulting from the use of this software rests entirely with the user.    #
#                                                                          #
# Send bug reports, bug fixes, enhancements, requests, flames etc., and    #
# I'll try to keep a version up to date.                                   #
#                                                                          #
# I can be reached as follows:                                             #
#  E-Mail:   AltBlue <altblue@tuiasi.ro>                                   #
# Homepage: http://www.cs.tuiasi.ro/altblue/                               #
############################################################################

$resources = "/home/httpd/www.iasi.mednet.ro/cgi-bin/.resurse";
$default_url = 'http://www.iasi.mednet.ro';

if($ENV{'QUERY_STRING'} =~ /^\d+$/) { 	# query string klumea (numar pozitiv)
	if(open(RES,$resources)) {		# open successful of bm file
		@bookmarks = <RES>;  
		close(RES);
		if($ENV{'QUERY_STRING'} <= $#bookmarks) {	# id valid
			($kk,$times,$url) = split(/\|/,$bookmarks[$ENV{'QUERY_STRING'}]);
			chomp($url);
			$times++;
			$bookmarks[$ENV{'QUERY_STRING'}]="$kk|$times|$url\n";
			if(open(RES,">$resources")) { # writing new scores
				$lockerror = &lockfile(RES);
				if ($lockerror) {
					$url = $default_url;
				}
				print RES @bookmarks;
				&unlockfile(RES);
			 	close(RES);
			}
		} else {
			$url = $default_url;
		}
	} else {
		$url = $default_url;
	}
} else {
	$url = $default_url;
}

print "Location: $url\n\n";


exit 0;

#=========================================================================
# usage lockfile(<file>); 
#=========
sub lockfile {
	local(*FILE) = @_;
	local $try = 10;
	while ($try--) {
	    $lockresult = eval("flock(FILE,6)");
	    if (!$lockresult) {
		select(undef,undef,undef,0.1);
	    } else {
		last;
	    }
	}
	return ($try >= 0) ? 0 : -1 ;
}

#=========================================================================
# usage unlockfile(<file>); 
#=========
sub unlockfile {
	local(*FILE) = @_;
	flock(FILE,8);
}