#!/usr/local/bin/perl -w

# NOTE: This program is a quick hack and will remain that way.  Please
# do not send feature requests.  This was written by request, and I really 
# don't use it.  However, I will take bug reports.  Furthermore, if you'd 
# like to add a feature, feel free to do so, and send it back to me.
# Essentially, it boils down to my not having time I'm willing to devout 
# to this.

# Usage:  right now, to defaults to using hardcoded values for the
#   bookmark file and the urlmonrc file.  They will soon be command line 
#   options -b and -f, respectively

$opt_d = 0;

$bookmarkfile = "$ENV{'HOME'}/.netscape/bookmarks.html";
$last_modified_database = ".urlmonrc";

$bookmarkfile = $opt_b if $opt_b;
$last_modified_database = $opt_f if $opt_f;
$lockfile		= "$ENV{'HOME'}/${last_modified_database}.LCK";

if ( -e $lockfile) {
  print "Oops: \"$lockfile\", the urlmon lock file, exists.  Make sure that urlmon is not running, then remove this file and try again!\n";
  exit 0;
}
$wait_max = 10;

($out = check_file($bookmarkfile)) and 
  die "Can't find \"$bookmarkfile\": $out\n";

init_mods();

open(BMARK, $bookmarkfile) or 
  die "Can't open \"$bookmarkfile\" for reading: $!\n";

foreach(<BMARK>) {
	chomp;
	($url, $last, $comment) = parseline($_); # returns 0 if the line wasn't valid
	
	# Note: NULLS aren't valid in the urlmonrc file.  They are used 
	# internally by urlmon for various reasons.
	if ($url) {
		next if ($url =~ /^telnet:\/\//); # we don't DO telnet
		$url =~ s/\0//g;
		$last =~ s/\0//g;
		$comment =~ s/\0//g;

		# make urlmon and this program agree on what a URL should 
		# look like
		$url = normalize($url);

		# assume urlmon has more accurate information
		$mods{$url} = $last unless $mods{$url};
		$comm{$url} = $comment;
	} 
}

close BMARK or warn "Strange, can't close \"$bookmarkfile\": $!\n";

write_mods_file();
exit;


################################
# subroutines
################################

sub parseline {
	my($line) = @_;

	# the following regular expression works for boomarks from Netscape
	# Navigator 3.01, prolly others
	if (/<DT><A HREF=\"(.+)\" ADD_DATE=\"\d+\" LAST_VISIT=\"\d+\" LAST_MODIFIED=\"(\d+)\">(.+)<\/A>/) {
		($1, $2, $3);
	} else {
		0;
	}
} # END parseline

sub check_file {
	0;
} # END check_file 

# NOTE:
#	The following routines were taken out of urlmon.  urlmon should 
#	be rewritten as a library to make this more sane.

sub normalize { # make things 'normal'
  my($url) = $_[0];
  my($hostname,$proto,$path);

  $url =~ s#(.*)/$#$1#; # get rid of trailing slashes

  if($url !~ m#^\w+://#) {
    $url = "http://$url";  # if there is no '://', add 'http://'
  }
  ($url ? $url : undef);
} # END normalize

sub init_mods { # sanity checks on urlmonrc and set %mods and %comm

        $mods_file_home = $ENV{'HOME'};
        if($opt_f) {
                $mods_file = $opt_f;
        } else {
                $mods_file = "$mods_file_home/$last_modified_database";
        }

        $opt_d and print "last_modified database is \"$mods_file\"\n";
        if( ! -r $mods_file) {
                die "Can't read \"$mods_file\"\n" if -e $mods_file;
                die "Can't create \"$mods_file\"\n" unless -w $mods_file_home;
                open(FOO,">$mods_file") or
                  die "Couldn't create \"$mods_file\": $!\n";
                close FOO or
                  warn "Something funky with \"$mods_file\" creation: $!\n";
        }
        if(! -w $mods_file) {
                warn "\"$mods_file\" not writeable.  Utilizing it read-only.\n";
                $read_only = 1;
        }
        # open, read, and parse the last_modified database
        open(MODS,$mods_file) or
          die "Can't open \"$mods_file\" for reading: $!\n";
        @mods = <MODS>;

	local $^W = 0; # shut up if @mods is empty.

	# check urlmonrc versioning info.
	if ($mods[0] =~ /^#\s*(.*)/) {
		$filevers = $1; # this needs to be defined so we know how
		$opt_d and print "urlmonrc version is $filevers, using new parse method\n";
		# to write the file back out

		my (@line, @fargs);
		my ($url, $mod, $comm, $filter, $display);
		foreach (@mods) {
			s/#.*$//;
			next unless /.+/;
			@line = splitline($_);
			foreach (@line) {

				/CODE=(.*)/ and do {
					my $file = $1;
					push @code, $file;
					goto LINEEND;   # you didn't see this...
				};

				/URL=(.*)/ and do {
					$url = $1;
					next;
				};

				/MOD=(.*)/ and do {
					$mod = $1;
					next;
				};

				/COMM=(.*)/ and do {
					$comm = $1;
					next;
				};

				/FILTER=(.*)/ and do {
					$filter = $1;
					next;
				};

				/FARGS=(.*)/ and do {
					@fargs = split /[,\s]+/, $1;
					next;
				};

				/DISPLAY=(.*)/ and do {
					$display = $1;
					next;
				};
			} # END foreach line

			# set the data for this URL
			if (! defined $url) {
				warn "the line \"@line\" of \"$mods_file\" contains no URL (target) to monitor!!\n";
			} elsif (! defined $mod) {
				warn "the line \"@line\" of \"$mods_file\" contains no modification information!!\n";
			} else {
				$mods{$url} = $mod;
				$comm{$url} = $comm if $comm;
				$filter{$url} = $filter if $filter;
				$display{$url} = $display?$display:$url;
				if ($filter and @fargs) {
					$fargs{$url} = [];
					@{$fargs{$url}} = @fargs;
				}
			}
		    LINEEND;
			$url = $mod = $comm = $filter = $display = '';
			@fargs = ();
		} # END foreach mods
	} else { # no version in urlmonrc file, use old method.
		$opt_d and print "no urlmonrc version, using old parse method\n";
		foreach (@mods) {
			s/#.*$//;
			next unless /.+/;
			($url,$data,@comment) = split(/\s+/,$_);
			$mods{$url} = $data;
			$comm{$url} = (@comment ? join ' ', @comment : '');
		}
	}
	@mods = ();
	close MODS or warn "Can't close \"$mods_file\": $!\n";
} # END init_mods

sub splitline {
	my($line) = @_;
	my(@line);

	my($regexp) = '[A-Z]+=(".*?"|([^"\s]*\S)*)';

	push @line, $1 while ($line =~ /($regexp)/g);

	@line;
}

sub is_cksum {
  my($cksum) = @_;
  $cksum = '' unless $cksum;
  $cksum =~ /^C/;
} # END is_cksum


sub write_mods_file {

	my($foo,$i);
	return if $read_only;
	# rewrite the last_modified data file with current info

	lockfile();

	open(MODS,">$mods_file") or die "Can't write to \"$mods_file\": $!\n";
	$opt_d and print "\n";

	$filevers = "3.0"; # force upgrade to new format
	print MODS "# $filevers\n";
	foreach $_ (@code) {
		print MODS "CODE=$_\n";
	}
	foreach $_ (keys %mods) {
		if(! defined $mods{$_}) {
			$opt_d and print "$_ has no modification date/sum!\n";
			next;
		}
		$opt_d and print "URL=$_\tMOD=$mods{$_}";
		$foo = "URL=$_\tMOD=$mods{$_}";
		if ($comm{$_}) {
			if ($comm{$_} =~ /\s/ and $comm{$_} !~ /^".*"$/) {
			# has spaces by not surrounded by quotes
				$quote = "\"";
			} else {
				$quote = '';
			}
			$opt_d and print "\tCOMM=${quote}${comm{$_}}${quote}";
			$foo = "${foo}\tCOMM=${quote}${comm{$_}}${quote}";
		}

		if ($filter{$_}) {
			$opt_d and print "\tFILTER=$filter{$_}";
			$foo = "${foo}\tFILTER=$filter{$_}";
		}

		if ($fargs{$_} and (ref ($fargs{$_}) eq 'ARRAY')) {
			my $fargs = join ',', @{$fargs{$_}};
			$opt_d and print "\tFARGS=$fargs";
			$foo = "${foo}\tFARGS=$fargs";
		}

                if (defined($display{$_}) && $display{$_} ne $_) {
                        $opt_d and print "\tDISPLAY=$display{$_}";
                        $foo = "${foo}\tDISPLAY=$display{$_}";
                }

		$opt_d and print "\n";
		$foo = "$foo\n";
		print MODS $foo;
	} # END foreach keys %mods

	$opt_d and print "\n";
	close MODS or warn "Can't close \"$mods_file\": $!\n";
	unlockfile();
} # END write_mods_file

sub unlockfile {
	unlink $lockfile or warn "WARNING: Cannot unlink \"$lockfile\".  Subsequent calls to \"$0\" will not be able to record URL modifications until it is removed!\n"; 
} # END unlockfile

sub lockfile {
	# rudimentary file locking
	#	
	$i = 0;	
	$opt_d and print "Looking for \"$lockfile\" as lock file\n";
	while ( -e $lockfile) {
		$opt_d and print "\"$lockfile\" exists, waiting for its removal...\n";
		if ($i >= $wait_max) {
			warn "Waiting for \"$lockfile\" to be removed for too long, exiting...\n";
			exit 4;
		}
		sleep 5;
		$i++;
	}
	$i = 0;
	#	
	open(LOCK,"> $lockfile") or do {
		warn "Can't create lock file \"$lockfile\": not writing out new modifications: $!\n";
		return;
	};
	close LOCK or warn "Can't close \"$lockfile\" (wierd): $!\n";
	#
}  # END lockfile
