[MacPerl] Java Scripting with MacPerl

[Chris Nandor <pudge@pobox.com>]

Here is a quick script adapted from an AppleScript included with the MRJ
SDK.  Install Mac::Glue, create a glue for Apple Applet Runner (I called my
glue MRJ), run an applet in Apple Applet Runner, and run this script.

You also need UnderMethods, included below.

#!perl -w
# show AWT components in a window
# pudge@pobox.com
# taken from an AppleScript example in MRJ SDK 2.2 EA1
# doesn't work with MRJ 2.2a1

use strict;
use Mac::Glue;
use UnderMethods;

my $java = new Mac::Glue 'MRJ';

for ($java) {
    print list_comps(obj(window => 1));
}

sub list_comps {
    my $ref = shift;
    my $pre = shift || '';
    my $rst = sprintf "%s%s", $pre, comp_name($ref);
    $pre .= "  ";
    my $c = get(prop(component_count => $ref));
    for my $i (1 .. $c) {
        my $obj = obj(component => $i => $ref);
        if (check($obj, belongs_to => 'Container')) {
            $rst .= list_comps($obj, $pre);
        } else {
            $rst .= sprintf "%s%s", $pre, comp_name($obj);
        }
    }
    return $rst;
}

sub comp_name {
    my $ref   = shift;
    my $obj   = get(prop(name => $ref)) || 'anonymous';
    my $class = (split m/\./, get(prop(name => of => class => $ref)))[-1];
    return "$class $obj\n";
}

__END__

UnderMethods.pm:

package UnderMethods;

use strict;
use overload;
use Carp;
use vars '$AUTOLOAD';

sub import {
    no strict 'refs';
    *{ caller() . "::AUTOLOAD" } = \&AUTOLOAD;
}

sub AUTOLOAD {
    my($ref) = (overload::StrVal($_) =~
/^(?:(.*)\=)?(?:[^=]*)\((?:[^\(]*)\)$/);
    croak "Undefined subroutine &$AUTOLOAD called" unless $ref;
    (my $name = $AUTOLOAD) =~ s/.*:://;
    my $func = $_->can($name);
    confess "Can't call method `$name' in $ref" unless $func;
    unshift @_, $_;
    goto &$func;
}

1;

__END__

-- 
Chris Nandor          mailto:pudge@pobox.com         http://pudge.net/
%PGPKey = ('B76E72AD', [1024, '0824090B CE73CA10  1FF77F13 8180B6B6'])

===== Want to unsubscribe from this list?
===== Send mail with body "unsubscribe" to macperl-request@macperl.org