[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]

Re: [MacPerl] Yet Another AppleEvents Question (YAAEQ)



You sent this to me, I think, and I never got around to it.

At 13.21 -0400 1998.09.10, Michael Leahy wrote:
>Here's a snippet from 'aete.convert':
>
>@EVENT "validate user", "Validate that a given password is correct for a
>user in a specific realm", 'WWW½', 'Vusr'
>@REPLY 'bool', "True: User is valid, False: user or password is invalid",
>REQ, SINGLE, NOENUM
>@DIRECT 'char', "user name", REQ, SINGLE, NOENUM, NOCHANGE
>@PARAM  "password", 'AUpw', 'char', "password", REQ, SINGLE, NOENUM
>@PARAM  "realm", 'AUrm', 'char', "realm", REQ, SINGLE, NOENUM
>
>@EVENT "Refuse Connections", "Toggle incoming connections on or off",
>'WWW½', 'fcon'
>@REPLY 'null', "¹", REQ, SINGLE, NOENUM
>@DIRECT 'bool', "True or False", REQ, SINGLE, NOENUM, NOCHANGE
>
>
>
>Here's a framework for the two routines (I inserted '???'s in the areas
>that I have no idea about):
>
>use Mac::AppleEvents::Simple;
>sub validate_user {
>    my ($userid, $realm, $passwd) = @_;
>    my $obj = "obj{obj{want:type(bool), " .                ???
>        "from:null(), form:enum(name), seld:TEXT(\@)}}";   ???
>    $event = do_event(qw/WWW½ VUsr WWW½/,
>        "'----':$obj, AUpw:TEXT(@), AUrm:TEXT(@)",
>        $userid, $passwd, $realm);
>    return ??? ;
>}
>
>sub refuse_connections {
>    my ($state) = shift;
>    my $obj = "obj{   ???   }";
>    $event = do_event(qw/WWW½ fcon WWW½/,
>        "'----':$obj", $state);
>}




>So my questions are:
>1) How do I pass a boolean?  Is it expecting a 0|1 or "TRUE|FALSE", etc?

First off:  you do not need to pass an object unless one is requested.  No
object is requested (noted by the 'obj ' keyword).  Second, you can pass it
manually or with AEPutParam{Desc}:

  #!perl -wl
  use Mac::AppleEvents::Simple;
  use Mac::AppleEvents;
  use Mac::Types;

  $x = build_event(qw/WWW½ VUsr WWW½/);
  AEPutParam($x->{EVT}, keyDirectObject, typeBoolean, MacPack(typeBoolean, 0));
  print AEPrint $x->{EVT};

  $y = build_event(qw/WWW½ VUsr WWW½/, q"'----':bool(Ē01Č)");
  print AEPrint $y->{EVT};

Both return the same thing (except the first is true, the second false):

  'WWW½'\VUsr{'----':bool(Ē00Č)}
  'WWW½'\VUsr{'----':bool(Ē01Č)}

(Incidentally, using build_event is a nice way to look at the events during
testing phase without actually sending the event.  The event can then be
sent with $x->send_event(), which can also take additional parameters like
priority and timeout).



>2) How do I retrieve a boolean result?

Well, you can get something like:

  $xx = AEGetParamDesc($x->{EVT}, keyDirectObject);
  $yy = AEGetParamDesc($y->{EVT}, keyDirectObject);
  print $xx->get;
  print $yy->get;
  AEDisposeDesc($xx);
  AEDisposeDesc($yy);

Returns:

  0
  1


>3) Is the routine 'event_error()' an appropriate way to check for error
>conditions?
>
># Ex: $err = event_error($evt)
>sub event_error {
>    $event = shift;
>    return "" unless $event;
>    my $err = $event->{REPLY};
>    if ($err =~ /errn:/) {
>        my ($val) = $err =~ /:(.*)}/;
>        return $val;
>    } else {
>        return "";
>    }
>}

This is better, and it is likely what I am going to use in my app glue
module.  It checks for errs or errn, and builds the error message with one
or both of them, and returns undef otherwise.

  $t = event_error($s->{EVT});
  print $t if $t;

  sub event_error {
    my($event, $errn, $errs, $error) = @_;
    return unless $event;
    $errn = AEGetParamDesc($event, keyErrorNumber);
    $errs = AEGetParamDesc($event, keyErrorString);
    if ($errn) {
      $error = " " . $errn->get;
      AEDisposeDesc($errn);
    }
    if ($errs) {
      $error .= sprintf(": %s", $errs->get);
      AEDisposeDesc($errs);
    }
    return $error ? "Application error$error" : undef;
  }

--
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 mac-perl-request@iis.ee.ethz.ch