PERFORCE change 12577 for review

Change 12577 by pudge@pudge-mobile on 2001/10/22 19:01:38

	Make ADDRESS called optionally as a method.

Affected files ...

... //depot/maint-5.6/macperl/macos/lib/Mac/Glue.pm#2 edit

Differences ...

==== //depot/maint-5.6/macperl/macos/lib/Mac/Glue.pm#2 (text) ====
Index: perl/macos/lib/Mac/Glue.pm
--- perl/macos/lib/Mac/Glue.pm.~1~	Mon Oct 22 13:15:05 2001
+++ perl/macos/lib/Mac/Glue.pm	Mon Oct 22 13:15:05 2001
@@ -30,14 +30,16 @@
 	$GENPKG $GENSEQ %OPENGLUES %MERGEDCLASSES @OTHEREVENT
 	@OTHERCLASS %SPECIALEVENT %SPECIALCLASS %DESCS
 	%MERGEDENUM @OTHERENUM %INSL %DESC_TYPE %COMP %LOGI
+	$RESERVED
 );
 
 #=============================================================================#
-# $Id: Glue.pm,v 1.1 2001/10/03 19:31:55 pudge Exp $
-($REVISION)	= ' $Revision: 1.1 $ ' =~ /\$Revision:\s+([^\s]+)/;
-$VERSION	= '1.00';
+# $Id: Glue.pm,v 1.3 2001/10/22 19:41:58 pudge Exp $
+($REVISION) 	= ' $Revision: 1.3 $ ' =~ /\$Revision:\s+([^\s]+)/;
+$VERSION	= '1.01';
 @ISA		= 'Exporter';
 @EXPORT		= ();
+$RESERVED	= 'REPLY|SWITCH|MODE|PRIORITY|TIMEOUT|RETOBJ|ERRORS|CALLBACK|CLBK_ARG|ADDRESS';
 @SYMS		= qw(
 			obj_form  param_type enum whose range location
 			glueTrue  glueFalse  glueNext gluePrevious
@@ -45,7 +47,7 @@
 			gTrue     gFalse     gNext    gPrevious
 			gFirst    gMiddle    gLast    gAny    gAll
 		);
-@METHS		= qw(	AUTOLOAD can launch obj prop	);
+@METHS		= qw(	ADDRESS AUTOLOAD can launch obj prop	);
 
 @EXPORT_OK	= ( @Mac::AppleEvents::EXPORT, @SYMS );
 %EXPORT_TAGS	= (
@@ -164,29 +166,38 @@
 
 	$self = { _DB => $db, ID => $db->{ID}, SWITCH => 0, GLUENAME => $app };
 
-	$self->{ADDRESS} = defined $addtype
-			? $addtype eq 'ppc'  || $addtype eq typeTargetID
-				? { typeTargetID() => pack_ppc($db->{ID}, @add) }
+	ADDRESS($self, $addtype, @add);
+
+	@{$self}{qw(CLASS NAMES IDS)} = _merge_classes($db);
+	_merge_enums($db, $self);
+
+	bless($self, $class);
+}
 
-			: $addtype eq 'eppc' || $addtype eq typeTargetID
-				? { typeTargetID() => pack_eppc($db->{ID}, @add) }
+#=============================================================================#
+# set target address
+sub ADDRESS {
+	my($self, $addtype, @add) = @_;
 
-			: $addtype eq 'psn'  || $addtype eq typeProcessSerialNumber
-				? { typeProcessSerialNumber() => pack_psn($add[0]) } 
+	$self->{ADDRESS} = defined $addtype
+		? $addtype eq 'ppc'	 || $addtype eq typeTargetID
+			? { typeTargetID() => pack_ppc($self->{ID}, @add) }
 
-			: $addtype eq 'path'
-				? { typeProcessSerialNumber() => _path_to_psn($add[0]) }
+		: $addtype eq 'eppc' || $addtype eq typeTargetID
+			? { typeTargetID() => pack_eppc($self->{ID}, @add) }
 
-			: { $addtype => $add[0] }
+		: $addtype eq 'psn'	 || $addtype eq typeProcessSerialNumber
+			? { typeProcessSerialNumber() => pack_psn($add[0]) } 
 
-		: { typeApplSignature() => $self->{ID} };
+		: $addtype eq 'path'
+			? { typeProcessSerialNumber() => _path_to_psn($add[0]) }
 
-	@{$self}{qw(CLASS NAMES IDS)} = _merge_classes($db);
-	_merge_enums($db, $self);
+		: { $addtype => $add[0] }
 
-	bless($self, $class);
+	: { typeApplSignature() => $self->{ID} };
 }
 
+
 #=============================================================================#
 # help UNIVERSAL::can out
 
@@ -212,7 +223,7 @@
 
 	if ($name eq 'DESTROY') {
 		return;
-	} elsif ($name =~ /^(?:REPLY|SWITCH|MODE|PRIORITY|TIMEOUT|RETOBJ|ERRORS)$/) {
+	} elsif ($name =~ /^(?:$RESERVED)$/) {
 		$sub = sub { $_[0]->{$name} = $_[1] if $_[1]; $_[0]->{$name} };
 	}
 
@@ -286,7 +297,7 @@
 	my $hash = {@args};
 	if ($hash) {
 		for my $p (keys %$hash) {
-			next if $p =~ /^(?:REPLY|SWITCH|MODE|PRIORITY|TIMEOUT|RETOBJ|ERRORS|CALLBACK|CLBK_ARG)$/;
+			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});
@@ -2103,7 +2114,7 @@
 
 Chris Nandor E<lt>[email protected]<gt>, http://pudge.net/
 
-Copyright (c) 1998-2000 Chris Nandor.  All rights reserved.  This program
+Copyright (c) 1998-2001 Chris Nandor.  All rights reserved.  This program
 is free software; you can redistribute it and/or modify it under the terms
 of the Artistic License, distributed with Perl.
 
End of Patch.