File Coverage

blib/lib/Mac/Glue.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package Mac::Glue;

# the code below is SCARY.  please consider your loved ones before
# venturing within.  it might seem reasonable at first, but then you
# get sucked in and it's all over.

use Mac::Glue::Common qw($MACGLUEDIR);
use Carp;
use Exporter;
use Fcntl;
use File::Basename;
use File::Spec::Functions;
use Mac::AppleEvents::Simple 1.14 ':all';
use Mac::Apps::Launch 1.90;
use Mac::Errors qw(%MacErrors $MacError);
use Mac::Files 1.09;
use Mac::Gestalt;
use Mac::Memory 1.20 ();
use Mac::OSA 1.05 ();
use Mac::Processes 1.04;
use Mac::Types;
use MLDBM ('DB_File', $Mac::Glue::Common::SERIALIZER);
use Time::Epoch 'perl2epoch';

use strict;
use vars qw(
	$REVISION $VERSION $AUTOLOAD %AE_PUT %AE_GET @SYMS @METHS
	@EXPORT @EXPORT_OK %EXPORT_TAGS @ISA $GLUEDIR
	$GENPKG $GENSEQ %OPENGLUES $MERGEDCLASSES $OTHEREVENT
	$OTHERCLASS %SPECIALEVENT %SPECIALCLASS %DESCS
	$MERGEDENUM $OTHERENUM %INSL %DESC_TYPE %COMP %LOGI
	$RESERVED $ENCODE $SYSEVT
);

#=============================================================================#
# $Id: Glue.pm,v 1.32 2007/01/03 22:12:24 pudge Exp $
($REVISION) 	= ' $Revision: 1.32 $ ' =~ /\$Revision:\s+([^\s]+)/;
$VERSION	= '1.30';
@ISA		= 'Exporter';
@EXPORT		= ();
$RESERVED	= 'REPLY|SWITCH|MODE|PRIORITY|TIMEOUT|RETOBJ|ERRORS|CALLBACK|CLBK_ARG';
@SYMS		= qw(
			obj_form  param_type enum whose range location
			glueTrue  glueFalse  glueNext gluePrevious
			glueFirst glueMiddle glueLast glueAny glueAll
			gTrue     gFalse     gNext    gPrevious
			gFirst    gMiddle    gLast    gAny    gAll
		);
@METHS		= qw(	ADDRESS AUTOLOAD can launch obj prop version app_process	);

@EXPORT_OK	= ( @Mac::AppleEvents::EXPORT, '%MacErrors', '$MacError', @SYMS );
%EXPORT_TAGS	= (
			all	=> [@EXPORT, @EXPORT_OK],
			glue	=> [@EXPORT, @SYMS],
			long	=> [grep !/^g[A-Z]/, @EXPORT, @SYMS],
			longall	=> [grep !/^g[A-Z]/, @EXPORT, @EXPORT_OK],
		);

$GENPKG		= __PACKAGE__;
$GENSEQ		= 0;
$ENCODE		= eval { require Encode };

#=============================================================================#
# exported functions
sub obj_form ($$;$)	{ bless [@_], 'Mac::AEObjDescForm' }
sub param_type ($$)	{ bless [@_], 'Mac::AEParamType' }
sub enum ($)		{ bless [@_], 'Mac::AEEnum' }
sub whose		{ bless [formTest, @_], 'Mac::AEObjDescType' }
sub range ($$)		{ bless [formRange, @_], 'Mac::AEObjDescType' }
sub location ($;$);	*location = *_do_loc{CODE};

#=============================================================================#
# constants
use constant glueTrue		=> enum('true');
use constant glueFalse		=> enum('false');

use constant glueFirst		=> obj_form(formAbsolutePosition, typeAbsoluteOrdinal, kAEFirst);
use constant glueMiddle		=> obj_form(formAbsolutePosition, typeAbsoluteOrdinal, kAEMiddle);
use constant glueLast		=> obj_form(formAbsolutePosition, typeAbsoluteOrdinal, kAELast);
use constant glueAny		=> obj_form(formAbsolutePosition, typeAbsoluteOrdinal, kAEAny);
use constant glueAll		=> obj_form(formAbsolutePosition, typeAbsoluteOrdinal, kAEAll);
use constant glueNext		=> obj_form(formRelativePosition, typeEnumerated, kAENext);
use constant gluePrevious	=> obj_form(formRelativePosition, typeEnumerated, kAEPrevious);

use constant glueNull		=> new AEDesc typeNull;

use constant glueAnd		=> new AEDesc typeEnumerated, kAEAND;
use constant glueOr		=> new AEDesc typeEnumerated, kAEOR;
use constant glueNot		=> new AEDesc typeEnumerated, kAENOT;

use constant glueGT		=> new AEDesc typeEnumerated, kAEGreaterThan;
use constant glueGE		=> new AEDesc typeEnumerated, kAEGreaterThanEquals;
use constant glueEquals		=> new AEDesc typeEnumerated, kAEEquals;
use constant glueLT		=> new AEDesc typeEnumerated, kAELessThan;
use constant glueLE		=> new AEDesc typeEnumerated, kAELessThanEquals;
use constant glueBeginsWith	=> new AEDesc typeEnumerated, kAEBeginsWith;
use constant glueEndsWith	=> new AEDesc typeEnumerated, kAEEndsWith;
use constant glueContains	=> new AEDesc typeEnumerated, kAEContains;

# short names
use constant gTrue		=> glueTrue();
use constant gFalse		=> glueFalse();

use constant gFirst		=> glueFirst();
use constant gMiddle		=> glueMiddle();
use constant gLast		=> glueLast();
use constant gAny		=> glueAny();
use constant gAll		=> glueAll();
use constant gNext		=> glueNext();
use constant gPrevious		=> gluePrevious();

use constant gNull		=> glueNull();

use constant gAnd		=> glueAnd();
use constant gOr		=> glueOr();
use constant gNot		=> glueNot();

use constant gGT		=> glueGT();
use constant gGE		=> glueGE();
use constant gEquals		=> glueEquals();
use constant gLT		=> glueLT();
use constant gLE		=> glueLE();
use constant gBeginsWith	=> glueBeginsWith();
use constant gEndsWith		=> glueEndsWith();
use constant gContains		=> glueContains();

#=============================================================================#
_open_others();
#=============================================================================#

sub new {
	my($class, $app, $addtype, @add) = @_;
	my($self, $glue, $db, $app1, $app2);

	# find glue, try a few different names just in case
	($app1 = $app) =~ tr/ /_/;
	($app2 = $app) =~ tr/_/ /;
	for (map { catfile($MACGLUEDIR, $_) } $app, $app1, $app2) {
		if (-e) {
			$glue = $_;
			last;
		}
	}
	croak "No application glue for '$app' found in '$MACGLUEDIR'" unless $glue;

	# if not already opened, open and store reference to db
	unless (exists $OPENGLUES{$glue}) {
		tie my %db, 'MLDBM', $glue, O_RDONLY or confess "Can't tie '$glue': $!";
		$OPENGLUES{$glue} = \%db;
	}
	$db = $OPENGLUES{$glue};

	# create new class to put this in, add the symbols we want,
	# nyah nyah nyah (gosh, I love Perl)
	$class = $GENPKG . '::GLUE' . $GENSEQ++;
	{
		no strict 'refs';
		for (@METHS) {
			*{$class . '::' . $_} = *{'Mac::Glue::' . $_}{CODE};
		}
	}

	$self = {
		_DB		=> $db,
		ID		=> $db->{ID},
		CREATOR_ID	=> $db->{CREATOR_ID} || $db->{ID},
		BUNDLE_ID	=> $db->{BUNDLE_ID},
		GLUENAME	=> $app,
		APPNAME		=> $db->{APPNAME},
		VERSION		=> $db->{VERSION},
		SWITCH		=> 0,
	};

	ADDRESS($self, $addtype, @add);

	@{$self}{qw(CLASS NAMES IDS)} = _merge_classes($db);
	_merge_enums($db, $self);

	bless($self, $class);
}

#=============================================================================#
# set target address
sub ADDRESS {
	my($self, $addtype, @add) = @_;

	$self->{ADDRESS} = defined $addtype
		? $addtype eq 'ppc'    || $addtype eq typeTargetID
			? { typeTargetID() => pack_ppc($self->{CREATOR_ID}, @add) }

		: $addtype eq 'eppc' && $^O eq 'MacOS'
			? { typeTargetID() => pack_eppc($self->{CREATOR_ID}, @add) }

		: $addtype eq 'eppc'
			? { typeApplicationURL() => pack_eppc_x(@add) }

		: $addtype eq 'psn'    || $addtype eq typeProcessSerialNumber
			? { typeProcessSerialNumber() => pack_psn($add[0]) }

		: $addtype eq 'pid'    || $addtype eq typeKernelProcessID
			? { typeKernelProcessID() => pack_pid($add[0]) }

		: $addtype eq 'bundle' || $addtype eq typeApplicationBundleID
			? { _get_bundle($add[0]) }

		: $addtype eq 'path'
			? { typeProcessSerialNumber() => _path_to_psn($add[0]) }

		: { $addtype => $add[0] }

	: $self->{BUNDLE_ID}
		? { _get_bundle($self->{BUNDLE_ID})  }
		: { typeApplSignature()       => $self->{CREATOR_ID} };

	# $self->{ID} will only be '????' if we could not identify
	# a creator ID *or* a bundle ID (or for older glues that
	# don't do bundle ID)
	if (! defined $addtype && $self->{ID} eq '????') {
		$self->{ADDRESS} = 'PSN';
	}
}

# Jaguar can't target bundles natively, so convert to a path
sub _get_bundle {
	my($bundle_id) = @_;
	if ($Gestalt{sysv} >= 4144) {
		return(typeApplicationBundleID, $bundle_id);
	} else {
		my $path = LSFindApplicationForInfo('', $bundle_id);
		return(typeProcessSerialNumber, _path_to_psn($path));
	}
}

#=============================================================================#
# help UNIVERSAL::can out

sub can {
	my($self, $meth) = @_;
	return unless @_ == 2;
	my $can = UNIVERSAL::can($self, $meth);
	unless ($can) {
		$AUTOLOAD = ref($self) . '::' . $meth;
		$can = AUTOLOAD('AUTOLOAD::can', $self);
	}
	return $can;
}

#=============================================================================#
# define event calls as subs

sub AUTOLOAD {
	my $can = $_[0] eq 'AUTOLOAD::can' ? shift : 0;
	my $self = $_[0];
	(my $name = $AUTOLOAD) =~ s/^.*://;
	my $sub;

	# catch reserved "method" names
	if ($name eq 'DESTROY') {
		return;
	} elsif ($name =~ /^(?:$RESERVED)$/) {
		$sub = sub { $_[0]->{$name} = $_[1] if defined $_[1]; $_[0]->{$name} };
	}

	# catch other-case versions of already-installed methods
	unless ($sub) {
		(my $auto = $AUTOLOAD) =~ s/:([^:]+)$/:\L$1/;
		if ($auto !~ /^can|obj|prop|launch|version$/) {
			$sub = $auto if defined &$auto;
		}
	}

	# define method if we can find it in the glue table
	unless ($sub) {
		if (my $event = _find_event($self, lc $name)) {
			$sub = sub { _primary($_[0], $event, lc $name, @_[1 .. $#_]) }
		} elsif (! $can) {
			# should this croak?  probably.  complain and come
			# up with another idea if you don't like it.
			croak "No event '$name' available from glue for '$self->{GLUENAME}'";
		}
	}

	# install new sub, only do AUTOLOAD for it once!
	if ($sub) {
		no strict 'refs';
		*{$AUTOLOAD} = $sub;
	}

	return $sub if $can;
	goto &$sub;
}

#=============================================================================#
# login using GTQ Login As OSAX
# will NOT return error if exists, because MacPerl does not handle replies well

# this should be removed, it is a bad idea.

sub login {
	my($self, $user, $pass) = @_;

	my $evt = build_event(qw(gtqp lgin McPL), q{'----':TEXT(@), pwrd:TEXT(@)},
		$user, $pass);
	$evt->send_event(kAENoReply);

	return 1;
}

#=============================================================================#
# basic subroutine building and sending every event call
# (see sub AUTOLOAD)

sub _primary {
	my($self, $e, $name, @args) = @_;
	my($evt, %xargs, $dobj, @origargs);

	my($class, $event, $reply, $params) = @{$e}{qw(class event reply params)};

	$dobj = shift @args if @args % 2;

	%xargs = @args;
	for (keys %xargs) {
		delete $xargs{$_} unless /^(?:CALLBACK|CLBK_ARG)$/;
	}

	if ($self->{ADDRESS} eq 'PSN') {
	        while (my($psn, $psi) = each %Process) {
			if ($psi->processName eq $self->{APPNAME}) {
				$self->{ADDRESS} = { typeProcessSerialNumber, pack_psn($psn) };
				last;
			}
		}
		if ($^O ne 'MacOS') {
			my $path = LSFindApplicationForInfo('', '', $self->{APPNAME})
				|| LSFindApplicationForInfo('', '', $self->{APPNAME} . '.app');
			my $psn = _path_to_psn($path);
			$self->{ADDRESS} = { typeProcessSerialNumber, $psn } if $psn;
		}
		croak "App not running" if $self->{ADDRESS} eq 'PSN';
	}

	@xargs{keys %{$self->{ADDRESS}}} = values %{$self->{ADDRESS}};

	# create event (Mac::AppleEvents::Simple object)
	$evt = build_event($class, $event, \%xargs);

	# prepare parameters (direct object)
	if (defined $dobj) {
		croak "Direct object parameter not present"
			unless exists $params->{keyDirectObject()};
		_params($self, $evt, $params->{keyDirectObject()}, $dobj, $class, $event);
		push @origargs, 'DOBJ', $dobj;
	}

	# prepare parameters (all the rest)
	my $hash = {@args};
	if ($hash) {
		for my $p (keys %$hash) {
			next if $p =~ /^(?:$RESERVED)$/;
			my $pp = $p eq 'DOBJ' ? keyDirectObject : lc $p;
			croak "'$p' parameter not available" unless exists $params->{$pp};
			_params($self, $evt, $params->{$pp}, $hash->{$p}, $class, $event);
			push @origargs, $pp, $hash->{$p};
		}
	}

	# prepare send parameters and send event
	local $Mac::AppleEvents::Simple::SWITCH =
		$hash->{SWITCH} ? $hash->{SWITCH} : $self->{SWITCH};

	# we'll wait if REPLY not set and TIMEOUT is set
	if (!exists $hash->{REPLY} && exists $hash->{TIMEOUT}) {
		$self->{REPLY} = 1;
	}

	my $mode =
		(ref $hash->{CALLBACK} eq 'CODE'
			? kAEQueueReply
			: (exists $hash->{REPLY}	# check event setting
				? $hash->{REPLY}
				: exists $self->{REPLY}	# check global setting
					? $self->{REPLY}
					: 1		# default to wait
			)
				? kAEWaitReply
				: kAENoReply)

			| (exists $hash->{MODE}
				? $hash->{MODE}
				: exists $self->{MODE}
					? $self->{MODE}
					: kAECanSwitchLayer);

	my $priority =
		exists $hash->{PRIORITY}
			? $hash->{PRIORITY}
			: exists $self->{PRIORITY}
				? $self->{PRIORITY}
				: kAENormalPriority;

	my $timeout =
		exists $hash->{TIMEOUT}
			? 60 * $hash->{TIMEOUT}		# convert seconds to ticks
			: exists $self->{TIMEOUT}
				? 60 * $self->{TIMEOUT}
				: kNoTimeOut;

	print AEPrint($evt->{EVT}), "\n" if $self->{_print_aes};

	# load scripting additions
	# XXX: do this only if necessary?
	# kASAppleScriptSuite\kGetAEUT
	do_event(qw(ascr gdut), \%xargs);

	$evt->send_event($mode, $priority, $timeout);

	my $retobj = exists $hash->{RETOBJ}
		? $hash->{RETOBJ}
		: exists $self->{RETOBJ}
			? $self->{RETOBJ}
			: 0;

	my $error_handler = exists $hash->{ERRORS}
		? $hash->{ERRORS}
		: exists $self->{ERRORS}
			? $self->{ERRORS}
			: 0;

	local $AE_GET{typeObjectSpecifier()} = sub {
		return(_obj_desc($self, $_[0]), 1);
	};

	local $Mac::AppleEvents::Simple::CLASSREC = sub {
		return _is_class($self, $_[0]);
	};

	local $Mac::AppleEvents::Simple::ENUMREC = sub {
		return _is_enum($self, $_[0]);
	};

	my @return;
	if ($retobj) {
		@return = $evt;
	} elsif (my $type = $evt->type) {
		@return = $evt->get;
		@return = _fix_reco($self, {@return}) if $type eq typeAERecord;
		@return = @{_fix_reco($self, \@return)} if $type eq typeAEList;
	}

	$^E = my $errno = exists $evt->{ERRNO} ? $evt->{ERRNO} : 0; # restore errno

	my $return = 1;
	# if error handler, only return if error handler returns true
	# what should error handler be passed?
	if ($errno && $error_handler) {
		my($package, $filename, $line) = caller(1);

		$error_handler = \&_default_error_handler
			if $error_handler eq 1;

		my($err, $errs, $errc);
		$err = $MacErrors{ $errno };
		$errs = $err ? $err->description : '';
		$errc = $err ? $err->symbol : '';

		$return = $error_handler->({
			_glue		=> $self,
			_event		=> $evt,
			glue		=> $self->{GLUENAME},
			event		=> $name,
			errs		=> $errs,
			errn		=> $errno,
			errc		=> $errc,
			line		=> $line,
			'package'	=> $package,
			filename	=> $filename,
		}, @origargs);
	}

	$^E = exists $evt->{ERRNO} ? $evt->{ERRNO} : 0; # really restore errno

	return(wantarray ? @return : $return[0]) if $return;
}

#=============================================================================#

sub _default_error_handler {
	my($err, @args) = @_;
	my $args = join ', ', @args;
	warn sprintf("%s->%s(%s) event failed:\n%s (%d)\n%s\n",
		$err->{glue}, $err->{event}, $args,
		$err->{errc}, $err->{errn}, $err->{errs}
	);
	return 1;
}

#=============================================================================#
# prepare all event parameters

sub _params {
	my($self, $evt, $p, $data, $class, $event) = @_;
	my($key, $type) = @{$p}[0, 1];

	if (ref $data eq 'Mac::AEParamType') {
		($data, $type) = @{$data}[1, 0];
	} elsif ($type eq typeObjectSpecifier && ref $data ne 'Mac::AEObjDesc') {
		$type = _check_default_type($data);

	# if we have a set data event, refer to direct object for type to use
	} elsif ($type eq typeWildCard && $class eq 'core' && $event eq 'setd' && $key eq 'data' && ref $data ne 'Mac::AEObjDesc') {
		if (my $dobj = AEGetParamDesc($evt->{EVT}, keyDirectObject)) {
			if ($dobj->type eq typeObjectSpecifier) {
				if (my $keydata = AEGetKeyDesc($dobj, keyAEKeyData)) {
					$type = _get_type($self, $data, $type, _get_name($self, $keydata->get));
					AEDisposeDesc $keydata;
				}
			}
			AEDisposeDesc $dobj;
		}
	}

	my($desc, $dispose) = _get_desc($self, $data, $type, $key);
	AEPutParamDesc($evt->{EVT}, $key, $desc)
		or confess "Can't put $key/$desc into event: $MacError";

	if ($self->{_print_aes}) {
		print <

AEPutParamDesc($evt->{EVT}, $key, $desc);
EOT
		print <
AEDisposeDesc($desc);
EOT
	}

	AEDisposeDesc $desc if $dispose;
}

#=============================================================================#
# Put anon array parameter data into AE list

sub _do_list {
	my($self, $data, $type, $key) = @_;
	my $list = AECreateList('', 0) or confess "Can't create list: $MacError";
	if ($self->{_print_aes}) {
		print <

$list = AECreateList('', 0);
EOT
	}
	my $count = 0;

	for my $d (@{$data}) {
		my $t = _get_type($self, $d, '', $key);
		my($desc, $dispose) = _get_desc($self, $d, $t); #$type);
		AEPutDesc($list, ++$count, $desc)
			or confess "Can't put $desc into $list: $MacError";
		if ($self->{_print_aes}) {
			print <
AEPutDesc($list, $count, $desc);
EOT
			print <
AEDisposeDesc($desc);
EOT
		}
		AEDisposeDesc $desc if $dispose;
	}

	return $list;
}

#=============================================================================#
# Put anon hash parameter data into AE record

sub _do_rec {
	my($self, $data, $type) = @_;
	my $reco = AECreateList('', 1) or confess "Can't create record: $MacError";
	if ($self->{_print_aes}) {
		print <

$reco = AECreateList('', 1);
EOT
	}
	my $class;

	while (my($k, $d) = each %{$data}) {
		if ($k =~ /^class$/i) {
			$class = _get_id($self, $d);
			next;
		}
		my $key = _get_id($self, $k);
		my $t = _get_type($self, $d, '', $k);
		my($desc, $dispose) = _get_desc($self, $d, $t);
		AEPutKeyDesc($reco, $key, $desc)
			or confess "Can't put $key/$desc into $reco: $MacError";
		if ($self->{_print_aes}) {
			print <
AEPutKeyDesc($reco, $key, $desc);
EOT
			print <
AEDisposeDesc($desc);
EOT
		}
		AEDisposeDesc $desc if $dispose;
	}

	if ($class) {
		my $nreco = AECoerceDesc($reco, $class)
			or confess "Can't coerce to '$class': $MacError";
		if ($self->{_print_aes}) {
			print <
$nreco = AECoerceDesc($reco, $class);
AEDisposeDesc($reco);
EOT
		}
		AEDisposeDesc $reco;
		$reco = $nreco;
	}

	return $reco;
}

#=============================================================================#
# create AE descriptor record

sub _do_obj {
	my($self, $data, $class, $from) = @_;

	if (ref $data eq 'ARRAY') {
		my @list;
		for (@$data) {
			push @list, _do_obj($self, $_, $class, $from);
		}
		return _obj_desc($self, _do_list($self, \@list));
	}

	my($list, $obj, $form, $dataform, $d, $ref);
	$class = 'property' if $class =~ /^(?:of|in|prop)$/;
	confess "Class '$class' does not exist for '$data'.\n"
		unless exists $self->{NAMES}{$class};

	$data = _get_objdesc($data);
	$ref = ref $data;

	if ($class eq 'property') {
		my $prop = $data;
		$data = _get_id($self, $data) or croak "Can't find property '$prop'.\n";
		$form = typeProperty;

	} elsif ($ref eq 'AEDesc' || $ref eq 'Mac::AEObjDescType') {
		$data = $DESC_TYPE{$data->[0]}->($self, $class, @{$data}[1 .. $#{$data}])
			if $ref eq 'Mac::AEObjDescType';
		$dataform = $form = $data->type;
		if ($form eq typeCompDescriptor || $form eq typeLogicalDescriptor) {
			$form = formTest;
		}

	} elsif ($ref eq 'Mac::AEObjDescForm') {
		$form = $$data[0];
		$dataform = $$data[1] if @$data == 3;
		$data = $$data[-1];

	} elsif ($data =~ /^[+-]?\d+$/) {
		$form = formAbsolutePosition;

	} else {
		$form = formName;
		if ($^O ne 'MacOS' && $class =~ /^f(?:ile|older)$/i) {
			$data = Mac::Files::_Unix2Mac($data);
		}
	}

	$dataform ||=
		$form eq formName		? typeChar	:
		$form eq formAbsolutePosition	? typeInteger	:
		$form eq typeProperty		? typeType	:
		$form;

	$class = $self->{NAMES}{$class};
	$list = AECreateList('', 1) or confess "Can't create list: $MacError";

	# form / keyAEForm
	AEPutKey($list, keyAEForm, typeEnumerated, $form)
		or confess "Can't put form:$form into object: $MacError";

	# want / keyAEDesiredClass
	AEPutKey($list, keyAEDesiredClass, typeType, $class->{id})
		or confess "Can't put want:$class->{id} into object: $MacError";

	if ($self->{_print_aes}) {
		print <

$list = AECreateList('', 1);
AEPutKey($list, keyAEForm, typeEnumerated, $form);
AEPutKey($list, keyAEDesiredClass, typeType, $class->{id});
EOT
	}

	# seld / keyAEKeyData
	($d, $dataform) = _get_data($self, $data, $dataform);
	if (ref $d eq 'AEDesc') {
		AEPutKeyDesc($list, keyAEKeyData, $d)
			or confess "Can't put seld:$d into object: $MacError";
		if ($self->{_print_aes}) {
			print <
AEPutKeyDesc($list, keyAEKeyData, $d);
EOT
		}

	} else {
		AEPutKey($list, keyAEKeyData, $dataform, $d)
			or confess "Can't put seld:$dataform($d) into object: $MacError";
		if ($self->{_print_aes}) {
			print <
AEPutKey($list, keyAEKeyData, $dataform, $d);
EOT
		}
	}

	# type / keyAEContainer
	# hm.  why are first two the same?  why didn't i comment this to
	# begin with?
	if ($from && $from eq typeCurrentContainer) {
		AEPutKey($list, keyAEContainer, $from, '')
			or confess "Can't put from:$from into object: $MacError";
		if ($self->{_print_aes}) {
			print <
AEPutKey($list, keyAEContainer, $from, '');
EOT
		}
	} elsif ($from && $from eq typeObjectBeingExamined) {
		AEPutKey($list, keyAEContainer, $from, '')
			or confess "Can't put from:$from into object: $MacError";
		if ($self->{_print_aes}) {
			print <
AEPutKey($list, keyAEContainer, $from, '');
EOT
		}
	} elsif ($from) {
		$from = _get_objdesc($from);
		AEPutKeyDesc($list, keyAEContainer, $from)
			or confess "Can't put from:$from into object: $MacError";
		if ($self->{_print_aes}) {
			print <
AEPutKeyDesc($list, keyAEContainer, $from);
EOT
		}
	} else {
		AEPutKey($list, keyAEContainer, typeNull, '')
			or confess "Can't put from:null into object: $MacError";
		if ($self->{_print_aes}) {
			print <
AEPutKey($list, keyAEContainer, typeNull, '');
EOT
		}
	}

	$obj = AECoerceDesc($list, typeObjectSpecifier)
		or confess "Can't coerce to 'obj ': $MacError";
	if ($self->{_print_aes}) {
		print <
$obj = AECoerceDesc($list, typeObjectSpecifier);
AEDisposeDesc($list);
EOT
	}
	AEDisposeDesc $list;

	return _obj_desc($self, $obj);
}

#=============================================================================#
# create insertion record

sub _do_loc ($;$) {
	my($pos, $obj) = @_;

	# just so we can look up _print_aes
	my $self = ref $obj eq 'Mac::AEObjDesc' ? $obj->{GLUE} : {};

	$obj = _get_objdesc($obj);
	my $desc = ref $obj eq 'AEDesc' ? $obj : gNull();
	my $list = AECreateList('', 1) or confess "Can't create list: $MacError";

	AEPutKeyDesc($list, keyAEObject, $desc)
		or confess "Can't put object in location: $MacError";
	AEPutKey($list, keyAEPosition, typeEnumerated, $INSL{$pos} || $pos)
		or confess "Can't put pos in location: $MacError";

	my $insl = AECoerceDesc($list, typeInsertionLoc)
		or confess "Can't coerce $list to 'obj ': $MacError";

	if ($self->{_print_aes}) {
		my $p = $INSL{$pos} || $pos;
		print <

$list = AECreateList('', 1);
AEPutKeyDesc($list, keyAEObject, $desc);
AEPutKey($list, keyAEPosition, typeEnumerated, $p);
$insl = AECoerceDesc($list, typeInsertionLoc);
AEDisposeDesc($list);
EOT
	}

	AEDisposeDesc $list;
	_save_desc($insl);
	return $insl;
}

#=============================================================================#
# create glue descriptor record

sub _do_range {
	my($self, $class, $r1, $r2) = @_;

	$r1 = _do_obj($self, $r1, $class, typeCurrentContainer);
	$r2 = _do_obj($self, $r2, $class, typeCurrentContainer);

	my $list = AECreateList('', 1) or confess "Can't create list: $MacError";

	AEPutKeyDesc($list, keyAERangeStart, $r1->{DESC})
		or confess "Can't add param to list: $MacError";
	AEPutKeyDesc($list, keyAERangeStop,  $r2->{DESC})
		or confess "Can't add param to list: $MacError";

	my $rang = AECoerceDesc($list, typeRangeDescriptor)
		or confess "Can't coerce to range: $MacError";

	if ($self->{_print_aes}) {
		print <

$list = AECreateList('', 1);
AEPutKeyDesc($list, keyAERangeStart, $r1->{DESC});
AEPutKeyDesc($list, keyAERangeStop,  $r2->{DESC});
$rang = AECoerceDesc($list, typeRangeDescriptor);
AEDisposeDesc($list);
EOT
	}

	AEDisposeDesc $list;
	_save_desc($rang);

	return $rang;
}

#=============================================================================#
# create comparison descriptor record

sub _do_comp {
	my $self = shift;
	my $len = @_;
	my($p1, $d1, $op, $p2, $d2, $c1, $c2, $dispose1, $dispose2);

	$p1 = $len < 4 ? 'property' : shift;
	$d1 = shift;
	$op = shift;
	$p2 = $len < 5 ? undef : shift;
	$d2 = shift;

	unless (ref $op eq 'AEDesc') {
		my $foo = $op;
		$op = $COMP{lc $op} or croak "Comparison operator '$foo' not recognized";
	}

	if ($p1 eq 'property' && $d1 eq 'it') {
		$c1 = new AEDesc typeObjectBeingExamined;
		if ($self->{_print_aes}) {
			print <

$c1 = AECreateDesc(typeObjectBeingExamined);
EOT
		}
		$dispose1 = 1;
	} else {
		$c1 = _do_obj($self, $d1, $p1, typeObjectBeingExamined)->{DESC};
	}

	if (defined $p2) {
		$c2 = _do_obj($self, $d2, $p2, typeObjectBeingExamined)->{DESC};
	} else {
		($c2, $dispose2) = _get_desc($self, $d2);
	}

	my $list = AECreateList('', 1) or confess "Can't create list: $MacError";

	AEPutKeyDesc($list, keyAECompOperator, $op);
	AEPutKeyDesc($list, keyAEObject1, $c1);
	AEPutKeyDesc($list, keyAEObject2, $c2);

	if ($self->{_print_aes}) {
		print <

$list = AECreateList('', 1);
AEPutKeyDesc($list, keyAECompOperator, $op);
AEPutKeyDesc($list, keyAEObject1, $c1);
AEPutKeyDesc($list, keyAEObject2, $c2);
EOT

		print <
AEDisposeDesc($c1);
EOT

		print <
AEDisposeDesc($c2);
EOT
	}

	AEDisposeDesc $c1 if $dispose1;
	AEDisposeDesc $c2 if $dispose2;

	my $comp = AECoerceDesc($list, typeCompDescriptor)
		or confess "Can't coerce list to comparison descriptor: $MacError";

	if ($self->{_print_aes}) {
		print <
$comp = AECoerceDesc($list, typeCompDescriptor);
AEDisposeDesc($list);
EOT
	}
	AEDisposeDesc $list;
	_save_desc($comp);

	return $comp;
}

#=============================================================================#
# create a logical descriptor record

sub _do_logical {
	my($self, $op, @args) = @_;
	my $terms = AECreateList('', 0) or confess "Can't create list: $MacError";

	if ($self->{_print_aes}) {
		print <

$terms = AECreateList('', 0);
EOT
	}

	unless (ref $op eq 'AEDesc') {
		my $foo = $op;
		$op = $LOGI{uc $op} or croak "Logical operator '$foo' not recognized";
	}

	for my $i (0 .. $#args) {
		my $term = $args[$i];
		my $desc;
		croak "Each logical term must be in an anonymous array ($term)\n"
			if ref $term ne 'ARRAY';

		if (grep { ref ne 'ARRAY' } @{$term}[1 .. $#{$term}]) {
			$desc = _do_comp($self, @$term);
		} else {
			$desc = _do_logical($self, @$term);
		}
		AEPutDesc($terms, $i + 1, $desc);
		if ($self->{_print_aes}) {
			my $j = $i + 1;
			print <
AEPutDesc($terms, $j, $desc);
EOT
		}
	}

	my $list = AECreateList('', 1) or confess "Can't create list: $MacError";
	AEPutKeyDesc($list, keyAELogicalOperator, $op);
	AEPutKeyDesc($list, keyAELogicalTerms, $terms);

	my $logi = AECoerceDesc($list, typeLogicalDescriptor)
		or confess "Can't coerce list into logical descriptor: $MacError";
	AEDisposeDesc $terms;
	AEDisposeDesc $list;

	if ($self->{_print_aes}) {
		print <
$list = AECreateList('', 1);
AEPutKeyDesc($list, keyAELogicalOperator, $op);
AEPutKeyDesc($list, keyAELogicalTerms, $terms);
$logi = AECoerceDesc($list, typeLogicalDescriptor);
AEDisposeDesc($terms);
AEDisposeDesc($list);
EOT
	}

	_save_desc($logi);

	return $logi;
}

#=============================================================================#
# help create a test object record

sub _do_whose {
	splice @_, 1, 1;  # remove class
	if (grep { ref ne 'ARRAY' } @_[2 .. $#_]) {
		goto &_do_comp;
	} else {
		goto &_do_logical;
	}
}

#=============================================================================#
# return descriptor as needed

sub _get_desc {
	my($self, $data, $type, $key) = @_;
	my($desc, $dispose, $ref);

	$dispose = 1;
	$data = _get_objdesc($data);
	$ref = ref $data;

	if ($ref eq 'Mac::AEParamType') {
		($data, $type) = @{$data}[1, 0];
	} elsif ($type && $type eq typeObjectSpecifier && $ref ne 'Mac::AEObjDesc') {
		$type = _check_default_type($data);
	}

	if ($ref eq 'ARRAY') {
		$desc = _do_list($self, $data, $type, $key);
	} elsif ($ref eq 'HASH') {
		$desc = _do_rec($self, $data, $type);
	} elsif ($ref eq 'AEDesc') {
		$desc = $data;
		$dispose = 0;
		_save_desc($desc);
	} else {
		my($d, $t);
		$t = _get_type($self, $data, $type);
		($d, $t) = _get_data($self, $data, $t);

		if (ref $d eq 'AEDesc') {
			$desc = $d;
			$dispose = 0;
			_save_desc($d);
		} else {
			$desc = AEDesc->new($t, $d);
			if ($self->{_print_aes}) {
				print <

$desc = AECreateDesc($t, $d);
EOT
			}
		}
	}

	return($desc, $dispose);
}

#=============================================================================#
# take a good guess at what the data type is

sub _get_type {
	my($self, $data, $type, $key) = @_;
	return '' if ref $data;
	if (defined $key) {
		my $href = _get_id($self, $key, 1);
		if (exists $href->{types}) {
			my @types = grep { exists $AE_PUT{$_} } @{$href->{types}};
			for my $t (@types) {
				if ($t eq typeUnicodeText) {
					# only use if text is UTF, and Encode is available
					if ($ENCODE && Encode::is_utf8($data)) {
						$type = typeUnicodeText;
						last;
					}
				} else {
					$type = $t;
					last;
				}
			}
		}
	}

	if (!$type || $type eq typeWildCard) {
		$type = _check_default_type($data);
	}

	return $type;
}

# check for UTF-ness?
sub _check_default_type {
	my($data) = @_;
	my $type = $data =~ /^[+-]?\d+$/
		? typeInteger
		: $data =~ /^[+-]?\d+\.\d+$/
			? typeFloat
			: typeChar;
	return $type;
}

#=============================================================================#
# fudge the data into something that the event will be expecting
# should only return data as simple non-reference scalar or AEDesc

sub _get_data {
	my($self, $data, $type) = @_;
	my $t;

	my $ref = ref $data;

	if ($ref eq 'Mac::AEEnum') {
		my $id = _get_id($self, $data->[0]);
		$data = $id if defined $id;
		$type = typeEnumerated; # typeEnumerated or typeType ???

	} elsif ($type eq typeType) {
		my $id = _get_id($self, $data);
		$data = $id if defined $id;

	# see the %AE_PUT data structure
	} elsif (exists $AE_PUT{$type}) {
		($data, $t) = $AE_PUT{$type}->($data);
	}

	return($data, $t || $type);
}

#=============================================================================#
# get class / property name

sub _get_name {
	my($self, $id) = @_;
	if (exists $self->{IDS}{$id}) {
		if (exists $self->{IDS}{$id}{name}) {
			return $self->{IDS}{$id}{name};
		}
	}
	return;
}

#=============================================================================#
# find if ID is class

sub _is_class {
	my($self, $id) = @_;
	my $name = _get_name($self, $id) or return;
	my $class = $self->{CLASS}{$name} or return;
	if (scalar keys %{$class->{properties}} > 1 ||
		(scalar keys %{$class->{properties}} == 1 && ! exists $class->{properties}{''})) {
		return 1;
	}
}

#=============================================================================#
# return name if type is enum

sub _is_enum {
	my($self, $id) = @_;
	return unless exists $self->{ENUM}{$id};
	return _get_name($self, $id);
}

#=============================================================================#
# fix record stuff

sub _fix_reco {
	my($self, $data) = @_;

	if (ref $data eq 'ARRAY') {
		my @narr;
		for my $i (@$data) {
			push @narr, (ref $i eq 'HASH' || ref $i eq 'ARRAY')
				? _fix_reco($self, $i) : $i;
		}
		return \@narr;
	} elsif (ref $data eq 'HASH') {
		my %nreco;
		for my $id (keys %$data) {
			my $nid = _get_name($self, $id);
			my $i = $data->{$id};
			$nreco{$nid || $id} = (ref $i eq 'HASH' || ref $i eq 'ARRAY')
				? _fix_reco($self, $i) : $i;
		}
		return \%nreco;
	}
}

#=============================================================================#
# get class / property id

sub _get_id {
	my($self, $name, $obj) = @_;
	(my $new = lc $name) =~ tr/ /_/;
	my $ref = $self->{NAMES}{$new} if exists $self->{NAMES}{$new};
	return $obj ? $ref : $ref->{id};
}

#=============================================================================#
# get Mac::AEObjDesc

sub _get_objdesc {
	my $ref = ref $_[0];
	if ($ref eq 'Mac::AEObjDesc') {
		return $_[0]->{DESC};
	} else {
		return $_[0];
	}
}

#=============================================================================#
# create Mac::AEObjDesc

sub _obj_desc {
	_save_desc($_[1]);
	my $self = bless { GLUE => $_[0], DESC => $_[1] }, 'Mac::AEObjDesc';
}

#=============================================================================#
# save AEDesc for destruction later in Mac::AppleEvents::Simple

sub _save_desc { $DESCS{$_[0]} = $_[0] }

#=============================================================================#
# find all information for an event, based on its "name"

sub _find_event {
	my($self, $name) = @_;
	my $event;

	return $SPECIALEVENT{$name} if exists $SPECIALEVENT{$name};

	for ($self->{_DB}{EVENT}, @$OTHEREVENT) {
		if (exists $_->{$name}) {
			$event = $_->{$name};
			last;
		}
	}

	return $event;
}

#=============================================================================#
# is class a plural of another?

sub _is_plural {
	my($self, $class) = @_;
	my $pl = 'c@#!';
	return unless exists $self->{CLASS}{$class}{properties};
	my $pref = $self->{CLASS}{$class}{properties};
	return scalar grep { $pref->{$_}[0] && $pref->{$_}[0] eq $pl } keys %$pref;
}

#=============================================================================#
# create an AE object

# heh heh heh ... stupid little shortcut
sub prop {
	@_ = ($_[0], 'property', @_[1 .. $#_]);
	goto &obj;
}

# this is pretty nasty, just go with it
sub obj {
	my($self, @data, $obj, @obj) = @_;

	if (ref($data[-1]) =~ /^(Mac::)?AE(?:Obj)?Desc$/) {
		$obj = pop @data;
	}

	for (my $i = 0; $i <= $#data; $i++) {
		my($k, $v) = $data[$i];
		if (!(
			$data[$i+1]
				&&
			ref($data[$i+1]) =~ /^(Mac::)?AE/)
				&&
			_is_plural($self, $k)
		) {
			$v = gAll();
		} else {
			$i++;
			$v = $data[$i];
		}
		push @obj, [$v, $k];
	}

	for (reverse @obj) {
		local $^W;
		$obj = _do_obj($self, @{$_}[0, 1], $obj);
	}

	return $obj;
}

#=============================================================================#
# get app version

sub version {
	my($self) = @_;

	my $reply = $self->prop('version')->get(RETOBJ => 1);
	my $vers;

	if ($reply->type eq 'vers') {
		my $data = $reply->get;
		my @l = split(//, unpack("a7", $data));
		$vers = unpack("x7a@{[ord($l[6])]}", $data);
	} else {
		$vers = $reply->get;
	}

	return $vers;
}

#=============================================================================#
# helper method to get the application process object

sub app_process {
	my($self) = @_;
	$SYSEVT ||= new Mac::Glue 'System Events';

	return $SYSEVT->obj(application_process => $self->{APPNAME})->get;
}

#=============================================================================#
# launch the app (done automatically when an event is called if not running)

sub launch {
	my($self, $location) = @_;
	if (defined $location) {
		LaunchSpecs($location);
	} elsif ($self->{BUNDLE_ID}) {
		$location = LSFindApplicationForInfo('', $self->{BUNDLE_ID});
		LaunchSpecs($location);
	} else {
		LaunchApps($self->{CREATOR_ID});
	}
}

#=============================================================================#
# launch spec and then get PSN

sub _path_to_psn {
	my($path) = @_;

	confess "Path '$path' does not exist" unless -e $path;

	my $lp = LaunchParam->new(
		launchControlFlags => (launchContinue | launchNoFileFlags | launchDontSwitch),
		launchAppSpec => $path
	);

	my $psn = LaunchApplication($lp) or confess "Cannot launch '$path': $MacError";

	return pack_psn($psn);
}

#=============================================================================#
# open scripting additions and dialect files only once,
# save them for further use by all Mac::Glue instances

sub _open_others {
	chomp(my $curdir = `pwd`);
	my @others;
	for my $dir (map { catfile($MACGLUEDIR, $_) } qw[dialects additions]) {
		unless (-e $dir) {
			warn "Please run gluedialect and gluescriptadds programs"
				unless $Mac::Glue::CREATINGGLUES;
			$Mac::Glue::NEEDCREATE = 1;
			next;
		}

		local *DIR;
		opendir DIR, $dir or confess "Can't open directory '$dir': $!";
		chdir $dir or confess "Can't chdir directory '$dir': $!";

		# add file type / creator checking ???
		# maybe add a new file type for glues?  i can do that now,
		# because i am special or something.
		for (readdir DIR) {
			next if -d;
			next if $_ eq "Icon\015";
			next if /\.pod$/;
			tie my %db, 'MLDBM', $_, O_RDONLY or confess "Can't tie '$_': $!";
			push @$OTHEREVENT, $db{EVENT} if $db{EVENT};
			push @$OTHERCLASS, $db{CLASS} if $db{CLASS};
			push @$OTHERENUM,  $db{ENUM}  if $db{ENUM};
		}
	}
	chdir $curdir or confess "Can't chdir to '$curdir': $!";
}

#=============================================================================#
# merge additions, dialect, and glue classes together
# wow, this is ugly.  i wonder if there is a better/faster way.  probably.
# or maybe a way to cache the results between iterations ... ?
# but then, how do we deal with added/removed classes?

sub _merge_classes {
	my($db) = @_;
	if (!exists $MERGEDCLASSES->{ $db->{ID} }) {
		my($ids, $names) = ({}, {});
		my($class, @classes) = ($db->{CLASS}, @$OTHERCLASS);

		for my $c (keys %$class) {
			$names->{$c}{id} = $class->{$c}{id};
			$ids->{$names->{$c}{id}}{name} = $c;

			for my $p (keys %{$class->{$c}{properties}}) {
				$names->{$p}{id} ||= $class->{$c}{properties}{$p}[0];
				$ids->{$names->{$p}{id}}{name} ||= $p;
				unshift @{$names->{$p}{types}}, $class->{$c}{properties}{$p}[1];
			}
		}

		for my $tempc (@classes) {
			for my $c (keys %$tempc) {
				$names->{$c}{id} ||= $tempc->{$c}{id};
				$ids->{$names->{$c}{id}}{name} = $c;

				for my $p (keys %{$tempc->{$c}{properties}}) {
					$names->{$p}{id} ||= $tempc->{$c}{properties}{$p}[0];
					$ids->{$names->{$p}{id}}{name} ||= $p;
					unshift @{$names->{$p}{types}}, $tempc->{$c}{properties}{$p}[1];

					$class->{$c}{properties}{$p} = $tempc->{$c}{properties}{$p}
						if (exists $class->{$c} &&
							$class->{$c}{id} eq $tempc->{$c}{id} &&
							! exists $class->{$c}{properties}{$p});
				}

				unless (exists $class->{$c}) {
					$class->{$c} = $tempc->{$c};
				}
			}
		}

		$MERGEDCLASSES->{ $db->{ID} } = [$class, $names, $ids];
	}
	return @{$MERGEDCLASSES->{ $db->{ID} }};
}

#=============================================================================#
# "merge" additions, dialect, and glue enumerations together
# see above about caching results, rethinking logic.  for a really
# really really really rainy day.

sub _merge_enums {
	my($db, $self) = @_;
	if (!exists $MERGEDENUM->{ $db->{ID} }) {
		my $names = $self->{NAMES};
		my $ids = $self->{IDS};

		for my $tempc (grep defined, $db->{ENUM}, @$OTHERENUM) {
			for my $c (keys %$tempc) {
				$self->{ENUMTYPE}{$c} = [];
				for my $n (keys %{$tempc->{$c}}) {
					$names->{$n}{id} ||= $tempc->{$c}{$n}{id};
					$ids->{$names->{$n}{id}} ||= { name => $n };
					$self->{ENUM}{$tempc->{$c}{$n}{id}} = 1;
					push @{$self->{ENUMTYPE}{$c}}, $tempc->{$c}{$n}{id};
				}
			}
		}
		$MERGEDENUM->{ $db->{ID} }++;
	}
	$MERGEDENUM->{ $db->{ID} };
}

#=============================================================================#

*AE_GET = *Mac::AppleEvents::Simple::AE_GET{HASH};
*DESCS  = *Mac::AppleEvents::Simple::DESCS{HASH};

%INSL = (
	end		=> kAEEnd,
	before		=> kAEBefore,
	beginning  	=> kAEBeginning,
	front		=> kAEBeginning,
	after		=> kAEAfter,
	back		=> kAEAfter,
	behind		=> kAEAfter,
);

%COMP = (
	g_t		=> gGT(),
	g_e		=> gGE(),
	equals		=> gEquals(),
	l_t		=> gLT(),
	l_e		=> gLE(),
	begins_with	=> gBeginsWith(),
	ends_with	=> gEndsWith(),
	contains	=> gContains(),
);

%LOGI = (
	AND		=> gAnd(),
	OR		=> gOr(),
	NOT		=> gNot(),
);

%AE_PUT = (
	typeShortFloat()	=> sub {MacPack(typeShortFloat,		$_[0])},
	typeFloat()		=> sub {MacPack(typeFloat,		$_[0])},
	typeMagnitude()		=> sub {MacPack(typeMagnitude,		$_[0])},
	typeShortInteger()	=> sub {MacPack(typeShortInteger,	$_[0])},
	typeInteger()		=> sub {MacPack(typeInteger,		$_[0])},
	typeBoolean()		=> sub {MacPack(typeBoolean,		$_[0])},
	typeChar()		=> sub {MacPack(typeChar,		$_[0])},
	typeFSS()		=> sub {MacPack(typeFSS,		$_[0])},
	typeAlias()		=> sub {
		my $alis = -e $_[0]
			? NewAliasMinimal($_[0])
			: NewAliasMinimalFromFullPath($_[0]);
		croak "Can't create alias for '$_[0]': $MacError" unless $alis;
		return $alis->get;
	},
	typeWildCard()		=> sub {
		my $type = _get_type('', $_[0], typeWildCard);
		my $data = _get_data('', $_[0], $type);
		return($data, $type);
	},
	typeProcessSerialNumber() => sub { pack_psn($_[0]) },
	typeLongDateTime()	=> sub {
		my $ldt = $^O eq 'MacOS' ? $_[0] : perl2epoch($_[0], 'macos');
		require Config;
		if ($Config::Config{byteorder} eq '1234') {
			return pack 'LL', $ldt, 0;
		# this may break if some platform uses neither 1234 or 4321!
		} else {
			return pack 'LL', 0, $ldt;
		}
	},

	'file'			=> sub {
		if ($^O ne 'MacOS') {
			return Mac::Files::_Unix2Mac($_[0]);
		} else {
			return $_[0];
		}
	},

	# empty four bytes for lang code
	typeIntlText()		=> sub {'    ' . MacPack(typeChar, $_[0])},
	typeUnicodeText()	=> sub {
		if ($ENCODE) {
			# BOM sometimes causes problems, so it is optional, and
			# we leave it off, and use native ordering explicitly
			require Config;
			my $bom = $Config::Config{byteorder} eq '1234' ? 'LE' : 'BE';
			return new AEDesc typeUnicodeText,
				Encode::encode('UTF-16'.$bom, $_[0]);
		} else { # oh well!
			return new AEDesc typeChar, $_[0];
		}
	}
);
$AE_PUT{folder} = $AE_PUT{file};

%DESC_TYPE = (
	formRange()	=> \&_do_range,
	formTest()	=> \&_do_whose,
);

%SPECIALEVENT = (
	'set'	=> {
		'class'		=> 'core',
		'event'		=> 'setd',
		'reply'		=> ['****', 0, 0, 0],
		'params'	=> {
			'----'	=> [keyDirectObject, 'obj ', 1, 0, 0, 1],
			'to'	=> ['data', '****', 1, 0, 0],
		}
	},
	'get'	=> {
		'class'		=> 'core',
		'event'		=> 'getd',
		'reply'		=> ['****', 1, 0, 0],
		'params'	=> {
			'----' => [keyDirectObject, 'obj ', 1, 0, 0, 0],
			'as' => ['rtyp', 'type', 0, 1, 0],
		}
	},
);

%SPECIALCLASS = (

);

#=============================================================================#
# other glue* stuff
for (gNull(), gAnd(), gOr(), gNot(), gGT(), gGE(), gEquals(),
	gLT(), gLE(), gBeginsWith(), gEndsWith(), gContains()) {
	_save_desc($_);
}

#=============================================================================#

package Mac::AEObjDesc;

use Carp;
use vars '$AUTOLOAD';

use Mac::AppleEvents;

sub getdata {
	my($self, $key) = @_;
	my $desc = $self->{DESC};
	return unless $desc && $desc->type eq typeObjectSpecifier;

	my $data = AEGetKeyDesc($desc, $key || keyAEKeyData);
	my $return = $data->Mac::AppleEvents::Simple::_getdata;
	AEDisposeDesc $data;
	return $return;
}

sub AUTOLOAD { # can?
	my($self, @args) = @_;

	(my $name = $AUTOLOAD) =~ s/^.*://;
	return if $name eq 'DESTROY';

	my $sub = $self->{GLUE}->can($name);
	if ($sub) {
		if ($name eq 'obj' || $name eq 'prop') {
			push @args, $self;
		} else {
			unshift @args, $self;
		}
		$sub->($self->{GLUE}, @args);
	} else {
		# should this croak?  probably.  complain and come
		# up with another idea if you don't like it.
		croak "No event '$name' available from glue for '$self->{GLUE}{GLUENAME}'";
	}
}


1;

__END__