#!perl

#################################################
# Netscape Cache Control 1.0.3                  #
# Written by Jack Browning (drbenway@texas.net) #
# November 19th, 1998                           #
# All rights reserved.                          #
#################################################

if ($#ARGV < 0) {
	MacPerl::Answer("Drop your Netscape Preferences file on Netscape Cache Control to activate the script.");
	exit;
}

$nstest = <>;
chop($nstest);
if ($nstest =~ /Netscape User Preferences/) {

	print "Welcome to Netscape™ Cache Control!\n";
	print "Author:  Jack Browning (drbenway\@texas\.net)\n";
	print "Version: 1.0.3\n";
	print "Created: November 19th, 1998\n\n";
	
	$prefs_path = $ARGV;
	print "You are working with:\n";
	print "$prefs_path\n";

	($file_creator, $file_type) = MacPerl::GetFileInfo($prefs_path);

	($disk_line_exists, $disk_size, $mem_line_exists, $mem_size) = &get_prefs_data;
		
	until ($main_menu == 4) {
	
		print "\nOptions:\n\n";
		print "1. Change size of disk cache (currently $disk_size KB)\n";
		print "2. Change size of memory cache (currently $mem_size KB)\n";
		print "3. Save changes\n";
		print "4. Exit\n\n";
		
		until ($main_menu =~ /[1234]/) {
			print "Select an option (1-4): ";
			$main_menu = <STDIN>;
			chop($main_menu);
		}
		
		if ($main_menu == 1) {
			$disk_size = get_cache_size("disk", $disk_size);
			$main_menu = undef;
		} elsif ($main_menu == 2) {
			$mem_size = get_cache_size("memory", $mem_size);
			$main_menu = undef;
		} elsif ($main_menu == 3) {
			
			$^I = " (Old)";
			@ARGV = $prefs_path;
			
			print "\nSaving data fork of new preference file.\n";
			
			if ($disk_line_exists) {
				if ($mem_line_exists) { # current pref has both disk line and mem line
					while (<>) {
						if (/disk_cache_size/) {
							s/\d+/$disk_size/;
							print;			
						} elsif (/memory_cache_size/) {
							s/\d+/$mem_size/;
							print;
						} else {
							print;
						}
					}	
				} else { # has only disk line
					while (<>) {
						if (/disk_cache_size/) { # print disk line then zero mem line
							s/\d+/$disk_size/;
							print;
							print "user_pref(\"browser.cache.memory_cache_size\", $mem_size);\n"
						} else {
							print;
						}
					}
				
				}
			} elsif ($mem_line_exists) { # current pref has only mem line
				while (<>) {
					if (/memory_cache_size/) { # print zero disk line then mem line
						print "user_pref(\"browser.cache.disk_cache_size\", $disk_size);\n";
						s/\d+/$mem_size/;
						print;
					} else {
						print;
					}
				}
			} else { 
				while(<>) { # current pref has no disk line or mem line
					if (/^\n$/) { # insert disk and mem lines at beginning of file
						print; # print the newline, then disk line and mem line
						print "user_pref(\"browser.cache.disk_cache_size\", $disk_size);\n";
						print "user_pref(\"browser.cache.memory_cache_size\", $mem_size);\n";
					} else {
						print;
					}
				}
			}
			MacPerl::SetFileInfo($file_creator, $file_type, $prefs_path);
			&copy_resources($file_creator, $file_type);
			
			$^I = undef;
			$main_menu = undef;		
		} elsif ($main_menu == 4) {
			MacPerl::Quit(2);
		} else {
			print "Selection must be a number between 1 and 4.\n\n";
			$main_menu = undef;
		}		
	}
			
} else {
	print "ERROR: This is not a Netscape preferences file."
}

sub get_prefs_data {
	my ($disk_line_out, $disk_size_out, $mem_line_out, $mem_size_out);
	my (@prefs_data) = <>;
	
	foreach (@prefs_data) {
		if (/disk_cache_size/) {
			$disk_line_out = /\d+/;
			$disk_size_out = $&;
			last if ($disk_line_out && $mem_line_out);		
		}
		if (/memory_cache_size/) {
			$mem_line_out = /\d+/;
			$mem_size_out = $&;
			last if ($disk_line_out && $mem_line_out);
		}
	}
	($disk_line_out, $disk_size_out, $mem_line_out, $mem_size_out);
}

sub get_cache_size {
	my $new_cache_size;
	until ($new_cache_size =~ /^\d+$/) {
		print "\nCurrent $_[0] cache size is $_[1] KB.\n";
		print "Enter new $_[0] cache size (in KB): ";
		$new_cache_size = <STDIN>;
		chop($new_cache_size);
		if ($new_cache_size =~ /\D+/) {
			print "Cache size must be 0 or a positive number.\n\n"
		}
	}
	$new_cache_size;
}

sub copy_resources {
	use Mac::Memory;
	use Mac::Resources;
	
	my (@res_types, $ind_res_type, $res_Handle, $res_ID, $res_type, $res_name);
	
	print "Saving resource fork of new preference file.\n";
	
	my $old_prefs_path = "$prefs_path"."$^I";
	my $old_res_spec = MacPerl::MakeFSSpec($old_prefs_path);
	
	my $new_res_spec = MacPerl::MakeFSSpec($prefs_path);
	
	my $old_res_FRN = FSpOpenResFile($old_res_spec, 1); # 1 = read-only permission
	if (defined($old_res_FRN)) {
		if (FSpCreateResFile($new_res_spec, $_[0], $_[1], -1)) { # -1 = default system script
			my $new_res_FRN = FSpOpenResFile($new_res_spec, 3); # 3 = exclusive read-write permission
			if (defined($new_res_FRN)) {
				UseResFile($old_res_FRN);
				for (1 .. Count1Types) {
				    push(@res_types, Get1IndType($_));
				}
				foreach $ind_res_type (@res_types) {
					print "...saving \'$ind_res_type\' resources...\n";
					for (1 .. Count1Resources($ind_res_type)) {
						$res_Handle = Get1IndResource($ind_res_type, $_);
						if (defined($res_Handle)) {
							($res_ID, $res_type, $res_name) = GetResInfo($res_Handle); # For some reason, this call does not return $res_type.
							if (defined($res_ID)) {
								DetachResource($res_Handle);
								UseResFile($new_res_FRN);
								AddResource($res_Handle, $ind_res_type, $res_ID, $res_name); # Hence, I use $ind_res_type here.
								UpdateResFile($new_res_FRN);
								ReleaseResource($res_Handle);
								UseResFile($old_res_FRN);
							} else {
								print "ERROR: Couldn't get resource info.\n";
							}
						} else {
							print "ERROR: Couldn't get resource for $ind_res_type.\n";
						}
					}
				}
				CloseResFile($old_res_FRN);
				CloseResFile($new_res_FRN);
			} else { print "ERROR: Couldn't open resource fork in new preferences file.\n"}
		} else { print "ERROR: Couldn't create resource fork in new preferences file.\n"}
	} else { print "ERROR: Couldn't open resource fork of old preferences file.\n" }
}