#!/usr/local/bin/perl

require 'getopts.pl';

&Getopts('c:d:r:v:') || &Usage;

if ($opt_v) {
	$opt_v = shift if ($opt_v == 1);
} else {
	$opt_v = shift if (@ARGV > 1);
}
($file = shift) || &Usage;
&Usage if @ARGV;

# Validate args
die "Specify only one of option at a time !!\n"
	if (($opt_c && ($opt_d . $opt_r . $opt_v)) ||
	    ($opt_d && ($opt_r . $opt_v)) ||
	    ($opt_r && $opt_v));

# URL should be in one of the options. 
# If empty, then just display all entries
$url = $opt_c . $opt_d . $opt_r . $opt_v;

# No directories allowed...
die "Sorry, URL may not be a directory.\n" if ($url =~ /\/$/);
die "Sorry, URL must begin with a '/'.\n" if ($url && $url !~ /^\//);

# Figure out what type of file...
# strip any DBM style extension
$file =~ s/\.db.?$//;
$file =~ s/\.dir$//;
$file =~ s/\.pag$//;
$dbm = $file . ".pag";

# Check for regular ascii
if (-r $file) {
	&regFile($file);
} elsif (-r $dbm) {
	&dbmFile($file);
} else {
	print STDERR "Cannot find either $file or $dbm\n";
	print STDERR "(Hint: touch either one to create it)\n";
	exit 1;
}
exit 0;

################################################################################
################################################################################

# Scan regular file for URL
sub regFile {
	local($file) = @_;
	local($found) = 0;

	open(IN, $file);
	fcntl(IN, 7, 0);  # Lock
	while (<IN>) {
		print, next if !$url;
		($furl,$fcnt,@fdate) = split;
		if ($furl eq $url) {
			$found++;
			next if $opt_d;
			if ($opt_v) {
				print;
				last;
			}
			$_ = sprintf("%s\t%010lu\t%s\n", $url, 0, &curdate)
				if ($opt_r);
		}
		push(@in, $_) if ! $opt_v;
	}
	fcntl(IN, 3, 0);  # Unlock
	close(IN);
	return if !$url;

	print "URL $url not found\n" if !$opt_c && !$found;

	push(@in, sprintf("%s\t%010lu\t%s\n", $url, 0, &curdate))
		if ($opt_c && !$found);
	print OUT @in if ($found || $opt_c);
	close(OUT);
}

# Search DBM file for URL
sub dbmFile {
	local($file) = @_;
	local($dbfile) = $file . ".pag";

	# Not ascii, try DBM
	dbmopen(%DB, $file, 0644) || die "Unable to open DBM file: $!\n";
	open(IN, "<$dbfile");
	fcntl(IN, 7, 0);  # Lock
	if (!$url) {
		while (($furl,$val) = each %DB) {
			print "$furl\t$val\n";
		}
	} elsif (defined $DB{"$url"}) {
		if ($opt_v) {
			print "$url\t$DB{$url}\n";
		} elsif ($opt_d) {
			delete $DB{"$url"};
		} elsif ($opt_r) {
			$DB{"$url"} = sprintf("%lu\t%s", 0, &curdate);
		}
	} elsif ($opt_c) {
		$DB{"$url"} = sprintf("%lu\t%s", 0, &curdate);
	} else {
		print "URL $url not found\n";
	}
	fcntl(IN, 3, 0);  # Unlock
	close(IN);
	dbmclose(%DB);
}

sub curdate {
@Weekdays =	('Sunday', 'Monday', 'Tuesday', 'Wednesday',
		'Thursday', 'Friday', 'Saturday');
@Months =	('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
		'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

	local($sec,$min,$hr,$mday,$mon,$yr,$wday,$yday) = localtime;
	return sprintf("%s, %02d-%s-%02d %02d:%02d:%02d", $Weekdays[$wday],
			$mday,$Months[$mon],$yr,$hr,$min,$sec);
}

sub Usage {
	print STDERR "Usage: $0 [ -cdrv URL ] counter_log\n\n";
	print STDERR "       -c     create URL\n";
	print STDERR "       -d     delete URL\n";
	print STDERR "       -r     reset counter\n";
	print STDERR "       -v     view counter\n";
	print STDERR "\n";
	print STDERR "     Create has no effect if URL exists, delete and \n";
	print STDERR "     reset have no effect if URL doesn't exist.\n";
	print STDERR "     View will display counter and reset date.\n";
	print STDERR "     If no option is supplied, then file is dumped\n";
	print STDERR "     displaying all entries.\n";
	exit 1;
}
