File Coverage

blib/lib/Mac/AppleScript/Glue.pm

Criterion	Covered	Total	%
statement	24	26	92.3
branch			n/a
condition			n/a
subroutine	9	9	100.0
pod			n/a
total	33	35	94.2

line	stmt	sub	time	code
1				package Mac::AppleScript::Glue;
2
3				=head1 NAME
4
5				Mac::AppleScript::Glue - allows AppleScript to be written in Perl
6
7				=head1 SYNOPSIS
8
9				use Mac::AppleScript::Glue;
10
11				my $finder = new Mac::AppleScript::Glue::Application('Finder');
12
13				$finder->insertion_location->open;
14
15
16				=head1 DESCRIPTION
17
18				This module allows you to write Perl code in object-oriented syntax to
19				control Mac applications. The module does not actually execute Apple
20				Events, but actually translates Perl code to AppleScript code and
21				causes it to be executed.
22
23
24				=head2 Quick start
25
26				The following AppleScript opens the "current" folder in the Finder:
27
28				tell application "Finder"
29				open insertion location
30				end tell
31
32				To do this in Perl, you first include the module:
33
34				use Mac::AppleScript::Glue;
35
36				Then you create an object you'll use to talk to the Finder application:
37
38				my $finder = new Mac::AppleScript::Glue::Application('Finder');
39
40				And finally you issue the compound statement:
41
42				# open the Finder's "insertion location" in a new window
43				$finder->insertion_location->open;
44
45				You can save the result of a statement:
46
47				# get the Finder's "insertion location"
48				my $loc = $finder->insertion_location;
49
50				And if that result is not a scalar, list, or hash (more on this
51				later), you can use that result as an object to do further work:
52
53				# now open that in a new window
54				$loc->open;
55
56				You can set attributes:
57
58				my $folder = $finder->make_new_folder;
59
60				$folder->set(name => 'My folder');
61
62				If you need to get a particular element of an object, put the
63				identifier as an argument to the thing that names the element list:
64
65				my $window = $finder->windows(1);
66
67				If you need to specify parameters of a command, use a hash for the
68				parameters, where each key/value pair corresponds to a parameter name
69				and value:
70
71				my $epson_files = $finder->files(whose_name_contains => 'epson');
72
73				You can specify both identifiers and parameters:
74
75				my $epson_files = $finder->files(1, whose_name_contains => 'epson');
76
77				Finally, there are cases where you need to create an object reference,
78				rather than obtaining one from an application. To do this, you can
79				use an application object to create a
80				Mac::AppleScript::Glue::Object(3pm) that refers to both the object
81				reference and the application to which that reference should belong:
82
83				my $folder = $finder->objref('folder "Applications"');
84
85				Then, you can use that as you normally would:
86
87				# open the "Applications" folder
88				$folder->open;
89
90				If you don't need a full-fledged object, you can simply specify a
91				parameter of a I to a scalar containing a string:
92
93				# open the "Applications" folder
94				$finder->open(\'folder "Applications"');
95
96				This is also what you should use if you need to pass an AppleScript
97				"constant" along:
98
99				$folder->duplicate(replacing => \'true');
100
101				But an easier way is to enclose the name of the constant in
102				angle-brackets; the module will know to use it verbatim rather than
103				trying to quote it:
104
105				$folder->duplicate(replacing => '');
106
107
108				=head2 Return values
109
110				If you issue a statement that will return a value, like C
111				location>, the result of that statement is always a scalar. The
112				actual contents of this scalar depends on the sort of statement. It
113				will be one of:
114
115				=over 4
116
117				=item regular scalar
118
119				A number or a string. This is what you'd expect in Perl -- like 1, or
120				"foo".
121
122				=item object reference
123
124				An object reference is a textual string that AppleScript uses to
125				describe both the class and context of a "thing". For example, the
126				C statement might return an object reference of:
127
128				folder "Desktop" of folder "johnl" of folder "Users" of startup
129				disk of application "Finder"
130
131				When Mac::AppleScript::Glue(3pm) sees this sort of reference, it puts the
132				whole object reference string into an object of type
133				Mac::AppleScript::Glue::Object(3pm) (see
134				L). It also stores in this object the
135				application object that created the object. By doing this, the
136				Mac::Application::Glue::Object(3pm) can be used by itself to access or
137				modify other data.
138
139				=item array or hash reference
140
141				If the statement returned an AppleScript "list" or "record", the
142				result will be a Perl array- or hash-reference, respectively. This
143				could contain simple scalars, or a combination of any of the result
144				types; it can also be nested.
145
146				Note that you'll have to dereference the references to use the
147				elements:
148
149				for my $window (@{ $finder->windows }) {
150				...
151				}
152
153				or:
154
155				my $props = $finder->properties;
156
157				while (my ($key, $val) = each %{$props}) {
158				...
159				}
160
161				=back
162
163
164				=head2 Notes
165
166				For multi-word AppleScript terms like C, use the
167				underscore character (_) in place of each space character.
168
169				You generally need to reverse the parts of a statement when
170				translating AppleScript to Perl. In AppleScript, C
171				location> really sends the "open" message to the object represented by
172				"insertion location". This maps to the Perl syntax
173				C<< insertion_location->open() >>.
174
175				Unlike Perl, AppleScript makes a distinction between booleans and
176				numbers -- you can't intermix them. So if an AppleScript method wants
177				a boolean as a parameter, you I use the AppleScript constants
178				B or B. You can do this by enclosing the string with
179				angle-brackets (C<< >>) or passing a reference to a string
180				containing the constant (C<\'true'>).
181
182
183				=head1 HOW IT WORKS
184
185				Contrary to what it might seem, this module knows nothing of Apple
186				Events, and only knows a sprinkling of AppleScript syntax.
187
188				Instead, it actually employs a variety of magic dust to accomplish its
189				tasks:
190
191				=over 4
192
193				=item *
194
195				The Mac::AppleScript::Glue module translates Perl-style object/method
196				calls to actual AppleScript.
197
198				=item *
199
200				The resulting AppleScript is executed by the Mac::AppleScript(3pm)
201				module (by Dan Sugalski); any results are returned as text.
202
203				=item *
204
205				The AppleScript-format result data is translated into into Perl data
206				structures as appropriate.
207
208				=item *
209
210				Perl's C<$AUTOLOAD> feature (L) is used to translate
211				statements like C<< $finder->insertion_location >> to AppleScript.
212				Method calls that aren't defined in the module itself and don't refer
213				to a part of the object's data structure are delegated to a translater
214				function that tries to write the method as if it was AppleScript.
215
216				=item *
217
218				AppleScript's concept of the "object reference" is essential to the
219				idea of having Perl objects for things other than applications.
220
221				=item *
222
223				The AppleScript interpreter seems somewhat lenient on the exact syntax
224				of the language. This makes it possible to write AppleScript
225				statements that work even though they look weird.
226
227				=back
228
229				=cut
230
231	3	3	22154	use strict;
	3		7
	3		124
232	3	3	17	use warnings;
	3		5
	3		137
233
234				require 5.6.0;
235
236				######################################################################
237
238	3	3	16	use base qw(Exporter);
	3		9
	3		619
239
240				our ($VERSION, $AUTOLOAD, @EXPORT, @EXPORT_OK);
241
242				$VERSION = '0.03';
243
244				BEGIN {
245	3	3	8	@EXPORT = qw();
246
247	3		198	@EXPORT_OK = qw(
248				%Debug
249				@DebugAll
250				dump
251				dump_pretty
252				is_number
253				to_string
254				from_string
255				);
256				}
257
258				our (%Debug, @DebugAll);
259
260				%Debug = ();
261
262				#
263				# NOTE: remember to update the "Debugging" section below if these are
264				# added or changed
265				#
266
267				@DebugAll = qw(
268				INIT
269				AUTOLOAD
270				SCRIPT
271				RESULT
272				EXEC
273				PARSE
274				);
275
276				######################################################################
277
278	3	3	24	use Carp;
	3		3
	3		210
279	3	3	3321	use Data::Dumper;
	3		35302
	3		274
280				$Data::Dumper::Indent =
281				$Data::Dumper::Useqq = 1;
282	3	3	2924	use IO::File;
	3		60129
	3		653
283	3	3	3132	use Text::ParseWords qw();
	3		4425
	3		86
284	3	3	5785	use Mac::AppleScript 0.03;
	0
	0
285
286				use Mac::AppleScript::Glue::Application;
287				use Mac::AppleScript::Glue::Object;
288
289				######################################################################
290				######################################################################
291				# beginning of methods
292
293				=head1 METHODS
294
295				There aren't any useful public methods in Mac::Application::Glue
296				itself. Instead, see L and
297				L.
298
299				=cut
300
301				######################################################################
302
303				#
304				# Constructor for object. Once initialized, each key/value pair of
305				# the argument list is treated as a separate method call, where the
306				# method corresponds to the key.
307				#
308
309				sub new {
310				my ($type, @args) = @_;
311
312				my $self = bless {}, $type;
313
314				$self->_init(\@args)
315				or return undef;
316
317				my %args = @args;
318
319				while (my ($method, $val) = each %args) {
320				warn "init: calling method \"$method\" with $val\n"
321				if $Debug{INIT};
322
323				$self->$method($val);
324				}
325
326				$self->dump('initialized')
327				if $Debug{INIT};
328
329				return $self;
330				}
331
332				######################################################################
333
334				#
335				# Default method for initializing a new object. Does nothing except
336				# return itself.
337				#
338
339				sub _init {
340				my ($self, $args) = @_;
341
342				return $self;
343				}
344
345				######################################################################
346
347				#
348				# An AUTOLOADer that handles all function/method calls not otherwise
349				# defined. It works by looking in the hashref $self to see if there's
350				# a key that starts with an underscore that corresponds to the
351				# attempted method (eg, "_foo" for a call of C<< $self->obj >>).
352				#
353				# Handles a simple "set" semantic with one argument.
354				#
355				# Calls the _unknown_method method for attempted methods that don't
356				# correspond to the $self's data structure.
357				#
358
359				sub AUTOLOAD {
360				my ($self, @args) = @_;
361
362				my $type = ref $self;
363
364				$AUTOLOAD =~ s/^.*:://;
365
366				my $method = $AUTOLOAD;
367
368				return if $method eq 'DESTROY';
369
370				if ($Debug{AUTOLOAD}) {
371				warn "\n[" . ref(${self}) . "::AUTOLOAD->$method]\n",
372				Data::Dumper->Dump(
373				[$self, \@args, join(':', (caller(0))[1..2])],
374				[qw(self args caller)]
375				);
376				}
377
378				if (exists $self->{"_$method"}) {
379				warn "[AUTOLOAD: calling local method \"$method\"]\n"
380				if $Debug{AUTOLOAD};
381
382				if (@args) {
383				$self->{"_$method"} = $args[0];
384				}
385
386				return $self->{"_$method"};
387				}
388
389				warn "[AUTOLOAD: handling unknown method \"$method\"]\n"
390				if $Debug{AUTOLOAD};
391
392				return $self->_unknown_method($method, @args);
393				}
394
395				######################################################################
396
397				#
398				# A default handler for AUTOLOAD'ed function calls.
399				#
400
401				sub _unknown_method {
402				my ($self, $method, @args) = @_;
403
404				confess "no method called \"$method\" in object $self";
405				}
406
407				# end of methods
408				######################################################################
409
410				######################################################################
411				# beginning of functions
412
413
414				=head1 FUNCTIONS
415
416				Note that no functions are exported by default. You can use them by
417				specifying the full package name:
418
419				Mac::AppleScript::Glue::run('something');
420
421				or by specifying them on the C statement at the top of your
422				program:
423
424				use Mac::AppleScript::Glue qw(run);
425
426				run('something');
427
428				=over 4
429
430				=cut
431
432				######################################################################
433
434				=item run([$app, ] @script)
435
436				Runs an AppleScript whose lines are in C<@script>. If C<$app> is
437				specified, it should be a previously created
438				Mac::AppleScript::Application(3pm) object to which any object
439				references will "belong to."
440
441				=cut
442
443				sub run {
444				my $app;
445
446				if (@_ && ref $_[0]) {
447				$app = shift;
448				}
449
450				my $script = join("\n", @_);
451
452				if ($Debug{SCRIPT}) {
453				warn "\n-- script --\n", $script, "\n";
454				}
455
456				my $result_str = Mac::AppleScript::RunAppleScript($script);
457
458				unless (defined $result_str) {
459				chomp $@;
460
461				if ($Debug{SCRIPT}) {
462				warn "-- error --\n",
463				"$@\n",
464				"-- done\n";
465				}
466
467				die "Mac::AppleScript returned error ($@)\n";
468				}
469
470				#
471				# work around Mac::AppleScript returning garbage in cases where it
472				# should return emptiness
473				#
474
475				$result_str =~ s/^\001.*//;
476
477				if ($Debug{SCRIPT}) {
478				warn "-- result --\n",
479				"$result_str\n",
480				"-- done --\n";
481				}
482
483				my $result = from_string($app, $result_str);
484
485				if ($Debug{RESULT}) {
486				dump_pretty($result, 'result');
487				}
488
489				return $result;
490				}
491
492				######################################################################
493
494				=item from_string([$app,] $str)
495
496				Parses a string containing an AppleScript result, and returns the Perl
497				data structures corresponding to that result. If C<$app> is specifed
498				as a Mac::AppleScript::Glue::Application(3pm) object, any object
499				references will be "owned" by that application.
500
501				=cut
502
503				sub from_string {
504				my $app;
505				my $str;
506
507				if (@_ == 2) {
508				($app, $str) = @_;
509				} else {
510				($str) = @_;
511				}
512
513				return undef unless $str;
514
515				chomp $str;
516
517				my @tokens = grep($_,
518				map {
519				# remove leading/trailing space
520
521				if ($_) {
522				s/^\s+//;
523				s/\s+$//;
524				}
525
526				$_;
527
528				} Text::ParseWords::parse_line(
529				'[,{}:]',
530				'delimiters',
531				$str
532				)
533				);
534
535				warn Data::Dumper->Dump([\@tokens], [qw(tokens)])
536				if $Debug{PARSE};
537
538				my $result = _parse_word(\@tokens, $app);
539
540				warn Data::Dumper->Dump([$result], [qw(result)])
541				if $Debug{PARSE};
542
543				return $result;
544				}
545
546				######################################################################
547
548				#
549				# internal function to parse a AppleScript list or record
550				#
551
552				sub _parse_list {
553				my ($tokens, $app) = @_;
554
555				my @list;
556				my $is_hash;
557
558				while (@$tokens) {
559				my $token = shift @$tokens;
560
561				# if the token after the next one is a colon, then this is
562				# a record, not a list, and this token is the key
563
564				if ($tokens->[0] && $tokens->[0] eq ':') {
565				$token =~ s/ /_/g;
566				push @list, $token;
567				shift @$tokens;
568				$is_hash = 1;
569				next;
570				}
571
572				# right-brace: list or record terminator
573				if ($token eq '}') {
574				last;
575
576				# comma: list or record separator
577				} elsif ($token eq ',') {
578				if ($is_hash && @list % 2 != 0) {
579				push @list, undef;
580				}
581
582				# ignore
583
584				# something else
585				} else {
586				unshift @$tokens, $token;
587				push @list, _parse_word($tokens, $app);
588				}
589				}
590
591				if ($is_hash) {
592				return { @list };
593				} else {
594				return \@list;
595				}
596				}
597
598				######################################################################
599
600				#
601				# internal function parse an AppleScript word (which could be the
602				# start of a list or record; see _parse_list above)
603				#
604
605				sub _parse_word {
606				my ($tokens, $app) = @_;
607
608				my $token = shift @$tokens;
609
610				# left-brace? -- it's a start of list or record
611				if ($token eq '{') {
612				return _parse_list($tokens, $app);
613
614				# number? -- leave as is
615				} elsif (is_number($token)) {
616				return $token;
617
618				# quoted-string? -- remove quotes
619				} elsif ($token =~ s/^"(.*?)"$/$1/) {
620				return $token;
621
622				# otherwise it's a reference of some sort
623				} else {
624				if ($app) {
625				my $appref = $app->ref;
626
627				$token =~ s/ of $appref$//;
628				}
629
630				return new Mac::AppleScript::Glue::Object(
631				app => $app,
632				ref => $token,
633				);
634				}
635				}
636
637				######################################################################
638
639				=item to_string($value)
640
641				Converts a Perl data structure into an AppleScript string. It will
642				correctly interpret Mac::AppleScript::Glue::Object(3pm) objects.
643
644				=cut
645
646				sub to_string {
647				my ($value) = @_;
648
649				#
650				# arrays are converted to AS lists (recursively)
651				#
652
653				if (ref($value) eq 'ARRAY') {
654				return '{'
655				. join(', ',
656				map {
657				to_string($_)
658				} @{$value})
659				. '}';
660
661				#
662				# hashes are converted to AS records (recursively)
663				#
664
665				} elsif (ref($value) eq 'HASH') {
666				my @list;
667
668				for my $key (keys %{$value}) {
669				my $val = $value->{$key};
670
671				$key =~ s/_/ /g;
672
673				push @list, "$key:" . to_string($val)
674				}
675
676				return '{' . join(', ', @list) . '}';
677
678				#
679				# scalar-refs are let through verbatim
680				#
681
682				} elsif (ref($value) eq 'SCALAR') {
683				return $$value;
684
685				#
686				# object references are let through verbatim
687				#
688
689				} elsif (ref $value && $value->isa('Mac::AppleScript::Glue::Object')) {
690				return $value->ref;
691
692				#
693				# otherwise it's something we don't know how to handle
694				#
695
696				} elsif (ref $value) {
697				confess "bad reference found in data";
698
699				#
700				# numbers are let through as is
701				#
702
703				} elsif (is_number($value)) {
704				return $value;
705
706				#
707				# strings enclosed in <> are treated like object-references
708				#
709
710				} elsif ($value =~ /^<(.*)>$/) {
711				return $1;
712
713				#
714				# anything else is a string, and is quoted
715				#
716
717				} else {
718				$value =~ s/^\\
719				$value =~ s/\\/\\\\/g; # quote backslashes
720				$value =~ s/"/\\"/g; # quote double-quotes
721
722				return "\"$value\""; # enclosee in double-quotes
723				}
724				}
725
726				######################################################################
727
728				=item dump($obj [, $label])
729
730				Provides a simple dumping facility for any sort of data. All this
731				does is call Data::Dumper(3pm)'s C method.
732
733				=cut
734
735				sub dump {
736				my ($obj, $label) = @_;
737
738				warn Data::Dumper->Dump([$obj], [$label \|\| 'obj']);
739				}
740
741				######################################################################
742
743				=item dump_pretty($object, $label [, $fh])
744
745				Provides a nicely-formatted view of any object. The object can be as
746				simple as a regular scalar, or a deeply-nested tree of references. If
747				the object is a Mac::AppleScript::Glue::Object, angle-brackets (E,
748				E) are placed around its value.
749
750				If a string is supplied as C<$label>, the output will be labeled suchly.
751
752				Output is to B by default; you can provide an alternate
753				filehandle in C<$fh> if you like.
754
755				=cut
756
757				sub dump_pretty {
758				my ($obj, $label, $fh, $level) = @_;
759
760				$fh \|\|= \*STDERR;
761				$level \|\|= 0;
762
763				my $indent = "\t" x $level;
764
765				$fh->print($indent);
766
767				if ($label) {
768				$fh->print("$label: ");
769				}
770
771				if (!defined $obj) {
772				$fh->print("undef\n");
773
774				} elsif (ref $obj) {
775				if (ref($obj) eq 'ARRAY') {
776				$fh->print("[\n");
777
778				for (@{$obj}) {
779				dump_pretty($_, undef, $fh, $level + 1);
780				}
781
782				$fh->print($indent, "]\n");
783
784				} elsif (ref($obj) eq 'HASH') {
785				$fh->print("{\n");
786
787				for (sort keys %{$obj}) {
788				dump_pretty($obj->{$_}, $_, $fh, $level + 1);
789				}
790
791				$fh->print($indent, "}\n");
792
793				} elsif ($obj->isa('Mac::AppleScript::Glue::Object')) {
794				$fh->print('<' . $obj->ref . ">\n");
795
796				} else {
797				$fh->print("<$obj>\n");
798				}
799
800				} elsif (is_number($obj)) {
801				$fh->print("$obj\n");
802
803				} else {
804				$fh->print("\"$obj\"\n");
805				}
806				}
807
808				######################################################################
809
810				=item is_number($str)
811
812				Returns true if the given string is really a number.
813
814				=cut
815
816				sub is_number {
817				my ($str) = @_;
818
819				# this line borrowed from the perl FAQs
820
821				$str =~ /^([+-]?)(?=\d\|\.\d)\d(\.\d)?([Ee]([+-]?\d+))?$/;
822				}
823
824				######################################################################
825				######################################################################
826				# end of functions
827
828				=back
829
830				=head1 DEBUGGING
831
832				Various amounts of debugging can be enabled by manipulating the
833				C<%Mac::AppleScript::Glue::Debug> hash. Debugging usually involves
834				printing messages to the B file handle.
835
836				To turn on a certain type of debugging, specify the key that names the
837				debug option, and a value of non-zero. For example, the following
838				enables debugging of generated AppleScripts:
839
840				$Mac::AppleScript::Glue::Debug{SCRIPT} = 1;
841
842				You can get a list of all the debugging keywords by examining
843				C<@Mac::AppleScript::Glue::DebugAll>.
844
845
846				=head2 Debugging keywords
847
848				=over 4
849
850				=item SCRIPT
851
852				Show each generated AppleScript before it's sent off to the script
853				interpreter, as well as the AppleScript-formatted result string. This
854				is useful when writing programs using Mac::AppleScript::Glue, as
855				looking at the generated AppleScript is often the best way to figure
856				out why a statement is failing.
857
858				=item RESULT
859
860				Show the parsed return value from the AppleScript result. This is the
861				data you will be working with when you examine a return value from a
862				statement.
863
864				=item PARSE
865
866				Show the process of parsing the AppleScript result. You probably
867				don't want to be setting this.
868
869				=item INIT
870
871				Show the values of Mac::AppleScript::Glue objects after all
872				initialization has been completed. You probably don't want to be
873				setting this.
874
875				=item AUTOLOAD
876
877				Show attempted calls to non-existent functions and methods. You
878				probably don't want to be setting this.
879
880				=back
881
882
883				=head1 HINTS
884
885				Unfortunately this package doesn't mean that you don't have to know
886				AppleScript, or the class/event hierarchy of the operating system.
887				Both of those can be quite inscrutable.
888
889				I recommend having the Script Editor program open while writing Perl
890				code. Use the dictionary browser (File menu > Open Dictionary) to
891				browse the dictionaries for the applications you're trying to control.
892				If you're having trouble getting the right Perl code written, try
893				writing it in AppleScript first, then translate to Perl, then let this
894				module translate it back to AppleScript. ;)
895
896				If you're trying to navigate through inscrutable AppleScript results,
897				try using the C function (see above).
898
899				Finally, turn on the B