File Coverage

blib/lib/e.pm
Criterion Covered Total %
statement 136 203 67.0
branch 60 124 48.3
condition 4 7 57.1
subroutine 57 83 68.6
pod n/a
total 257 417 61.6


line stmt bran cond sub pod time code
1             package e;
2              
3             =encoding utf8
4              
5             =head1 LOGO
6              
7             ⢀⣀⡤ ⢀⣤⣿⡗ ⣀⣀⣀
8             ⢀⣤⣤⣤⣄⡀ ⣠⡶⠿⠛⣹⡾⠛⢁⡼⠟⢛⠉⠉⠉⣉⣣⣀⣀⣀⣀⣀⣀⣀⣀⣀⣀⡄
9             ⢉⠻⣯⣉⡛⠒⠻⡷⢮⡙⠳⣤⡐⣾⠟⣀⣴⠋⠁⣀⡴⠋ ⣠⡟ ⠐⠚⠉⠉⠉⠉⠉⠉⠉⠉⠉⠉⢩⠛
10             ⠘⣧ ⠹⣿⡳⡀⠙⢦⡈⠳⠈⢱⡟ ⠋⣼⣿⣿⢿⠁⠰⣶⠏⢐⡆⢠ ⣠⣖⣢⠤⠶⠶⠂ ⡽⢃ ⣀
11             ⠈⢗⣲⠞⠓⠛⢦⡌⡿ ⡾⠃ ⣿⣿⡾ ⣿ ⣼⣠⠏⢀⡾⣿⠟⣂⣠⡤⠤⠴⠶⠛⠛⠛⢋⡿
12             ⢀⡴⡲⠹⠍⠁ ⠐⢶⡂⠈⣓⠱⣆⡼⠃ ⢰⣿⡟⢳ ⢀⣾⢇⡜⠋⠁⣰⣯⠾⠷⠚⠉ ⢀⣴⠎ ⢸⡇
13             ⠘⠙⠳⠤⣕ ⠳⣄ ⠉⠓⢴⣱⣿⡅⣀⣤⠾⣟⣯⣤⣶⡶⢿⣿⣯⠆ ⢈⣽⠃⣀⣀⣠⣴⣾⣯⠄ ⣴⠇
14             ⢀⣹⣶⡀⢈⣷⣶⣤⣼⣿⡿⢗⡋⣩⣶⡟⣛⣿⣿⣷⣾⣛⣉⣀⡤⠾⠛⠒⠋⠉⠛⣿⡿⠋ ⢠⡏
15             ⠙⠛⣲⡶⣤⣤⣿⡿⠋⠁⠻⠿⠛⠛⠙⠛⠛⠋⠉⠹⠿⠿⢿⣿⣏⣠⡖⣀⢀⣠⠤⢀⣈⣳⣄ ⢨⣶⣦⡤⣄⣀
16             ⠉⢁⣴⣋⣸⠟ ⣰⣶⠴⠒ ⠈⠛⠻⢿⣿⣿⡛⠋⠉⠙⣿ ⣠⡶⣫⣭⠶⣭⡀
17             ⢀⣴⠟⠉⢡⡏⡼ ⢠⡞ ⠉ ⢸⣿⡿⢿⡒⠒⠲⠿⠶⠶⠶⠟⠋⠁⣀⣀⣀⠉⠳⣄
18             ⠲⣿⠷⠃⢀⣾⠷⠿⠦⢤⣤⡟ ⢀⣀⣤⣶⣯⣥⣤⣤⡞⠁ ⠈⣼⣿⣷⣝⡳⠤⣤⣀⣀ ⠉ ⠙⠻⢦⣈⢳⡄
19             ⢀⡼⢋⣤⠴⠋⠁ ⣴⠿⠿⢶⣶⣿⣿⠟⠛⢻⣿⣿⠟⠁ ⠈⠻⣿⡍⠛⠷⣦⣄⡀⠳⢤⡀ ⠙⠧⣄
20             ⣠⣿⠟⠉ ⣀⣀⡀ ⣤⣤⣼⣿⣿⣷⣂⣴⣿⡿⠋ ⠰⡆ ⢻⣿⣿⣶⣄⡈⠻⣝ ⠈⠙⠲⣤⣀⡀ ⠑⢦⣌⡙⠒
21             ⢰⡟⠁ ⠛⢩⠶⠖⠛⣀⡏⠉⠙⠿⣿⣿⡟⠉ ⣷ ⣿⣿⣧⡙⢷⣄⡈⠂ ⠉⠉⠙⢷⡄⠈⠛⢦
22             ⣠⡿⠛⢶⣦⣤⣤⣴⣶ ⠈⡿⠟⠛⠉⠁⢀⣀⣀ ⠉⠙⠛⠒⠂ ⡿ ⣽⣿⠘⢻⣷⡀⠈⠉⠉ ⠹⣆ ⠁
23             ⡏ ⢸⣿⡿⠉⠙⠋ ⠈ ⠈⠉⣉⠅ ⠓⠲⢤⣄⡀ ⣼⠃ ⢿⣿ ⣿⠇⢠⡀ ⠠⣄⣄ ⢹⡆
24             ⣷⡀ ⡿ ⣀⠔ ⣠⣞⣁⣀⣠⣤⣤⣷⣌⠙⢦⡀⢀⡾⠃ ⢸⣿⡆⣻⠇ ⢹⣄ ⢹⡌⢳⣜⡟
25             ⢻⣧⣠⣸⡇ ⣠⡾⠟⠛⠉⣥⡾⢿⣿⣿⣿⣆ ⠙⠃ ⣿⢏⣿⡿⡀ ⠻⣷⢤⡀ ⢸⡇ ⢿⡇
26             ⠉⢻⢿⣿⣶⣤⣤⣀⣀⣀⣀⣤⣴⡿⠋⠁⣠⡴⠟⢁⣴⣿⣿⣿⣿⣿⡆ ⣼⡟⣼⣿⣷⢻⡜⣆ ⠘⢷⡙ ⣠⣤⡿ ⠈⠛⠁
27             ⠘⠦⢿⣍⠉⠉⠉⠙⢿⠩⢻⣿⣾⠞⠛⠁ ⣾⠏⠈⢻⣿⣿⣿⣿⡀⡀ ⢻⣰⠟⠁⠘⢦⡻⣿⡆ ⢸⣷ ⣿⡟⠁
28             ⠙⠋⠛⠳⣶⣶⠷⢾⣿⣿ ⢀⣿ ⢻⣿⣿⣿⡧ ⢀⣴⠋ ⠁⠈⢳ ⣸⠙⣦⢰⡟
29             ⠘⣿⣄⢼⣿⣿⣇⠒⢢⣿⣼⣧⡀ ⢤⡀⣿⣿⣿⡧ ⢀⣾⠃ ⢀⢠⡆ ⡞⢀⡴⣃⣸⡟⠳⣇
30             ⠹⡽⣾⣿⠹⣿⣆⣾⢯⣿⣿ ⡞ ⠻⣿⣿⣿⠁ ⢠⣿⢏ ⡀ ⡟ ⢀⣴⣿⠃⢁⡼⠁ ⠈
31             ⠈⠛ ⢻⣿⣧⢸⢟⠶⢾⡇ ⣸⡿⠁ ⢠⣾⡟⢼ ⣷ ⡇ ⣰⠋⠙⠁
32             ⠈⣿⣻⣾⣦⣇⢸⣇⣀⣶⡿⠁⣀⣀⣾⢿⡇⢸ ⣟⡦⣧⣶⠏ unleashed
33             ⠸⢿⡍⠛⠻⠿⠿⠿⠋⣠⡾⢋⣾⣏⣸⣷⡸⣇⢰⠟⠛⠻⡄ v1.37
34             ⢻⡄ ⠐⠚⠋⣠⡾⣧⣿⠁⠙⢳⣽⡟
35             ⠈⠳⢦⣤⣤⣀⣤⡶⠛ ⠈⢿⡆ ⢿⡇
36             ⠈ ⠈⠓ ⠈
37              
38             =head1 NAME
39              
40             e - beast mode unleashed
41              
42             =cut
43              
44 5     5   822572 use 5.006;
  5         20  
45 5     5   34 use strict;
  5         6  
  5         219  
46 5     5   32 use warnings;
  5         10  
  5         1808  
47              
48             our $VERSION = '1.37';
49              
50             =head1 SYNOPSIS
51              
52             Add a trace marker:
53              
54             $ perl -Me -e 'sub f1 { trace } sub f2 { f1 } f2'
55              
56             Watch a reference for changes:
57              
58             $ perl -Me -e 'my $v = {}; sub f1 { watch( $v ) } sub f2 { f1; $v->{a} = 1 } f2'
59              
60             $ perl -Me -e '
61             package A {
62             use e;
63             my %h = ( aaa => 111 );
64              
65             watch(\%h);
66              
67             sub f1 {
68             $h{b} = 1;
69             }
70              
71             sub f2 {
72             f1();
73             delete $h{aaa};
74             }
75             }
76              
77             A::f2();
78             '
79              
80             Benchmark two snippets of code:
81              
82             $ perl -Me -e 'n { slow => sub{ ... }, fast => sub{ ... }}, 10000'
83              
84             Create a breakpoint in code:
85              
86             $ perl -Me -e 'repl'
87              
88             Invoke the Tiny::Prof:
89              
90             $ perl -Me -e 'prof'
91              
92             Convert a data structure to json:
93              
94             $ perl -Me -e 'say j { a => [ 1..3] }'
95              
96             Convert a data structure to yaml:
97              
98             $ perl -Me -e 'say yml { a => [ 1..3] }'
99              
100             Pretty print a data structure:
101              
102             $ perl -Me -e 'p { a => [ 1..3] }'
103              
104             Data dump a data structure:
105              
106             $ perl -Me -e 'd { a => [ 1..3] }'
107              
108             Devel::Peek dump a data structure:
109              
110             $ perl -Me -e 'dd { a => [ 1..3] }'
111              
112             Print data as a table:
113              
114             $ perl -Me -e 'table( [qw(key value)], [qw(red 111)], [qw(blue 222)] )'
115             +------+-------+
116             | key | value |
117             +------+-------+
118             | red | 111 |
119             | blue | 222 |
120             +------+-------+
121              
122             Encode/decode UTF-8:
123              
124             $ perl -Me -e 'printf "%#X\n", ord for split //, enc "\x{5D0}"'
125             0XD7
126             0X90
127              
128             $ perl -C -Me -e 'say dec "\xD7\x90"'
129             $ perl -Me -e 'utf8; say dec "\xD7\x90"'
130             א
131              
132             And much, much more ...
133              
134             =cut
135              
136             =head1 DESCRIPTION
137              
138             This module imports many features that make
139             one-liners and script debugging much faster.
140              
141             It has been optimized for performance to not
142             import all features right away:
143             thereby making its startup cost quite low.
144              
145             =head2 How to Import
146              
147             This module will overwrite existing methods
148             of the same name (which triggers a warning)!
149              
150             Should this happen and it is not desired,
151             simply import this module first.
152              
153             Should you prefer the methods in this module,
154             import this module last (if needed, at the end
155             of the file).
156              
157             =cut
158              
159             =head1 SUBROUTINES
160              
161             =cut
162              
163             =head2 Investigation
164              
165             =head3 repl
166              
167             Add a breakpoint using L.
168              
169             Basically inserts a Read Evaluate Print Loop.
170              
171             Version 0 was basically:
172              
173             while ( 1 ) {
174             my $input = ;
175             last if $input eq 'q';
176             eval "$input";
177             }
178              
179             (Much more powerful since then).
180              
181             Enable to analyze code in the process.
182              
183             CODE ...
184              
185             # Breakpoint
186             use e;
187             repl
188              
189             CODE ...
190              
191             Simple debugger on the command line:
192              
193             $ perl -Me -e 'repl'
194              
195             =head3 trace
196              
197             Show a stack trace.
198              
199             trace( OPTIONS )
200              
201             OPTIONS:
202              
203             -levels => NUM, # How many scope levels to show.
204             NUM, # Same.
205              
206             -raw => 1, # Include internal calls.
207             -NUM, # Same.
208              
209             -message => STR, # Message to display.
210             STR, # Same.
211              
212             =head3 watch
213              
214             Watch a reference for changes.
215              
216             watch( $ref, OPTIONS )
217              
218             OPTIONS:
219              
220             -clone => 0, # Will not watch cloned objects.
221              
222             -methods => "fetch", # Monitor just this method.
223             -methods => [ "fetch" ], # Same.
224              
225             -levels => NUM, # How many scope levels to show.
226             NUM, # Same.
227              
228             -raw => 1, # Include internal calls.
229             -NUM, # Same.
230              
231             -message => STR, # Message to display.
232             STR, # Same.
233              
234             =head3 prof
235              
236             Profile the code from this point on.
237              
238             my $obj = prof;
239             ...
240             # $obj goes out of scope and builds results.
241              
242             =head3 n
243              
244             Benchmark and compare different pieces of code.
245              
246             Time single block of code.
247             n sub{ ... };
248             n sub{ ... }, 100000;
249              
250             # Compare blocks of code.
251             n {
252             slow => sub{ ... },
253             fast => sub{ ... },
254             };
255             n {
256             slow => sub{ ... },
257             fast => sub{ ... },
258             }, 10000;
259              
260             $ perl -Me -e '$v = 333; n { concat => sub { 111 . $v }, interp => sub { "111$v" }, list => sub { 111,$v } }, 100000000'
261              
262             Rate interp concat list
263             interp 55248619/s -- -6% -62%
264             concat 58479532/s 6% -- -60%
265             list 144927536/s 162% 148% --
266              
267             =cut
268              
269             =head2 Format Conversions
270              
271             =head3 csv
272              
273             CSV parser.
274              
275             Syntax:
276              
277             csv ( ARRAYREF_OF_ARRAYREFS )
278             csv ( ARRAYREF, [ARRAYREF] )
279             csv ( STRING )
280             csv ( )
281              
282             Convert Perl object to CSV string:
283              
284             $ perl -Me -e 'say csv [ "A1", "B1", "C1" ], [ "A2", "B2", "C2" ]'
285             A1,B1,C1
286             A2,B2,C2
287              
288             Convert CSV string to Perl object:
289              
290             # Single row:
291             perl -Me -e 'p csv "A1,B1,C1"'
292             [
293             [0] [
294             [0] "A1",
295             [1] "B1",
296             [2] "C1",
297             ],
298             ]
299              
300             # Multiple rows at once:
301             $ perl -Me -e 'p csv "A1,B1,C1\nA2,B2,C2"'
302             [
303             [0] [
304             [0] "A1",
305             [1] "B1",
306             [2] "C1",
307             ],
308             [1] [
309             [0] "A2",
310             [1] "B2",
311             [2] "C2",
312             ],
313             ]
314              
315             # Can use default variable:
316             $ perl -Me -e 'p csv for "A1,B1,C1", "A2,B2,C2"'
317             [
318             [0] [
319             [0] "A1",
320             [1] "B1",
321             [2] "C1",
322             ],
323             ]
324             [
325             [0] [
326             [0] "A2",
327             [1] "B2",
328             [2] "C2",
329             ],
330             ]
331              
332             =head3 j
333              
334             JSON Parser.
335              
336             my $bytes = j([1, 2, 3]);
337             my $bytes = j({foo => 'bar'});
338             my $value = j($bytes);
339              
340             Encode Perl data structure or decode JSON with L.
341              
342             Convert Perl object to JSON string:
343              
344             $ perl -Me -e 'say j { a => [1..3]}'
345              
346             Convert JSON string to Perl object:
347              
348             $ perl -Me -e 'p j q({"a":[1,2,3]})'
349              
350             =head3 x
351              
352             XML parser.
353              
354             my $dom = x('
Hello!
');
355              
356             Turn HTML/XML input into L object.
357              
358             $ perl -Me -e 'say x("
hey")->at("div")->text'
359              
360             Force HTML semantics:
361              
362             $ perl -Me -e 'say x->xml(0)->parse("Name")'
363             Name
364              
365             Force XML semantics (case sensitive tags and more):
366              
367             $ perl -Me -e 'say x->xml(1)->parse("Name")'
368             Name
369              
370             =head3 yml
371              
372             YAML parser.
373              
374             Convert Perl object to YAML string:
375              
376             $ perl -Me -e 'say yml { a => [1..3]}'
377              
378             Convert YAML string to Perl object:
379              
380             $ perl -Me -e 'p yml "---\na:\n- 1\n- 2\n- 3"'
381              
382             =head3 clone
383              
384             Storable's deep clone.
385              
386             $ perl -Me -e '
387             my $arr1 = [ 1..3 ];
388             my $arr2 = clone $arr1;
389             $arr2->[0] = 111;
390              
391             say $arr1;
392             p $arr1;
393              
394             say "";
395             say $arr2;
396             p $arr2;
397             '
398              
399             # Output:
400             ARRAY(0x5d0b8a408518)
401             [
402             [0] 1,
403             [1] 2,
404             [2] 3,
405             ]
406              
407             ARRAY(0x5d0b8a42d9e0)
408             [
409             [0] 111,
410             [1] 2,
411             [2] 3,
412             ]
413              
414             =head3 enc
415              
416             Encode UTF-8 code point to a byte stream:
417              
418             $ perl -Me -e 'printf "%#X\n", ord for split //, enc "\x{5D0}"'
419             0XD7
420             0X90
421              
422             =head3 dec
423              
424             Decode a byte steam to UTF-8 code point:
425              
426             $ perl -C -Me -e 'say dec "\xD7\x90"'
427             א
428              
429             =head3 utf8
430              
431             Set STDOUT and STDERR as UTF-8 encoded.
432              
433             If given a filehandle, will set the encoding
434             for it to UTF-8.
435              
436             utf8($fh);
437              
438             =cut
439              
440             =head2 Enhanced Types
441              
442             =head3 b
443              
444             Work with strings.
445              
446             my $stream = b('lalala');
447              
448             Turn string into a L object.
449              
450             $ perl -Me -e 'b(g("mojolicious.org")->body)->html_unescape->say'
451              
452             =head3 c
453              
454             Work with arrays.
455              
456             my $collection = c(1, 2, 3);
457              
458             Turn list into a L object.
459              
460             =head3 set
461              
462             Work with sets.
463              
464             my $set = set(2,4,6,4);
465              
466             Turn list into a L object.
467              
468             $ perl -Me -e 'say set(2,4,6,2)'
469             (2 4 6)
470              
471             Get elements:
472              
473             $ perl -Me -e 'say for sort(set(2,4,6,2)->elements)'
474             $ perl -Me -e 'say for sort(set(2,4,6,2)->@*)'
475             2
476             4
477             6
478              
479             Check for existence of an element:
480              
481             $ perl -Me -e 'say set(2,4,6,2)->has(7)'
482             $ perl -Me -e 'say set(2,4,6,2)->has(4)'
483             1
484              
485             Intersection:
486              
487             $ perl -Me -e 'say set(2,4,6,2) * set(3,4,5,6)'
488             (4 6)
489              
490             Create a new universe:
491              
492             # Universe 1:
493             # ...
494             Set::Scalar::Universe->new->enter;
495             # Universe 2:
496             # ...
497              
498             Operations:
499              
500             set value
501              
502             $a (a b c d e _ _ _ _)
503             $b (_ _ c d e f g _ _)
504             $c (_ _ _ _ e f g h i)
505              
506             union: $a + $b (a b c d e f g _ _)
507             union: $a + $b + $c (a b c d e f g h i)
508             intersection: $a * $b (_ _ c d e _ _ _ _)
509             intersection: $a * $b * $c (_ _ _ _ e _ _ _ _)
510             difference: $a - $b (a b _ _ _ _ _ _ _)
511             difference: $a - $b - $c (a b _ _ _ _ _ _ _)
512             unique: $a % $b (a b _ _ _ f g _ _)
513             symm_diff: $a / $b (a b _ _ _ f g _ _)
514             complement: -$a (_ _ c d e f g h i)
515              
516             =cut
517              
518             =head2 Files Convenience
519              
520             =head3 f
521              
522             Work with files.
523              
524             my $path = f('/home/sri/foo.txt');
525              
526             Turn string into a L object.
527              
528             $ perl -Me -e 'say r j f("hello.json")->slurp'
529              
530             =cut
531              
532             =head2 List Support
533              
534             =head3 max
535              
536             Get the biggest number in a list.
537              
538             $ perl -Me -e 'say max 2,4,1,3'
539             4
540              
541             =head3 min
542              
543             Get the smallest number in a list.
544              
545             $ perl -Me -e 'say max 2,4,1,3'
546             1
547              
548             =head3 sum
549              
550             Adds a list of numbers.
551              
552             $ perl -Me -e 'say sum 1..10'
553             55
554              
555             =head3 uniq
556              
557             Get the unique values in a list.
558              
559             $ perl -Me -e 'say for uniq 2,4,4,6'
560             2
561             4
562             6
563              
564             =cut
565              
566             =head2 Output
567              
568             =head3 say
569              
570             Obnoxious print with a newline.
571              
572             $ perl -Me -e 'say 123'
573             $ perl -Me -e 'say for 1..3'
574              
575             Always sends output to the terminal even
576             when STDOUT and/or STDERR are redirected:
577              
578             $ perl -Me -e '
579             say "Shown before";
580             close *STDOUT;
581             close *STDERR;
582             say "Shown with no stdout/err";
583             print "Print not seen\n";
584             '
585             Shown with no stdout/err
586              
587             =head3 p
588              
589             Pretty data printer.
590              
591             $ perl -Me -e 'p [1..3]'
592              
593             =head3 np
594              
595             Return pretty printer data.
596              
597             $ perl -Me -e 'my $v = np [1..3]; say "got: $v"'
598              
599             Can be used with C to output to the terminal
600             (incase STDOUT/STDERR are redirected):
601              
602             $ perl -Me -e '
603             close *STDOUT;
604             close *STDERR;
605             say np [ 1.. 3 ];
606             '
607              
608             =head3 d
609              
610             Data dumper.
611              
612             $ perl -Me -e 'd [1..3]'
613              
614             =head3 dd
615              
616             Internal data dumper.
617              
618             $ perl -Me -e 'dd [1..3]'
619              
620             =head3 dye
621              
622             Color a string.
623              
624             $ perl -Me -e 'say dye 123, "RED"'
625              
626             =head3 table
627              
628             Print data as a table:
629              
630             $ perl -Me -e 'table( [qw(key value)], [qw(red 111)], [qw(blue 222)] )'
631             +------+-------+
632             | key | value |
633             +------+-------+
634             | red | 111 |
635             | blue | 222 |
636             +------+-------+
637              
638             Context sensitive!
639              
640             - Void - output table.
641             - List - return individual lines.
642             - Scalar - return entire table as a string.
643              
644             =cut
645              
646             =head2 Web Related
647              
648             =head3 g
649              
650             my $res = g('example.com');
651             my $res = g('http://example.com' => {Accept => '*/*'} => 'Hi!');
652             my $res = g('http://example.com' => {Accept => '*/*'} => form => {a => 'b'});
653             my $res = g('http://example.com' => {Accept => '*/*'} => json => {a => 'b'});
654              
655             Perform C request with L and return resulting L object.
656              
657             $ perl -Me -e 'say g("mojolicious.org")->dom("h1")->map("text")->join("\n")'
658              
659             =head3 post
660              
661             my $res = post('example.com');
662             my $res = post('http://example.com' => {Accept => '*/*'} => 'Hi!');
663             my $res = post('http://example.com' => {Accept => '*/*'} => form => {a => 'b'});
664             my $res = post('http://example.com' => {Accept => '*/*'} => json => {a => 'b'});
665              
666             Perform C request with L and return resulting L object.
667              
668             $ perl -Me -e 'say post("mojolicious.org")->dom("h1")->map("text")->join("\n")'
669              
670             =head3 l
671              
672             Work with URLs.
673              
674             my $url = l('https://mojolicious.org');
675              
676             Turn a string into a L object.
677              
678             $ perl -Me -e 'say l("/perldoc")->to_abs(l("https://mojolicious.org"))'
679              
680             =cut
681              
682             =head2 Asynchronous
683              
684             This sector includes commands to run asynchronous
685             (or pseudo-async) operations.
686              
687             It is not entirely clear which method to always use.
688              
689             C limits to number of action or 20 (whichever is smaller).
690              
691             C and C have no such limits.
692              
693             Typically using threads (with C) seems to be fastest.
694              
695             Some statistics using different run commands:
696              
697             $ gitb status -d
698             s/iter runt runio runf series
699             runt 1.74 -- -35% -59% -74%
700             runio 1.12 55% -- -36% -59%
701             runf 0.716 142% 56% -- -36%
702             series 0.456 281% 146% 57% --
703              
704             $ gitb branch -d
705             Rate runt runf series runio
706             runt 0.592/s -- -71% -81% -83%
707             runf 2.02/s 240% -- -34% -42%
708             series 3.05/s 415% 51% -- -12%
709             runio 3.47/s 486% 72% 14% --
710              
711             $ gitb pull -d
712             s/iter runio series runt runf
713             runio 4.27 -- -7% -21% -33%
714             series 3.97 8% -- -15% -28%
715             runt 3.38 26% 17% -- -15%
716             runf 2.87 49% 38% 18% --
717              
718             =head3 runf
719              
720             Run tasks in parallel using L.
721              
722             Returns the results.
723              
724             $ perl -Me -e '
725             p {
726             runf
727             map {
728             my $n = $_;
729             sub{ $n => $n**2 };
730             } 1..5
731             }
732             '
733             {
734             1 => 1,
735             2 => 4,
736             3 => 9,
737             4 => 16,
738             5 => 25,
739             }
740              
741             Takes much overhead to start up!
742              
743             Will use up to 20 processes.
744              
745             =head3 runio
746              
747             Run tasks in parallel using L.
748              
749             Returns the results.
750              
751             $ perl -Me -e '
752             p {
753             runio
754             map {
755             my $n = $_;
756             sub{ $n => $n**2 };
757             } 1..5
758             }
759             '
760             {
761             1 => 1,
762             2 => 4,
763             3 => 9,
764             4 => 16,
765             5 => 25,
766             }
767              
768             This is apparently better to use for IO related tasks.
769              
770             =head3 runt
771              
772             Run tasks in parallel using L.
773              
774             Returns the results.
775              
776             $ perl -Me -e '
777             p {
778             runt
779             map {
780             my $n = $_;
781             sub{ $n => $n**2 };
782             } 1..5
783             }
784             '
785             {
786             1 => 1,
787             2 => 4,
788             3 => 9,
789             4 => 16,
790             5 => 25,
791             }
792              
793             This is the fastest run* command usually.
794              
795             =head3 run1
796              
797             Run tasks in series (normal 1-by-1 way).
798              
799             Mainly for switching between parallel and series
800             processing (incase parallel does not work in certain
801             cases).
802              
803             $ perl -Me -e '
804             p {
805             run1
806             map {
807             my $n = $_;
808             sub{ $n => $n**2 };
809             } 1..5
810             }
811             '
812             {
813             1 => 1,
814             2 => 4,
815             3 => 9,
816             4 => 16,
817             5 => 25,
818             }
819              
820              
821             =cut
822              
823             =head2 Time Related
824              
825             =head3 tm
826              
827             Creates a L object.
828              
829             # Just the object.
830             my $tm = tm;
831              
832             # Specific time.
833             my $tm = tm( year => 2025, month => 3, day => 14 );
834             my $now = tm->now;
835              
836             =cut
837              
838             =head2 Package Tools
839              
840             =head3 monkey_patch
841              
842             Insert subroutines into the symbol table.
843              
844             Extracted from Mojo::Util for performance.
845              
846             Imports method(s) into another package
847             (as done in this module):
848              
849             Take a look at the import method for an example.
850              
851             =head3 pod
852              
853             Work with perl pod.
854              
855             =head3 import
856              
857             Imports a DSL into another package.
858              
859             Can be used in a sub class to import this class
860             plus its own commands like this:
861              
862             package e2;
863             use parent qw( e );
864              
865             sub import {
866             shift->SUPER::import(
867             scalar caller,
868             my_command_1 => sub {},
869             my_command_2 => sub {},
870             my_command_3 => sub {},
871             );
872             }
873              
874             =cut
875              
876             sub monkey_patch {
877 6     6   190 my ( $class, %patch ) = @_;
878              
879             # Can be omitted, but it makes traces much
880             # nicer since it adds names to subs.
881 6         4118 require Sub::Util;
882              
883 5     5   44 no strict 'refs';
  5         22  
  5         21936  
884              
885 6         1908 for ( keys %patch ) {
886 191         6673 *{"${class}::$_"} =
887 191         961 Sub::Util::set_subname( "${class}::$_", $patch{$_} );
888             }
889             }
890              
891             sub import {
892 5     5   66 my ( $class, $caller, %extra ) = @_;
893 5         11 my %imported; # Require only once a package.
894 5   33     50 $caller //= caller;
895              
896             monkey_patch(
897             $caller,
898              
899             ######################################
900             # Investigation
901             ######################################
902              
903             # Debugging.
904             repl => sub {
905 0 0   0   0 if ( !$imported{$caller}{"Runtime::Debugger"}++ ) {
        0      
906 0         0 require Runtime::Debugger;
907             }
908             Runtime::Debugger::repl(
909 0         0 levels_up => 1,
910             @_,
911             );
912             },
913              
914             # Tracing.
915             trace => sub {
916 0 0   0   0 if ( !$imported{$caller}{"Data::Trace"}++ ) {
        0      
917 0         0 require Data::Trace;
918             }
919 0         0 Data::Trace::Trace( @_ );
920             },
921              
922             # Alias for trace.
923             watch => sub {
924 0 0   0   0 if ( !$imported{$caller}{"Data::Trace"}++ ) {
        0      
925 0         0 require Data::Trace;
926             }
927 0         0 Data::Trace::Trace( @_ );
928             },
929              
930             # Profiling.
931             prof => sub {
932 0 0   0   0 if ( !$imported{$caller}{"Tiny::Prof"}++ ) {
        0      
933 0         0 require Tiny::Prof;
934             }
935             Tiny::Prof->run(
936 0         0 name => 'Test',
937             @_,
938             );
939             },
940              
941             # Benchmark/timing.
942             n => sub {
943 16 100   16   8620 if ( !$imported{$caller}{"Benchmark"}++ ) {
        16      
944 4         2844 require Benchmark;
945 4         27336 Benchmark->import( ':hireswallclock' );
946             }
947              
948 16         736 my ( $arg, $times ) = @_;
949 16 100       92 my $subs =
950             ( ref $arg eq "CODE" )
951             ? { "test" => $arg }
952             : $arg;
953 16   100     100 $times //= 1;
954              
955 16         52 Benchmark::cmpthese( $times, $subs );
956             },
957              
958             ######################################
959             # Format Conversions
960             ######################################
961              
962             # CSV.
963             csv => sub {
964 48 100   48   209416 if ( !$imported{$caller}{"Text::CSV_XS"}++ ) {
        48      
965 4         7216 require Text::CSV_XS;
966              
967             # Avoid rebuilding this object.
968 4         105152 $e::_csv = Text::CSV_XS->new(
969             {
970             binary => 1,
971             auto_diag => 1,
972             }
973             );
974             }
975              
976 48 100       836 my @args = @_ ? @_ : ( $_ );
977 48         56 my ( $thing ) = @args;
978 48 50       92 return if !defined $thing;
979              
980             # String to reference.
981 48 100       72 if ( !ref $thing ) {
982 20         188 open my $io, "<", \$thing;
983 20         604 return $e::_csv->getline_all( $io );
984             }
985              
986             # Reference to string.
987 28 50       64 if ( ref( $thing ) ne "ARRAY" ) {
988 0         0 die "csv arguement is not an array reference!\n";
989             }
990              
991 28 100       52 if ( ref( $thing->[0] ) ne "ARRAY" ) {
992 20         52 $thing = [@args];
993             }
994              
995             join "\n",
996 28 50       52 map { $e::_csv->combine( @$_ ) && $e::_csv->string; } @$thing;
  44         424  
997              
998             },
999              
1000             # Json.
1001             j => sub {
1002 8 100   8   9200 if ( !$imported{$caller}{"Mojo::JSON"}++ ) {
        8      
1003 4         4492 require Mojo::JSON;
1004             }
1005 8 50       1006580 my @args = @_ ? @_ : ( $_ );
1006 8         32 Mojo::JSON::j( @args );
1007             },
1008              
1009             # XML/HTML.
1010             x => sub {
1011 4 50   4   3368 if ( !$imported{$caller}{"Mojo::DOM"}++ ) {
        4      
1012 4         2928 require Mojo::DOM;
1013             }
1014 4 50       110444 my @args = @_ ? @_ : ( $_ );
1015 4         24 Mojo::DOM->new( @args );
1016             },
1017              
1018             # YAML.
1019             yml => sub {
1020 8 100   8   8256 if ( !$imported{$caller}{"YAML::XS"}++ ) {
        8      
1021 4         2152 require YAML::XS;
1022             }
1023 8 50       11436 my @args = @_ ? @_ : ( $_ );
1024 8         16 my ( $thing ) = @args;
1025 8 100       1164 ref $thing
1026             ? YAML::XS::Dump( $thing )
1027             : YAML::XS::Load( $thing );
1028             },
1029              
1030             # Storable's deep clone.
1031             clone => sub {
1032 4 50   4   24 if ( !$imported{$caller}{"Storable"}++ ) {
        4      
1033 4         28 require Storable;
1034             }
1035 4         244 Storable::dclone( $_[0] );
1036             },
1037              
1038             # UTF-8 conversions.
1039             enc => sub {
1040 20 100   20   24208 if ( !$imported{$caller}{"Encode"}++ ) {
        20      
1041 4         24 require Encode;
1042             }
1043 20         40 my ( $ucp ) = @_;
1044 20         160 Encode::encode( "UTF-8", $ucp,
1045             Encode::WARN_ON_ERR() | Encode::LEAVE_SRC() );
1046             },
1047             dec => sub {
1048 20 50   20   11956 if ( !$imported{$caller}{"Encode"}++ ) {
        20      
1049 0         0 require Encode;
1050             }
1051 20         56 my ( $ubs ) = @_;
1052 20         132 Encode::decode( "UTF-8", $ubs,
1053             Encode::WARN_ON_ERR() | Encode::LEAVE_SRC() );
1054             },
1055              
1056             # Set UTF-8 for STDOUT and STDERR.
1057             utf8 => sub {
1058 128 50   128   1784716 my @fh = @_ ? @_ : ( *STDOUT, *STDERR );
        128      
1059 128     4   1712 binmode $_, "encoding(UTF-8)" for @fh;
  4         4980  
  4         92  
  4         28  
1060             },
1061              
1062             ######################################
1063             # Enhanced Types
1064             ######################################
1065              
1066             # String Object.
1067             b => sub {
1068 4 50   4   3460 if ( !$imported{$caller}{"Mojo::ByteStream"}++ ) {
        4      
1069 4         36 require Mojo::ByteStream;
1070             }
1071 4         104 Mojo::ByteStream::b( @_ );
1072             },
1073              
1074             # Array Object.
1075             c => sub {
1076 4 50   4   4264 if ( !$imported{$caller}{"Mojo::Collection"}++ ) {
        4      
1077 4         32 require Mojo::Collection;
1078             }
1079 4         28 Mojo::Collection::c( @_ );
1080             },
1081              
1082             # Array Object.
1083             set => sub {
1084 16 100   16   8152 if ( !$imported{$caller}{"Set::Scalar"}++ ) {
        16      
1085 4         3620 require Set::Scalar;
1086             }
1087 16         64816 Set::Scalar->new( @_ );
1088             },
1089              
1090             ######################################
1091             # Files Convenience
1092             ######################################
1093              
1094             # File Object.
1095             f => sub {
1096 4 50   4   5928 if ( !$imported{$caller}{"Mojo::File"}++ ) {
        4      
1097 4         2832 require Mojo::File;
1098             }
1099 4         136456 Mojo::File::path( @_ );
1100             },
1101              
1102             ######################################
1103             # List Support
1104             ######################################
1105              
1106             max => sub {
1107 4 50   4   5440 if ( !$imported{$caller}{"List::Util"}++ ) {
        4      
1108 4         44 require List::Util;
1109             }
1110              
1111 4         40 List::Util::max( @_ );
1112             },
1113              
1114             min => sub {
1115 4 50   4   148 if ( !$imported{$caller}{"List::Util"}++ ) {
        4      
1116 0         0 require List::Util;
1117             }
1118              
1119 4         32 List::Util::min( @_ );
1120             },
1121              
1122             sum => sub {
1123 4 50   4   28 if ( !$imported{$caller}{"List::Util"}++ ) {
        4      
1124 0         0 require List::Util;
1125             }
1126              
1127 4         40 List::Util::sum( @_ );
1128             },
1129              
1130             uniq => sub {
1131 4 50   4   32 if ( !$imported{$caller}{"List::Util"}++ ) {
        4      
1132 0         0 require List::Util;
1133             }
1134              
1135             # Since uniq is missing in some recent versions.
1136 4 50       76 if ( List::Util->can( "uniq" ) ) {
1137 4         96 List::Util::uniq( @_ );
1138             }
1139             else {
1140 0         0 my %h;
1141 0         0 grep { !$h{$_}++ } @_;
  0         0  
1142             }
1143             },
1144              
1145             ######################################
1146             # Output
1147             ######################################
1148              
1149             # Print.
1150             say => sub {
1151 28 100   28   756 my @args = @_ ? @_ : ( $_ );
        28      
1152              
1153             # Send to terminal.
1154             # Needs to be explicitly closed to avoid
1155             # issues with next say() if still closed:
1156             # "say() on closed filehandle STDOUT"
1157 28 50       96 if ( !-t STDOUT ) {
1158 28 50       1000 if ( open my $tty, ">", "/dev/tty" ) {
1159 0         0 caller->can( "utf8" )->( $tty ); # Method now in caller.
1160 0         0 my $prefix =
1161             caller->can( "dye" )->( "no-stdout: ", "CYAN" );
1162 0         0 CORE::say( $tty $prefix, @args );
1163 0         0 close $tty;
1164             }
1165             }
1166              
1167             # Send to output incase something expects it there.
1168 28         236 caller->can( "utf8" )->();
1169 28         2472 CORE::say( @args );
1170              
1171             },
1172              
1173             # Pretty Print.
1174             p => sub {
1175 8 100   8   44 if ( !$imported{$caller}{"Data::Printer"}++ ) {
        8      
1176 4         3984 require Data::Printer;
1177 4         148928 Data::Printer->import(
1178             use_prototypes => 0,
1179             show_dualvar => "off",
1180             hash_separator => " => ",
1181             end_separator => 1,
1182             show_refcount => 1,
1183             );
1184             }
1185 8 100       1480 my @args = @_ ? @_ : ( $_ );
1186 8         16 p( @args );
1187             },
1188             np => sub {
1189 0 0   0   0 if ( !$imported{$caller}{"Data::Printer"}++ ) {
        0      
1190 0         0 require Data::Printer;
1191 0         0 Data::Printer->import(
1192             use_prototypes => 0,
1193             show_dualvar => "off",
1194             hash_separator => " => ",
1195             end_separator => 1,
1196             show_refcount => 1,
1197             );
1198             }
1199 0 0       0 my @args = @_ ? @_ : ( $_ );
1200 0         0 np( @args );
1201             },
1202              
1203             # Dumper.
1204             d => sub {
1205 0 0   0   0 if ( !$imported{$caller}{"Mojo::Util"}++ ) {
        0      
1206 0         0 require Mojo::Util;
1207             }
1208 0         0 print Mojo::Util::dumper( @_ );
1209             },
1210              
1211             # Dump C stuctures.
1212             dd => sub {
1213 0 0   0   0 if ( !$imported{$caller}{"Devel::Peek"}++ ) {
        0      
1214 0         0 require Devel::Peek;
1215             }
1216 0         0 Devel::Peek::Dump( @_ );
1217             },
1218              
1219             # Color.
1220             dye => sub {
1221 0 0   0   0 if ( !$imported{$caller}{"Term::ANSIColor"}++ ) {
        0      
1222 0         0 require Term::ANSIColor;
1223             }
1224 0         0 Term::ANSIColor::colored( @_ );
1225             },
1226              
1227             # Table.
1228             table => sub {
1229 12 100   12   5060 if ( !$imported{$caller}{"Term::Table"}++ ) {
        12      
1230 4         2160 require Term::Table;
1231             }
1232              
1233 12         48860 my ( $header, @rows ) = @_;
1234 12         64 my @lines = Term::Table->new(
1235             header => $header,
1236             rows => \@rows,
1237             sanitize => 0, # To not show \n
1238             )->render;
1239              
1240 12 100       15384 return @lines if wantarray;
1241 8 100       56 return join "\n", @lines if defined wantarray;
1242              
1243 4         92 print "$_\n" for @lines;
1244             },
1245              
1246             ######################################
1247             # Web Related
1248             ######################################
1249              
1250             # GET request.
1251             g => sub {
1252 0 0   0   0 if ( !$imported{$caller}{"Mojo::UserAgent"}++ ) {
        0      
1253 0         0 require Mojo::UserAgent;
1254             }
1255 0         0 my $ua = Mojo::UserAgent->new;
1256 0 0       0 $ua->max_redirects( 10 ) unless defined $ENV{MOJO_MAX_REDIRECTS};
1257 0 0       0 $ua->proxy->detect unless defined $ENV{MOJO_PROXY};
1258 0         0 $ua->get( @_ )->result;
1259             },
1260              
1261             # POST Request.
1262             post => sub {
1263 0 0   0   0 if ( !$imported{$caller}{"Mojo::UserAgent"}++ ) {
        0      
1264 0         0 require Mojo::UserAgent;
1265             }
1266 0         0 my $ua = Mojo::UserAgent->new;
1267 0 0       0 $ua->max_redirects( 10 ) unless defined $ENV{MOJO_MAX_REDIRECTS};
1268 0 0       0 $ua->proxy->detect unless defined $ENV{MOJO_PROXY};
1269 0         0 $ua->post( @_ )->result;
1270             },
1271              
1272             # URL.
1273             l => sub {
1274 0 0   0   0 if ( !$imported{$caller}{"Mojo::URL"}++ ) {
        0      
1275 0         0 require Mojo::URL;
1276             }
1277 0         0 Mojo::URL->new( @_ );
1278             },
1279              
1280             ######################################
1281             # Asynchronous
1282             ######################################
1283              
1284             runio => sub {
1285 4 50   4   2592 if ( !$imported{$caller}{"Mojo::IOLoop"}++ ) {
        4      
1286 4         1920 require Mojo::IOLoop;
1287             }
1288              
1289 4         655668 my $ioloop = Mojo::IOLoop->new;
1290 4         16 my @res;
1291              
1292 4         12 for my $cb ( @_ ) {
1293 12     12   468 $ioloop->timer( 0 => sub { push @res, $cb->() } );
  12         412  
1294             }
1295              
1296 4         116 $ioloop->start;
1297              
1298 4         128 @res;
1299             },
1300              
1301             runf => sub {
1302 4 50   4   32 if ( !$imported{$caller}{"Parallel::ForkManager"}++ ) {
        4      
1303 4         2552 require Parallel::ForkManager;
1304             }
1305              
1306 4         179172 my $MAX_PROCESSES = 20;
1307 4 50       28 my $processes = ( @_ > $MAX_PROCESSES ) ? $MAX_PROCESSES : @_;
1308 4         24 my $pm = Parallel::ForkManager->new( $processes );
1309 4         36096 my @res;
1310              
1311             $pm->run_on_finish(
1312             sub {
1313 3   50 3   2013040 push @res, @{ $_[-1] // [] };
  3         35  
1314             }
1315 4         56 );
1316 4         60 for my $cb ( @_ ) {
1317 9 100       25500 $pm->start and next;
1318 3         39375 $pm->finish( 0, [ $cb->() ] );
1319             }
1320 1         7293 $pm->wait_all_children;
1321              
1322 1         40 @res;
1323             },
1324              
1325             runt => sub {
1326 0 0   0   0 if ( !$imported{$caller}{"Config"}++ ) {
        0      
1327 0         0 require Config;
1328             }
1329              
1330 0 0       0 if ( !$Config::Config{useithreads} ) {
1331 0         0 die "Threading not supported!\n";
1332             }
1333              
1334 0 0       0 if ( !$imported{$caller}{"threads"}++ ) {
1335 0         0 require threads;
1336             }
1337              
1338 0         0 map { $_->join }
1339 0         0 map { threads->create( $_ ) } @_;
  0         0  
1340             },
1341              
1342             run1 => sub {
1343 1     1   5491 map { $_->() } @_;
  3     1   59  
1344             },
1345              
1346             ######################################
1347             # Time Related
1348             ######################################
1349              
1350             tm => sub {
1351 1 50   1   972 if ( !$imported{$caller}{"Time::Moment"}++ ) {
        1      
1352 1         917 require Time::Moment;
1353             }
1354              
1355 1         4566 Time::Moment->new( @_ );
1356             },
1357              
1358             ######################################
1359             # Package Tools
1360             ######################################
1361              
1362             monkey_patch => \&monkey_patch,
1363              
1364             pod => sub {
1365 0 0   0   0 if ( !$imported{$caller}{"App::Pod"}++ ) {
        0      
1366 0         0 require App::Pod;
1367 0         0 App::Pod->import;
1368             }
1369              
1370 0         0 local @ARGV = @_;
1371 0         0 App::Pod->run;
1372             },
1373              
1374             ######################################
1375             # Extra Methods
1376             ######################################
1377              
1378             # Make it easier to subclass.
1379 5         308 %extra,
1380              
1381             );
1382             }
1383              
1384             =head1 AUTHOR
1385              
1386             Tim Potapov, C<< >>
1387              
1388             =head1 BUGS
1389              
1390             Please report any bugs or feature requests to
1391             L.
1392              
1393             =head1 SUPPORT
1394              
1395             You can find documentation for this module
1396             with the perldoc command.
1397              
1398             perldoc e
1399              
1400             You can also look for information at:
1401              
1402             L
1403              
1404             L
1405              
1406             Logo was generated using: L
1407              
1408             =head1 LICENSE AND COPYRIGHT
1409              
1410             This software is Copyright (c) 2024 by Tim Potapov.
1411              
1412             This is free software, licensed under:
1413              
1414             The Artistic License 2.0 (GPL Compatible)
1415              
1416             =cut
1417              
1418             "\x{1f42a}\x{1f977}"