view release on metacpan or  search on metacpan

Glue.pm  view on Meta::CPAN

	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) = @_;