Re: [MacPerl] Launching a script from another script??

[Chris Nandor <pudge@pobox.com>]

At 20.15 -0400 1999.04.26, Schwartz, Todd wrote:
>I have a Perl script that is designed to launch another Perl script and keep
>going while the launched script runs in the background. These scripts work
>fine on Win32 and Unix -- on those platforms the launching script uses
>Win32::CreateProcess or fork, respectively.  I am now trying to port them to
>MacPerl, and am starting to have some serious doubts.  Does anyone know if
>this is even possible on the Mac? (Please bear with me, I am a relative
>newcomer to the Mac environment).  Here are the problems I am seeing:

Here is a script that will run another MacPerl by launching another copy of
the MacPerl app (creating it if need be) and then telling it to Do Script,
and passing arguments as appropriate.

If you want it to, it will do the script and wait for it to finish and
return whatever was sent to STDOUT.  But if you want this done, you could
just do() the script in the first place.  So the default is to not wait for
reply.


#!perl -w
# launchotherperl.plx
# pudge@pobox.com, Wednesday, April 28, 1999

use File::Copy;
use Mac::AppleEvents;
use Mac::Files;
use Mac::Processes;
use strict;

my $script = "$ENV{MACPERL}myscript";
my @args   = 'a' .. 'j';
my $psn    = launch_copy();


# if you wait for reply, run_script will return
# the STDOUT of the script ... else, STDOUT will
# go the MacPerl copy
my $wait   = kAENoReply; # kAENoReply or kAEWaitReply


# quit other MacPerl copy when done ...
# maybe use MacPerl::Quit or something
my $ret    = run_script($script, $wait, @args);
print $ret if $ret;


sub run_script {
    my($script, $wait, @args) = @_;
    my($list, $evt, $rep, $stdout, $ret);

    $list = AECreateList('', 0);

    AEPut($list, 1, typeAlias, NewAliasMinimal($script)->get) or die $^E;
    for (0 .. $#args) {
        AEPut($list, $_ + 2, typeChar, $args[$_]) or die $^E;
    }

    $evt = AEBuildAppleEvent(qw(misc dosc), typeProcessSerialNumber, $psn,
        kAutoGenerateReturnID, kAnyTransactionID,
        $wait == kAEWaitReply ? 'MODE:BATC' : '',
    ) or die $^E;

    AEPutParamDesc($evt, keyDirectObject, $list) or die $^E;

    if (defined $evt) {
        $rep = AESend($evt, $wait) or die $^E;
    }

    if ($wait == kAEWaitReply) {
        if ($stdout = AEGetParamDesc($rep, keyDirectObject)) {
            $ret = $stdout->get if $stdout->get;
            AEDisposeDesc($stdout);
        }
    }

    AEDisposeDesc($list);
    AEDisposeDesc($evt);
    AEDisposeDesc($rep);

    return $ret;
}


sub launch_copy {
    my($macperl, $copys, $copy, $count, $psn);
    $macperl = "$ENV{MACPERL}$^X";
    $copys   = "$macperl copy";

    # not exactly most reliable ... someone could start process
    # while we are looking for it to not exist
    while (! $copy) {
        my $psn;
        $copy = $copys . ($count ? ' ' . $count : '');
        foreach (keys %Process) {
            $psn = $_ if $Process{$_}->processAppSpec eq $copy;
        }
        $count++;
        undef $copy if $psn;
    }

    copy($macperl, $copy) unless -e $copy;

    LaunchApplication(LaunchParam->new(
        launchAppSpec => $copy,
        launchControlFlags =>
            launchContinue | launchNoFileFlags | launchDontSwitch
    )) or die $^E;

    foreach (keys %Process) {
        $psn = $_ if $Process{$_}->processAppSpec eq $copy;
        last if $psn;
    }

    return unless $psn;

    $psn = pack('ll', $psn / (2**32), $psn % (2**32));

    return $psn;
}

__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