From 2ab2302a10ea0123745dca96f3a88d5d2283103f Mon Sep 17 00:00:00 2001 From: Timofey Potapov Date: Sat, 27 Jul 2024 17:33:55 +0200 Subject: [PATCH] Version 1.26 Internal cleanup. Added color when STDOUT is closed. Added set command (Set::Scalar). --- Build.PL | 1 + Changes | 8 +++ README.md | 97 +++++++++++++++++++++++++++++++---- lib/e.pm | 136 ++++++++++++++++++++++++++++++++++++++++++-------- t/01-simple.t | 93 ++++++++++++++++++++++++++++++++++ 5 files changed, 304 insertions(+), 31 deletions(-) diff --git a/Build.PL b/Build.PL index df69abe..718cdbb 100755 --- a/Build.PL +++ b/Build.PL @@ -45,6 +45,7 @@ my $builder = $class->new( 'Data::Trace' => '1.05', 'Mojolicious' => '0', 'Runtime::Debugger' => '1.03', + 'Set::Scalar' => '0', 'Sub::Util' => '0', 'Term::Table' => '0', 'Tiny::Prof' => '0.03', diff --git a/Changes b/Changes index 4b55931..be1e650 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,13 @@ Revision history for e +================= +1.26 - 2024-07-27 +================= + +Internal cleanup. +Added color when STDOUT is closed. +Added set command (Set::Scalar). + ================= 1.25 - 2024-07-04 ================= diff --git a/README.md b/README.md index 0b279ae..4732d56 100644 --- a/README.md +++ b/README.md @@ -26,7 +26,7 @@ ⠹⡽⣾⣿⠹⣿⣆⣾⢯⣿⣿ ⡞ ⠻⣿⣿⣿⠁ ⢠⣿⢏ ⡀ ⡟ ⢀⣴⣿⠃⢁⡼⠁ ⠈ ⠈⠛ ⢻⣿⣧⢸⢟⠶⢾⡇ ⣸⡿⠁ ⢠⣾⡟⢼ ⣷ ⡇ ⣰⠋⠙⠁ ⠈⣿⣻⣾⣦⣇⢸⣇⣀⣶⡿⠁⣀⣀⣾⢿⡇⢸ ⣟⡦⣧⣶⠏ unleashed - ⠸⢿⡍⠛⠻⠿⠿⠿⠋⣠⡾⢋⣾⣏⣸⣷⡸⣇⢰⠟⠛⠻⡄ v1.25 + ⠸⢿⡍⠛⠻⠿⠿⠿⠋⣠⡾⢋⣾⣏⣸⣷⡸⣇⢰⠟⠛⠻⡄ v1.26 ⢻⡄ ⠐⠚⠋⣠⡾⣧⣿⠁⠙⢳⣽⡟ ⠈⠳⢦⣤⣤⣀⣤⡶⠛ ⠈⢿⡆ ⢿⡇ ⠈ ⠈⠓ ⠈ @@ -264,6 +264,11 @@ Decode a byte steam to UTF-8 code point: Set STDOUT and STDERR as UTF-8 encoded. +If given a filehandle, will set the encoding +for it to UTF-8. + + utf8($fh); + ## Enhanced Types ### b @@ -284,6 +289,57 @@ Work with arrays. Turn list into a [Mojo::Collection](https://metacpan.org/pod/Mojo%3A%3ACollection) object. +### set + +Work with sets. + + my $set = set(2,4,6,4); + +Turn list into a [Set::Scalar](https://metacpan.org/pod/Set%3A%3AScalar) object. + + $ perl -Me -e 'say set(2,4,6,2)' + (2 4 6) + + +Get elements: + + $ perl -Me -e 'say for sort(set(2,4,6,2)->elements)' + $ perl -Me -e 'say for sort(set(2,4,6,2)->@*)' + 2 + 4 + 6 + +Intersection: + + $ perl -Ilib/ -Me -e 'say set(2,4,6,2) * set(3,4,5,6)' + (4 6) + +Create a new universe: + + # Universe 1: + # ... + Set::Scalar::Universe->new->enter; + # Universe 2: + # ... + +Operations: + + set value + + $a (a b c d e _ _ _ _) + $b (_ _ c d e f g _ _) + $c (_ _ _ _ e f g h i) + + union: $a + $b (a b c d e f g _ _) + union: $a + $b + $c (a b c d e f g h i) + intersection: $a * $b (_ _ c d e _ _ _ _) + intersection: $a * $b * $c (_ _ _ _ e _ _ _ _) + difference: $a - $b (a b _ _ _ _ _ _ _) + difference: $a - $b - $c (a b _ _ _ _ _ _ _) + unique: $a % $b (a b _ _ _ f g _ _) + symm_diff: $a / $b (a b _ _ _ f g _ _) + complement: -$a (_ _ c d e f g h i) + ## Files Convenience ### f @@ -309,11 +365,11 @@ Always sends output to the terminal even when STDOUT and/or STDERR are redirected: $ perl -Me -e ' + say "Shown before"; close *STDOUT; close *STDERR; - say 111; - print "999\n"; - say 222; + say "Shown with no stdout/err"; + print "Print not seen\n"; ' 111 222 @@ -406,16 +462,39 @@ Insert subroutines into the symbol table. Extracted from Mojo::Util for performance. -Import methods into another function -(as done this module): - - $ perl -e 'package A; use e; sub import { my $c = caller(); monkey_patch $c, new => sub { say "Im new" } } package main; A->import; new()' +Import methods into another package +(as done in this module): + + $ perl -e ' + package A; + use e; + sub import { + my $c = caller(); + monkey_patch + $c, + new => sub { say "Im new" }; + } + package main; + A->import; + new(); + ' Im new Import methods into the same package (probably not so useful): - $ perl -e 'package A; use e; sub import { my $c = caller(); monkey_patch $c, new => sub { say "Im new" } } A->import; A->new()' + $ perl -e ' + package A; + use e; + sub import { + my $c = caller(); + monkey_patch + $c, + new => sub { say "Im new" }; + } + A->import; + A->new(); + ' Im new Perhaps can be updated based on the outcome diff --git a/lib/e.pm b/lib/e.pm index 0bfca26..1d7142d 100644 --- a/lib/e.pm +++ b/lib/e.pm @@ -30,7 +30,7 @@ package e; ⠹⡽⣾⣿⠹⣿⣆⣾⢯⣿⣿ ⡞ ⠻⣿⣿⣿⠁ ⢠⣿⢏ ⡀ ⡟ ⢀⣴⣿⠃⢁⡼⠁ ⠈ ⠈⠛ ⢻⣿⣧⢸⢟⠶⢾⡇ ⣸⡿⠁ ⢠⣾⡟⢼ ⣷ ⡇ ⣰⠋⠙⠁ ⠈⣿⣻⣾⣦⣇⢸⣇⣀⣶⡿⠁⣀⣀⣾⢿⡇⢸ ⣟⡦⣧⣶⠏ unleashed - ⠸⢿⡍⠛⠻⠿⠿⠿⠋⣠⡾⢋⣾⣏⣸⣷⡸⣇⢰⠟⠛⠻⡄ v1.25 + ⠸⢿⡍⠛⠻⠿⠿⠿⠋⣠⡾⢋⣾⣏⣸⣷⡸⣇⢰⠟⠛⠻⡄ v1.26 ⢻⡄ ⠐⠚⠋⣠⡾⣧⣿⠁⠙⢳⣽⡟ ⠈⠳⢦⣤⣤⣀⣤⡶⠛ ⠈⢿⡆ ⢿⡇ ⠈ ⠈⠓ ⠈ @@ -45,7 +45,7 @@ use 5.006; use strict; use warnings; -our $VERSION = '1.25'; +our $VERSION = '1.26'; =head1 SYNOPSIS @@ -284,6 +284,11 @@ Decode a byte steam to UTF-8 code point: Set STDOUT and STDERR as UTF-8 encoded. +If given a filehandle, will set the encoding +for it to UTF-8. + + utf8($fh); + =cut =head2 Enhanced Types @@ -308,6 +313,58 @@ Turn list into a L object. =cut +=head3 set + +Work with sets. + + my $set = set(2,4,6,4); + +Turn list into a L object. + + $ perl -Me -e 'say set(2,4,6,2)' + (2 4 6) + +Get elements: + + $ perl -Me -e 'say for sort(set(2,4,6,2)->elements)' + $ perl -Me -e 'say for sort(set(2,4,6,2)->@*)' + 2 + 4 + 6 + +Intersection: + + $ perl -Ilib/ -Me -e 'say set(2,4,6,2) * set(3,4,5,6)' + (4 6) + +Create a new universe: + + # Universe 1: + # ... + Set::Scalar::Universe->new->enter; + # Universe 2: + # ... + +Operations: + + set value + + $a (a b c d e _ _ _ _) + $b (_ _ c d e f g _ _) + $c (_ _ _ _ e f g h i) + + union: $a + $b (a b c d e f g _ _) + union: $a + $b + $c (a b c d e f g h i) + intersection: $a * $b (_ _ c d e _ _ _ _) + intersection: $a * $b * $c (_ _ _ _ e _ _ _ _) + difference: $a - $b (a b _ _ _ _ _ _ _) + difference: $a - $b - $c (a b _ _ _ _ _ _ _) + unique: $a % $b (a b _ _ _ f g _ _) + symm_diff: $a / $b (a b _ _ _ f g _ _) + complement: -$a (_ _ c d e f g h i) + +=cut + =head2 Files Convenience =head3 f @@ -335,11 +392,11 @@ Always sends output to the terminal even when STDOUT and/or STDERR are redirected: $ perl -Me -e ' + say "Shown before"; close *STDOUT; close *STDERR; - say 111; - print "999\n"; - say 222; + say "Shown with no stdout/err"; + print "Print not seen\n"; ' 111 222 @@ -436,16 +493,39 @@ Insert subroutines into the symbol table. Extracted from Mojo::Util for performance. -Import methods into another function -(as done this module): - - $ perl -e 'package A; use e; sub import { my $c = caller(); monkey_patch $c, new => sub { say "Im new" } } package main; A->import; new()' +Import methods into another package +(as done in this module): + + $ perl -e ' + package A; + use e; + sub import { + my $c = caller(); + monkey_patch + $c, + new => sub { say "Im new" }; + } + package main; + A->import; + new(); + ' Im new Import methods into the same package (probably not so useful): - $ perl -e 'package A; use e; sub import { my $c = caller(); monkey_patch $c, new => sub { say "Im new" } } A->import; A->new()' + $ perl -e ' + package A; + use e; + sub import { + my $c = caller(); + monkey_patch + $c, + new => sub { say "Im new" }; + } + A->import; + A->new(); + ' Im new Perhaps can be updated based on the outcome @@ -497,7 +577,7 @@ sub monkey_patch { sub import { my ( $class, $caller ) = @_; - my %imported; + my %imported; # Require only once a package. $caller //= caller; monkey_patch( @@ -637,6 +717,14 @@ sub import { Mojo::Collection::c( @_ ); }, + # Array Object. + set => sub { + if ( !$imported{$caller}{"Set::Scalar"}++ ) { + require Set::Scalar; + } + Set::Scalar->new( @_ ); + }, + ###################################### # Files Convenience ###################################### @@ -662,15 +750,19 @@ sub import { # issues with next say() if still closed: # "say() on closed filehandle STDOUT" if ( !-t STDOUT ) { - open my $tty, ">", "/dev/tty" or die $!; - caller->can( "utf8" )->( $tty ); # Method now in caller. - CORE::say $tty @args; - close $tty; + if ( open my $tty, ">", "/dev/tty" ) { + caller->can( "utf8" )->( $tty ); # Method now in caller. + my $prefix = + caller->can( "dye" )->( "no-stdout: ", "CYAN" ); + CORE::say( $tty $prefix, @args ); + close $tty; + } } # Send to output incase something expects it there. - caller->can( "utf8" ); - CORE::say @args; + caller->can( "utf8" )->(); + CORE::say( @args ); + }, # Pretty Print. @@ -735,7 +827,7 @@ sub import { my @lines = Term::Table->new( header => $header, rows => \@rows, - sanitize => 0, # To not show \n + sanitize => 0, # To not show \n )->render; return @lines if wantarray; @@ -753,10 +845,10 @@ sub import { if ( !$imported{$caller}{"Mojo::UserAgent"}++ ) { require Mojo::UserAgent; } - my $UA = Mojo::UserAgent->new; - $UA->max_redirects( 10 ) unless defined $ENV{MOJO_MAX_REDIRECTS}; - $UA->proxy->detect unless defined $ENV{MOJO_PROXY}; - $UA->get( @_ )->result; + my $ua = Mojo::UserAgent->new; + $ua->max_redirects( 10 ) unless defined $ENV{MOJO_MAX_REDIRECTS}; + $ua->proxy->detect unless defined $ENV{MOJO_PROXY}; + $ua->get( @_ )->result; }, # URL. diff --git a/t/01-simple.t b/t/01-simple.t index 5d69e9a..1902c06 100644 --- a/t/01-simple.t +++ b/t/01-simple.t @@ -17,6 +17,8 @@ sub run { eval { shift->() }; } + $out .= $@ if $@; + $out; } @@ -148,6 +150,81 @@ is_deeply [ 1, 2, 3 ], "c - uniq"; +# Set - Unique. +is + run( sub { print set( 2, 4, 6, 4 ) } ), + "(2 4 6)", + "set unique"; + +# Clear a new universe to not interfere with above. +Set::Scalar::Universe->new->enter; + +# Set Object. +my $a = set( qw( a b c d e ) ); +my $b = set( qw( c d e f g ) ); +my $c = set( qw( e f g h i ) ); + +# Set - Union. +is + run( sub { print $a + $b } ), + "(a b c d e f g)", + "set union: a + b"; +is + run( sub { print $a + $b + $c } ), + "(a b c d e f g h i)", + "set union: a + b + c"; + +# Set - Intersection. +is + run( sub { print $a * $b } ), + "(c d e)", + "set intersection: a * b"; +is + run( sub { print $a * $b * $c } ), + "(e)", + "set intersection: a * b * c"; + +# Set - Difference. +is + run( sub { print $a - $b } ), + "(a b)", + "set difference: a - b"; +is + run( sub { print $a - $b - $c } ), + "(a b)", + "set difference: a - b - c"; + +# Set - Symmetric Difference. +is + run( sub { print $a % $b } ), + "(a b f g)", + "set symmetric difference: a % b"; +is + run( sub { print $a % $b % $c } ), + "(a b e h i)", + "set symmetric difference: a % b % c"; + +# Set - Unique. +is + run( sub { print $a / $b } ), + "(a b f g)", + "set unique: a / b"; +is + run( sub { print $a / $b / $c } ), + "(a b e h i)", + "set unique: a / b / c"; + +# Set - Complement. +is + run( sub { print -$a } ), + "(f g h i)", + "set complement: -a"; +is + run( sub { print -$b } ), + "(a b h i)", + "set complement: -b"; + + ###################################### # Files Convenience ###################################### @@ -162,6 +239,22 @@ is # Output ###################################### +# Say +is + run( sub { say 11 } ), + "11\n", + "say - scalar"; + +is + run( sub { say 11, 22 } ), + "1122\n", + "say - array"; + +is + run( sub { say for 1, 2, 3 } ), + "1\n2\n3\n", + "say - void (default var)"; + # Table { my @lines = ( [qw(key value)], [qw(red 111)], [qw(blue 222)] );