App-Cheats
view release on metacpan or search on metacpan
}
# Perl Hash noop.
# There is one additional caveat that didn’t apply to
# square brackets. Since braces are also used for
# several other things (including blocks), you may
# occasionally have to disambiguate braces at the
# beginning of a statement by putting a + or a
# return in front, so that Perl realizes the opening
# brace isn’t starting a block. For example, if you
# want a function to make a new hash and return a
# reference to it, you have these options:
sub hashem { { @_ } } # Silently WRONG — returns @_.
sub hashem { +{ @_ } } # Ok.
sub hashem { return { @_ } } # Ok.
#############################################################
## Perl Inplace Edit
#############################################################
# Print attempted change of Shebang line
perl -ple 's{^#!.*$}{#!/usr/bin/perl}' my_file
# Change Shebang line of file (without making a backup)
perl -i -ple 's{^#!.*$}{#!/usr/bin/perl}' my_file
# Change Shebang line of file (and backup the file in the same directory)
perl -i'.bak' -ple 's{^#!.*$}{#!/usr/bin/perl}' my_file
# Change Shebang line of file (and backup the file in another directory)
perl -i'Backup/*.bak' -ple 's{^#!.*$}{#!/usr/bin/perl}' my_file
# Change comment indentation for a file to 60 (some reason need to subtract 1 from the desired amount)
perl -i'.bak' -lpe 's/^(\s*+[^#]+?)\s*(#+.*$)/sprintf "%-59s %s",$1,$2/e' my_file
# Customizable inplace editing (only when desired). Undef disables inplace editing
perl -le 'local $^I = ($run == 1) ? "bak_*" : undef'
# Apply export markings to many files
#
# Goal
sed -i -e '1 e cat export.txt' hpcclr_bore.ada
#
# Only if a single line in files
perl -i -lpe 'INIT{$m=shift; $m=`cat $m`} print "$m"' marking.txt file*
#
# Too long
perl -i -lne 'INIT{$m=`cat marking.txt`} print "$m" if $. == 1; close ARGV if eof; print' file*
#
# Slurps entire file
perl -i -lp0777e 'INIT{$m=`cat marking.txt`} print "$m"' file*
#
# Many system calls
perl -i -0pe 's/^/`cat marking.txt`/e' file1 file2
#
# Cached file content (seems to be like slurp mode)
perl -i -0pe 'INIT{$m=`cat marking.txt`} print $m' file1 file2
# GS2 par.txt into a data structure that can be evaled later
cat par.txt | perl -MData::Dumper -ln00e 'next if /^-/; my($t,@c)=split "\n"; $h{$t}=\@c }{ $d=Data::Dumper->new([\%h]); print $d->Terse(1)->Indent(1)->Deparse(1)->Purity(1)->Sortkeys(1)->Dump' > C
#############################################################
## Perl Math
#############################################################
# solve for 12x + 15y + 16z = 281 (perl,regex)
# maximizing x
local $_ = 'a' x 281;
my $r = qr{^
(a*)\1{11}
(a*)\2{14}
(a*)\3{15}
$}x;
printf "x=%i y=%i z=%i\n",
map{length}/$r/;
__END__
x=17 y=3 z=2
# Solve an algebra problem. get all solutions to: 3x + 4y + 5z = 100
perl -lE '("a"x100) =~ /^(a*)\1{2}(a*)\2{3}(a*)\3{4}$(?{ printf "3x+4y+5z=100 (x=%s,y=%s,z=%s)\n", map{length}($1,$2,$3) })(*F)/'
# Solve an algebra problem. get all solutions to: 3x + 4y + 5z = 20
perl -lE '("a"x20) =~ /^(a*)\1{2}(a*)\2{3}(a*)\3{4}$(?{ printf "3x+4y+5z=20 (x=%s,y=%s,z=%s)\n", map{length}($1,$2,$3) })(*F)/'
# View all the permutations of a list (List::Permutor)
perl -le '@a=qw(a b c); @rv=(0..$#a); sub n{@ret=@a[@rv]; @h=@rv; @t=pop @h; push @t,pop @h while @h and $h[-1]>$t[-1]; if(@h){ $x=pop @h; ($p)=grep{$x<$t[$_]}0..$#t; ($x,$t[$p])=($t[$p],$x); @rv=(@h,$x,@t) }else{ @rv=() } @ret} print "@n" while @n=n...
# Find the prime numbers
#
# Generate numbers
n=`perl -le 'print for 1..100'`
#
# Simple and incomplete (will report 0 and 1 as prime. they are not prime by definition)
echo "$n" | perl -nle 'sub is_prime{("N" x shift) !~ /^ (NN+?) \1+ $/x} print if is_prime($_)'
#
# Disallow 0 and 1
echo "$n" | perl -nle 'sub is_prime{("N" x shift) !~ /^ N? $ | ^ (NN+?) \1+ $/x} print if is_prime($_)'
echo "$n" | perl -nle 'sub is_prime{("N" x shift) !~ /^(?:N?|(NN+?)\1+)$/} print if is_prime($_)'
#
# "N" to 1
echo "$n" | perl -nle 'sub is_prime{(1 x shift) !~ /^ 1? $ | ^ (11+?) \1+ $/x} print if is_prime($_)'
echo "$n" | perl -nle 'sub is_prime{(1 x shift) !~ /^1?$|^(11+?)\1+$/} print if is_prime($_)'
echo "$n" | perl -nle 'sub is_prime{(1 x shift) !~ /^(?:1?|(11+?)\1+)$/} print if is_prime($_)'
#
# Deparse commands
echo "$n" | perl -MO=Deparse -nle 'sub is_prime{("N" x shift) !~ /^ (NN+?) \1+ $/x} print if is_prime($_)'
#
# Debug Regex 1
echo "$n" | perl -nle 'sub is_prime{($n)=@_; ("N" x $n) !~ /^ (NN+?) (?{ print "Trying: $n. Grouping by: $^N" }) \1+ $/x} is_prime($_); print ""'
#
# Debug Regex 2
echo "$n" | perl -Mre=debug -nle 'sub is_prime{("N" x shift) !~ /^ (NN+?) \1+ $/x} print if is_prime($_)'
# Calculate pi using the formula:
# pi = SUMMATION(x:0.5 to 0.5): 4 / (1 + x^2)
perl -le '$int = 5; $h = 1/$int; for m^C$i(1..$int){ my $x = $h * ($i - 0.5); $sum += 4 / (1 + $x**2) }; $pi = $h * $sum; print $pi'
# Example of having true value that is numerically 0.
# Documented in: perldoc perlfunc
ABC
# Perl regex verb - MARK,SKIP
perl -E '"123ABC456" =~ / 123 (*MARK:past_digits) [A-Z]+ (*SKIP) 9.. | .* /x; say $&'
456
perl -E '"123ABC456" =~ / 123 (*MARK:past_digits) [A-Z]+ (*SKIP:past_digits) 9.. | .* /x; say $&'
ABC456
# Perl regex verb - MARK
perl -E '"1x2" =~ /(?:x(*MARK:x)|y(*MARK:y)|z(*MARK:z))/; say $^N'
perl -E '"1x2" =~ /(?:x(*MARK:mx)|y(*MARK:my)|z(*MARK:mz))/; say $REGMARK'
# Use atomic script runs to prevent named attacks. (paypal.com,perl regex verb ASR)
perl -C -E 'say "\N{CYRILLIC SMALL LETTER ER}aypal.com" =~ /^\w+\.com$/' # 1
perl -C -E 'say "\N{CYRILLIC SMALL LETTER ER}aypal.com" =~ /(*asr:^\w+\.com$)/' # 0
# Control verb: FAIL versus split.
perl -Me -e 'n { split => sub{ my %c; $c{lc($_)}++ for split("", "supercalifragilisticexpialidocious") }, fail => sub { my %c; "supercalifragilisticexpialidocious" =~ /([aeiou])(?{ $c{$1}++; })(*FAIL)/i } }, 1000000'
Rate fail split
fail 114679/s -- -17%
split 137741/s 20% --
#############################################################
## Perl Regular Expressions - Word Boundary
#############################################################
# Normal word boundary.
perl -E "say for q(Tim's favorite candy) =~ /(\b\w.*?\b)/g"
Tim
s
favorite
candy
# More precise and newer word boundary.
# Available from v5.22.
# https://perldoc.perl.org/perlrebackslash#%5Cb%7B%7D%2C-%5Cb%2C-%5CB%7B%7D%2C-%5CB
perl -E "say for q(Tim's favorite candy) =~ /(\b{wb}\w.*?\b{wb})/g"
Tim's
favorite
candy
# More precise and newer word boundary.
# Only with word like characters
# (not double quotes).
perl -E 'say for q(Tim"s favorite candy) =~ /(\b{wb}\w.*?\b{wb})/g'
Tim
s
favorite
candy
#############################################################
## Perl Signal Handling
#############################################################
# Catch Control-C
perl -lE '$SIG{INT}=sub{die "\n\nYou hit control C\n\n"}; say "Press Enter" and <> while 1'
# Assign many signal handlers
perl -MData::Dumper -lE 'sub pr{my $d=Data::Dumper->new(\@_)->Purity(1); say $d->Dump} $SIG{INT}=sub{die"\nINT\n"}; $SIG{QUIT}=sub{die"\nQUIT\n"}; $SIG{TERM}=sub{die"\nTERM\n"}; $SIG{PIPE}=sub{die"\nPIPE\n"}; $SIG{ALRM}=sub{die"\nALRM\n"}; $SIG{HUP}...
# Assign many signal handlers
perl -MData::Dumper -le 'sub pr{print Data::Dumper->new(\@_)->Deparse(1)->Dump} for my $s(qw/INT QUIT TERM PIPE ALRM HUP CHLD __WARN__ __DIE__/){ $SIG{$s} = sub{die"\n$s\n"}} pr \%SIG; <> while 1'
perl -MData::Dumper -le 'sub pr{print Data::Dumper->new(\@_)->Deparse(1)->Dump} for my $s(keys %SIG){ $SIG{$s} = sub{print "\n$s\n"}} pr \%SIG; print $$; <> while 1'
# Alarm signal handler
perl -le 'for my $s(qw/INT QUIT TERM PIPE ALRM HUP CHLD/){ $SIG{$s} = sub{die"\n$s\n"}} alarm 2; <> while 1'
perl -le '$SIG{ALRM}=sub{die"\n\nEND OF TIME\n\n"}; alarm 1; <> while 1'
# Perl signal handling (eval,die,exit)
perl -E 'eval { exit 1 }; say $@; say "here"' # Blank
perl -E 'eval { exit 0 }; say $@; say "here"' # Same
perl -E 'eval { return 1 }; say $@; say "here"' # Return early from an eval. ürints "here"
perl -E 'eval { die }; say $@; say "here"' # caught die, prints "here"
perl -E 'eval { exit 1 }; say $@; END {say "here"}' # Run before final exit. prints "here"
perl -E 'eval { die }; say $@; END {say "here"}' # Same.
perl -E 'open FH, ">", "file"; say FH "123"; exit 1' # File closed and contains "123"
# Perl signal handling (eval,die,exit)
# Avoid using $SIG{__DIE__}
https://www.perlmonks.org/?node_id=1173708
perl -E '$SIG{__DIE__} = sub { say "caught die!" }; die; say $@; say "here"'
# Perl signal handling (eval,die,exit)
# Catch exit command.
perl -E 'BEGIN{ *CORE::GLOBAL::exit = sub(;$){die "EXIT_OVERRIDE: @_\n"} } eval { exit 1 }; print "caught error: $@" if $@; say "here"; exit 0'
# Perl signal handling (eval,die,exit)
# exit overrite snippet. Plus capture all signals.
# exit overrite snippet. Plus capture all signals.
our $ExitOverride = 1;
BEGIN {
*CORE::GLOBAL::exit = sub {
die "EXIT_OVERRIDE:Caught: @_\n" if $ExitOverride;
CORE::exit(@_);
};
}
local %SIG = %SIG;
KEY:
for my $Key ( sort keys %SIG ) {
next KEY if $Key eq 'CHLD';
next KEY if $Key eq 'CLD';
next KEY if $Key eq '__DIE__';
next KEY if $Key eq '__WARN__';
$SIG{$Key} = sub { die $Key }; ## no critic
}
#
# RUN CODE HERE
#
$ExitOverride = 0;
# Perl signal handling (eval,die,__DIE__)
# Capture STDOUT and STDERR.
# Catch die and throw to STDOUT.
perl -MApp::Pod -E '{ local *STDOUT; open STDOUT, ">", \$out or die $!; local *STDERR; open STDERR, ">>", \$err or die $!; print "print-out"; print STDERR "print-err"; local $SIG{__DIE__} = sub{ my $m = shift; chomp $m; print STDERR "<$m>" }; eval{di...
#
# Use $@ to capture eval error.
# Better than SIG{__DIE__} since sub calls may except an die
# to stop something, like Pod::Simple, which is used by Pod::LOL).
perl -Ilib -MApp::Pod -E '{ local *STDOUT; open STDOUT, ">", \$out or die $!; local *STDERR; open STDERR, ">>", \$err or die $!; print "print-out"; print STDERR "print-err"; eval{die "die\n"}; print STDERR "<$@>" if $@; print "print-out2" } say "\n[$...
# Redirect to terminal even when STDOUT and/STDERR are sent somewhere else.
perl -E 'open my $fh, ">", "/dev/tty" or die $!; close *STDOUT; say $fh "111"; say "HERE"; say $fh "123";'
111
#############################################################
## Perl Modules - DateTime
#############################################################
# Create expiration dates (Start of tomorrow,start of next week)
perl -MDateTime -E '$dt = DateTime->now; say $dt->add(days => 1)->truncate(to => "day" )'
# 2021-08-06T00:00:00
perl -MDateTime -E '$dt = DateTime->now; say $dt->add(weeks => 1)->truncate(to => "local_week" )'
# 2021-08-08T00:00:00
# Truncate date to start of this week (Monday).
perl -MDateTime -E '$dt = DateTime->now; say $dt->truncate(to => "week" )->strftime("%e %b %Y")'
# Truncate date to end of 3 weeks from now on a Friday.
perl -MDateTime -E '$dt = DateTime->now; say $dt->truncate(to => "week" )->add(weeks => 3, days => 4)->strftime("%e %b %Y")'
#############################################################
## Perl Modules - Data::DPath
#############################################################
# Recurse through a data structure and print matches.
perl -MData::DPath -Mojo -E 'my $data = {a => [0, {complex => 1}]}; say "\nBefore:"; say r $data; for my $node ( grep {ref} Data::DPath->match($data, "//") ){ say "Tying: $node: " . r $node}'
#
# Before:
# {
# "a" => [
# 0,
# {
# "complex" => 1
# }
# ]
# }
#
# Tying: ARRAY(0xb400007e98818a28): [
# 0,
# {
# "complex" => 1
# }
# ]
#
# Tying: HASH(0xb400007e98818698): {
# "complex" => 1
# }
#
# Tying: HASH(0xb400007e988291f0): {
# "a" => [
# 0,
# {
# "complex" => 1
# }
# ]
# }
# Show where a complex data structure is being updated.
perl -MData::DPath -MCarp=longmess -MTie::Watch -Mojo -E 'my $data = {a => [0, {complex => 1}]}; say "\nBefore:"; say r $data; for my $node ( grep {ref} Data::DPath->match($data, "//") ){ say "Tying: $node"; Tie::Watch->new( -variable => $node, -stor...
#############################################################
## Perl Modules - Data::Dumper
#############################################################
# Deparse a subroutine in a data structure
perl -MData::Dumper -le '$ref=sub{print "in sub"}; &$ref; my $d=Data::Dumper->new([$ref])->Deparse(1); print $d->Dump'
# Deparse/show the code of a subroutine
perl -MData::Dumper -le '$Data::Dumper::Deparse=1; sub add{my($a,$b)=@_; $a+$b}; print Dumper \&add'
perl -MData::Dumper -le '$Data::Dumper::Deparse=1; $add=sub{my($a,$b)=@_; $a+$b}; print Dumper $add'
# Data Dumper subroutine template
sub _dumper {
require Data::Dumper;
my $data = Data::Dumper
->new( [@_] )
->Indent( 1 )
->Sortkeys( 1 )
->Terse( 1 )
->Useqq( 1 )
->Dump;
return $data if defined wantarray;
say $data;
}
#############################################################
## Perl Modules - Data::Printer
#############################################################
# Colorful data dumper.
# p - print.
# np - capture dump output.
perl -MData::Printer -E 'my $var = [1..3, {a => 1, b => 2}, 123]; p $var'
[
[0] 1,
[1] 2,
[2] 3,
[3] {
a 1,
b 2
},
[4] 123
]
#############################################################
## Perl Modules - Data::Trace
#############################################################
# Show where a complex data structure is being updated.
cpanm Data::Trace
perl -MData::Trace -Mojo -E 'my $data = {a => [0, {complex => 1}]}; say "\nBefore:"; say r $data; Data::Trace->Trace($data); sub BadCall{ $data->{a}[0] = 1 } say ""; BadCall(); say "After:"; say r $data'
# Data::Trace (WIP).
perl -Me -MData::Trace -E 'get("Kernel::System::Cache")->Set( Type => "Ticket", Key => "ABC", Value => [1..3] ); Data::Trace->Trace( get("Kernel::System::Cache") ); get("Kernel::System::Cache")->Delete( Type => "Ticket", Key => "ABC" )'
#############################################################
## Perl Modules - DBD::mysql
#############################################################
# Bug in DBD::mysql before version 5.007:
#
cpanm DBD::mysql@5.006
perl -Me2 -e '$d = get("Kernel::System::DB"); $d->Connect; $d->Disconnect; $d->Connect; say "END"'
ConnectCached
Disconnect
ConnectCached
Segmentation fault (core dumped)
#
cpanm DBD::mysql@5.007
perl -Me2 -e '$d = get("Kernel::System::DB"); $d->Connect; $d->Disconnect; $d->Connect; say "END"'
ConnectCached
Disconnect
},
'.'
);
#############################################################
## Perl Modules - File::Tee
#############################################################
# Writing to multiple filehandles
# Bug: does not work with crontab
#
# Better to do this instead:
open STDOUT, "| tee -a $log" or die $!;
open STDERR, "| tee -a $log" or die $!;
#############################################################
## Perl Modules - File::Temp
#############################################################
# Perl Modules - File::Temp
# In recent releases, Perl’s open function offers a
# simple way to create temporary files whose names
# you cannot know.
# Explicitly pass undef as the filename to open:
open(my $fh, "+>", undef)
or die "$0: can't create temporary file: $!\n";
#############################################################
## Perl Modules - Filter::Simple
#############################################################
# Filter::Simple example.
# Change.pm:
package Change;
use Filter::Simple sub{s/abc/ABC/};
1;
#
# Main.pm:
use Change;
print "abcde\n";
#############################################################
## Perl Modules - FindBin
#############################################################
# Perl operator qw does not interpolate variables
# FindBin qw($bin) same as:
# FindBin '$Bin'
perl -le '$a="A"; print for qw/$a $b c/'
#############################################################
## Perl Modules - Getopt::Long
#############################################################
# Extract command line options using a library
perl -MGetopt::Long -MData::Dumper -le 'GetOptions(\%opts, "delim=s"); print Dumper \%opts' 5 3 02 .4f --delim=,
# Get the command line options (perl)
# Option can be used like this:
# -r
# -r VALUE
#
GetOptions(\%opts,
"debug|s",
"quiet|q",
"recursive|r:s", # Takes optional string
);
for($opts{recursive}){
if(defined){ $_ ||= "DEFAULT" } # If blank, use default
else { $_ = 0 } # Do not use option
}
# Pull out flags and data in Perl (command line options, function)
my $is_flag = qr/^ --? (\w[-\w]*) (?:= ([\w,]+) )? $/x;
for(splice @ARGV){
if(/$is_flag/){ $flags{$1} = $2 // 1 }
else { push @data, $_ }
}
#############################################################
## Perl Modules - Hash::Util
#############################################################
# Perl bucket ratio (hash in scalar content)
perl -MHash::Util=bucket_ratio -le "%h=qw(a 1 b 2 c 3 d 4 e 5 f 6); print bucket_ratio %h"
#############################################################
## Perl Modules - Hook::LexWrap
#############################################################
# Wrap a subroutine and see the input and output
perl -MHook::LexWrap -le 'wrap 'abc', pre => sub{print "pre: [@_[0..$#_-1]]"}, post => sub{print "post: [@{$_[-1]}]"}; sub abc{my($a,$b)=@_; $a+$b} print abc 2,3'
# Wrap a subroutine and see the input and output. modify results
perl -MHook::LexWrap -le 'wrap 'abc', post => sub{$_[-1] = 8}; sub abc{my($a,$b)=@_; $a+$b} print abc 2,3'
# Wrap and unwrap all class functions. (idea)
perl -MModule::Functions=get_full_functions -MHook::LexWrap -MB -E '$class = "MyClass"; my @unwrap = map wrap($_, pre => sub{ my @c=caller; say "[@c] " . B::svref_2object(__SUB__)->GV->NAME; my @c2 = CORE::caller; say "@c"; }), sort {$a cmp $b} map {...
#############################################################
## Perl Modules - HTML::Tree
#############################################################
# Reduce Data::Dumper to the first layer of depth
perl -MHTML::Tree -MData::Dumper -le 'sub pr{my $d=Data::Dumper->new(\@_)->Sortkeys(1)->Terse(1)->Indent(1)->Maxdepth(1); print $d->Dump} $t=HTML::Tree->new_from_file("rakudo2.html"); $f=$t->look_down(qw/_tag td/); pr $_ for $f'
# Extract text from HTML
perl -MHTML::Tree -le '$t=HTML::Tree->new_from_file("rakudo2.html"); $f=$t->find(qw/tr td table/); print $f->as_text'
# Extract latest href download link from an html document
perl -MHTML::Tree -le '$t=HTML::Tree->new_from_file("rakudo.html"); print $_->attr("href") for ($t->look_down(class => "ext-gz"))[0]'
perl -MHTML::Tree -le '$t=HTML::Tree->new_from_file("rakudo.html"); print $t->look_down(class => "ext-gz")->attr("href")'
#############################################################
## Perl Modules - Inline::C
#############################################################
# Example of using Inline::C in perl
use Inline "C";
use Inline "NOCLEAN"; # Keep build library.
print triple(5);
__END__
__C__
int triple(int num) {
return num * 3;
}
# Inline::C oneliner
perl -MInline='C,int triple(int num){ return num * 3; }' -E 'say triple 4'
# Inline::C oneliner (Keep build library)
perl -MInline=NOCLEAN -MInline='C,int triple(int num){ return num * 3; }' -E 'say triple 4'
#############################################################
## Perl Modules - IO::Select
#############################################################
# Simple example of Perl Modules - IO::Select
perl -MIO::Select -E 'say *STDOUT; say fileno(*STDOUT); my $s = IO::Select->new( \*STDIN ); say $s->can_read(0.5)'
*main::STDOUT
1
#############################################################
## Perl Modules - IO::Socket::INET
#############################################################
# Simple perl client using IO::Socket::INET.
use IO::Socket::INET;
if(@ARGV < 2 or $ARGV[0] =~ /^\d$/){
print "\n Syntax: client {add,sub} {numbers}\n\n";
exit 1;
}
my $socket = new IO::Socket::INET(
PeerHost => 'localhost',
PeerPort => 171717,
) or die $!;
print $socket $_ for @ARGV, "END";
my $data = <$socket>; chomp $data;
print "Sum: $data";
$socket->close;
# Simple perl server using IO::Socket::INET.
last if /END/;
next unless /^\d+$/ and $act{$op};
$sum = $act{$op}( $sum, $_ );
printf "%s %s = %s\n", $op, $_, $sum;
}
print "Sum: $sum";
print $client_socket $sum;
}
$socket->close;
#############################################################
## Perl Modules - IPC::Open2, IPC::Open3
#############################################################
# Simple example of capturing STDOUT and STDERR separately in perl.
perl -MSymbol=gensym -MIPC::Open3 -E 'my $pid = open3( my $in_fh, my $out_fh, my $err_fh = gensym(), "echo OUT; echo ERR >&2" ); while(<$err_fh>){ chomp; say}'
#
# STDERR goes to the same place.
perl -MIPC::Open3 -E '$pid = open3( $in_fh, $out_fh, ">&STDERR", "echo OUT; echo ERR >&2; exit 123" ); waitpid( $pid, 0 ); my $error = $? >> 8; say "error=$error"; if($error){ while(<$out_fh>){ print } }'
perl -MIPC::Open2 -E '$pid = open2( $out_fh, $in_fh, "echo OUT; echo ERR >&2; exit 1" ); waitpid( $pid, 0 ); my $error = $? >> 8; say "error=$error"; if($error){ while(<$out_fh>){ print } }'
# IPC::Open3 Bug?!
perl -MFile::Temp=tempfile -MIPC::Open3 -E '($fh,$file)=tempfile(); print $fh "1234567890"x10000; close $fh; $pid = open3( $in_fh, $out_fh, ">&STDERR", "cat $file" ); waitpid( $pid, 0 ); say "DONE $file"'
#############################################################
## Perl Modules - IPC::SysV
#############################################################
# Create a new SysV IPC stream
perl -MIPC::SysV=IPC_PRIVATE,IPC_CREAT,S_IRUSR,S_IWUSR -le 'print msgget(IPC_PRIVATE, IPC_CREAT | S_IRUSR | S_IWUSR)'
#############################################################
## Perl Modules - JavaScript::Minifier::XS
#############################################################
# Minify a javascript file
perl -MJavaScript::Minifier::XS=minify -e "open IN, 'operation-add.js'; open OUT, '>', 'operation-add.min.js'; {local $/; $d=<IN>} print OUT minify($d)"
#############################################################
## Perl Modules - JSON
#############################################################
# Read a json file in perl
perl -MJSON -le "open FH, 'my.json'; local $/; $raw=<FH>; $d = from_json($raw)->{KEY}; print for @$d"
#############################################################
## Perl Modules - Lingua::EN::Tagger
#############################################################
# Add tags to text
perl -MLingua::EN::Tagger -le '$p=Lingua::EN::Tagger->new; print for $p->add_tags("I like food. I like food")'
perl -MLingua::EN::Tagger -le '$p=Lingua::EN::Tagger->new; print for $p->get_readable("I like food. I like food")'
# View natural language lexicon (on lnxbr42)
cd /usr/share/perl5/Lingua/EN/Tagger
perl -MData::Dumper -MStorable -le '$T=retrieve "pos_tags.hash"; print Dumper $T->{pp}'
perl -MData::Dumper -MStorable -le '$W=retrieve "pos_words.hash"; print Dumper $W->{I}'
# Find how likely a certain word is a particular part of speech
cd /usr/share/perl5/Lingua/EN/Tagger
perl -MStorable -le '$W=(retrieve "pos_words.hash")->{I}; $T=(retrieve "pos_tags.hash")->{pp}; print for reverse sort map{ ${$W->{$_}} * $T->{$_} . " $_" } keys $W'
#############################################################
## Perl Modules - List::Util
#############################################################
# Perl Modules - List::Util
# Shuffle the elements of an array.
use List::Util qw(shuffle);
@array = shuffle(@array);
#
# or for a single value
$value = $array[ int(rand(@array)) ];
# Perl Modules - List::Util reduce mimic.
sub My::reduce (&@) {
my $code = shift;
no strict 'refs';
return shift unless @_ > 1;
use vars qw($a $b);
my $c = caller;
local(*{$c."::a"}) = \my $a;
local(*{$c."::b"}) = \my $b;
$a = shift;
foreach (@_) {
$b = $_;
$a = &{$code}();
}
$a;
}
*reduce = *My::reduce;
# print "def2" if defined *reduce{CODE};
print My::reduce {$a + $b} 1..10;
__END__
55
# Perl Modules - List::Util reduce mimic.
sub My::reduce(&@) {
my $sub = shift;
while( @_ > 1 ) {
unshift @_, $sub->(shift, shift);
}
$_[0];
}
print My::reduce {$_[0] + $_[1]} 1..10;
__END__
55
#############################################################
## Perl Modules - Locale::Country
#############################################################
# Build key value lookup table of all country codes.
perl -MLocale::Country -E 'say uc "$_: " . code2country($_) for all_country_codes'
#############################################################
## Perl Modules - Lock::File
#############################################################
# Simple module for locking a file. (exclusive,shared)
perl -MLock::File=lockfile -E 'my $lock = lockfile("my.lock7") or die $!; sleep 100000'
perl -MLock::File=lockfile -E 'my $lock = lockfile("my.lock7", {shared => 1}) or die $!; sleep 100000'
#############################################################
## Perl Modules - LWP
#############################################################
# Send a post request (LWP)
u="http://pythonscraping.com/pages/files/processing.php"
perl -MLWP -le '$u=shift; $ua=LWP::UserAgent->new; $ua->env_proxy; $rc=$ua->post($u,{qw/^Crstname FIRST lastname LAST/}); print $rc->content' $u
#############################################################
## Perl Modules - LWP::UserAgent
#############################################################
# Get http request. practice using LWP::UserAgent
perl -MLWP::UserAgent -MData::Dumper -le '$u="http://www.google.com"; $ua=LWP::UserAgent->new; $ua->env_proxy; $r=$ua->get($u); print $r->header("Server")'
#############################################################
## Perl Modules - Mail::Address
#############################################################
# Example of using Mail::Address.
perl -Mojo -MMail::Address -E 'say r $_ for Mail::Address->parse("First Last email\@localhost")'
bless( [
"",
"First",
""
], 'Mail::Address' )
bless( [
"",
"Last",
""
], 'Mail::Address' )
bless( [
"",
"email\@localhost",
""
], 'Mail::Address' )
#############################################################
## Perl Modules - Math::Combinatorics
#############################################################
# Get permutations of lists (make a table).
perl -lE '$_="{0,1}"x3; say for glob'
perl -E 'say for glob "{A,B}{1,2}"'
perl -lE 'say for glob "{0,1}{0,1}{0,1}{0,1}"'
perl -MMath::Combinatorics=permute -lE 'say for map{"@$_"} permute(qw/a b c/)'
#############################################################
## Perl Modules - Math::Expression
#############################################################
# Perl Modules - Math::Expression example
perl -MMath::Expression -E 'my $m = Math::Expression->new; say $m->ParseToScalar("Dog := 4; Chicken := 2; Dog + Chicken")'
6
# 0,5 versus 0.5 in a math expression.
perl -MMath::Expression -Mojo -E 'my $m = Math::Expression->new; my $tree = $m->Parse("0,5 - 5"); say r $tree'
{
"after" => 1,
"left" => {
"oper" => "const",
"type" => "num",
"val" => 0
},
"oper" => ",",
"right" => {
"after" => 1,
"left" => {
"oper" => "const",
memoize(
"Other::Add",
NORMALIZER => sub {
my ($self,$num) = @_;
join "::", $self->{num}, $num;
}
);
my $obj = bless { num => 2 }, "Other";
say($obj->Add(3)) for 1..3;
$obj->{num} = 4;
say($obj->Add(3)) for 1..3;
'
[2024/05/10-10:22:08.164] --> [2] Add ...
5
5
5
[2024/05/10-10:22:08.175] --> [2] Add ...
7
7
7
#############################################################
## Perl Modules - Memoize::Storable
#############################################################
# Persistent cache using Memoize::Storable
#############################################################
## Perl Modules - Modern::Perl
#############################################################
# Modern::Perl defaults to v5.12 (bug!?)
perl -E 'say $^V'
v5.36.0
perl -Modern::Perl -e 'say Modern::Perl::validate_date(2022)'
:5.34
perl -Modern::Perl -e 'say Modern::Perl::validate_date()'
:5.12
perl -E 'sub abc ($n) {$n}'
perl -Modern::Perl=2022 -e 'sub abc ($n) {$n}'
perl -Modern::Perl -e 'sub abc ($n) {$n}'
Illegal character in prototype for main::abc : $n at -e line 1.
Global symbol "$n" requires explicit package name (did you forget to declare "my $n"?) at -e line 1.
Execution of -e aborted due to compilation errors.
#############################################################
## Perl Modules - Module::CoreList, corelist
#############################################################
# Find perl module
perl -MModule::CoreList -le 'print for Module::CoreList->find_modules("Class")'
cpan -l | grep -e '^Class'
# Find all available modules for a certain version
perl -MModule::CoreList -le 'print for Module::CoreList->find_modules(/5.010/)'
# Find find release of a perl module
corelist Data::Dumper
# Find all release versions of a perl module
corelist -a Data::Dumper
# Find the release date of a perl version
corelist -r 5.005 # Perl 5.005 was released on 1998-07-22
# Find modules installed with a specific
# perl version.
corelist –v 5.038
#############################################################
## Perl Modules - Module::Refresh
#############################################################
# Perl Modules - Module::Refresh
# My.pm:
#
#!/usr/bin/env perl
package My;
use strict;
use warnings;
use parent qw( Exporter );
our @EXPORT = qw( Run );
sub Run { print "111\n" }
1;
#
perl -I. -MModule::Refresh -E 'use My; Run(); say qq(before: $INC{"My.pm"}); Module::Refresh->refresh_module("My.pm"); say qq(after: $INC{"My.pm"}); Run()'
111
before: My.pm
after: My.pm
Undefined subroutine called at -e line 1.
# Cannot undef, delete, and require a subroutine.
# My.pm:
package My;
sub Run { print "111\n" }
1;
#
perl -e '
require My;
My->Run();
undef &My::Run;
delete $My::{Run};
require My; Run();
'
111
Undefined subroutine called at -e line 1.
#############################################################
## Perl Modules - Module::Starter
#############################################################
# Create a new distribution in perl abd run it.
x2hs -X Example # Pure Perl
h2xs -A -n Example # XS
perl Makefile.PL
make
perl -Mblib -MExample2 -E 'Example2::print_hello()'
# Using -Mblib is similar to using:
perl -MTerm::ReadKey -e 'ReadMode 3; while($c=ReadKey(0),$o=ord($c),$o != 10 and $o != 13){ if($o == 127 || $o == 8){chop $p; print "\b \b"}elsif($o < 32){}else{ $p .= $c; print "*" }} ReadMode 0; print "[$p]\n"'
perl -MTerm::ReadKey -e 'ReadMode 4; while($c=ReadKey(0),$o=ord($c),$o!=10){ if($o==127 or $o==8){chop $p; print "\b \b"}elsif($o < 32){}else{$p.=$c; print "*"}} ReadMode 0; print "[$p]\n"'
#############################################################
## Perl Modules - Term::ReadLine::Gnu
#############################################################
# Given input, return the possible completion words.
# Like compgen.
compgen -W "cat cake bat bake" -- c
perl -MTerm::ReadLine -E 'my $term = Term::ReadLine->new("my"); my $attribs = $term->Attribs; $attribs->{completion_word} = [qw( cat cake bat bake )]; my @matches = $term->completion_matches( shift//"", $attribs->{list_completion_function} ); $term->...
#############################################################
## Perl Modules - Text::CSV
#############################################################
# Write a csv file (super easy)
perl -MText::CSV_XS=csv -E "csv(in => [[qw/A B C/],[1,2,3]], out => 'my.csv')"
# Read certain lines of a CSV file
perl -l -MText::CSV -e '$csv=Text::CSV->new; open FH, "book1.csv"; while($a=$csv->getline(FH)){print $a->[0]}'
# CSV file into an array (Mike)
perl -l -MText::CSV_XS -e '$csv=Text::CSV_XS->new; open FH, "a.csv"; $a=$csv->getline_all(FH); print $a->[1][3]'
#############################################################
## Perl Modules - Text::ParseWords
#############################################################
# Split a line by a character while honoring quotes
# and backslashes. (perl)
use Text::ParseWords qw/ parse_line /;
parse_line( '/', 1, $string );
# Perl Modules - Text::ParseWords example.
use Text::ParseWords;
my @a = map{
chomp;
[shellwords($_)]
} <DATA>;
p \@a;
__DATA__
ab1c def
abc "d ef"
# 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
%S: 18
%t: \t
%T: 00:01:18
%u: 1
%U: 36
%V: 36
%w: 1
%W: 36
%x: 09/05/2016
%X: 12:01:18 AM
%y: 16
%Y: 2016
%z: +0200
%Z: CEST
%+: %+
%%: %
#############################################################
## Perl Modules - Time::Seconds
#############################################################
# Date arithmetic in Javascript (add 90 days to a date)
# Time::Seconds imports ONE_DAY
perl -MTime::Seconds -MTime::Piece -le "$now=localtime; $now+=$now->tzoffset; $now += ONE_DAY * 90; print $now->strftime('%Y-%m-%d')"
# Subtract days.
perl -MPOSIX -le '
@t = localtime; $t[3] -= 1299;
print scalar localtime mktime @t
'
# Seconds to HMS (hhmmss)
use Time::Seconds;
my $time = Time::Seconds->new(time - $time0)->pretty;
#
perl -MTime::Seconds -E 'say Time::Seconds->new(time)->pretty;'
# 18845 days, 18 hours, 4 minutes, 21 seconds
#############################################################
## Perl Modules - Tk (General)
#############################################################
# Create a simple Tk window
perl -MTk -le '$mw=MainWindow->new; $mw->title("Hello"); $mw->Button(-text => "Done", -command => sub{exit})->pack; MainLoop'
# Create a simple grid window
perl -MTk -le '$m=MainWindow->new; $m->Button->grid($m->Button,$m->Button); $m->Button->grid($m->Button,$m->Button); MainLoop'
# Create a simple grid window with last button spanning several columns
perl -MTk -le '$m=MainWindow->new; $m->Button->grid($m->Button,$m->Button); $m->Button->grid($m->Button,"-", -sticky => "nsew"); MainLoop'
# Create a simple grid window with last button spanning several rows
perl -MTk -le '$m=MainWindow->new; $m->Button->grid($m->Button,$m->Button, -sticky => "nsew"); $m->Button->grid($m->Button,"^"); MainLoop'
# Create a simple grid window with last button removed/ignored/skipped
perl -MTk -le '$m=MainWindow->new; $m->Button->grid($m->Button,$m->Button); $m->Button->grid("x",$m->Button, -sticky => "nsew"); MainLoop'
# Have a button to disable another button
perl -MData::Dumper -MTk -wle '
$mw = MainWindow->new;
$exit_b = $mw->Button(-text => "exit", -command => sub{exit})->pack(-ipadx => 20, -ipady => 10);
$text = "Disable Exit";
$mw->Button(-textvariable => \$text, -command => sub{
if( ($exit_b->configure(-state))[-1] eq "disabled" ){
$exit_b->configure(-state => "normal");
$text = "Disable Exit";
}
else{
$exit_b->configure(-state => "disabled");
$text = "Enable Exit";
}
})->pack;
MainLoop;
'
# TODO: Check if Unigraph is perl tk
# Create Menu Buttons (PTk,bind method)
perl -MTk -le '$mw=MainWindow->new; $mw->Button(-text => "Exit", -command => sub{exit})->pack(-side => "bottom", -fill => "both", -expand => 1); $f=$mw->Frame(-relief => "ridge", -borderwidth => 2)->pack(-side => "top", -expand => 1, -fill => "both")...
# Perk Tk Event Types (PTk,bind method)
ButtonPress (or Button)
ButtonRelease
Circulate
Colormap
Configure
Destroy
Enter
Expose
FocusIn
FocusOut
Gravity
KeyPress (or Key)
KeyRelease
Leave
Map
Motion
Reparent
Unmap
Visibility
# Perl Tk Event Info Usage program
perl -MTk -le '$mw=MainWindow->new; $b=$mw->Button->pack(-ipadx => 60); $b->bind("<Key>", [sub{print "ARGV: @_[1..$#_]"}, Ev("k"), Ev("K"), Ev("N"), Ev("T")]); MainLoop'
# Perl Tk Event Info (PTk,bin methods,Ev)
#
# Coordinates (relative to window)
Ev('x')
Ev('y')
#
# Coordinates (relative to root of window)
Ev('X')
Ev('Y')
#
# Button Number (of mouse click)
Ev('b')
#
# Size of widget
Ev('h') # height
# § \xC2\xA7 \xA7 # utf8::decode($v)
# § \xC3\x82\xC2\xA7 \xC2\xA7 # utf8::upgrade($v)
# § \xC2\xA7 # utf8::downgrade($v)
#############################################################
## Perl Modules - XML::LibXML
#############################################################
# Parse and find specific nodes/elements in an xml file
# "//Page" means to look recursively down for a "Page" element
perl -MXML::LibXML -le '$d=XML::LibXML->load_xml(location => "my.xml"); print "$_\n\n" for $d->findnodes("//Page")'
# Parse xml file. Find all "PageTable" elements
# Select all PageTableProperty inside.
# Print out the value of the PageTableName (Use @ to find an attribute instead of a value)
# Print out the value (using ->to_literal)
perl -MXML::LibXML -le '$d=XML::LibXML->load_xml(location => "my.xml"); for($d->findnodes("//PageTable")){ ($p)=$_->findnodes("PageTableProperty"); print map $_->to_literal, $p->findnodes("\@PageTableName") }' | head
# Parse xml file. Find all "PageTable" elements
# findvalue is like findnode and then to_literal. Use it when you expect a single node
perl -MXML::LibXML -le '$d=XML::LibXML->load_xml(location => "my.xml"); for($d->findnodes("//PageTable")){ ($p)=$_->findnodes("PageTableProperty"); print $p->findvalue("\@PageTableName") }'
#
# Same thing but using getAttribute() DOM method.
perl -MXML::LibXML -le '$d=XML::LibXML->load_xml(location => "my.xml"); for($d->findnodes("//PageTable")){ ($p)=$_->findnodes("./PageTableProperty"); print $p->getAttribute("PageTableName") }'
#
# Can also use the tied hash accessing approach $p->{ATTRIBUTE}
perl -MXML::LibXML -le '$d=XML::LibXML->load_xml(location => "my.xml"); for($d->findnodes("//PageTable")){ ($p)=$_->findnodes("PageTableProperty"); print $p->{PageTableName} }'
# Parse xml file. Find all "PageTable" elements
# Print only the actuator page
perl -MXML::LibXML -le '$d=XML::LibXML->load_xml(location => "my.xml"); for($d->findnodes("//PageTable")){ ($p)=$_->findnodes("./PageTableProperty"); $v=$p->findvalue("\@PageTableName"); print if $v eq "ACTUATOR" }'
# Process HTML using XML::LibXML
# Does not load badly formated files without these options:
# recover
# suppress_errors
perl -MXML::LibXML -le '$d=XML::LibXML->load_html(location => "index.html", recover => 1, suppress_errors => 1); print $d'
# XML Process big files. Save memory
perl -MXML::LibXML::Reader -le '$d=XML::LibXML::Reader->new(location => "xml"); printf "%-10s %-10s %-10s %-10s\n", $d->nodeType, $d->depth, $d->name, $d->getAttribute("code") while $d->read'
# Pull out parts of of a list
perl -MXML::LibXML -le '$d=XML::LibXML->load_html(location => "OSRS", recover => 1, suppress_errors => 1); @t = $d->findnodes(q(//table[@class="wikitable infobox"])); @t = grep { $_->findvalue(q(tr[th/a/@title="Members"]/td)) =~ /No/} @t; print for @...
# Issues with XML::LibXML. Cannot parse control characters (except \n or \r)
perl -MXML::LibXML -E 'my $v = XML::LibXML->load_xml( string => "<div>\f</div>")'
#
# HTML::Entities does not help.
perl -MXML::LibXML -MHTML::Entities -E 'my $v = XML::LibXML->load_xml( string => encode_entities("<div>\f</div>", "\f"))'
#
# Same:
perl -MXML::LibXML -E 'my $v = XML::LibXML->load_xml( string => "<div></div>")'
#############################################################
## Perl Modules - XML::Simple
#############################################################
# Read xml file and print out the structure
perl -MXML::Simple -MData::Dumper -le '$xs=XML::Simple->new; print Dumper($xs->XMLin("embraer.xml"))'
# Print the structure of an xml file while reading the input
perl -MXML::Simple -MData::Dumper -le '$d=XML::Simple::XMLin($ARGV[0]//die"\nSyntax: tool xmlfile\n\n"); print Dumper($d)'
# XML::Simple example
perl -Me -MXML::Simple -e 'my $xml = XML::Simple->new; say $xml->XMLout( "hey", AttrIndent => 1, NoAttr => 1, KeyAttr => [], RootName => "RootElement" )'
# Why use XML::Simple AND XML::LibXML together
perl -Me -MXML::Simple -MXML::LibXML -e 'my $x = XML::Simple->new->XMLout( "hey\f", AttrIndent => 1, NoAttr => 1, KeyAttr => [], RootName => "RootElement" ); say(XML::LibXML->load_xml( string => $x))'
:1: parser error : PCDATA invalid Char value 12
<RootElement>hey
</RootElement>
^
perl -Me -MXML::Simple -MXML::LibXML -e 'my $x = XML::Simple->new->XMLout( "hey\f", AttrIndent => 1, NoAttr => 1, KeyAttr => [], RootName => "RootElement" ); say(XML::LibXML->load_xml( string => "abc"))'
#############################################################
## Perl Modules - YAML::XS
#############################################################
# Simple example of converting between yaml and a data structure.
perl -MYAML::XS -E '$yml = Dump [1..3]; $arr = Load $yml'
#############################################################
## Perl Book - Learning Perl Examples
#############################################################
# Exercise 2.1 (Learning Perl)
perl -le '$r=12.5; $pi=3.141592654; $c=2*$r*$pi; print $c'
# Exercise 2.2 (Learning Perl)
perl -le 'print "Enter radius: "; $r=<STDIN>; $pi=3.141592654; $c=2*$r*$pi; print $c'
# Exercise 2.3 (Learning Perl)
perl -le 'print "Enter radius: "; $r=<STDIN>; if($r < 0){ $r = 0 } $pi=3.141592654; $c=2*$r*$pi; print $c'
# Exercise 2.4 (Learning Perl)
perl -le 'print "Enter Num1: "; chomp($num1=<STDIN>); print "Enter Num2: "; chomp($num2=<STDIN>); print "$num1 * $num2 = ", ($num1 * $num2)'
# Exercise 2.5 (Learning Perl)
perl -le 'print "Enter String: "; chomp($string=<STDIN>); print "Enter num: "; chomp($num=<STDIN>); print $string x $num'
#############################################################
## Perl6 Programs (Rakudo)
#############################################################
# Setup/install/compile rakudo (perl6)
# 1. Get Latest
rm -f ~/rakudo/setup/index.html*
read -sp "Password: " PASSWORD
echo "$PASSWORD" | perl -ple 's/(\W)/ sprintf "%%%x", ord($1) /eg'
wget http://rakudo.org/downloads/star/ -P ~/rakudo/setup
ls ~/rakudo/setup/index.html | perl -MHTML::Tree -lne 'print HTML::Tree->new_from_file($_)->look_down(class => "ext-gz")->attr("href")'
basename `$LATEST`
# Setup/install/compile rakudo (perl6)
# 2. Download
read -sp "Password: " PASSWORD
echo "$PASSWORD" | perl -ple 's/(\W)/ sprintf "%%%x", ord($1) /eg'
wget http://rakudo.org/downloads/star/$LATEST -P ~/rakudo/setup
# Square all numbers in a list (compare)
python -c 'A=list(map((lambda x: x**2), range(10))); print A'
python -c 'A=[x**2 for x in range(10)]; print A'
perl -le '@A=map{$_**2}0..9; print "@A"'
# Square all even numbers
python -c 'A=list(map((lambda x: x**2), filter((lambda x: x%2 == 0), range(10)))); print A'
python -c 'A=[x**2 for x in range(10) if x%2 == 0]; print A'
perl -le '@A=map{$_**2} grep{$_ % 2 == 0} 0..9; print "@A"'
# Add 2D lists (compare)
python -c 'A=[x + y for x in [0,1,2] for y in [100,200,300]]; print A'
perl -le '@A=map{$x=$_; map{$x+$_}100,200,300 }0,1,2; print "@A"'
perl -le 'local $,="+"; @A=map eval, <{0,1,2}+{100,200,300}>; print "@A"'
# Add 3D lists (compare)
python -c 'A=[x + y + z for x in [0,1,2] for y in [100,200,300] for z in [1000,2000,3000]]; print A'
perl -le '@A=map{$x=$_; map{$y=$_; map{$x+$y+$_}1000,2000,3000 }100,200,300 }0,1,2; print "@A"'
perl -le 'local $,="+"; @A=map{eval}<{0,1,2}+{100,200,300}+{1000,2000,3000}>; print "@A"'
perl -le 'local $,="+"; @A=map eval, <{0,1,2}+{100,200,300}+{1000,2000,3000}>; print "@A"'
# Add 4D lists (compare)
python -c 'A=[x + y + z + aa for x in [0,1,2] for y in [100,200,300] for z in [1000,2000,3000] for aa in [10000,20000]]; print A'
perl -le '@A=map{$x=$_; map{$y=$_; map{$z=$_; map{$x+$y+$z+$_}10000,20000 }1000,2000,3000 }100,200,300 }0,1,2; print "@A"'
perl -le 'local $,="+"; @A=map eval, <{0,1,2}+{100,200,300}+{1000,2000,3000}+{10000,20000}>; print "@A"'
# Interate through list combinations
python -c 'A=[x+y for x in "spam" for y in "SPAM"]; print A'
perl -le '@A=<{s,p,a,m}{S,P,A,M}>; print "@A"'
perl -le '@A=<{@{[join ",",split //,"spam"]}}{@{[join ",",split //,"SPAM"]}}>; print "@A"'
# Max constant for using glob (permutations)
perl -MPOSIX -le 'print POSIX::sysconf(_SC_ARG_MAX)'
# Add 2D lists with conditionals (compare)
python -c 'A=[x+y for x in "spam" if x in "sm" for y in "SPAM" if y in ("P","A")]; print A'
perl -le '@A=map{$x=$_; map{$x.$_ }grep /[PA]/, split "", "SPAM" } grep /[sm]/, split "", "spam"; print "@A"'
perl -le '@a=join ",", grep /[sm]/, split "", "spam"; @b=join ",", grep /[PA]/, split "", "SPAM"; @A=<{@a}{@b}>; print "@A"'
perl -le '@A=<{@{[ join ",", grep /[sm]/, split "", "spam" ]}}{@{[ join ",", grep /[PA]/, split "", "SPAM" ]}}>; print "@A"'
perl -le '@A=<{s,m}{P,A}>; print "@A"'
# Show even and odd lists (compare)
python -c 'A=[(x,y) for x in range(5) if x % 2 == 0 for y in range(5) if y % 2 == 1]; print A'
perl -le '@A=map{$x=$_; map{"($x,$_)"} grep{$_ % 2 == 1}0..4 }grep{$_ % 2 == 0}0..4; print "@A"'
perl -le '@A=<({@{[ join ",",grep{$_ % 2 == 0}0..4 ]}},{@{[ join ",",grep{$_ % 2 == 1}0..4 ]}})>; print "@A"'
# Extract the forward diagonal from a matrix (compare)
python -c 'M=[[1,2,3],[4,5,6],[7,8,9]]; A=[M[i][i] for i in range(len(M))]; print A'
perl -le '@M=([1,2,3],[4,5,6],[7,8,9]); @A=map{ $M[$_][$_] } 0..$#M; print "@A"'
# Extract the backward diagonal from a matrix (compare)
python -c 'M=[[1,2,3],[4,5,6],[7,8,9]]; A=[M[i][len(M)-1-i] for i in range(len(M))]; print A'
perl -le '@M=([1,2,3],[4,5,6],[7,8,9]); @A=map{ $M[$_][$#M-$_] } 0..$#M; print "@A"'
# Increment column in a matrix (compare)
python -c 'M=[[1,2,3],[4,5,6],[7,8,9]]; A=[row[1]+10 for row in M]; print A'
perl -le '@M=([1,2,3],[4,5,6],[7,8,9]); @A=map{ $_->[1]+10 } @M; print "@A"'
# Increment all columns in a matrix (compare)
python -c 'M=[[1,2,3],[4,5,6],[7,8,9]]; A=[[col+10 for col in row] for row in M]; print A'
perl -MData::Dumper -le '@M=([1,2,3],[4,5,6],[7,8,9]); @A=map{[map{ $_+10}@$_] } @M; print Dumper \@A'
perl -le '@M=([1,2,3],[4,5,6],[7,8,9]); @A=map{[map{ $_+10}@$_] } @M; print "@$_" for @A'
# Multiply matrices (compare)
python -c 'M=[[1,2,3],[4,5,6],[7,8,9]]; N=[[2,2,2],[3,3,3],[4,4,4]]; A=[M[row][col] * N[row][col] for row in range(3) for col in range (3)]; print A'
perl -le '@M=([1,2,3],[4,5,6],[7,8,9]); @N=([2,2,2],[3,3,3],[4,4,4]); @A=map{$row=$_; map{ $M[$row][$_] * $N[$row][$_] }0..2 }0..2; print "@A"'
# Multiply matrices preserving rows (compare)
python -c 'M=[ [1,2,3],[4,5,6],[7,8,9]]; N=[[2,2,2],[3,3,3],[4,4,4]]; A=[[col1 * col2 for (col1,col2) in zip(row1,row2)] for (row1,row2) in zip(M,N)]; print A'
perl -le '@M=([1,2,3],[4,5,6],[7,8,9]); @N=([2,2,2],[3,3,3],[4,4,4]); @A=map{$row=$_; [map{ $M[$row][$_] * $N[$row][$_] }0..2] }0..2; print "@$_" for @A'
#############################################################
## Python Functions
#############################################################
# Keyword (Named) Arguments in Python
# Same definition
def myfunc(parm1, parm1):
...
myfunc(parm1=arg1, parm1=arg2)
#############################################################
## Python PIP
#############################################################
# Install a python package
setup_http_proxy
sudo pip install matplotlib --proxy $https_proxy
# Python package is not in the normal location. (Nathan)
# Add it to the include PATH
import sys; sys.path.append("/usr/lib/pyshared/python2.7/matplotlib")
import matplotlib
# Look up a python package
python -m pydoc <module>
perldoc <module> # similar
#############################################################
## Python Regex
#############################################################
# Python offers two different primitive operations based on
# regular expressions: re.match() checks for a match only at
# the beginning of the string, while re.search() checks for
# a match anywhere in the string (this is what Perl does by
# default).
python -c 'import re; print(re.match("c", "abcdef"))'
python -c 'import re; print(re.search("c", "abcdef"))'
# Capture words in regex
python -c 'import re; m=re.search("(\w+) is (\d+)", "abc is 3"); print(m.groups())'
perl -le 'print for "abc is 3" =~ /(\w+) is (\d+)/'
perl -le 'print "abc is 3" =~ /(\w+) is (\d+)/'
# Allow free space in regex
python -c 'import re; print(re.search("(?x) c ", "abcdef"))'
perl -le 'print "abcdef" =~ / c /x'
( run in 1.951 second using v1.01-cache-2.11-cpan-5a3173703d6 )