App-Cheats
1 match

 view release on metacpan or  search on metacpan

cheats.txt  view on Meta::CPAN 

# Shared and non shared variables example
perl -lMthreads -Mthreads::shared -le '$a=$b=1; share($a); async(sub{$a++; $b++})->join; print "a=$a, b=$b"'

# Thread pitfall. $a can be either 2 or 3 (race condition)
perl -lMthreads -Mthreads::shared -le '$a=1; share($a); $_->join for map async(sub{my $foo=$a; $a=$foo+1}), 1..2; print "a=$a"'

# Allow only one thread to touch a variable at a time
# This will cause a "deadlock" where one thread requires a reourses
# locked by another thread and vice versa
perl -Mthreads -Mthreads::shared -le 'share $a; share $b; push @t, async(sub{lock $a; sleep 20; lock $b}); push @t, async(sub{lock $b; sleep 20; lock $a}); $_->join for @t'
#
# Alternate syntax 1
perl -Mthreads -le 'my $a :shared; my $b :shared; push @t, async(sub{lock $a; sleep 20; lock $b}); push @t, async(sub{lock $b; sleep 20; lock $a}); $_->join for @t'
#
# Alternate syntax 2
perl -Mthreads -le 'my $a :shared; my $b :shared; push @t, threads->create(sub{lock $a; sleep 20; lock $b}); push @t, threads->create(sub{lock $b; sleep 20; lock $a}); $_->join for @t'

# Thread safe queues. Passing data around
perl -Mthreads -MThread::Queue -le 'my $q=Thread::Queue->new; $t=async(sub{ print "Popped $d off the queue" while $d=$q->dequeue  }); $q->enqueue(12); $q->enqueue(qw/A B C/); sleep 1; $q->enqueue(undef); $t->join'

# Thread safe queues. Passing complex data around
perl -Mthreads -MThread::Queue -le 'my $q=Thread::Queue->new; $t=async(sub{ print "Popped @$d off the queue" while $d=$q->dequeue  }); $q->enqueue([1..3]); $q->enqueue([qw/A B C/]); sleep 1; $q->enqueue(undef); $t->join'

# Compute pi using parallel threading
time perl -Mthreads -Mthreads::shared -le 'share $sum; $M=100_000_000; $T=6; $h=1/$M; sub sum { my $s; my($from,$to)=@_; for($from..$to){ my $x=$h*($_-0.5); $s += 4/(1+$x**2)}; $s } sub split_by { my($max,$by)=@_; my $from=1; my @l; while($to<$max){ ...


#############################################################
## Perl Modules - CAM::PDF
#############################################################

# Example getting title fields from a pdf.
use CAM::PDF;
use e;
my $infile   = shift or die "\nSyntax: perl fill:pdf.pl my.pdf\n";
(my $outfile = $infile) =~ s/(?=\.pdf)/_filled/i;
my $doc      = CAM::PDF->new($infile) or die "$CAM::PDF::errstr\n";
say "Titles of the fields:";
p [$doc->getFormFieldList];
say "Adding new field values";
$doc->fillFormFields(
   Start_Date => "Value 1",
   Closed_Date => "Value 2",
   Closed_By => "Value 3",
);
say "saving new file";
$doc->cleanoutput($outfile);


#############################################################
## Perl Modules - Carp
#############################################################

# Show a stack trace in perl.
perl -MCarp=longmess -E 'sub fun1{ fun2("TO FUN2") } sub fun2{ say longmess } fun1("TO FUN1")'

# Show a stack trace in perl. (Carp uses a similar approach).
# @DB::args is set (for a scope) when this command is run (some magic).
{
   package DB;
   my @caller = caller($scope);
   () = caller($scope);             # Same thing (to invoke LIST context).
}
perl -E 'sub fun1{ fun2("TO FUN2") } sub fun2{ my $scope = 0; while(my @caller = caller($scope)){ {package DB; () = caller($scope)} say "@caller[1,2,3,4] - (@DB::args)"; $scope++ }} fun1("TO FUN1")'


#############################################################
## Perl Modules - Carton
#############################################################

# Keep track of the installed modules in a local directory by making a
# virtual environment. Like virtualenv and requirements.txt, but for Perl.
cpanm Carton

# Perl install modules found in cpanfile
carton install

# Perl zip modules found in cpanfile
carton bundle


#############################################################
## Perl Modules - CGI
#############################################################

# Make html ordered lists from array lists
perl -MCGI=ol,li -le 'print ol(li([qw/red blue green/]))'
perl -MCGI=ol,li -le 'print ol(li [qw/red blue green/])'
perl -MCGI=ol,li -le 'print ol li [qw/red blue green/]'

# Generate a sample html page
perl -MCGI=:standard,:html3 -le 'print header(),start_html(),ol(li [qw/red blue green/]),end_html()' > my.html
perl -MCGI=:standard,:html3 -le 'print header(),start_html(),td(Tr [qw/red blue green/]),end_html()' > my2.html


#############################################################
## Perl Modules - Class::Tiny
#############################################################

# Alternate to Mojo::Base has.
perl -Mojo -E '{ package A; use Class::Tiny qw(name age color); sub new { bless {}, shift } } my $obj = A->new; $obj->name("bob"); $obj->color("blue"); say r $obj'
bless( {
  "color" => "blue",
  "name" => "bob"
}, 'A' )


#############################################################
## Perl Modules - Crypt::JWT
#############################################################

# Example of encoding using JWT.
perl -MCrypt::JWT=encode_jwt -E '$token = encode_jwt(payload=> "hello jwt", alg=>"HS256", key=>"mypass"); say $token'
eyJhbGciOiJIUzI1NiJ9.aGVsbG8gand0.UMNFghYANKBBnAbLgTVe26QEyPFLwPMbb7piDSRYNBQ

# Example of decoding using JWT.
perl -MCrypt::JWT=encode_jwt,decode_jwt -E '$token = encode_jwt(payload=> "hello jwt", alg=>"HS256", key=>"mypass"); say decode_jwt(token => $token, key => "mypass" )'
HMAC Integrity check
  - key:  [mypass]
$X4]hmac: [PÃE4 AË5^Û¤ÈñKÀóºb
hello jwt


#############################################################

cheats.txt  view on Meta::CPAN 


# Create a deep clone of a reference.
perl -MStorable=dclone -E 'my $h={a => [1..2]}; my $h2 = dclone($h); say $_, " ", $_->{a} for $h, $h2'

# Storable error: Max. recursion depth with nested structures exceeded
# Can update the Storable recursion limit with:
$Storable::recursion_limit = 10000;
$Storable::recursion_limit = -1;    # Disables all limits.
#
# Create a heavily nested structure.
perl -Me -e '$d = [$d] for 1..1000000; clone $d'
Max. recursion depth with nested structures exceeded at -e line 1.
#
# Its about depth. This is ok:
perl -MStorable=dclone -e '$Storable::recursion_limit = 2; dclone( [ [ ], [], [], [] ] )'
#
# Whereas, this one is not:
perl -MStorable=dclone -e '$Storable::recursion_limit = 2; dclone( [ [ [] ] ] )'
Max. recursion depth with nested structures exceeded at -e line 1.

# Storable recursion limit seems to be about depth, not size, and not accumulative depth:
perl -MStorable=dclone -e '$Storable::recursion_limit = 3; dclone( [ [ [] ], [ 111, [222] ], [ [ 333, 444] ], [ [ 555, 666 ], [ 777, 888 ], { aaa => 999 }, [], [], [], [], [] ], [], 111 ], )'

# Simple server using perl Socket module.
use Socket;
my ($socket,$new_socket);
my $port        = 171717;
my $address     = 'localhost';
my $MAX_CONN    = 10;
my $packed_addr = pack_sockaddr_in(
    $port, inet_aton($address),
);
my $client_addr;
socket $socket, AF_INET, SOCK_STREAM, 0;
bind $socket, $packed_addr or die $!;
setsockopt $socket, SOL_SOCKET, SO_REUSEADDR, 1 or die $!;
listen $socket, $MAX_CONN or die $!;
print "Listening on port=$port, address=$address";
while($client_addr = accept $new_socket, $socket)
{
   my $name = gethostbyaddr $client_addr, AF_INET;
   print "Someone connected ($name)";
   print $new_socket "I'm from the Server";
   print $new_socket "I'm from the Server 2";
   close $new_socket;
}


#############################################################
## Perl Modules - Subs::Trace
#############################################################

# WhoAmI to all functions in a class.
+ #!/usr/bin/perl
+
+ package Subs::Trace;
+
+ use v5.32;
+
+ sub import {
+   my $pkg = caller();
+
+   INIT {
+     no strict 'refs';
+
+     for my $func (sort keys %{"${pkg}::"}) {
+         my $code = ${"${pkg}::"}{$func}->*{CODE};
+         next if not $code;
+
+         ${"${pkg}::"}{$func}->** = sub {
+             say "-> $pkg\::$func";
+             &$code;
+         }
+     }
+   }
+ }
+
+
+ 1

# Subs::Trace use case (example)
perl -I. -E '{ package P; use Subs::Trace; sub F1{10} sub F2{20} } say P::F1() + P::F2()'

# Subs::Trace cpan modules.
cpanm Subs::Trace
perl -E '{ package P; sub F1{10} sub F2{20} sub F4{40} use Subs::Trace; sub F3{30} } say P::F1() + P::F2() + P::F3() + P::F4()'
-> P::F1
-> P::F2
-> P::F4
100


#############################################################
## Perl Modules - Template (Toolkit,tt)
#############################################################

# Concatenation operator in template tookkit (tt)
Data.var1 _ Data.var2

# Compare |html and |uri:
perl -MTemplate -E 'my $out; Template->new->process( \("[% id | html %]"), { id => "has & and spaces" }, \$out); say $out'
has &amp; and spaces
#
perl -MTemplate -E 'my $out; Template->new->process( \("[% id | uri %]"), { id => "has & and spaces" }, \$out); say $out'
has%20%26%20and%20spaces


#############################################################
## Perl Modules - Term::Animation
#############################################################

# Using a terminal animation framework
perl -MTerm::Animation -MCurses -E 'use v5.32; my $anim = Term::Animation->new; halfdelay(2); $anim->new_entity(shape => "<=0=>", position => [3,7,10], callback_args => [1,0,0,0], wrap => 1); while(1){ $anim->animate; my $in = getch(); last if $in eq...

# Using a terminal animation framework (with colors)
perl -MTerm::Animation -MCurses -E 'use v5.32; my $anim = Term::Animation->new; halfdelay(1); $anim->color(1); $anim->new_entity(shape => "<=0=>", position => [3,7,10], callback_args => [1,0,0,0], wrap => 1, default_color => "yellow"); while(1){ $ani...


#############################################################
## Perl Modules - Term::ANSIColor
#############################################################

cheats.txt  view on Meta::CPAN 

# Perl Modules - Text::ParseWords example.
sub get_file_data{
	use Text::ParseWords;
	map{chomp; [quotewords('\s+', 1, $_)]} <DATA>;
}


#############################################################
## Perl Modules - Tie::Array
#############################################################

# Tie a simple array variable
perl -MData::Dumper -MTie::Array -le 'tie @a, "Tie::StdArray"; @a=(1,3,4); print Dumper tied @a'


#############################################################
## Perl Modules - Tie::File
#############################################################

# Tie an array to a file
perl -MTie::File -le 'tie @file,"Tie::File","array.pl"; print $file[4]'


#############################################################
## Perl Modules - Tie::Hash
#############################################################

# Tie a simple hash variable
perl -MData::Dumper -MTie::Hash -le 'tie %h, "Tie::StdHash"; $h{age}=123; print Dumper tied %h'

# Tie append hash example.
package Tie::AppendHash;   
use Tie::Hash;   
our @ISA = qw(Tie::StdHash);   
sub STORE {       
    my ($self, $key, $value) = @_;       
    push @{$self->{$key}}, $value;   
}  


#############################################################
## Perl Modules - Tie::Scalar
#############################################################

# Tie a simple scalar variable
perl -MData::Dumper -MTie::Scalar -le 'tie $n, "Tie::StdScalar"; $n=5; print Dumper tied $n'
perl -Me -MTie::Scalar -e 'my $obj = tie $var, "Tie::StdScalar"; $var=5; p $var; p $obj'

# Tie to scalar (without template)
perl -le '{package P; sub TIESCALAR{my($c,$o)=@_; bless \$o,$c} sub FETCH{my($s)=@_; $$s} sub STORE{my($s,$v)=@_; $$s = $v} } tie $var, "P", 123; print $var; $var=42; print $var'


#############################################################
## Perl Modules - Tie::Watch
#############################################################

# Tie Watch. OOP interface that hides making packages for tied variables
perl -MTie::Watch -le 'my $v=1; Tie::Watch->new(-variable => \$v, -fetch => sub{my $s=shift; $v=$s->Fetch; $s->Store($v+1); $v}); print $v; print $v; print $v'

# Check when a variable is updated. (watcher)
perl -MTie::Watch -Mojo -le 'my $h={a => [1..2]}; say r $h; Tie::Watch->new( -variable => \$h->{a}, -store => sub{my ($s,$v) = @_; $s->Store($v); my $Scope = 0; while( my ($Pkg,$Line) = caller(++$Scope) ){ say "$Pkg:$Line" } }); sub func{$h->{a}=456}...

# Check when a variable is updated. (watcher)
use Tie::Watch;
Tie::Watch->new(
   -variable => \$Self->{Cache}->{ $Param{Type} }->{ $Param{Key} },
   -store    => sub{
       my ($S,$Value) = @_;
       $S->Store($Value);
       my $Scope = 0;
       my $Limit = 5;
       while( my ($Package,$Line) = (caller(++$Scope))[0,2] ){
          next if $Package =~ /\ATie::/;
          say "* Store: $Package line $Line";
          last if $Scope >= $Limit;
       }
   },
);

# Problem using Tie::Watch with Storable::dclone.
perl -MData::Tie::Watch -MStorable -e '$data = {}; $obj = Data::Tie::Watch->new( -variable => $data ); Storable::dclone($data)'
perl -MData::Tie::Watch -MStorable -e '$data = 111; $obj = Data::Tie::Watch->new( -variable => \$data ); Storable::dclone(\$data)'
Can't store CODE items at -e line 1.

# Sample test code.
perl -Me -Ilib -MData::Tie::Watch -e '{ my $data = []; Data::Tie::Watch->new( -variable => $data ); my $d2 = {}; Data::Tie::Watch->new( -variable => $d2 ); } say "DONE"'
perl -Me -Ilib -MData::Trace -e '{ my $d1 = []; my $d2 = {}; Trace($d1); Trace($d2); $d1->[2] = 22; $d2->{cat} = 1 } say "DONE"; use Data::Tie::Watch; p \%Data::Tie::Watch::METHODS'


#############################################################
## Perl Modules - Time::HiRes
#############################################################

# Perl Modules - Time::HiRes
# Higher resolution sleeps.
perl -MTime::HiRes=sleep -E 'sleep 0.25 and say "sleeping" while 1'


#############################################################
## Perl Modules - Time::Moment
#############################################################

# Difference between with_offset_same_instant and with_offset_same_local.
# Instant form will use the time zone from the object (Probably what you want).
perl -MTime::Moment -E '$tm = Time::Moment->now; $tmi = $tm->with_offset_same_instant(0); $tml = $tm->with_offset_same_local(0); say "Normal:   $tm"; say "Instance: $tmi"; say "Local:    $tml"'
# Normal:   2022-03-10T18:44:46.882016+01:00
# Instance: 2022-03-10T17:44:46.882016Z
# Local:    2022-03-10T18:44:46.882016Z

# Timestamp using milliseconds.
perl -MTime::Moment -E 'say Time::Moment->now->strftime("%Y/%m/%d-%T%3f")'


#############################################################
## Perl Modules - Time::Piece
#############################################################

# Prefer using Time::Piece over DateTime if possible
#
# 1. Less dependencies:
cpanm --showdeps Time::Piece -q | wc -l   # 4
cpanm --showdeps DateTime -q | wc -l      # 35
#
# 2. Issues with using DateTime and cron.
# Could be due to also perlbrew trying a different
# library path (which I could not resolve).

# Print the currect time, the inputed time, and difference in seconds (accounts for timezone offset)
perl -MTime::Piece -le '$now=localtime; $t=Time::Piece->strptime("20170320 095200 -0400","%Y%m%d %H%M%S %z"); print $_->strftime," ",$_->tzoffset for $now,$t; print $now-$t'

# Compare the current time to a string (desired). Accounts for time zone
perl -MTime::Piece -le '$now=localtime; $now+=$now->tzoffset; print $now;  $t=Time::Piece->strptime("Mon Apr 17 14:36:02 2017","%a %b %d %H:%M:%S %Y"); print $now-$t'

cheats.txt  view on Meta::CPAN 


# Ubuntu prevent auto suspend when closing the lid.
sudo apt install gnome-tweaks
# Start Tweaks -> General


#############################################################
## Ubuntu - X-Server
#############################################################

# On Ubuntu there are 2 X-Servers available during login:
   - Wayland
   - Xorg
# Wayland is newer and to use screen sharing (share,jitsi) in
   chrome enable this:
chrome://flags/#enable-webrtc-pipewire-capturer
# Xorg should be avoided since it can cause a black screen on lock screen
   (at least if an extra monitor is connected).


#############################################################
## Ubuntu - Desktop/Tasklist App
#############################################################

# Sample .desktop file to add xair as a favorite program.
cat xair.desktop
[Desktop Entry]
Encoding=UTF-8
Version=1.0
Type=Application
Name=XAIR
# If file name is to be renamed, also probably need to update this class,
# (as is done now).
# Run:
#   xprop WM_CLASS      # WM_CLASS(STRING) = "X-AIR-Edit", "X-AIR-Edit"
StartupWMClass=X-AIR-Edit
Exec=/home/tim/git/xair/software/latest/RUN.sh
Icon=/home/tim/git/xair/software/latest/xair.png


#############################################################
## VBA Regex
#############################################################

# Regex for validating input on database
cat data | add_color -r '(?x) ^ (?! ^( (ALLENGINES|ASAPPLICABLE|PW\d+\w+-?\w+)(,|$))+ ((Except:)? (\d{6}-\d{6}|\d{6}) (,|$) )* $ ) .*'


#############################################################
## Vim Strings
#############################################################

# Example of using a multiline string in Vim
#
+ " Perl Data Dumper and other useful features all in one mapping.
+ function PerlDev()
+    let l:PERL_DEV = "
+       \\nuse v5.32;
+       \\nuse Mojo::Util qw(dumper);
+       \\nuse Carp       qw( croak confess carp cluck );
+       \\nsub WhoAmI { say '--> ' . (caller(1))[3] }
+       \\nsay 'var: ', dumper $var;
+       \\n$Self->HandleException('message'); # New    - Test/*
+       \\n$Selenium->HandleError('message'); # Legacy - script/*
+       \\n
+       \\n"
+
+    put =l:PERL_DEV
+ endfunction
+
+ nnoremap <leader>r :call PerlDev()<CR>


#############################################################
## Vim Quitting
#############################################################

# Exit, saving changes (Vim)
:x

# Exit as long as there have been no changes (Vim)
:q

# Exit and save changes if any have been made (Vim)
ZZ

# Exit and ignore any changes (Vim)
:q!


#############################################################
## Vim Variables
#############################################################

# Do substitution on a string or variable (vim)
let new_variable s = ubstitute("My::Long::Package", "::", "/", "g")
let old_variable = "My::Long::Package"
let new_variable = substitute(old_variable, "::", "/", "g")

# Check if a string or variable contains a pattern (vim)
echo "My::Package" =~ "::"       # 1
let var = "My::Package"
if var =~ "::"
   echo "Got a perl package"
endif


#############################################################
## Vim File Operations
#############################################################

# Check if a file is readable (vim,exists)
if filereadable(l:filename) == 1
   execute "edit" l:filename
else
   echohl WarningMsg | echo "File does not exist: " . l:filename | echohl None
endif


#############################################################
## Vim Funtions



( run in 1.428 second using v1.01-cache-2.11-cpan-ff9377addf4 )