[MacPerl] as2p

[Chris Nandor <pudge@pobox.com>]

Requires a new Mac::OSA::Simple 0.10, on CPAN.

Will make all perl scripts dropped on it into compiled AppleScripts.  Lets
you select to either embed perl script text in the compiled AppleScript, or
to just make AppleScript contain alias to the script.  Both have their
advantages: one method lets you have one file and easily distribute it.
The other lets you easily edit the script since you only have a pointer to
it in the AppleScript.

This has only been tested by me, so caveat scriptor.  Please let me know
how it works for you.

Why a compiled AppleScript?  So you can put it in your scripts menu in
programs like BBEdit and ircle and OSA Menu.

#!perl -w
# as2p :)
# pudge@pobox.com
# 1999.03.10

use File::Basename;
use Mac::OSA::Simple 0.10;
use Mac::Resources;
use Mac::Memory;
use strict;

sub fix_text (\$);

die "Need at least one Perl script!\n" unless @ARGV;

# select which type of compiled script you want ... hardcode this
# if you like:  Text = 1, Alias = 0
my $switch = MacPerl::Answer('For all scripts, save script text or ' .
     'alias to script on disk?', 'Text', 'Alias');

# drop as many scripts as you can handle
for my $f (@ARGV) {
    my($comp, $data, $res, $script, $len, $file, $dir, $text);

    # get AppleScript text
    $text = ($switch ? get_text($f) : get_alias($f))
        or (warn("No text for '$f'") && next);

    # get new name of file
    ($file, $dir) = fileparse($f, '\..+$');
    $file = "$dir$file.scr";

    # get compiled AppleScript and stick it in a new handle
    $comp = compile_applescript($text);
    $data = $comp->compiled or (warn("No data for '$f'") && next);
    $len = length($data);
    $script = NewHandle($len);
    $script->set(0, $len, $data);

    # create new compiled AppleScript file (will fail if file exists)
    CreateResFile($file) or (warn("Can't create '$file': $^E") && next);
    MacPerl::SetFileInfo('ToyS', 'osas', $file);

    # put data into new file
    $res = FSpOpenResFile $file, 0
        or (warn("Can't open '$file': $^E") && next);
    AddResource($script, 'scpt', 128, 'MacPerl Script')
        or (warn("Can't add resource to '$file': $^E") && next);
    UpdateResFile($res)
        or (warn("Can't update resources for '$file': $^E") && next);
    CloseResFile($res);
}

sub get_alias {
    my($file, $text) = @_;

    fix_text($file);

    $text = qq'tell application "MacPerl" to Do Script alias "$file"';

    $text;
}

sub get_text {
    my($file, $script, $text) = @_;
    local($/, *F);

    open F, $file or die "Can't open '$file': $!";
    $script = <F>;
    close F or die "Can't close '$file': $!";

    fix_text($script);

    $text = <<EOS;
tell application "MacPerl" to Do Script "
$script
"
EOS

    $text;
}

sub fix_text (\$) {
    my $text = shift;

    # more to do than just fix " marks and \ ?
    $$text =~ s/\\/\\\\/g;
    $$text =~ s/"/\\"/g;

    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