Mac::InternetConfig - Interface to Peter Lewis' and Quinns Internet Config system

use strict;

package Mac::InternetConfig;

BEGIN {
	use Exporter   ();
	use DynaLoader ();
	
	use vars qw(
		$VERSION @ISA @EXPORT @EXPORT_OK 
		%RawInternetConfig %InternetConfig %InternetConfigMap $ICInstance);
	$VERSION = '1.04';
	@ISA = qw(Exporter DynaLoader);
	@EXPORT = qw(
		ICStart
		ICStop
		ICFindConfigFile
		ICFindUserConfigFile
		ICGeneralFindConfigFile
		ICChooseConfig
		ICChooseNewConfig
		ICGetConfigName
		ICGetConfigReference
		ICSetConfigReference
		ICGetSeed
		ICGetComponentInstance
		ICBegin
		ICGetPref
		ICSetPref
		ICCountPref
		ICGetIndPref
		ICDeletePref
		ICEnd
		ICEditPreferences
		ICParseURL
		ICLaunchURL
		ICMapFilename
		ICMapTypeCreator
		ICMapEntriesFilename
		ICMapEntriesTypeCreator
		ICCountMapEntries
		ICGetIndMapEntry
		ICGetMapEntry
		ICSetMapEntry
		ICDeleteMapEntry
		ICAddMapEntry
		
		%RawInternetConfig 
		%InternetConfig
		%InternetConfigMap
		
		kICRealName
		kICEmail
		kICMailAccount
		kICMailPassword
		kICNewsAuthUsername
		kICNewsAuthPassword
		kICArchiePreferred
		kICArchieAll
		kICUMichPreferred
		kICUMichAll
		kICInfoMacPreferred
		kICInfoMacAll
		kICPhHost
		kICWhoisHost
		kICFingerHost
		kICFTPHost
		kICTelnetHost
		kICSMTPHost
		kICNNTPHost
		kICGopherHost
		kICLDAPServer
		kICLDAPSearchbase
		kICWWWHomePage
		kICWAISGateway
		kICListFont
		kICScreenFont
		kICPrinterFont
		kICTextCreator
		kICBinaryTypeCreator
		kICDownloadFolder
		kICSignature
		kICOrganization
		kICPlan
		kICQuotingString
		kICMailHeaders
		kICNewsHeaders
		kICMapping
		kICCharacterSet
		kICHelper
		kICServices
		kICNewMailFlashIcon
		kICNewMailDialog
		kICNewMailPlaySound
		kICNewMailSoundName
		kICWebBackgroundColour
		kICNoProxyDomains
		kICUseSocks
		kICSocksHost
		kICUseHTTPProxy
		kICHTTPProxyHost
		kICUseFTPProxy
		kICFTPProxyHost
		kICFTPProxyUser
		kICFTPProxyPassword
		kICFTPProxyAccount
		ICmap_binary
		ICmap_resource_fork
		ICmap_data_fork
		ICmap_post
		ICmap_not_incoming
		ICmap_not_outgoing
		ICservices_tcp
		ICservices_udp
		icNoPerm
		icReadOnlyPerm
		icReadWritePerm
		GetURL
		GetICHelper
);
	@EXPORT_OK = qw(
		$ICInstance
	);
}

sub kICRealName ()                 { "RealName"; }
sub kICEmail ()                    { "Email"; }
sub kICMailAccount ()              { "MailAccount"; }
sub kICMailPassword ()             { "MailPassword"; }
sub kICNewsAuthUsername ()         { "NewsAuthUsername"; }
sub kICNewsAuthPassword ()         { "NewsAuthPassword"; }
sub kICArchiePreferred ()          { "ArchiePreferred"; }
sub kICArchieAll ()                { "ArchieAll"; }
sub kICUMichPreferred ()           { "UMichPreferred"; }
sub kICUMichAll ()                 { "UMichAll"; }
sub kICInfoMacPreferred ()         { "InfoMacPreferred"; }
sub kICInfoMacAll ()               { "InfoMacAll"; }
sub kICPhHost ()                   { "PhHost"; }
sub kICWhoisHost ()                { "WhoisHost"; }
sub kICFingerHost ()               { "FingerHost"; }
sub kICFTPHost ()                  { "FTPHost"; }
sub kICTelnetHost ()               { "TelnetHost"; }
sub kICSMTPHost ()                 { "SMTPHost"; }
sub kICNNTPHost ()                 { "NNTPHost"; }
sub kICGopherHost ()               { "GopherHost"; }
sub kICLDAPServer ()               { "LDAPServer"; }
sub kICLDAPSearchbase ()           { "LDAPSearchbase"; }
sub kICWWWHomePage ()              { "WWWHomePage"; }
sub kICWAISGateway ()              { "WAISGateway"; }
sub kICListFont ()                 { "ListFont"; }
sub kICScreenFont ()               { "ScreenFont"; }
sub kICPrinterFont ()              { "PrinterFont"; }
sub kICTextCreator ()              { "TextCreator"; }
sub kICBinaryTypeCreator ()        { "BinaryTypeCreator"; }
sub kICDownloadFolder ()           { "DownloadFolder"; }
sub kICSignature ()                { "Signature"; }
sub kICOrganization ()             { "Organization"; }
sub kICPlan ()                     {  "Plan"; }
sub kICQuotingString ()            { "QuotingString"; }
sub kICMailHeaders ()              { "MailHeaders"; }
sub kICNewsHeaders ()              { "NewsHeaders"; }
sub kICMapping ()                  { "Mapping"; }
sub kICCharacterSet ()             { "CharacterSet"; }
sub kICHelper ()                   { "Helper\245"; }
sub kICServices ()                 { "Services"; }
sub kICNewMailFlashIcon ()         { "NewMailFlashIcon"; }
sub kICNewMailDialog ()            { "NewMailDialog"; }
sub kICNewMailPlaySound ()         { "NewMailPlaySound"; }
sub kICNewMailSoundName ()         { "NewMailSoundName"; }
sub kICWebBackgroundColour ()      { "WebBackgroundColour"; }
sub kICNoProxyDomains ()           { "NoProxyDomains"; }
sub kICUseSocks ()                 { "UseSocks"; }
sub kICSocksHost ()                { "SocksHost"; }
sub kICUseHTTPProxy ()             { "UseHTTPProxy"; }
sub kICHTTPProxyHost ()            { "HTTPProxyHost"; }
sub kICUseFTPProxy ()              { "UseFTPProxy"; }
sub kICFTPProxyHost ()             { "FTPProxyHost"; }
sub kICFTPProxyUser ()             { "FTPProxyUser"; }
sub kICFTPProxyPassword ()         { "FTPProxyPassword"; }
sub kICFTPProxyAccount ()          { "FTPProxyAccount"; }

sub ICmap_binary ()           	  { 0x00000001; }
sub ICmap_resource_fork ()    	  { 0x00000002; }
sub ICmap_data_fork ()       	     { 0x00000004; }
sub ICmap_post ()             	  { 0x00000008; }
sub ICmap_not_incoming ()     	  { 0x00000010; }
sub ICmap_not_outgoing ()     	  { 0x00000020; }
sub ICservices_tcp ()        	     { 0x00000001; }
sub ICservices_udp ()        	     { 0x00000002; }
sub icNoPerm ()					  	  { 0; }
sub icReadOnlyPerm ()			     { 1; }
sub icReadWritePerm ()				  { 2; }

bootstrap Mac::InternetConfig;

sub ICFindConfigFile {
	my($inst, @folders) = @_;
	ICGeneralFindConfigFile($inst, 1, 0, @folders) if $^O eq 'MacOS';
}

sub ICFindUserConfigFile {
	my($inst, @folders) = @_;
	ICGeneralFindConfigFile($inst, 0, 0, @folders) if $^O eq 'MacOS';
}

package Mac::InternetConfig::_Raw;

BEGIN {
	use Tie::Hash  ();
	import Mac::InternetConfig;
	import Mac::InternetConfig qw($ICInstance);

	use vars qw(@ISA);
	
	@ISA = qw(Tie::Hash);
}

sub TIEHASH {
	my($package) = @_;
	
	my($enum) = 0;
	ICFindConfigFile($ICInstance) if $^O eq 'MacOS';
	
	bless \$enum, $package;
}

sub DESTROY {
}

sub FETCH {
	my($me, $key) = @_;
	
	ICGetPref($ICInstance, $key);
}

sub STORE {
	my($me, $key, @value) = @_;
	
	ICSetPref($ICInstance, $key, @value);
}

sub DELETE {
	my($me, $key) = @_;
	
	ICDeletePref($ICInstance, $key);
}

sub FIRSTKEY {
	my($me) = @_;
	
	$$me = 0;
	
	NEXTKEY $me;
}

sub NEXTKEY {
	my($me) = @_;

	++$$me;
	
	ICBegin($ICInstance, icReadOnlyPerm());
	my($key) = ICGetIndPref($ICInstance, $$me);
	ICEnd($ICInstance);
	
	$key;
}

package Mac::InternetConfig::_Map;

BEGIN {
	use Tie::Hash  ();
	use Mac::Types;
	use Mac::Memory qw(DisposeHandle);
	import Mac::InternetConfig;
	import Mac::InternetConfig qw($ICInstance);

	use vars qw(@ISA %ictypes %ICPack %ICUnpack);
	
	@ISA = qw(Tie::Hash);
}

sub new {
	my($package,$blob) = @_;
	
	bless { entries => new Handle($blob) }, $package;
}

sub TIEHASH {
	my($package,$blob) = @_;
	
	if (ref($blob)) {
		return $blob;
	} else {
		return new($package, $blob);
	}
}

sub DESTROY {
	my($my) = @_;
	
	DisposeHandle($my->{entries}) if $my->{entries};
}

sub FETCH {
	my($my, $key) = @_;
	
	if (ref($key) eq "ICMapEntry") { # dummy case
		return $key;
	} elsif (ref($key)) { 	# [type, creator, optionally name]
		return ICMapEntriesTypeCreator($ICInstance, $my->{entries}, @$key);
	} else {    		# File name
		return ICMapEntriesFilename($ICInstance, $my->{entries}, $key);
	}
}

sub STORE {
	my($my, $key, $value) = @_;
	
	$key = $my->FETCH($key) unless ref($key) eq "ICMapEntry";
	my($pos) = Mac::InternetConfig::_ICMapFind($ICInstance, $my->{entries}, $key);
	if (defined $pos) {
		ICSetMapEntry($ICInstance, $my->{entries}, $pos, $value);
	} else {
		ICAddMapEntry($ICInstance, $my->{entries}, $value);
	}
}

sub DELETE {
	my($my, $key) = @_;
	
	$key = $my->FETCH($key) unless ref($key) eq "ICMapEntry";
	my($pos) = Mac::InternetConfig::_ICMapFind($ICInstance, $my->{entries}, $key);
	if (defined $pos) {
		ICDeleteMapEntry($ICInstance, $my->{entries}, $pos);
	} 
}

sub FIRSTKEY {
	my($my) = @_;
	
	$my->{'index'} = 1;
	return scalar(ICGetIndMapEntry($ICInstance, $my->{entries}, $my->{'index'}));
}

sub NEXTKEY {
	my($my) = @_;
	return scalar(ICGetIndMapEntry($ICInstance, $my->{entries}, ++$my->{'index'}));
}

package Mac::InternetConfig::_Cooked;

BEGIN {
	use Tie::Hash  ();
	use Mac::Types;
	use Mac::Memory();
	import Mac::InternetConfig;
	import Mac::InternetConfig qw($ICInstance);

	use vars qw(@ISA %ictypes %ICPack %ICUnpack);
	
	@ISA = qw(Tie::Hash);
}

%ictypes = (
	kICRealName() 				=> 'STR ',
	kICEmail() 					=> 'STR ',
	kICMailAccount() 			=> 'STR ',
	kICMailPassword() 		=> 'STR ',
	kICNewsAuthUsername() 	=> 'STR ',
	kICNewsAuthPassword() 	=> 'STR ',
	kICArchiePreferred() 	=> 'STR ',
	kICArchieAll() 			=> 'STR#',
	kICUMichPreferred() 		=> 'STR ',
	kICUMichAll() 				=> 'STR#',
	kICInfoMacPreferred() 	=> 'STR ',
	kICInfoMacAll() 			=> 'STR#',
	kICPhHost() 				=> 'STR ',
	kICWhoisHost() 			=> 'STR ',
	kICFingerHost() 			=> 'STR ',
	kICFTPHost() 				=> 'STR ',
	kICTelnetHost() 			=> 'STR ',
	kICSMTPHost() 				=> 'STR ',
	kICNNTPHost() 				=> 'STR ',
	kICGopherHost() 			=> 'STR ',
	kICLDAPServer() 			=> 'STR ',
	kICLDAPSearchbase() 		=> 'STR ',
	kICWWWHomePage() 			=> 'STR ',
	kICWAISGateway() 			=> 'STR ',
	kICListFont() 				=> 'ICFontRecord',
	kICScreenFont() 			=> 'ICFontRecord',
	kICPrinterFont() 			=> 'ICFontRecord',
	kICTextCreator() 			=> 'ICAppSpec',
	kICBinaryTypeCreator() 	=> 'ICFileInfo',
	kICDownloadFolder() 		=> 'ICFileSpec',
	kICSignature() 			=> 'TEXT',
	kICOrganization() 		=> 'STR ',
	kICPlan() 					=> 'TEXT',
	kICQuotingString() 		=> 'STR ',
	kICMailHeaders() 			=> 'TEXT',
	kICNewsHeaders() 			=> 'TEXT',
	kICMapping() 				=> 'ICMapEntries',
	kICCharacterSet() 		=> 'ICCharTable',
	kICHelper() 				=> 'ICAppSpec',
	kICServices() 				=> 'ICServices',
	kICNewMailFlashIcon() 	=> 'bool',
	kICNewMailDialog() 		=> 'bool',
	kICNewMailPlaySound() 	=> 'bool',
	kICNewMailSoundName() 	=> 'STR ',
	kICWebBackgroundColour()=> 'RGBColor',
	kICNoProxyDomains() 		=> 'STR#',
	kICUseSocks() 				=> 'bool',
	kICSocksHost() 			=> 'STR ',
	kICUseHTTPProxy() 		=> 'bool',
	kICHTTPProxyHost() 		=> 'STR ',
	kICUseFTPProxy() 			=> 'bool',
	kICFTPProxyHost() 		=> 'STR ',
	kICFTPProxyUser() 		=> 'STR ',
	kICFTPProxyPassword() 	=> 'STR ',
	kICFTPProxyAccount() 	=> 'STR ',
);

# should accept only one item for tied interface
sub _PackICFontRecord {
	my($size,$face,$font) = @_;
	return pack("sCx", $size, $face) . MacPack('STR ', $font);
}

# should return only one item for tied interface
sub _UnpackICFontRecord {
	my($blob) = @_;

	return (unpack("sC", $blob), MacUnpack('STR ', substr($blob, 4)));
}

# should accept only one item for tied interface
sub _PackICAppSpec {
	my($type,$name) = @_;
	return MacPack('type', $type) . MacPack('STR ', $name);
}

# should return only one item for tied interface
sub _UnpackICAppSpec {
	my $blob = shift or return;
	return (MacUnpack('type', $blob), MacUnpack('STR ', substr($blob, 4)));
}

# should accept only one item for tied interface
sub _PackICFileInfo {
	my($type,$creator,$name) = @_;
	return MacPack('type', $type) . MacPack('type', $creator) . MacPack('STR ', $name);
}

# should return only one item for tied interface
sub _UnpackICFileInfo {
	my $blob = shift or return;
	return (MacUnpack('type', $blob), MacUnpack('type', substr($blob, 4, 4)), MacUnpack('STR ', substr($blob, 8)));
}

# should accept only one item for tied interface
sub _PackICFileSpec {
	my($vol, $creation, $spec, $alias) = @_;
	$vol = substr(MacPack('STR ', $vol) . ('\0' x 32), 0, 32);
	return $vol . MacPack('long', $creation) . $spec . $alias->get;
}

# should return only one item for tied interface
sub _UnpackICFileSpec {
	my($blob) = @_;

	return (
		MacUnpack('STR ', $blob), 
		MacUnpack('long', substr($blob, 32, 4)), 
		MacUnpack('fss ', substr($blob, 36, 70)),
		new Handle(substr($blob, 106)));
}

sub _UnpackICMapEntries {
	my($blob) = @_;

	return new Mac::InternetConfig::_Map $blob;
}

%ICPack = (
	ICFileInfo		=> \&_PackICFileInfo,
	ICFontRecord	=> \&_PackICFontRecord,
	ICAppSpec		=> \&_PackICAppSpec,
	ICFileSpec		=> \&_PackICFileSpec,
);

%ICUnpack = (
	ICFileInfo		=> \&_UnpackICFileInfo,
	ICFontRecord	=> \&_UnpackICFontRecord,
	ICAppSpec		=> \&_UnpackICAppSpec,
	ICFileSpec		=> \&_UnpackICFileSpec,
	ICMapEntries	=> \&_UnpackICMapEntries,
);

sub TIEHASH {
	my($package) = @_;
	
	bless {}, $package;
}

sub DESTROY {
	# Do *not* inherit _Raw::DESTROY
}

sub FETCH {
	my($me, $key) = @_;
	
	my($data) = $RawInternetConfig{$key};
	my $type = $ictypes{$key};
	if ($type && (exists $ICUnpack{$type} || exists $MacUnpack{$type})) {
		return MacUnpack(\%ICUnpack, $type, $data);
	} else {
		return $data;
	}
}

sub STORE {
	my($me, $key, @value) = @_;
	my $type = $ictypes{$key};
	if ($type && (exists $ICPack{$type} || exists $MacPack{$type})) {
		$RawInternetConfig{$key} = MacPack(\%ICPack, $type, @value);
	} else {
		$RawInternetConfig{$key} = $value[0];
	}
}

sub FIRSTKEY {
	 Mac::InternetConfig::_Raw::FIRSTKEY(tied(%RawInternetConfig));
}

sub NEXTKEY {
	Mac::InternetConfig::_Raw::NEXTKEY(tied(%RawInternetConfig));
}

package Mac::InternetConfig;

$ICInstance = ICStart();

tie %RawInternetConfig, q(Mac::InternetConfig::_Raw);
tie %InternetConfig,    q(Mac::InternetConfig::_Cooked);
tie %InternetConfigMap, q(Mac::InternetConfig::_Map), $InternetConfig{kICMapping()};

sub GetURL {
	my $url = shift or return;
	ICGeneralFindConfigFile($ICInstance) if $^O eq 'MacOS';
	ICLaunchURL($ICInstance, 0, $url);
}

sub GetICHelper {
	my $proto    = shift or return;
	my $helper   = $InternetConfig{kICHelper() . $proto} or return;
	my $app_id   = pack 'N', unpack 'L', substr($helper, 0, 4);
	my $app_name = substr($helper, 5, ord(substr($helper, 4, 1)));
	return wantarray ? ($app_id, $app_name) : $app_id;
}

END {
	ICStop($ICInstance);
}

1;

__END__