PERFORCE change 13122 for review

[email protected] (Chris Nandor) Tue, 20 Nov 2001 23:57:26 -0500
Newsgroups perl.perl5.changes.mac
Message-ID <p05100305b820e4b1d06e@[10.0.1.177]>
Change 13122 by pudge@pudge-mobile on 2001/11/20 03:20:17

	Add p2as droplet to distribution.

Affected files ...

.... //depot/maint-5.6/macperl/macos/macperl/Droplets/p2as.plx#1 add

Differences ...

==== //depot/maint-5.6/macperl/macos/macperl/Droplets/p2as.plx#1 (text) ====
Index: perl/macos/macperl/Droplets/p2as.plx
--- perl/macos/macperl/Droplets/p2as.plx.~1~	Mon Nov 19 20:30:05 2001
+++ perl/macos/macperl/Droplets/p2as.plx	Mon Nov 19 20:30:05 2001
@@ -0,0 +1,67 @@
+#!perl -w
+# p2as
+# [email protected]
+# 1999.03.12
+
+use File::Basename;
+use Mac::OSA::Simple 0.50 qw(:all);
+use Mac::Resources;
+use Mac::Memory;
+use strict;
+
+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 save it to the file
+	$comp = compile_applescript($text) or die $^E;
+	$comp->save($file);
+}
+
+sub get_alias {
+	my($file, $text) = @_;
+	
+	fix_text($file);
+
+	$text = qq'tell application "MacPerl"\n	 activate\n	 Do Script alias "$file"\nend tell';
+}
+
+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 = qq'tell application "MacPerl"\n	 activate\n	 Do Script "\n$script\n"\nend tell';
+}
+
+sub fix_text {
+	my $text = shift;
+	
+	# more to do than just fix " marks and \ ?
+	$$text =~ s/\\/\\\\/g;
+	$$text =~ s/"/\\"/g;
+
+	1;
+}
+
+__END__
End of Patch.