PERFORCE change 12966 for review
[email protected] (Chris Nandor) Tue, 13 Nov 2001 09:31:49 -0500
| Newsgroups | perl.perl5.changes.mac |
|---|---|
| Message-ID | <p05100301b816df4440ef@[10.0.1.177]> |
Change 12966 by pudge@pudge-mobile on 2001/11/13 05:43:58
Some cleanup; change some globals to references for
possible persistence later.
Affected files ...
.... //depot/maint-5.6/macperl/macos/lib/Mac/Glue.pm#3 edit
Differences ...
==== //depot/maint-5.6/macperl/macos/lib/Mac/Glue.pm#3 (text) ====
Index: perl/macos/lib/Mac/Glue.pm
--- perl/macos/lib/Mac/Glue.pm.~1~ Mon Nov 12 23:00:05 2001
+++ perl/macos/lib/Mac/Glue.pm Mon Nov 12 23:00:05 2001
@@ -1,5 +1,9 @@
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.
+
BEGIN {
use vars qw($SERIALIZER);
$SERIALIZER =
@@ -27,19 +31,19 @@
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
+ $GENPKG $GENSEQ %OPENGLUES $MERGEDCLASSES $OTHEREVENT
+ $OTHERCLASS %SPECIALEVENT %SPECIALCLASS %DESCS
+ $MERGEDENUM $OTHERENUM %INSL %DESC_TYPE %COMP %LOGI
$RESERVED
);
#=============================================================================#
-# $Id: Glue.pm,v 1.3 2001/10/22 19:41:58 pudge Exp $
-($REVISION) = ' $Revision: 1.3 $ ' =~ /\$Revision:\s+([^\s]+)/;
+# $Id: Glue.pm,v 1.4 2001/11/13 03:47:40 pudge Exp $
+($REVISION) = ' $Revision: 1.4 $ ' =~ /\$Revision:\s+([^\s]+)/;
$VERSION = '1.01';
@ISA = 'Exporter';
@EXPORT = ();
-$RESERVED = 'REPLY|SWITCH|MODE|PRIORITY|TIMEOUT|RETOBJ|ERRORS|CALLBACK|CLBK_ARG|ADDRESS';
+$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
@@ -101,7 +105,7 @@
use constant glueEndsWith => new AEDesc typeEnumerated, kAEEndsWith;
use constant glueContains => new AEDesc typeEnumerated, kAEContains;
-
+# short names
use constant gTrue => glueTrue();
use constant gFalse => glueFalse();
@@ -221,21 +225,26 @@
(my $name = $AUTOLOAD) =~ s/^.*://;
my $sub;
+ # catch reserved "method" names
if ($name eq 'DESTROY') {
return;
} elsif ($name =~ /^(?:$RESERVED)$/) {
$sub = sub { $_[0]->{$name} = $_[1] if $_[1]; $_[0]->{$name} };
}
+ # catch other-case versions of already-installed methods
unless ($sub) {
(my $auto = $AUTOLOAD) =~ s/:([^:]+)$/:\L$1/;
$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}'";
}
}
@@ -254,6 +263,8 @@
# 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) = @_;
@@ -536,6 +547,8 @@
}
# 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: $^E";
@@ -890,7 +903,7 @@
return $SPECIALEVENT{$name} if exists $SPECIALEVENT{$name};
- for ($self->{_DB}{EVENT}, @OTHEREVENT) {
+ for ($self->{_DB}{EVENT}, @$OTHEREVENT) {
if (exists $_->{$name}) {
$event = $_->{$name};
last;
@@ -914,15 +927,17 @@
#=============================================================================#
# 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$/) { # @data % 2 &&
+ if (ref($data[-1]) =~ /^(Mac::)?AE(?:Obj)?Desc$/) {
$obj = pop @data;
}
@@ -999,27 +1014,42 @@
opendir DIR, $dir or confess "Can't open directory '$dir': $!";
chdir $dir or confess "Can't chdir directory '$dir': $!";
- # ### add file type / creator checking
+ # 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 $_ 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};
+ 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': $!";
+
+# would this even help anything? BAH!
+# tie my %merged, 'MLDBM', "$ENV{MACGLUEDIR}gluemergecache", O_RDWR or confess "Can't tie '$_': $!";
+# if ($merged{EVENT} ne "@$OTHEREVENT" || $merged{CLASS} ne "@$OTHERCLASS" || $merged{ENUM} ne "@$OTHERENUM") {
+# $MERGEDCLASSES = $merged{CLASSES} = {};
+# $MERGEDENUM = $merged{ENUM} = {};
+# } else {
+# $MERGEDCLASSES = $merged{CLASSES};
+# $MERGEDENUM = $merged{ENUM};
+# }
}
#=============================================================================#
# 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} }) {
+ if (!exists $MERGEDCLASSES->{ $db->{ID} }) {
my($ids, $names) = ({}, {});
- my($class, @classes) = ($db->{CLASS}, @OTHERCLASS);
+ my($class, @classes) = ($db->{CLASS}, @$OTHERCLASS);
for my $c (keys %$class) {
$names->{$c}{id} = $class->{$c}{id};
@@ -1054,21 +1084,23 @@
}
}
- $MERGEDCLASSES{ $db->{ID} } = [$class, $names, $ids];
+ $MERGEDCLASSES->{ $db->{ID} } = [$class, $names, $ids];
}
- return @{$MERGEDCLASSES{ $db->{ID} }};
+ 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} }) {
+ if (!exists $MERGEDENUM->{ $db->{ID} }) {
my $names = $self->{NAMES};
my $ids = $self->{IDS};
- for my $tempc (grep defined, $db->{ENUM}, @OTHERENUM) {
+ for my $tempc (grep defined, $db->{ENUM}, @$OTHERENUM) {
for my $c (keys %$tempc) {
$self->{ENUMTYPE}{$c} = [];
for my $n (keys %{$tempc->{$c}}) {
@@ -1079,9 +1111,9 @@
}
}
}
- $MERGEDENUM{ $db->{ID} }++;
+ $MERGEDENUM->{ $db->{ID} }++;
}
- $MERGEDENUM{ $db->{ID} };
+ $MERGEDENUM->{ $db->{ID} };
}
#=============================================================================#
@@ -1338,6 +1370,10 @@
my $glue = Mac::Glue->new('My App', eppc => 'My App Name',
'some.machine.com');
+Also, the address can be changed after the fact:
+
+ my $glue = Mac::Glue->new('My App');
+ $glue->ADDRESS(eppc => 'My App Name', 'some.machine.com');
Once you have your glue set up, you start calling events, as they are
documented in the POD file for the glue. The events can be called
@@ -2121,7 +2157,7 @@
=head1 THANKS
-Matthias Neeracher E<lt>[email protected]<gt>,
+Matthias Neeracher E<lt>[email protected]<gt>,
David Schooley E<lt>[email protected]<gt>,
Graham Barr E<lt>[email protected]<gt>,
John W Baxter E<lt>[email protected]<gt>,
@@ -2153,7 +2189,7 @@
Mac::AppleEvents, Mac::AppleEvents::Simple, macperlcat, Inside Macintosh:
Interapplication Communication.
- http://sourceforge.net/projects/mac-glue/
+ http://sf.net/projects/mac-glue/
=cut
End of Patch.