File Coverage

blib/lib/Sub/Middler.pm
Criterion Covered Total %
statement 74 86 86.0
branch 24 38 63.1
condition n/a
subroutine 13 13 100.0
pod 3 4 75.0
total 114 141 80.8


line stmt bran cond sub pod time code
1             package Sub::Middler;
2 2     2   184745 use 5.024000;
  2         6  
3 2     2   12 use strict;
  2         14  
  2         57  
4 2     2   9 use warnings;
  2         4  
  2         126  
5 2     2   10 use feature "refaliasing";
  2         3  
  2         362  
6              
7              
8             our $VERSION = 'v0.4.1';
9 2     2   1018 use Export::These qw;
  2         1384  
  2         12  
10              
11             sub new {
12             #simply an array...
13 2     2 1 145074 bless [], __PACKAGE__;
14             }
15              
16             # register sub refs to middleware makers
17             sub register {
18 2     2   1960 no warnings "experimental";
  2         4  
  2         299  
19 7     7 1 694 \my @middleware=$_[0]; #self
20 7         10 my $sub=$_[1];
21             #die "Middleware must be a CODE reference" unless ref($sub) eq "CODE";
22 7         11 push @middleware, $sub;
23 7         16 return $_[0]; #allow chaining
24             }
25              
26             *append=\®ister;
27             *add=\®ister;
28              
29              
30             # Link together sub and give each one an index
31             # Required argument is the 'dispatcher' which is the end point to call
32             #
33             sub _sink_sub;
34             sub link {
35 2     2   12 no warnings "experimental";
  2         3  
  2         2589  
36              
37             #die "A CODE reference is required when linking middleware" unless(@_ >=2 and ref $_[1] eq "CODE");
38            
39              
40 2     2 1 15 \my @self=shift; #self;
41              
42 2         8 my $dispatcher=_sink_sub shift, 1;
43              
44              
45 2         8 my @args=@_;
46              
47 2         3 my @mw; # The generated subs
48              
49 2         6 my @middleware=@self;
50 2         5 for(@middleware){
51 7         16 $_=_sink_sub $_;
52             }
53              
54 2         9 for my $i (reverse 0..@middleware-1){
55 7         45 my $maker=$middleware[$i];
56 7 100       19 my $next=($i==@middleware-1)?$dispatcher:$mw[$i+1];
57            
58              
59 7         18 $mw[$i]=$maker->($next, $i, @args);
60             }
61              
62 2 50       27 @middleware?$mw[0]:$dispatcher;
63             }
64              
65             sub linker {
66 1     1 0 157814 my $dispatch=pop;
67              
68 1         10 my $chain=Sub::Middler->new;
69 1         6 $chain->register($_) for @_;
70 1         4 $chain->link($dispatch);
71            
72             }
73              
74             sub _sink_sub {
75 9     9   33 my $in=$_[0];
76 9         14 my $is_dispatch=$_[1];
77              
78 9 100       31 return $in if ref $in eq "CODE";
79              
80             my $wrap=sub {
81 5     5   7 my $next=shift;
82 5         6 my $out;
83              
84 5         15 for (ref $in){
85              
86              
87 5 100       18 if(/SCALAR/){
    100          
    100          
    50          
88             $out=$is_dispatch
89             ?sub {
90 0 0       0 if($$in){
91 0         0 $$in.=qq|$"@{$_[0]}|;
  0         0  
92             }
93             else {
94 0         0 $$in.=qw|@{$_[0]}|;
95             }
96 0 0       0 $_[1] and $_[1]->(); # Auto call call back
97             }
98             :sub {
99             #Convert into string
100 4 100       7 if($$in){
101 3         6 $$in.=qq|$"@{$_[0]}|;
  3         8  
102             }
103             else {
104 1         2 $$in.=qq|@{$_[0]}|;
  1         4  
105             }
106 4         7 &$next;
107             }
108 1 50       10 }
109              
110             elsif(/ARRAY/){
111              
112             $out=$is_dispatch
113             ?sub {
114             # Copy and append into array,
115 4         13 push @$in, @{$_[0]};
  4         14  
116 4 100       10 $_[1] and $_[1]->();
117             }
118             :sub {
119             # Copy and append into array,
120 4         8562 push @$in, @{$_[0]};
  4         11  
121 4         7 &$next;
122             }
123 2 100       15 }
124              
125             elsif(/HASH/) {
126             $out=$is_dispatch
127             ?sub {
128             # copy into hash
129 0         0 for (my $i=0; $i<$_[0]->@*; $i+=2){
130 0         0 $in->{$_[0][$i]}=$_[0][$i+1];
131             }
132             ############################
133             # for my($k,$v)(@{$_[0]}){ #
134             # $in->{$k}=$v; #
135             # } #
136             ############################
137 0 0       0 $_[1] and $_[1]->();
138             }
139             :sub {
140             # copy into hash
141 4         11 for (my $i=0; $i<$_[0]->@*; $i+=2){
142 11         32 $in->{$_[0][$i]}=$_[0][$i+1];
143             }
144             ############################
145             # for my($k,$v)(@{$_[0]}){ #
146             # $in->{$k}=$v; #
147             # } #
148             ############################
149 4         6 &$next;
150             }
151 1 50       7 }
152              
153              
154             elsif(/REF/){
155 1         9 my $r=$$in;
156 1 50       4 if(ref $r eq "CODE"){
157             # treat a ref to a code ref as
158             $out=$is_dispatch
159             ?sub {
160 0         0 &$r;
161 0 0       0 $_[1] and $_[1]->();
162             }
163              
164             :sub {
165 4         10 &$r;
166 4         21 &$next;
167             }
168 1 50       5 }
169             else {
170 0         0 die "should not get here";
171             }
172             }
173             else {
174 0         0 die "Could not link unkown reference: ". ref $in;
175             }
176             }
177 5         24 $out;
178 5         17 };
179 5 100       13 $is_dispatch?$wrap->():$wrap;
180             }
181              
182             1;
183              
184             =head1 NAME
185              
186             Sub::Middler - Middleware subroutine chaining
187              
188             =head1 SYNOPSIS
189              
190             use strict;
191             use warings;
192             use Sub::Middler;
193              
194            
195             my @array;
196             my %hash;
197             my $scalar;
198              
199             # append results in variables
200             my $head=linker
201             # Short cut to store (copy/append) in array
202             \@array
203             # Short cut to modifiy inputs
204             =>\sub { $_*=2 for @{$_[0]}},
205             # Short cut to store in hash
206             =>\%hash,
207             # Short cut to stringyfiy and append to scalar
208             =>\$scalar;
209            
210              
211             $head->([1,2,3,4,], sub {...})
212             # inputs ready cb
213              
214              
215             use strict;
216             use warnings;
217             use Sub::Middler;
218              
219             my $middler=Sub::Middler->new;
220              
221             $middler->register(mw1(x=>1));
222             $middler->register(mw2(y=>10));
223              
224             my $head=$middler->link(
225             sub {
226             print "Result: $_[0]\n";
227             }
228             );
229              
230             $head->(0); # Call the Chain
231              
232             # Middleware 1
233             sub mw1 {
234             my %options=@_;
235             sub {
236             my ($next, $index, @optional)=@_;
237             sub {
238             my $work=$_[0]+$options{x};
239             $next->($work);
240             }
241             }
242             }
243              
244             # Middleware 2
245             sub mw2 {
246             my %options=@_;
247             sub {
248             my ($next, $index, @optional)=@_;
249             sub {
250             my $work= $_[0]*$options{y};
251             $next->( $work);
252             }
253             }
254             }
255              
256             =head1 DESCRIPTION
257              
258             A small module, facilitating linking subroutines together, acting as middleware
259             ,filters or chains with low runtime overhead.
260              
261             To achieve this, the 'complexity' is offloaded to the definition of
262             middleware/filters subroutines. They must be wrapped in subroutines
263             appropriately to facilitate the lexical binding of linking variables.
264              
265             This differs from other 'sub chaining' modules as it does not use a loop
266             internally to iterate over a list of subroutines at runtime. As such there is
267             no implicit synchronous call to the 'next' item in the chain. Each stage can run
268             the following stage synchronously or asynchronously or not at all. Each element
269             in the chain is responsible for how and when it calls the 'next'.
270              
271             Finally the arguments and signatures of each stage of middleware are completely
272             user defined and are not interfered with by this module. This allows reuse of
273             the C<@_> array in calling subsequent stages for ultimate performance if you
274             know what you're doing.
275              
276             As a general guide it's suggested the last argument to a stage be a subroutine
277             reference to allow callbacks and asynchronous usage. Instead of a flat list of
278             multiple inputs into a stage, it is suggested to also contain these in an array
279              
280             From v0.4.0, shortcuts can be used to to bypass writing the nestled
281             subroutines subroutines for some common use cases. A reference to a
282             SCALAR/ARRAY/HASH/CODE can be used instead of custom middleware
283              
284             =head1 API
285              
286             =head2 Inline linking
287              
288             linker mw1, ..., dispatch
289              
290             From v0.3.0, the C subroutine is exported and will do an inline build
291             and link for a given middleware and dispatch routine
292              
293             The return value is the head of the linked chain, and is equivalent to created
294             a C object, adding middleware, and the calling the link method.
295              
296              
297             =head2 Short Cuts
298              
299            
300             Instead of writing custom middleware, references to variables and CODE can be
301             used instead.
302              
303             If an array reference is used, all elements from the first argument will be
304             appended to the referenced array
305              
306             If an hash reference is used, the elements from the first argument will be
307             treated as key value pairs and set the corresponding elements in the target
308             hash
309              
310             If a scalar reference is used, the elements from the first argument will be
311             converted to strings using the C<$"> variable as the joiner. If the scalar
312             already has length, it is treated as another item and joined with the C<$">
313             like it was another element in the input;
314              
315              
316             If a reference is a CODE reference is used, the underlying subroutine is
317             expected to modify the first argument elements in place. The return value is
318             not used.
319              
320              
321             In all the above cases, the next link in the chain is automatically called with
322             the same arguments, making chaining and saving intermediate values easy
323              
324              
325             =head2 Managing a chain
326              
327             =head3 new
328            
329             my $object=Sub::Middler->new;
330              
331             Creates a empty middler object ready to accept middleware. The object is a
332             blessed array reference which stores the middleware directly.
333              
334             =head3 register
335              
336             $object->register(my_middlware());
337              
338             Appends the middleware to the internal list for later linking.
339              
340             =head3 append, add
341              
342             Alias for register
343              
344             =head3 link
345              
346             $object->link($last,[@args]);
347              
348             Links together the registered middleware in the sequence of addition. Each
349             middleware is intrinsically linked to the next middleware in the list. The last
350             middleware being linked to the C<$last> argument, which must be a code ref.
351              
352             The C<$last> ref MUST be a regular subroutine reference, acting as the
353             'kernel' as described in following sections.
354              
355             Calls C if C<$last> is not a code ref.
356              
357             Any optional additional arguments C<@args> are passed to this function are
358             passed on to each 'maker' sub after the C<$next> and C<$index>, parameters.
359             This gives an alternative approach to distributing configuration data to each
360             item in the chain prior to runtime. It is up to each item's maker sub to store
361             relevant passed values as they see fit.
362              
363             =head2 Creating Middleware
364              
365             To achieve low over head in linking middleware, functional programming
366             techniques (higher order functions) are utilised. This also give the greatest
367             flexibility to the middleware, as signatures are completely user defined.
368              
369             The trade off is that the middleware must be defined in a certain code
370             structure. While this isn't difficult, it takes a minute to wrap your head
371             around.
372              
373              
374             =head3 Middlware Definition
375              
376             Middleware must be a subroutine (top/name) which returns a anonymous subroutine
377             (maker), which also returns a anonymous subroutine to perform work (kernel).
378              
379             This sounds complicated by this is what is looks like in code:
380              
381             sub my_middleware { (1) Top/name subroutine
382             my %options=@_; Store any config
383            
384             sub { (2) maker sub is returned
385             my ($next, $index, @optional)=@_; (3) Must store at least $next
386              
387             sub { (4) Returns the kernel sub
388             # Code here implements your middleware
389             # %options are lexically accessable here
390             # as are the @optional parameters
391            
392              
393             # Execute the next item in the chain
394             $next->(...); (5) Does work and calls the next entry
395              
396              
397             (6) Post work if applicable
398             }
399             }
400             }
401              
402             =over
403              
404             =item Top Subroutine
405              
406             The top sub routine (1) can take any arguments you desire and can be called
407             what you like. The idea is it represents your middleware/filter and stores any
408             setup lexically for the B sub to close over. It returns the B
409             sub.
410              
411             =item Maker Subroutine
412              
413             This anonymous sub (2) closes over the variables stored in B and is the
414             input to this module (via C). When being linked (called) by this
415             module it is provided at least two arguments: the reference to the next item in
416             the chain and the current middleware index. These B be stored to be
417             useful, but can be called anything you like (3).
418            
419             Any optional/additional arguments supplied during a call to C are also
420             used as arguments 'as is' to all maker subroutines in the chain.
421              
422              
423             =item Kernel subroutine
424              
425             This anonymous subroutine (4) actually performs the work of the
426             middleware/filter. After work is done, the next item in the chain must be
427             called explicitly (5). This supports synchronous or asynchronous middleware.
428             Any extra work can be performed after the chain is completed after this call
429             (6).
430              
431             =back
432              
433              
434             =head2 LINKING CHAINS
435              
436             Multiple chains of middleware can be linked together. This needs to be done in
437             reverse order. The last chain after being linked, becomes the C<$last> item
438             when linking the preceding chain and so on.
439              
440              
441             =head2 EXAMPLES
442              
443             The synopsis example can be found in the examples directory of this
444             distribution.
445              
446              
447             =head1 SEE ALSO
448              
449             L and L links together subs. They provide other
450             features that this module does not.
451              
452             These iterate over a list of subroutines at runtime to achieve named subs etc.
453             where as this module pre links subroutines together, reducing overhead.
454              
455              
456             =head1 AUTHOR
457              
458             Ruben Westerberg, Edrclaw@mac.comE
459              
460             =head1 REPOSITORTY and BUGS
461              
462             Please report any bugs via git hub: L
463              
464             =head1 COPYRIGHT AND LICENSE
465              
466             Copyright (C) 2025 by Ruben Westerberg
467              
468             This library is free software; you can redistribute it
469             and/or modify it under the same terms as Perl or the MIT
470             license.
471              
472             =head1 DISCLAIMER OF WARRANTIES
473              
474             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS
475             OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE
476             IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
477             PARTICULAR PURPOSE.
478             =cut
479