File Coverage

blib/lib/Sub/QuoteX/Utils.pm
Criterion Covered Total %
statement 108 112 96.4
branch 46 56 82.1
condition 6 11 54.5
subroutine 12 12 100.0
pod 4 4 100.0
total 176 195 90.2


line stmt bran cond sub pod time code
1             package Sub::QuoteX::Utils;
2              
3             # ABSTRACT: Sugar for Sub::Quote
4              
5 5     5   678470 use 5.006;
  5         15  
6              
7 5     5   16 use strict;
  5         7  
  5         76  
8 5     5   15 use warnings;
  5         5  
  5         214  
9              
10             our $VERSION = '0.07'; # TRIAL
11              
12             use Sub::Quote
13 5     5   1292 qw( quoted_from_sub inlinify capture_unroll sanitize_identifier quote_sub );
  5         10096  
  5         283  
14              
15 5     5   22 use Scalar::Util qw( weaken refaddr blessed );
  5         6  
  5         231  
16 5     5   18 use Carp;
  5         6  
  5         211  
17              
18 5     5   19 use Exporter 'import';
  5         5  
  5         5491  
19              
20             our @EXPORT_OK = qw(
21             quote_subs
22             inlinify_coderef
23             inlinify_method
24             inlinify_code
25             );
26              
27             our %EXPORT_TAGS = ( all => \@EXPORT_OK );
28              
29              
30             #pod =func quote_subs
31             #pod
32             #pod my $coderef = quote_subs( $spec, ?$spec, ... , ?\%options );
33             #pod
34             #pod Creates a compiled subroutine from syntactically complete chunks of
35             #pod code or from snippets of code.
36             #pod
37             #pod Chunks may be extracted from code previously inlined by L,
38             #pod specified as strings containing code, or generated to accomodate
39             #pod invoking object methods or calling non-inlineable code.
40             #pod
41             #pod By default each chunk will localize C<@_> to avoid changing C<@_> for
42             #pod the other chunks. This can be changed on a per-chunk basis by
43             #pod specifying the C option in each specification.
44             #pod
45             #pod Specifications may take one of the following forms:
46             #pod
47             #pod =over
48             #pod
49             #pod =item C<$coderef>
50             #pod
51             #pod If C<$coderef> is inlineable (i.e, generated by
52             #pod L) it will be directly inlined, else code to
53             #pod invoke it will be generated.
54             #pod
55             #pod =item C<[ $coderef, %option ]>
56             #pod
57             #pod This is another way of specifying a code reference, allowing
58             #pod more manipulation; see L for available options.
59             #pod
60             #pod =item C<[ $object, $method, %option ]>
61             #pod
62             #pod Inline a method call. A weakened reference to C<$object> is kept to
63             #pod avoid leaks. Method lookup is performed at runtime. See
64             #pod L for available options.
65             #pod
66             #pod =item C<[ $string, %option ]>
67             #pod
68             #pod Inline a chunk of code in a string. See L for
69             #pod available options.
70             #pod
71             #pod =item C<$scalarref>
72             #pod
73             #pod Inline a snippet of code stored in the referenced scalar. Snippets
74             #pod need not be syntactically complete, and thus may be used to enclose
75             #pod chunks in blocks. For example, to catch exceptions thrown by a chunk:
76             #pod
77             #pod $coderef = quote_subs( \'eval {', \&chunk_as_func, \'};' );
78             #pod
79             #pod Specify any required captured values in the C option to
80             #pod C.
81             #pod
82             #pod =back
83             #pod
84             #pod If the C option is passed in a specification, a lexical
85             #pod variable with the specified name will automatically be created.
86             #pod See L.
87             #pod
88             #pod Options which may be passed as the last parameter include all of the
89             #pod options accepted by L<< C|Sub::Quote/quote_sub
90             #pod >>, as well as:
91             #pod
92             #pod =over
93             #pod
94             #pod =item C => I
95             #pod
96             #pod An optional name for the compiled subroutine.
97             #pod
98             #pod =item C => I
99             #pod
100             #pod A hash containing captured variable names and values. See the
101             #pod documentation of the C<\%captures> argument to L
102             #pod for more information.
103             #pod
104             #pod
105             #pod =item C => I
106             #pod
107             #pod One or more lexical variables to declare. If specified, B
108             #pod will enclose the generated code in a block and will declare these
109             #pod variables at the start of the block. For example,
110             #pod
111             #pod quote_subs( \'@x = 33;',
112             #pod \'@y = 22;',
113             #pod lexicals => [ '@x', '@y' ]
114             #pod );
115             #pod
116             #pod will result in code equivalent to:
117             #pod
118             #pod {
119             #pod my ( @x, @y );
120             #pod @x = 33;
121             #pod @y = 22;
122             #pod }
123             #pod
124             #pod
125             #pod =back
126             #pod
127             #pod
128             #pod =cut
129              
130             # quote_subs( [], [], {} );
131             sub quote_subs {
132              
133 24     24 1 35341 my @caller = caller( 0 );
134              
135             # need to duplicate these bits from Sub::Quote::quote_sub, as they rely upon caller
136             my %option = (
137             lexicals => [],
138             package => $caller[0],
139             hints => $caller[8],
140             warning_bits => $caller[9],
141             hintshash => $caller[10],
142 24 100       114 'HASH' eq ref $_[-1] ? %{ pop @_ } : (),
  15         63  
143             );
144             my %qsub_opts
145 24         36 = map { $_ => $option{$_} } qw[ package hints warning_bits hintshash ];
  96         148  
146              
147 24 100       63 if ( $option{name} ) {
148 2         2 my $subname = $option{name};
149 2 50       6 my $package = $subname =~ s/(.*)::// ? $1 : $option{package};
150 2         5 $option{name} = join '::', $package, $subname;
151             }
152              
153 24 100       19 my %global_capture = %{ delete $option{capture} || {} };
  24         99  
154              
155 24         29 my @code;
156 24         35 for my $thing ( @_ ) {
157              
158 88 100       175 my @arr = 'ARRAY' eq ref $thing ? @$thing : ($thing);
159              
160             # invoke appropriate inlinify subroutine, then remove
161             # non-optional arguemnts from the argument list
162 88 100       212 if ( 'CODE' eq ref $arr[0] ) {
    100          
    100          
    50          
163              
164 38         53 push @code, inlinify_coderef( \%global_capture, @arr ), q[;] ;
165             }
166              
167             elsif ( blessed $arr[0] ) {
168              
169 6         10 push @code, inlinify_method( \%global_capture, @arr ), q[;] ;
170              
171             # this one gets two non-optional arguments, remove the
172             # first; the second is done below
173 6         11 shift @arr;
174             }
175              
176             elsif ( !ref $arr[0] ) {
177              
178 18         30 push @code, inlinify_code( \%global_capture, @arr ), q[;] ;
179             }
180              
181             elsif ( 'SCALAR' eq ref $arr[0] ) {
182              
183 26         18 push @code, ${ $arr[0] };
  26         39  
184              
185             }
186             else {
187              
188 0         0 croak( "don't understand argument in $_[@{[ scalar @code ]}]\n" );
  0         0  
189             }
190             # remove the remaining non-optional argument
191 88         85 shift @arr;
192              
193 88         98 my %opt = @arr;
194              
195             # if we're storing the results in a lexical variable, declare it
196 88 100       171 if ( defined $opt{store} ) {
197             $option{lexicals} = [ $option{lexicals} ]
198 3 50       8 unless 'ARRAY' eq ref $option{lexicals};
199              
200 3 50       7 if ( $opt{store} =~ /^[\$@%]/ ) {
201 3         2 push @{ $option{lexicals} }, $opt{store};
  3         8  
202             }
203             else {
204 0         0 push @{ $option{lexicals} },
205             '$' . $opt{store},
206 0         0 '@' . $opt{store};
207             }
208             }
209             }
210              
211             $option{lexicals} = [ $option{lexicals} ]
212 24 100       58 unless 'ARRAY' eq ref $option{lexicals};
213 24 100       31 if ( @{ $option{lexicals} } ) {
  24         49  
214              
215             # uniqify
216 12         8 my %lex;
217 12         8 @lex{ @{ $option{lexicals} } } = 1;
  12         24  
218              
219 12         13 unshift @code, qq/{ my ( @{[ join ', ', keys %lex ]} );/;
  12         37  
220              
221 12         23 push @code, '}';
222             }
223              
224              
225             quote_sub(
226 24   66     156 ( delete $option{name} || () ),
227             join( "\n", @code ),
228             \%global_capture, \%qsub_opts
229             );
230              
231             }
232              
233             sub _process_options {
234              
235 121     121   87 my ( $option, $capture ) = @_;
236              
237 121         105 $option->{provide_args} = 1;
238              
239 121 100       128 if ( exists $option->{args} ) {
240              
241 64 100       67 if ( defined $option->{args} ) {
242              
243 60 100       113 if ( my $ref = ref $option->{args} ) {
244              
245 10         10 my $arg = $option->{args};
246 10         11 $capture->{'$arg'} = \$arg;
247              
248             $option->{args}
249 10 0       20 = 'ARRAY' eq $ref ? '@{$arg}'
    50          
250             : 'HASH' eq $ref ? '%{$arg}'
251             : croak( q[args option must be an arrayref, hashref, or string] );
252             }
253             }
254              
255             # args explicitly undef, set @_ to ();
256             else {
257              
258 4         6 $option->{args} = '()';
259 4         4 $option->{provide_args} = 0;
260             }
261             }
262              
263             else {
264              
265 57         70 $option->{args} = '@_';
266             }
267             }
268              
269              
270             #pod =func inlinify_coderef
271             #pod
272             #pod my $code = inlinify_coderef( \%global_capture, $coderef, %options );
273             #pod
274             #pod Generate code which will execute C<$coderef>. If C<$coderef> is
275             #pod inlineable, it is inlined, else code which will invoke it is generated.
276             #pod
277             #pod See L for more information on C<%global_capture>.
278             #pod
279             #pod Available options are:
280             #pod
281             #pod =over
282             #pod
283             #pod =item C => I
284             #pod
285             #pod An optional string used as part of the hash key for this chunk's captures.
286             #pod
287             #pod =item C => I
288             #pod
289             #pod If true (the default) changes to C<@_> will be local, e.g.
290             #pod
291             #pod local @_ = ...;
292             #pod
293             #pod rather than
294             #pod
295             #pod @_ = ...;
296             #pod
297             #pod =item C => I
298             #pod
299             #pod If specified, the result of the generated code will be stored in the variable
300             #pod of the given name. For example
301             #pod
302             #pod store => '@x'
303             #pod
304             #pod would result in code equivalent to:
305             #pod
306             #pod @x = &$coderef;
307             #pod
308             #pod The variable is not declared. See L.
309             #pod
310             #pod =item C => I | I | I | C
311             #pod
312             #pod This specified the values of C<@_>.
313             #pod
314             #pod =over
315             #pod
316             #pod =item *
317             #pod
318             #pod if not specified, the value of C<@_> is unchanged.
319             #pod
320             #pod =item *
321             #pod
322             #pod if the value is C, C<@_> will be empty.
323             #pod
324             #pod =item *
325             #pod
326             #pod if the value is a reference to an array or hash, C<@_> will be set
327             #pod equal to its contents. Note that the reference is I, so
328             #pod
329             #pod =over
330             #pod
331             #pod =item *
332             #pod
333             #pod changes to its contents will be reflected in calls to the code.
334             #pod
335             #pod =item *
336             #pod
337             #pod there is the danger of memory leaks, as any non-weakened references in
338             #pod the structure will be destroyed only when both C<%global_capture> and
339             #pod any subroutines based on this are destroyed.
340             #pod
341             #pod =back
342             #pod
343             #pod =item *
344             #pod
345             #pod if a string, this is inlined directly, e.g.
346             #pod
347             #pod args => q[( 'FRANK' )]
348             #pod
349             #pod results in
350             #pod
351             #pod @_ = ( 'FRANK' )
352             #pod
353             #pod =back
354             #pod
355             #pod =back
356             #pod
357             #pod =cut
358              
359             sub inlinify_coderef {
360              
361 41     41 1 6333 my ( $global_capture, $coderef, %option ) = @_;
362              
363 41 50       65 croak( "\$coderef must be a CODEREF\n" )
364             unless 'CODE' eq ref $coderef;
365              
366 41         66 my $qtd = quoted_from_sub( $coderef );
367              
368 41         243 my %capture;
369 41         50 _process_options( \%option, \%capture );
370              
371 41         33 my $code;
372              
373 41 100       47 if ( $qtd ) {
374              
375 5         6 $code = $qtd->[1];
376 5         1 $capture{$_} = $qtd->[2]{$_} for keys %{ $qtd->[2] };
  5         16  
377             }
378             else {
379              
380 36         45 $code = q[&$sub;];
381 36         42 $capture{ '$sub' } = \$coderef;
382             }
383              
384              
385 41         78 inlinify_code( $global_capture, $code, capture => \%capture, %option );
386             }
387              
388             #pod =func inlinify_method
389             #pod
390             #pod my $code = inlinify_method( \%global_capture, $object, $method, %options );
391             #pod
392             #pod Generate code which will invoke the method named by C<$method> on
393             #pod C<$object>. While method resolution is performed at runtime,
394             #pod C checks that C<$method> is available for C<$object>
395             #pod and will C if not.
396             #pod
397             #pod See L for more information on C<%global_capture>.
398             #pod
399             #pod Available options are:
400             #pod
401             #pod =over
402             #pod
403             #pod =item C => I
404             #pod
405             #pod An optional string used as part of the hash key for this chunk's captures.
406             #pod
407             #pod =item C => I
408             #pod
409             #pod If true (the default) changes to C<@_> will be local, e.g.
410             #pod
411             #pod local @_ = ...;
412             #pod
413             #pod rather than
414             #pod
415             #pod @_ = ...;
416             #pod
417             #pod =item C => I
418             #pod
419             #pod If specified, the result of the generated code will be stored in the variable
420             #pod of the given name. For example
421             #pod
422             #pod store => '@x'
423             #pod
424             #pod would result in code equivalent to:
425             #pod
426             #pod @x = $object->$method( @_ );
427             #pod
428             #pod The variable is not declared. See L.
429             #pod
430             #pod =item C => I | I | I | C
431             #pod
432             #pod This specified the values of C<@_>.
433             #pod
434             #pod =over
435             #pod
436             #pod =item *
437             #pod
438             #pod if not specified, the value of C<@_> is unchanged.
439             #pod
440             #pod =item *
441             #pod
442             #pod if the value is C, C<@_> will be empty.
443             #pod
444             #pod =item *
445             #pod
446             #pod if the value is a reference to an array or hash, C<@_> will be set
447             #pod equal to its contents. Note that the reference is I, so
448             #pod
449             #pod =over
450             #pod
451             #pod =item *
452             #pod
453             #pod changes to its contents will be reflected in calls to the code.
454             #pod
455             #pod =item *
456             #pod
457             #pod there is the danger of memory leaks, as any non-weakened references in
458             #pod the structure will be destroyed only when both C<%global_capture> and
459             #pod any subroutines based on this are destroyed.
460             #pod
461             #pod =back
462             #pod
463             #pod =item *
464             #pod
465             #pod if a string, this is inlined directly, e.g.
466             #pod
467             #pod args => q[( 'FRANK' )]
468             #pod
469             #pod results in
470             #pod
471             #pod @_ = ( 'FRANK' )
472             #pod
473             #pod =back
474             #pod
475             #pod =back
476             #pod
477             #pod =cut
478              
479             sub inlinify_method {
480              
481 9     9 1 3663 my ( $global_capture, $object, $method, %option ) = @_;
482              
483 9         14 weaken $object;
484              
485 9 50       19 croak( "\$method must be a method name\n" )
486             unless ref $method eq '';
487              
488 9 50       32 croak( "object does not provide a method named $method" )
489             unless $object->can( $method );
490              
491              
492 9         14 my %capture = ( '$r_object' => \\$object );
493              
494 9   33     36 $option{name} ||= refaddr $capture{'$r_object'};
495              
496 9         13 _process_options( \%option, \%capture );
497              
498             inlinify_code( $global_capture,
499             join( '',
500             '${$r_object}->',
501             $method,
502 9 100       37 $option{provide_args} ? '( @_ )' : '()',
503             'if defined ${$r_object};',
504             ),
505              
506             capture => \%capture, %option );
507              
508             }
509              
510             #pod =func inlinify_code
511             #pod
512             #pod my $code = inlinify_code( \%global_capture, $code, %options );
513             #pod
514             #pod Generate code which inlines C<$code> handling captures specified in C<%options>.
515             #pod
516             #pod Available options are:
517             #pod
518             #pod =over
519             #pod
520             #pod =item C => I
521             #pod
522             #pod A hash containing captured variable names and values. See the
523             #pod documentation of the C<\%captures> argument to L
524             #pod for more information.
525             #pod
526             #pod =item C => I
527             #pod
528             #pod An optional string used as part of the hash key for this chunk's captures.
529             #pod
530             #pod =item C => I
531             #pod
532             #pod If true (the default) changes to C<@_> will be local, e.g.
533             #pod
534             #pod local @_ = ...;
535             #pod
536             #pod rather than
537             #pod
538             #pod @_ = ...;
539             #pod
540             #pod =item C => I
541             #pod
542             #pod If specified, the result of the generated code will be stored in the variable
543             #pod of the given name. For example
544             #pod
545             #pod store => '@x'
546             #pod
547             #pod would result in code equivalent to:
548             #pod
549             #pod @x = ... code ...;
550             #pod
551             #pod The variable is not declared. See L.
552             #pod
553             #pod =item C => I | I | I | C
554             #pod
555             #pod This specified the values of C<@_>.
556             #pod
557             #pod =over
558             #pod
559             #pod =item *
560             #pod
561             #pod if not specified, the value of C<@_> is unchanged.
562             #pod
563             #pod =item *
564             #pod
565             #pod if the value is C, C<@_> will be empty.
566             #pod
567             #pod =item *
568             #pod
569             #pod if the value is a reference to an array or hash, C<@_> will be set
570             #pod equal to its contents. Note that the reference is I, so
571             #pod
572             #pod =over
573             #pod
574             #pod =item *
575             #pod
576             #pod changes to its contents will be reflected in calls to the code.
577             #pod
578             #pod =item *
579             #pod
580             #pod there is the danger of memory leaks, as any non-weakened references in
581             #pod the structure will be destroyed only when both C<%global_capture> and
582             #pod any subroutines based on this are destroyed.
583             #pod
584             #pod =back
585             #pod
586             #pod =item *
587             #pod
588             #pod if a string, this is inlined directly, e.g.
589             #pod
590             #pod args => q[( 'FRANK' )]
591             #pod
592             #pod results in
593             #pod
594             #pod @_ = ( 'FRANK' )
595             #pod
596             #pod =back
597             #pod
598             #pod =back
599             #pod
600             #pod =cut
601              
602             sub inlinify_code {
603              
604 71     71 1 3433 my ( $global_capture, $code, %option ) = @_;
605              
606 71 100       51 my %capture = %{ delete $option{capture} || {} };
  71         204  
607              
608 71         101 _process_options( \%option, \%capture );
609              
610 71         55 my $r_capture = \%capture;
611              
612 71   66     227 $option{name} ||= refaddr $r_capture;
613 71         113 my $cap_name = q<$capture_for_> . sanitize_identifier( $option{name} );
614 71         351 $global_capture->{$cap_name} = \$r_capture;
615              
616 71   50     113 $option{args} ||= '@_';
617 71 100       104 $option{local} = 1 unless defined $option{local};
618              
619              
620             my $inlined_code
621             = inlinify( $code, $option{args},
622             capture_unroll( $cap_name, $r_capture, 0 ),
623 71         120 $option{local} );
624              
625 71 100       1363 if ( my $variable = $option{store} ) {
626              
627 12         6 my @code;
628              
629 12 100       26 if ( $variable =~ /^[\$@%]/ ) {
630              
631 9         19 @code = ( qq/$variable = do {/,
632             $inlined_code,
633             q/};/ );
634              
635             }
636             else {
637 3         12 @code = (
638             q/if ( defined wantarray() ) { /,
639             q/ if ( wantarray() ) {/,
640             qq/ \@$variable = do {/, $inlined_code, q/};/,
641             q/ }/,
642             q/ else {/,
643             qq/ \$$variable = do {/, $inlined_code, q/};/,
644             q/ }/,
645             q/} else { /, $inlined_code, q/ }/,
646             q/;/
647             );
648             }
649              
650 12         70 return join( "\n", '',@code );
651             }
652              
653 59         140 return $inlined_code;
654             }
655              
656             1;
657              
658             #
659             # This file is part of Sub-QuoteX-Utils
660             #
661             # This software is Copyright (c) 2016 by Smithsonian Astrophysical Observatory.
662             #
663             # This is free software, licensed under:
664             #
665             # The GNU General Public License, Version 3, June 2007
666             #
667              
668             =pod
669              
670             =encoding UTF-8
671              
672             =head1 NAME
673              
674             Sub::QuoteX::Utils - Sugar for Sub::Quote
675              
676             =head1 VERSION
677              
678             version 0.07
679              
680             =head1 SYNOPSIS
681              
682             use Sub::Quote;
683             use Sub::QuoteX::Utils qw[ quote_subs ];
684            
685             my $sub;
686            
687             # class with method
688             {
689             package Yipee;
690             use Moo;
691             sub halloo { shift; print "Yipee, @_\n" }
692             }
693            
694             # and the object
695             my $object = Yipee->new;
696            
697             # quoted sub
698             my $foo = quote_sub(
699             q[ print "$foo: @_\n"],
700             { '$foo' => \"Foo" }
701             );
702            
703            
704             # bare sub
705             sub bar { print "Bar: @_\n" }
706            
707            
708             # create single subroutine. each invoked piece of code will have a
709             # localized view of @_
710             $sub = quote_subs(
711             \&bar, # bare sub
712             $foo, # quoted sub
713             [ q[ print "$goo: @_\n"], # code in string with capture
714             capture => { '$goo' => \"Goo" },
715             ],
716             [ $object, 'halloo' ], # method call
717             );
718            
719            
720             # and run it
721             $sub->( "Common" );
722            
723             # Bar: Common
724             # Goo: Common
725             # Foo: Common
726             # Yipee: Common
727            
728            
729             # now, give each a personalized @_
730             $sub = quote_subs(
731             [ \&bar, # bare sub
732             args => [qw( Bar )]
733             ],
734             [ $foo, # quoted sub
735             args => [qw( Foo )]
736             ],
737             [ q[ print "$goo, @_\n"], # code in string with capture
738             capture => { '$goo' => \"Goo" },
739             args => [qw( Goo )],
740             ],
741             [ $object, 'halloo', # method call
742             args => [qw( Yipee )]
743             ],
744             );
745            
746             $sub->( "Common" );
747            
748             # Bar: Bar
749             # Foo: Foo
750             # Goo: Goo
751             # Yipee: Yipee
752            
753             # now, explicitly empty @_
754             $sub = quote_subs(
755             [ \&bar, # bare sub
756             args => undef
757             ],
758             [ $foo, # quoted sub
759             args => undef
760             ],
761             [ q[ print "$goo, @_\n"], # code in string with capture
762             capture => { '$goo' => \"Goo" },
763             args => undef,
764             ],
765             [ $object, 'halloo', #method call
766             args => undef
767             ],
768             );
769            
770             $sub->( "Common" );
771            
772             # Bar:
773             # Foo:
774             # Goo:
775             # Yipee:
776              
777             =head1 DESCRIPTION
778              
779             B provides a simplified interface to the process of
780             combining L compatible code references with new code.
781              
782             L provides a number of routines to make code more
783             performant by inlining syntactically complete chunks of code into a
784             single compiled subroutine.
785              
786             When a chunk of code is compiled into a subroutine by L<<
787             C|Sub::Quote/quote_sub >>, B
788             keeps track of the code and any captured variables used to construct
789             that subroutine, so that new code can be added to the original code
790             and the results compiled into a new subroutine.
791              
792             B makes that latter process a little easier.
793              
794             =head2 Usage
795              
796             Typically, L is used rather than the lower level
797             C routines. C is passed a list of chunk
798             specifications or snippets of code, and generates code which is
799             isolated in a Perl block. Each code chunk is additionally isolated in
800             its own block, while code snippets are in the main block. This
801             permits manipulation of the code chunk values. This is schematically
802             equivalent to
803              
804             {
805            
806             do { };
807            
808             do { };
809             do { };
810             }
811              
812             The values of each chunk may be stored (see L)
813             and manipulated by the code snippets.
814              
815             =head2 Storing Chunk Values
816              
817             A code chunk may have it's value stored in a lexical variable by
818             adding the C option to the chunk's options. For example,
819              
820             quote_subs( [ q{ sqrt(2); }, { store => '$x' } ],
821             [ q{ log(2); }, { store => '$y' } ],
822             [ q{ ( 0..10 ); }, { store => '@z' } ],
823             \q{print $x + $y, "\n";},
824             );
825              
826             would result in code equivalent to:
827              
828             {
829             my ( $x, $y, @z );
830              
831             $x = do { sqrt(2) };
832             $y = do { log(2) };
833             @z = do { ( 0.. 10 ) };
834             print $x + $y, "\n";
835             }
836              
837             If the variable passed to C has no sigil, e.g. C, then the
838             calling context is taken into account. In list context, the value is
839             stored in C<@x>, in scalar context it is stored in C<$x> and in void
840             context it is not stored at all.
841              
842             Automatic declaration of the variables occurs only when
843             C is used to generate the code.
844              
845             =head2 Captures
846              
847             B keeps track of captured variables in hashes, I
848             the values. For example,
849              
850             use Sub::Quote;
851            
852             my $sound = 'woof';
853            
854             my $emit = quote_sub( q{ print "$sound\n" }, { '$sound' => \$sound } );
855            
856             &$emit; # woof
857            
858             $sound = 'meow';
859            
860             &$emit; # woof
861              
862             When combining chunks of inlined code, each chunk has it's own set of
863             captured values which must be kept distinct.
864              
865             L manages this for the caller, but when using the low
866             level routines ( L, L,
867             L ) the caller must manage the captures. These
868             routines store per-chunk captures in their C<\%global_capture> argument.
869             The calling routine optionally may provide a mnemonic (but unique!)
870             string which will be part of the key for the chunk.
871              
872             The C<%global_capture> hash should be passed to
873             L, when the final subroutine is compiled. For
874             example,
875              
876             my %global_capture;
877             my $code = inlinify_coderef( \%global_capture, $coderef, %options );
878              
879             # add more code to $code [...]
880              
881             $new_coderef = Sub::Quote::quote_sub( $code, \%global_capture );
882              
883             =head1 FUNCTIONS
884              
885             =head2 quote_subs
886              
887             my $coderef = quote_subs( $spec, ?$spec, ... , ?\%options );
888              
889             Creates a compiled subroutine from syntactically complete chunks of
890             code or from snippets of code.
891              
892             Chunks may be extracted from code previously inlined by L,
893             specified as strings containing code, or generated to accomodate
894             invoking object methods or calling non-inlineable code.
895              
896             By default each chunk will localize C<@_> to avoid changing C<@_> for
897             the other chunks. This can be changed on a per-chunk basis by
898             specifying the C option in each specification.
899              
900             Specifications may take one of the following forms:
901              
902             =over
903              
904             =item C<$coderef>
905              
906             If C<$coderef> is inlineable (i.e, generated by
907             L) it will be directly inlined, else code to
908             invoke it will be generated.
909              
910             =item C<[ $coderef, %option ]>
911              
912             This is another way of specifying a code reference, allowing
913             more manipulation; see L for available options.
914              
915             =item C<[ $object, $method, %option ]>
916              
917             Inline a method call. A weakened reference to C<$object> is kept to
918             avoid leaks. Method lookup is performed at runtime. See
919             L for available options.
920              
921             =item C<[ $string, %option ]>
922              
923             Inline a chunk of code in a string. See L for
924             available options.
925              
926             =item C<$scalarref>
927              
928             Inline a snippet of code stored in the referenced scalar. Snippets
929             need not be syntactically complete, and thus may be used to enclose
930             chunks in blocks. For example, to catch exceptions thrown by a chunk:
931              
932             $coderef = quote_subs( \'eval {', \&chunk_as_func, \'};' );
933              
934             Specify any required captured values in the C option to
935             C.
936              
937             =back
938              
939             If the C option is passed in a specification, a lexical
940             variable with the specified name will automatically be created.
941             See L.
942              
943             Options which may be passed as the last parameter include all of the
944             options accepted by L<< C|Sub::Quote/quote_sub
945             >>, as well as:
946              
947             =over
948              
949             =item C => I
950              
951             An optional name for the compiled subroutine.
952              
953             =item C => I
954              
955             A hash containing captured variable names and values. See the
956             documentation of the C<\%captures> argument to L
957             for more information.
958              
959             =item C => I
960              
961             One or more lexical variables to declare. If specified, B
962             will enclose the generated code in a block and will declare these
963             variables at the start of the block. For example,
964              
965             quote_subs( \'@x = 33;',
966             \'@y = 22;',
967             lexicals => [ '@x', '@y' ]
968             );
969              
970             will result in code equivalent to:
971              
972             {
973             my ( @x, @y );
974             @x = 33;
975             @y = 22;
976             }
977              
978             =back
979              
980             =head2 inlinify_coderef
981              
982             my $code = inlinify_coderef( \%global_capture, $coderef, %options );
983              
984             Generate code which will execute C<$coderef>. If C<$coderef> is
985             inlineable, it is inlined, else code which will invoke it is generated.
986              
987             See L for more information on C<%global_capture>.
988              
989             Available options are:
990              
991             =over
992              
993             =item C => I
994              
995             An optional string used as part of the hash key for this chunk's captures.
996              
997             =item C => I
998              
999             If true (the default) changes to C<@_> will be local, e.g.
1000              
1001             local @_ = ...;
1002              
1003             rather than
1004              
1005             @_ = ...;
1006              
1007             =item C => I
1008              
1009             If specified, the result of the generated code will be stored in the variable
1010             of the given name. For example
1011              
1012             store => '@x'
1013              
1014             would result in code equivalent to:
1015              
1016             @x = &$coderef;
1017              
1018             The variable is not declared. See L.
1019              
1020             =item C => I | I | I | C
1021              
1022             This specified the values of C<@_>.
1023              
1024             =over
1025              
1026             =item *
1027              
1028             if not specified, the value of C<@_> is unchanged.
1029              
1030             =item *
1031              
1032             if the value is C, C<@_> will be empty.
1033              
1034             =item *
1035              
1036             if the value is a reference to an array or hash, C<@_> will be set
1037             equal to its contents. Note that the reference is I, so
1038              
1039             =over
1040              
1041             =item *
1042              
1043             changes to its contents will be reflected in calls to the code.
1044              
1045             =item *
1046              
1047             there is the danger of memory leaks, as any non-weakened references in
1048             the structure will be destroyed only when both C<%global_capture> and
1049             any subroutines based on this are destroyed.
1050              
1051             =back
1052              
1053             =item *
1054              
1055             if a string, this is inlined directly, e.g.
1056              
1057             args => q[( 'FRANK' )]
1058              
1059             results in
1060              
1061             @_ = ( 'FRANK' )
1062              
1063             =back
1064              
1065             =back
1066              
1067             =head2 inlinify_method
1068              
1069             my $code = inlinify_method( \%global_capture, $object, $method, %options );
1070              
1071             Generate code which will invoke the method named by C<$method> on
1072             C<$object>. While method resolution is performed at runtime,
1073             C checks that C<$method> is available for C<$object>
1074             and will C if not.
1075              
1076             See L for more information on C<%global_capture>.
1077              
1078             Available options are:
1079              
1080             =over
1081              
1082             =item C => I
1083              
1084             An optional string used as part of the hash key for this chunk's captures.
1085              
1086             =item C => I
1087              
1088             If true (the default) changes to C<@_> will be local, e.g.
1089              
1090             local @_ = ...;
1091              
1092             rather than
1093              
1094             @_ = ...;
1095              
1096             =item C => I
1097              
1098             If specified, the result of the generated code will be stored in the variable
1099             of the given name. For example
1100              
1101             store => '@x'
1102              
1103             would result in code equivalent to:
1104              
1105             @x = $object->$method( @_ );
1106              
1107             The variable is not declared. See L.
1108              
1109             =item C => I | I | I | C
1110              
1111             This specified the values of C<@_>.
1112              
1113             =over
1114              
1115             =item *
1116              
1117             if not specified, the value of C<@_> is unchanged.
1118              
1119             =item *
1120              
1121             if the value is C, C<@_> will be empty.
1122              
1123             =item *
1124              
1125             if the value is a reference to an array or hash, C<@_> will be set
1126             equal to its contents. Note that the reference is I, so
1127              
1128             =over
1129              
1130             =item *
1131              
1132             changes to its contents will be reflected in calls to the code.
1133              
1134             =item *
1135              
1136             there is the danger of memory leaks, as any non-weakened references in
1137             the structure will be destroyed only when both C<%global_capture> and
1138             any subroutines based on this are destroyed.
1139              
1140             =back
1141              
1142             =item *
1143              
1144             if a string, this is inlined directly, e.g.
1145              
1146             args => q[( 'FRANK' )]
1147              
1148             results in
1149              
1150             @_ = ( 'FRANK' )
1151              
1152             =back
1153              
1154             =back
1155              
1156             =head2 inlinify_code
1157              
1158             my $code = inlinify_code( \%global_capture, $code, %options );
1159              
1160             Generate code which inlines C<$code> handling captures specified in C<%options>.
1161              
1162             Available options are:
1163              
1164             =over
1165              
1166             =item C => I
1167              
1168             A hash containing captured variable names and values. See the
1169             documentation of the C<\%captures> argument to L
1170             for more information.
1171              
1172             =item C => I
1173              
1174             An optional string used as part of the hash key for this chunk's captures.
1175              
1176             =item C => I
1177              
1178             If true (the default) changes to C<@_> will be local, e.g.
1179              
1180             local @_ = ...;
1181              
1182             rather than
1183              
1184             @_ = ...;
1185              
1186             =item C => I
1187              
1188             If specified, the result of the generated code will be stored in the variable
1189             of the given name. For example
1190              
1191             store => '@x'
1192              
1193             would result in code equivalent to:
1194              
1195             @x = ... code ...;
1196              
1197             The variable is not declared. See L.
1198              
1199             =item C => I | I | I | C
1200              
1201             This specified the values of C<@_>.
1202              
1203             =over
1204              
1205             =item *
1206              
1207             if not specified, the value of C<@_> is unchanged.
1208              
1209             =item *
1210              
1211             if the value is C, C<@_> will be empty.
1212              
1213             =item *
1214              
1215             if the value is a reference to an array or hash, C<@_> will be set
1216             equal to its contents. Note that the reference is I, so
1217              
1218             =over
1219              
1220             =item *
1221              
1222             changes to its contents will be reflected in calls to the code.
1223              
1224             =item *
1225              
1226             there is the danger of memory leaks, as any non-weakened references in
1227             the structure will be destroyed only when both C<%global_capture> and
1228             any subroutines based on this are destroyed.
1229              
1230             =back
1231              
1232             =item *
1233              
1234             if a string, this is inlined directly, e.g.
1235              
1236             args => q[( 'FRANK' )]
1237              
1238             results in
1239              
1240             @_ = ( 'FRANK' )
1241              
1242             =back
1243              
1244             =back
1245              
1246             =head1 SEE ALSO
1247              
1248             L
1249              
1250             =head1 AUTHOR
1251              
1252             Diab Jerius
1253              
1254             =head1 COPYRIGHT AND LICENSE
1255              
1256             This software is Copyright (c) 2016 by Smithsonian Astrophysical Observatory.
1257              
1258             This is free software, licensed under:
1259              
1260             The GNU General Public License, Version 3, June 2007
1261              
1262             =cut
1263              
1264             __END__