/* $Header: tyrathect:Development:Perl::RCS:missing.c,v 1.2 1994/05/04 02:12:43 neeri Exp $
 *
 *    Copyright (c) 1996 Matthias Neeracher
 *
 *    You may distribute under the terms of the Perl Artistic License,
 *    as specified in the README file.
 *
 * $Log: missing.c,v $
 */

#define MAC_CONTEXT

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <Folders.h>
#include <Files.h>
#include <TFileSpec.h>
#include <Script.h>
#include <Errors.h>
#include <Aliases.h>

typedef FSSpec			RealFSSpec;
typedef CInfoPBPtr 	CatInfo;

static CatInfo NewCatInfo()
{
	CatInfo	ci;
	ci = (CatInfo) malloc(sizeof(CInfoPBRec)+sizeof(Str63));
	ci->hFileInfo.ioNamePtr = (StringPtr) ((char *)ci+sizeof(CInfoPBRec));
	
	return ci;
}

static SV * SvTIE(SV * sv)
{
	SV * varsv = (SV *) newHV();
	
	sv_magic(varsv, sv, 'P', Nullch, 0);
	
	return newRV(varsv);
}

static SV * SvUNTIE(SV * sv)
{
	MAGIC * mg ;
	SV * deref;

	if (SvROK(sv)) {
		deref = (SV*)SvRV(sv);
    	if (!SvOBJECT(deref))
			sv = deref;
	}

    if (SvMAGICAL(sv)) {
        if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
            mg = mg_find(sv, 'P') ;
        else
            mg = mg_find(sv, 'q') ;

        if (mg)
            return mg->mg_obj;
	}
		
	return 0;
}

MODULE = Mac::Files	PACKAGE = CatInfo

CatInfo
TIEHASH(name,info=NULL)
	char *	name
	CatInfo	info
	CODE:
	if (info)
		RETVAL = info;
	else
		RETVAL = NewCatInfo();
	OUTPUT:
	RETVAL

void
DESTROY(cat)
	CatInfo	cat
	CODE:
	free(cat);

SV *
FETCH(my, field)
	CatInfo	my
	char *	field
	CODE:
	switch (field[2]) {
	case 'A':
		if (!strcmp(field, "ioACUser")) {
			RETVAL = newSViv(my->hFileInfo.ioACUser);
		} else
			goto invalidField;
		break;
	case 'D':
		switch (field[4]) {
		case 'B':
			if (!strcmp(field, "ioDrBkDat")) {
				RETVAL = newSViv((long)my->dirInfo.ioDrBkDat);
			} else
				goto invalidField;
			break;
		case 'C':
			if (!strcmp(field, "ioDrCrDat")) {
				RETVAL = newSViv((long)my->dirInfo.ioDrCrDat);
			} else
				goto invalidField;
			break;
		case 'D':
			if (!strcmp(field, "ioDrDirID")) {
				RETVAL = newSViv(my->dirInfo.ioDrDirID);
			} else
				goto invalidField;
			break;
		case 'F':
			if (!strcmp(field, "ioDrFndrInfo")) {
				/* Can't handle "DXInfo" automatically */
			} else
				goto invalidField;
			break;
		case 'M':
			if (!strcmp(field, "ioDrMdDat")) {
				RETVAL = newSViv((long)my->dirInfo.ioDrMdDat);
			} else
				goto invalidField;
			break;
		case 'N':
			if (!strcmp(field, "ioDrNmFls")) {
				RETVAL = newSViv(my->dirInfo.ioDrNmFls);
			} else
				goto invalidField;
			break;
		case 'P':
			if (!strcmp(field, "ioDrParID")) {
				RETVAL = newSViv(my->dirInfo.ioDrParID);
			} else
				goto invalidField;
			break;
		case 'U':
			if (!strcmp(field, "ioDrUsrWds")) {
				/* Can't handle "DInfo" automatically */
			} else
				goto invalidField;
			break;
		case 'r':
			if (!strcmp(field, "ioDirID")) {
				RETVAL = newSViv(my->hFileInfo.ioDirID);
			} else
				goto invalidField;
			break;
		default:
			goto invalidField;
		}
		break;
	case 'F':
		switch (field[4]) {
		case 'A':
			if (!strcmp(field, "ioFlAttrib")) {
				RETVAL = newSViv(my->hFileInfo.ioFlAttrib);
			} else
				goto invalidField;
			break;
		case 'B':
			if (!strcmp(field, "ioFlBkDat")) {
				RETVAL = newSViv((long)my->hFileInfo.ioFlBkDat);
			} else
				goto invalidField;
			break;
		case 'C':
			if (!strcmp(field, "ioFlClpSiz")) {
				RETVAL = newSViv(my->hFileInfo.ioFlClpSiz);
			} else if (!strcmp(field, "ioFlCrDat")) {
				RETVAL = newSViv((long)my->hFileInfo.ioFlCrDat);
			} else
				goto invalidField;
			break;
		case 'F':			
			if (!strcmp(field, "ioFlFndrInfo")) {
				RETVAL = 
					SvTIE(sv_setref_pvn(
						NEWSV(0, 0), "FInfo", 
						(char *)&my->hFileInfo.ioFlFndrInfo, sizeof(FInfo)));
			} else
				goto invalidField;
			break;
		case 'L':
			if (!strcmp(field, "ioFlLgLen")) {
				RETVAL = newSViv(my->hFileInfo.ioFlLgLen);
			} else
				goto invalidField;
			break;
		case 'M':
			if (!strcmp(field, "ioFlMdDat")) {
				RETVAL = newSViv((long)my->hFileInfo.ioFlMdDat);
			} else
				goto invalidField;
			break;
		case 'P':
			if (!strcmp(field, "ioFlParID")) {
				RETVAL = newSViv(my->hFileInfo.ioFlParID);
			} else if (!strcmp(field, "ioFlPyLen")) {
				RETVAL = newSViv(my->hFileInfo.ioFlPyLen);
			} else
				goto invalidField;
			break;
		case 'R':
			if (!strcmp(field, "ioFlRLgLen")) {
				RETVAL = newSViv(my->hFileInfo.ioFlRLgLen);
			} else if (!strcmp(field, "ioFlRPyLen")) {
				RETVAL = newSViv(my->hFileInfo.ioFlRPyLen);
			} else if (!strcmp(field, "ioFlRStBlk")) {
				RETVAL = newSViv(my->hFileInfo.ioFlRStBlk);
			} else
				goto invalidField;
			break;
		case 'S':
			if (!strcmp(field, "ioFlStBlk")) {
				RETVAL = newSViv(my->hFileInfo.ioFlStBlk);
			} else
				goto invalidField;
			break;
		case 'X':
			if (!strcmp(field, "ioFlXFndrInfo")) {
				/* Can't handle "FXInfo" automatically */
			} else
				goto invalidField;
			break;
		default:
			if (!strcmp(field, "ioFDirIndex")) {
				RETVAL = newSViv(my->hFileInfo.ioFDirIndex);
			} else if (!strcmp(field, "ioFRefNum")) {
				RETVAL = newSViv(my->hFileInfo.ioFRefNum);
			} else if (!strcmp(field, "ioFVersNum")) {
				RETVAL = newSViv(my->hFileInfo.ioFVersNum);
			} else
				goto invalidField;
			break;
		}
		break;
	case 'N':
		if (!strcmp(field, "ioNamePtr")) {
			RETVAL = newSVpv((char *) my->hFileInfo.ioNamePtr+1, *my->hFileInfo.ioNamePtr);
		} else
			goto invalidField;
		break;
	case 'V':
		if (!strcmp(field, "ioVRefNum")) {
			RETVAL = newSViv(my->hFileInfo.ioVRefNum);
		} else
			goto invalidField;
		break;
	default:
invalidField:	
		croak("CatInfo has no field named %s", field);
	}
	OUTPUT:
	RETVAL

void
STORE(my, field, value)
	CatInfo	my
	char *	field
	SV *		value
	CODE:
	switch (field[2]) {
	case 'A':
		if (!strcmp(field, "ioACUser")) {
			my->hFileInfo.ioACUser = (SInt8) SvIV(value);
		} else
			goto invalidField;
		break;
	case 'D':
		switch (field[4]) {
		case 'B':
			if (!strcmp(field, "ioDrBkDat")) {
				my->dirInfo.ioDrBkDat = (unsigned long)	SvIV(value);
			} else
				goto invalidField;
			break;
		case 'C':
			if (!strcmp(field, "ioDrCrDat")) {
				my->dirInfo.ioDrCrDat = (unsigned long)	SvIV(value);
			} else
				goto invalidField;
			break;
		case 'D':
			if (!strcmp(field, "ioDrDirID")) {
				my->dirInfo.ioDrDirID = (long) SvIV(value);
			} else
				goto invalidField;
			break;
		case 'F':
			if (!strcmp(field, "ioDrFndrInfo")) {
				/* Can't handle "DXInfo" automatically */
			} else
				goto invalidField;
			break;
		case 'M':
			if (!strcmp(field, "ioDrMdDat")) {
				my->dirInfo.ioDrMdDat = (unsigned long)	SvIV(value);
			} else
				goto invalidField;
			break;
		case 'N':
			if (!strcmp(field, "ioDrNmFls")) {
				my->dirInfo.ioDrNmFls = (unsigned short) SvIV(value);
			} else
				goto invalidField;
			break;
		case 'P':
			if (!strcmp(field, "ioDrParID")) {
				my->dirInfo.ioDrParID = (long) SvIV(value);
			} else
				goto invalidField;
			break;
		case 'U':
			if (!strcmp(field, "ioDrUsrWds")) {
				/* Can't handle "DInfo" automatically */
			} else
				goto invalidField;
			break;
		case 'r':
			if (!strcmp(field, "ioDirID")) {
				my->hFileInfo.ioDirID = (long) SvIV(value);
			} else
				goto invalidField;
			break;
		default:
			goto invalidField;
		}
		break;
	case 'F':
		switch (field[4]) {
		case 'A':
			if (!strcmp(field, "ioFlAttrib")) {
				my->hFileInfo.ioFlAttrib = (SInt8) SvIV(value);
			} else
				goto invalidField;
			break;
		case 'B':
			if (!strcmp(field, "ioFlBkDat")) {
				my->hFileInfo.ioFlBkDat = (unsigned long)	SvIV(value);
			} else
				goto invalidField;
			break;
		case 'C':
			if (!strcmp(field, "ioFlClpSiz")) {
				my->hFileInfo.ioFlClpSiz = (long) SvIV(value);
			} else if (!strcmp(field, "ioFlCrDat")) {
				my->hFileInfo.ioFlCrDat = (unsigned long)	SvIV(value);
			} else
				goto invalidField;
			break;
		case 'F':
			if (!strcmp(field, "ioFlFndrInfo")) {
				SV * sv = SvUNTIE(value);
				if (sv && sv_isa(sv, "FInfo"))
	    			memcpy(&my->hFileInfo.ioFlFndrInfo, SvPV((SV*)SvRV(sv), na), sizeof(FInfo));
				else
	    			croak("value is not of type FInfo");
			} else
				goto invalidField;
			break;
		case 'L':
			if (!strcmp(field, "ioFlLgLen")) {
				my->hFileInfo.ioFlLgLen = (long) SvIV(value);
			} else
				goto invalidField;
			break;
		case 'M':
			if (!strcmp(field, "ioFlMdDat")) {
				my->hFileInfo.ioFlMdDat = (unsigned long)	SvIV(value);
			} else
				goto invalidField;
			break;
		case 'P':
			if (!strcmp(field, "ioFlParID")) {
				my->hFileInfo.ioFlParID = (long) SvIV(value);
			} else if (!strcmp(field, "ioFlPyLen")) {
				my->hFileInfo.ioFlPyLen = (long) SvIV(value);
			} else
				goto invalidField;
			break;
		case 'R':
			if (!strcmp(field, "ioFlRLgLen")) {
				my->hFileInfo.ioFlRLgLen = (long) SvIV(value);
			} else if (!strcmp(field, "ioFlRPyLen")) {
				my->hFileInfo.ioFlRPyLen = (long) SvIV(value);
			} else if (!strcmp(field, "ioFlRStBlk")) {
				my->hFileInfo.ioFlRStBlk = (unsigned short) SvIV(value);
			} else
				goto invalidField;
			break;
		case 'S':
			if (!strcmp(field, "ioFlStBlk")) {
				my->hFileInfo.ioFlStBlk = (unsigned short) SvIV(value);
			} else
				goto invalidField;
			break;
		case 'X':
			if (!strcmp(field, "ioFlXFndrInfo")) {
				/* Can't handle "FXInfo" automatically */
			} else
				goto invalidField;
			break;
		default:
			if (!strcmp(field, "ioFDirIndex")) {
				my->hFileInfo.ioFDirIndex = (short) SvIV(value);
			} else if (!strcmp(field, "ioFRefNum")) {
				my->hFileInfo.ioFRefNum = (short) SvIV(value);
			} else if (!strcmp(field, "ioFVersNum")) {
				my->hFileInfo.ioFVersNum = (SInt8) SvIV(value);
			} else
				goto invalidField;
			break;
		}
		break;
	case 'N':
		if (!strcmp(field, "ioNamePtr")) {
			/* Can't handle "StringPtr" automatically */
		} else
			goto invalidField;
		break;
	case 'V':
		if (!strcmp(field, "ioVRefNum")) {
			my->hFileInfo.ioVRefNum = (short) SvIV(value);
		} else
			goto invalidField;
		break;
	default:
invalidField:	
		croak("CatInfo has no field named %s", field);
	}

void
FIRSTKEY()
	CODE:
	croak("CatInfo::FIRSTKEY is not implemented");

void
NEXTKEY()
	CODE:
	croak("CatInfo::NEXTKEY is not implemented");

void
EXISTS()
	CODE:
	croak("CatInfo::EXISTS is not implemented");

void
DELETE()
	CODE:
	croak("CatInfo::DELETE is not implemented");

void
CLEAR()
	CODE:
	croak("CatInfo::CLEAR is not implemented");

MODULE = Mac::Files	PACKAGE = FInfo

FInfo
TIEHASH(name)
	char *	name
	CODE:
	OUTPUT:
	RETVAL

void
DESTROY(cat)
	FInfo	cat
	CODE:

SV *
FETCH(my, field)
	FInfo		my
	char *	field
	CODE:
 	if (!strcmp(field, "fdCreator")) {
		RETVAL = newSVpv((char *)&my.fdCreator, 4);
	} else if (!strcmp(field, "fdFlags")) {
		RETVAL = newSViv(my.fdFlags);
	} else if (!strcmp(field, "fdFldr")) {
		RETVAL = newSViv(my.fdFldr);
	} else if (!strcmp(field, "fdLocation")) {
		/* Can't handle "Point" automatically */
	} else if (!strcmp(field, "fdType")) {
		RETVAL = newSVpv((char *)&my.fdType, 4);		
	} else {
		croak("FInfo has no field named %s", field);
	}
	OUTPUT:
	RETVAL

void
STORE(my, field, value)
	FInfo		my
	char *	field
	SV *		value
	CODE:
	if (!strcmp(field, "fdCreator")) {
		memcpy(&my.fdCreator, SvPV(value,na), sizeof(OSType));
	} else if (!strcmp(field, "fdFlags")) {
		my.fdFlags = (unsigned short) SvIV(value);
	} else if (!strcmp(field, "fdFldr")) {
		my.fdFldr = (short) SvIV(value);
	} else if (!strcmp(field, "fdLocation")) {
		/* Can't handle "Point" automatically */
	} else if (!strcmp(field, "fdType")) {
		memcpy(&my.fdType, SvPV(value,na), sizeof(OSType));
	} else {
		croak("FInfo has no field named %s", field);
	}
	OUTPUT:
	my

void
FIRSTKEY()
	CODE:
	croak("FInfo::FIRSTKEY is not implemented");

void
NEXTKEY()
	CODE:
	croak("FInfo::NEXTKEY is not implemented");

void
EXISTS()
	CODE:
	croak("FInfo::EXISTS is not implemented");

void
DELETE()
	CODE:
	croak("FInfo::DELETE is not implemented");

void
CLEAR()
	CODE:
	croak("FInfo::CLEAR is not implemented");

MODULE = Mac::Files	PACKAGE = Mac::Files

=item FSpGetCatInfo FILE [, INDEX ]

If INDEX is omitted or 0, returns information about the specified 
file or folder. If INDEX is nonzero, returns information obout the 
nth item in the specified folder.

=cut
SV *
FSpGetCatInfo(file, index=0)
	FSSpec	file
	short		index
	PREINIT:
	CatInfo	info;
	CODE:
	if ((index && FSpUp(&file)) || !(info = NewCatInfo())) {
		XSRETURN_UNDEF;
	}
	info->hFileInfo.ioVRefNum 	= file.vRefNum;
	info->hFileInfo.ioDirID 		= file.parID;
	info->hFileInfo.ioFDirIndex = index;
	if (!index)
		memcpy(info->hFileInfo.ioNamePtr, file.name, *file.name+1);
	if (gLastMacOSErr = PBGetCatInfoSync(info)) {
		free(info);
		XSRETURN_UNDEF;
	}
	RETVAL =	SvTIE(sv_setref_pv(NEWSV(0, 0), "CatInfo", info));
	OUTPUT:
	RETVAL

=item FSpSetCatInfo FILE, INFO

Change information about the specified file.

=cut
MacOSRet
FSpSetCatInfo(file, inf)
	FSSpec	file
	SV *	inf
	PREINIT:
	CatInfo	info;
	CODE:
	inf = SvUNTIE(inf);
	if (inf && sv_isa(inf, "CatInfo"))
	    info = (CatInfo) SvIV((SV*)SvRV(inf));
	else
	    croak("info is not of type CatInfo");
	info->hFileInfo.ioVRefNum 	= file.vRefNum;
	info->hFileInfo.ioDirID 	= file.parID;
	memcpy(info->hFileInfo.ioNamePtr, file.name, *file.name+1);
	RETVAL = PBSetCatInfoSync(info);
	OUTPUT:
	RETVAL

=item FSMakeFSSpec VREF, DIRID, NAME

Creates a file system specification record from a volume number, 
directory ID, and name. This call never returns a path name.

=cut
RealFSSpec
FSMakeFSSpec(vRefNum, dirID, fileName)
	short		vRefNum
	long		dirID
	Str255	fileName
	CODE:
	if (gLastMacOSErr = FSMakeFSSpec(vRefNum, dirID, fileName, &RETVAL)) {
		XSRETURN_UNDEF;
	}
	OUTPUT:
	RETVAL

=item FSpCreate FILE, CREATOR, TYPE [, SCRIPTTAG]

Creates a file with the specified file creator and type. You don't
want to know what a script tag is.

=cut
MacOSRet
FSpCreate(spec, creator, type, scriptTag=smSystemScript)
	FSSpec	&spec
	OSType	creator
	OSType 	type
	char		scriptTag
	
=item FSpDirCreate FILE [, SCRIPTTAG]

Creates a directory and returns its ID.

=cut
long
FSpDirCreate(spec, scriptTag=smSystemScript)
	FSSpec	&spec
	char		scriptTag
	CODE:
	if (gLastMacOSErr = FSpDirCreate(&spec, scriptTag, &RETVAL))
		RETVAL = 0;
	OUTPUT:
	RETVAL

=item FSpDelete FILE

End the sad existence of a file or (empty) folder.

=cut
MacOSRet
FSpDelete(spec)
	FSSpec	&spec

=item FSpGetFInfo FILE

Returns finder info about a specified file.

=cut
SV *
FSpGetFInfo(spec)
	FSSpec	&spec
	PREINIT:
	FInfo	info;
	CODE:
	if (gLastMacOSErr = FSpGetFInfo(&spec, &info)) {
		XSRETURN_UNDEF;
	}
	RETVAL = 
		SvTIE(
			sv_setref_pvn(
				NEWSV(0, 0), "FInfo", 
				(char *)&info, sizeof(FInfo)));
	OUTPUT:
	RETVAL

=item FSpGetFInfo FILE, INFO

Changes the finder info about a specified file.

=cut
MacOSRet
FSpSetFInfo(spec, inf)
	FSSpec	&spec
	SV *		inf
	PREINIT:
	FInfo	info;
	CODE:
	inf = SvUNTIE(inf);
	if (inf && sv_isa(inf, "FInfo"))
		memcpy(&info, SvPV((SV*)SvRV(inf), na), sizeof(FInfo));
	else
		croak("info is not of type FInfo");
	RETVAL = FSpSetFInfo(&spec, &info);
	OUTPUT:
	RETVAL

=item FSpSetFLock FILE

Software lock a file.

=cut
MacOSRet
FSpSetFLock(spec)
	FSSpec	&spec

=item FSpGetFInfo FILE

Unlock a file.

=cut
MacOSRet
FSpRstFLock(spec)
	FSSpec	&spec

=item FSpRename FILE, NAME

Rename a file (only the name component).

=cut
MacOSRet
FSpRename(spec, newName)
	FSSpec	&spec
	Str255	newName

=item FSpCatMove FILE, FOLDER

Move a file into a different folder.

=cut
MacOSRet
FSpCatMove(source, dest)
	FSSpec	&source
	FSSpec	&dest

=item FSpExchangeFiles FILE1, FILE2

Swap the contents of two files, e.g. if you saved to a temp file
and finally swap it with the original.

=cut
MacOSRet
FSpExchangeFiles(source, dest)
	FSSpec	&source
	FSSpec	&dest

=item NewAlias FILE

Returns an AliasHandle for the file.

=cut
Handle
NewAlias(target)
	FSSpec	&target
	CODE:
	gLastMacOSErr = NewAlias(nil, &target, (AliasHandle *)&RETVAL);
	OUTPUT:
	RETVAL

=item NewAliasRelative FROM, FILE

Returns a AliasHandle relative to FROM for the file.

=cut
Handle
NewAliasRelative(from, target)
	FSSpec	&from
	FSSpec	&target
	CODE:
	gLastMacOSErr = NewAlias(&from, &target, (AliasHandle *)&RETVAL);
	OUTPUT:
	RETVAL

=item NewAliasMinimal FILE

Returns an AliasHandle containing minimal information for the file.
This type of alias is best suited for short lived aliases, e.g. in
AppleEvents.

=cut
Handle
NewAliasMinimal(target)
	FSSpec	&target
	CODE:
	gLastMacOSErr = NewAliasMinimal(&target, (AliasHandle *)&RETVAL);
	OUTPUT:
	RETVAL

=item FindFolder VREF, FOLDERTYPE [, CREATE]

Returns a path to a special folder on the given volume (specify 
C<kOnSystemDisk> for the boot volume). Values for FOLDERTYPE are

=cut
FSSpec
FindFolder(vRefNum, folderType, createFolder=0)
	short 	vRefNum
	OSType 	folderType
	Boolean 	createFolder
	CODE:
	if (gLastMacOSErr = FindFolder(vRefNum, folderType, createFolder, &RETVAL.vRefNum, &RETVAL.parID)) {
		XSRETURN_UNDEF;
	}
	FSpUp(&RETVAL);
	OUTPUT:
	RETVAL