1.21 Gigawatts

5 Great Modules You Won’t Believe You’re Not Already Using!

use List::Util;

use List::Util; my $x = first { $_ > 1
} @list;

} @list; my $y = min @list;

} @list; my $y = min @list; die if any { $_ < 0 } @list;

! use List::MoreUtils; ! ! ! ! ! ! !
! !

use List::MoreUtils;

use List::MoreUtils; my ($min, $max) = minmax(@list);

use List::MoreUtils; my ($min, $max) = minmax(@list); my @header =
before { $_ eq ‘’ } @input;

before { $_ eq ‘’ } @input; die if any { $_ < 0 } @list;

before { $_ eq ‘’ } @input; die if any { $_ < 0 } @list; @x = uniq @x;

! use List::Util ‘firstval’; ! use List::MoreUtils ‘first’;

! use List::AllUtils qw(first firstval);

! use List::AllUtils;

use Pobox; ! ! ! ! ! !

use Pobox::DB; ! ! ! ! ! !

use Pobox::DB::IMAP; ! ! ! ! ! !

use Pobox::DB::IMAP::Account; ! ! ! ! ! !

use Pobox::DB::IMAP::Account; ! my $acct = Pobox::DB::IMAP::Account ->get( … );
|| die Pobox::DB::IMAP::Account ->errstr;

use aliased ‘Pobox::DB::IMAP::Account’; ! my $acct = Account->get( … );
|| die Account->errstr;

! use aliased;

! ! ! open my $fh, ‘-|’, ‘gzcat myfile.csv.gz’; !
!

! ! close $text_file_handle; ! system(gzip => $text_file); !

! ! my $fh = IO::Uncompress::Gunzip ->new("myfile.csv.gz"); ! my $fh
= IO::Compress::Gzip ->new("output.txt.gz"); !

use autodie; ! my $fh = IO::Uncompress::Gunzip ->new("myfile.csv.gz"); ! my
$fh = IO::Compress::Gzip ->new("output.txt.gz"); !

! use autodie;

use autodie; ! my $fh = IO::Uncompress::Gunzip ->new("myfile.csv.gz"); ! my
$fh = IO::Compress::Gzip ->new("output.txt.gz"); !

use autodie; # <-- won't help ! my $fh =
IO::Uncompress::Gunzip ->new("myfile.csv.gz"); ! my $fh = IO::Compress::Gzip ->new("output.txt.gz"); !

! IO::Uncompress::Gzip IO::Decompress::Gzip IO::Compress::Gzip IO::Uncompress::GZip IO::Compress::Gunzip IO::Compress::GZip IO::Uncompress:Gunzip

use PerlIO::gzip; ! ! open my $fh, '<:gzip', "myfile.csv.gz"; !
open my $fh, '>:gzip', "output.txt.gz";

use PerlIO::gzip; use autodie; ! open my $fh, '<:gzip', "myfile.csv.gz";
! open my $fh, '>:gzip', "output.txt.gz";

! use PerlIO::gzip;

if ($^O eq "MSWin32") { use Win32::CopingMechanism; }

if ($^O eq "MSWin32") { use Win32::CopingMechanism; } if ($]
> 5.022) { use strict 'time'; }

! use if $^O eq "MSWin32", "Win32::CopingMechanism"; ! ! use
if $] > 5.022, strict => 'time';

! use if;

$ cpan Dist::Zilla ! ! !

$ cpan Dist::Zilla installing 10% of CPAN... ! !

$ cpan Dist::Zilla installing 10% of CPAN... installing 20% of
CPAN... !

CPAN... installing 30% of CPAN...

CPAN... installing 30% of CPAN... installing 40% of CPAN...

Checking if you have ExtUtils::MakeMaker 6.30 ... Yes (6.86) Running
Makefile.PL Configuring superclass-0.002 ... Checking if your kit is complete... Looks good Generating a Unix-style Makefile Writing Makefile for superclass Writing MYMETA.yml and MYMETA.json OK Checking dependencies from MYMETA.json ... Checking if you have version 0.9901 ... Yes (0.9906) Checking if you have File::Temp 0 ... Yes (0.2304) Checking if you have warnings 0 ... Yes (1.18) Checking if you have Module::Load 0.24 ... Yes (0.28) Checking if you have Config 0 ... Yes (5.018002) Checking if you have vars 0 ... Yes (1.03) Checking if you have File::Spec::Functions 0 ... Yes (3.40) Checking if you have strict 0 ... Yes (1.07) Checking if you have File::Find 0 ... Yes (1.23) Checking if you have ExtUtils::MakeMaker 0 ... Yes (6.86) Checking if you have List::Util 0 ... Yes (1.35) Checking if you have Test::More 0 ... Yes (1.001002) Building and testing superclass-0.002 ... cp lib/superclass.pm blib/lib/superclass.pm Manifying blib/man3/superclass.3 PERL_DL_NONLAZY=1 /Users/rjbs/.plenv/versions/18.2/bin/perl5.18.2 "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t t/00-compile.t .................. ok t/00-report-prereqs.t ........... # Prerequisite Report: # Version Module # -------- --------------------- # 5.018002 Config # 6.86 ExtUtils::MakeMaker # 1.23 File::Find # 3.40 File::Spec::Functions # 0.2304 File::Temp # 1.35 List::Util # 0.28 Module::Load # 1.001002 Test::More # 1.07 strict # 1.03 vars # 0.9906 version # 1.18 warnings t/00-report-prereqs.t ........... ok t/compile-time-file.t ........... ok t/compile-time.t ................ ok t/inherit-classfromclassfile.t .. ok t/inherit-classfromfile.t ....... ok t/inherit-pmc.t ................. ok t/inherit-returns-false.t ....... ok t/inherit.t ..................... ok t/version-check.t ............... ok All tests successful. Files=10, Tests=50, 1 wallclock secs ( 0.04 usr 0.02 sys + 0.36 cusr 0.05 csys = 0.47 CPU) Result: PASS Manifying blib/man3/superclass.3 Installing /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2/superclass.pm Installing /Users/rjbs/.plenv/versions/18.2/man/man3/superclass.3 Appending installation info to /Users/rjbs/.plenv/versions/18.2/lib/perl5/5.18.2/darwin-2level/perllocal.pod OK Successfully installed superclass-0.002 Installing /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2/darwin-2level/.meta/superclass-0.002/install.json Installing /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2/darwin-2level/.meta/superclass-0.002/MYMETA.json Building and testing TAP-Harness-Restricted-0.002 ... cp lib/TAP/Harness/Restricted.pm blib/lib/TAP/Harness/Restricted.pm Manifying blib/man3/TAP::Harness::Restricted.3 PERL_DL_NONLAZY=1 /Users/rjbs/.plenv/versions/18.2/bin/perl5.18.2 "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t t/00-compile.t ......... ok t/00-report-prereqs.t .. # Prerequisite Report: # Version Module # -------- --------------------- # 6.86 ExtUtils::MakeMaker # 1.23 File::Find # 3.40 File::Spec::Functions # 0.2304 File::Temp # 1.005 File::pushd # 1.35 List::Util # 0.051 Path::Tiny # 3.30 TAP::Harness # 0.008 Test::FailWarnings # 1.001002 Test::More # 1.07 strict # 0.002 superclass # 1.18 warnings t/00-report-prereqs.t .. ok t/test.t ............... ok All tests successful. Files=3, Tests=3, 0 wallclock secs ( 0.03 usr 0.01 sys + 0.24 cusr 0.03 csys = 0.31 CPU) Result: PASS Installing /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2/TAP/Harness/Restricted.pm Installing /Users/rjbs/.plenv/versions/18.2/man/man3/TAP::Harness::Restricted.3 Appending installation info to /Users/rjbs/.plenv/versions/18.2/lib/perl5/5.18.2/darwin-2level/perllocal.pod OK Successfully installed TAP-Harness-Restricted-0.002 Installing /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2/darwin-2level/.meta/TAP-Harness-Restricted-0.002/install.json Installing /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2/darwin-2level/.meta/TAP-Harness-Restricted-0.002/MYMETA.json Expiring 2 work directories. 2 distributions installed

t/00-report-prereqs.t ........... ok t/compile-time-file.t ........... ok t/compile-time.t ................ ok t/inherit-classfromclassfile.t
.. ok t/inherit-classfromfile.t ....... ok t/inherit-pmc.t ................. ok t/inherit-returns-false.t ....... ok t/inherit.t ..................... ok t/version-check.t ............... ok All tests successful. Files=10, Tests=50, 1 wallclock secs ( 0.04 usr 0.02 sys + 0.36 cusr 0.05 csys = 0.47 CPU) Result: PASS Manifying blib/man3/superclass.3 Installing /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2/superclass.pm Installing /Users/rjbs/.plenv/versions/18.2/man/man3/superclass.3 Appending installation info to /Users/rjbs/.plenv/versions/18.2/lib/perl5/5.18.2/darwin-2level/ perllocal.pod OK Successfully installed superclass-0.002 Installing /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2/darwin-2level/.meta/ superclass-0.002/install.json Installing /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2/darwin-2level/.meta/ superclass-0.002/MYMETA.json Building and testing TAP-Harness-Restricted-0.002 ... cp lib/TAP/Harness/Restricted.pm blib/lib/TAP/ Harness/Restricted.pm Manifying blib/man3/TAP::Harness::Restricted.3 PERL_DL_NONLAZY=1 /Users/rjbs/.plenv/versions/18.2/bin/perl5.18.2 "-MExtUtils::Command::MM" "- MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t t/00-compile.t ......... ok t/00-report-prereqs.t .. # Prerequisite Report: # Version Module # -------- --------------------- # 6.86 ExtUtils::MakeMaker # 1.23 File::Find # 3.40 File::Spec::Functions

t/00-compile.t ......... ok t/00-report-prereqs.t .. # Prerequisite Report: # Version
Module # -------- --------------------- # 6.86 ExtUtils::MakeMaker # 1.23 File::Find # 3.40 File::Spec::Functions # 0.2304 File::Temp # 1.35 List::Util # 0.28 Module::Load # 1.001002 Test::More # 1.07 strict # 1.03 vars # 0.9906 version # 1.18 warnings t/00-report-prereqs.t ........... ok t/compile-time-file.t ........... ok t/compile-time.t ................ ok t/inherit-classfromclassfile.t .. ok t/inherit-classfromfile.t ....... ok t/inherit-pmc.t ................. ok t/inherit-returns-false.t ....... ok t/inherit.t ..................... ok t/version-check.t ............... ok t/pod-syntax .................... not ok ha ha ha sucker

t/pod-syntax .............. not ok ha ha ha sucker

! ! $ cpan Dist::Zilla ! ! !

$ export HARNESS_SUBCLASS=TAP::Harness::Restricted $ cpan Dist::Zilla ! ! !

$ export HARNESS_SUBCLASS=TAP::Harness::Restricted $ cpan Dist::Zilla ... ! !

$ export HARNESS_SUBCLASS=TAP::Harness::Restricted $ cpan Dist::Zilla ... 69,105 distributions installed
!

! use TAP::Harness::Restricted;

This Man Wrote Over 4 Modules, And We’ll Tell You
Their Secrets!

system(cowsay => $motto); ! !

system(cowsay => $motto); die "it failed" if $?; !

! ! system(cowsay => $motto); if ($?) { my $exit
= $? >> 8; die "it exited $exit"; }

! ! system(cowsay => $motto); if ($?) { my $exit
= $? >> 8; my $signal = $? & 127; die "it exited $exit" . ", signal $signal"; }

use Process::Status;

use Process::Status; system(cowsay => $motto);

use Process::Status; system(cowsay => $motto); my $p = Process::Status;

use Process::Status; system(cowsay => $motto); my $p = Process::Status; die
"it " . $p->as_string unless $p->is_success;

! use Process::Status;

my @todo = stuff_i_gotta_do; ! ! ! ! !

my @todo = sort { $a->priority <=> $b->priority } stuff_i_gotta_do;
! ! !

my @todo = sort { $a->todo eq 'eat pie' ?
-1 : $b->todo eq 'eat pie' ? 1 : $a->priority <=> $b->priority } stuff_i_gotta_do;

use Sort::ByExample 'sbe'; ! my $sorter = sbe( [ 'eat
pie', 'eat cake' ], { xform => sub { $_[0]->todo }, fallback => sub { $_[3]->priority <=> $_[2]->priority }, } ); ! my @todo = $sorter->( stuff_i_gotta_do );

use Sort::ByExample 'sbe'; ! my $sorter = sbe( [ 'eat
pie', 'eat cake' ], # <---- { xform => sub { $_[0]->todo }, fallback => sub { $_[3]->priority <=> $_[2]->priority }, } ); ! my @todo = $sorter->( stuff_i_gotta_do );

! use Sort::ByExample;

my $want = read_expected_file; my $have = perform_some_operation; ! is($have,
$want, "matching text");

not ok - matching text !

not ok - matching text # got: 'Everything is okay!'
# expected: 'Everything is okay!'

my $want = read_expected_file; my $have = perform_some_operation; ! is($have,
$want, "matching text");

use Test::BinaryData; ! my $want = read_expected_file; my $have =
perform_some_operation; ! is_binary($have, $want, "matching text"); !

# have (hex) have want (hex) want # 457665727974 Everyt
= 457665727974 Everyt # 68696e67a069 hing.i ! 68696e672069 hing i # 73a06f6b6179 s.okay ! 73206f6b6179 s okay # 21---------- ! = 21---------- !

! use Test::BinaryData;

open my $lock_fh, '>', 'lockfile'; flock $lock_fh, LOCK_EX

• locking over NFS is "interesting

• locking over NFS is "interesting • SQL locks are
released if your connection is interrutped

released if your connection is interrutped • (use autoreconnect? you won't notice!)

released if your connection is interrutped • (use autoreconnect? you won't notice!) • sometimes a really stupid hack is good enough

use DBIx::Locker; ! my $locker = DBIx::Locker->new(\%arg); ! for my
$todo (@agenda) { my $lock = $locker->lock($todo->id); ... }

CREATE TABLE semaphores ( id int PRIMARY KEY AUTO_INCREMENT, lockstring
varchar(128) UNIQUE, created datetime NOT NULL, expires datetime NOT NULL, locked_by text NOT NULL );

! use DBIx::Locker;

use less 'cpu'; ! ! ! ! !

use less 'cpu'; ! use less 'memory'; ! ! !

use less 'cpu'; ! use less 'memory'; ! use less
'stack'; !

'stack'; ! use less 'processes';

'stack'; ! use fewer 'processes';

! use fewer;

See This Amazing Language Change And Learn How You Gain!

! ! ! my $value = $from_config // 1; !
! 5.10's Best Change

$sock->send("UPDATE $key $value"); ! ! 5.10's Best Change (that's 5.8-safe)

$sock->send("UPDATE $key $value"); ! Use of uninitialized value in concatenation
(.) or string 5.10's Best Change (that's 5.8-safe)

$sock->send("UPDATE $key $value"); ! Use of uninitialized value ($key) in
concatenation (.) or string 5.10's Best Change (that's 5.8-safe)

$x ~~ $y 5.10's Worst Change

! ! ! package Mr::Fusion; ! ! 5.12's Best Change

! ! ! package Mr::Fusion 1.234; ! ! 5.12's Best
Change

! ! ! package Mr::Fusion 1.234; # <--- !!!! !
! 5.12's Best Change

! ! if (length $xyz) { ... } ! !
! ! ! 5.12's Best Change (that's 5.8-safe)

! if (length $xyz) { ... } ! if (length($xyz
// $xyz)) { ... } ! ! 5.12's Best Change (that's 5.8-safe)

! if (length $xyz) { ... } ! if (length($xyz
// $xyz)) { ... } ! if (defined $xyz && length $xyz) { ... } 5.12's Best Change (that's 5.8-safe)

if (length $xyz) { ... } ! if (length($xyz //
$xyz)) { ... } ! if (defined $xyz && length $xyz) { ... } ! if (length $xyx > 0) { ... } 5.12's Best Change (that's 5.8-safe)

... 5.12's Worst Change

if ($awesome) { $awesome->do_awesome_stuff; } else { ...; # can't
get here } 5.12's Worst Change

package Mr::Fusion 1.234; use strict; sub produce_energy { my ($self,
garbage) = @_; ... return $Watt * 1.21 * (10 ** 9); } 5.14's Best Change (it's a tie)

package Mr::Fusion 1.234 { use strict; sub produce_energy { my
($self, garbage) = @_; ... return $Watt * 1.21 * (10 ** 9); } } 5.14's Best Change (it's a tie)

(my $new = $old) =~ s!Mario!Luigi!; ! ! ! 5.14's
Best Change (it's a tie)

(my $y2013 = $y2012) =~ s!Mario!Luigi!g; ! my $y2013 =
$y2012 =~ s!Mario!Luigi!gr; ! 5.14's Best Change (it's a tie)

(my $y2013 = $y2012) =~ s!Mario!Luigi!g; ! my $y2013 =
$y2012 =~ s!Mario!Luigi!gr; ! my @y2013 = map {s!Mario!Luigi!gr} @y2012; 5.14's Best Change (it's a tie)

???? 5.14's Best Change (that's 5.8-safe)

???? 5.14's Worst Change

5.16's Best Change

print "I \N{HEAVY BLACK HEART} Perl!" 5.16's Best Change

print "I \N{HEAVY BLACK HEART} Perl!" ==> I ❤ Perl!
5.16's Best Change

5.16's Best Change (the other one)

my $fact = sub { my $n = shift; $n
== 1 ? 1 : $n * __SUB__->( $n - 1 ); }; 5.16's Best Change (the other one)

???? 5.16's Best Change (and worst) (5.8-safe)

5.18's Best Stuff • regex char class set operations •
the experimental warnings

5.20's Best Change??

my %hash = (a => 1, b => 2, c
=> 3); 5.20's Best Change??

my %hash = (a => 1, b => 2, c
=> 3); @hash{ qw( a c ) } ➜ (1, 3) 5.20's Best Change??

my %hash = (a => 1, b => 2, c
=> 3); @hash{ qw( a c ) } ➜ (1, 3) %hash{ qw( a c ) } ➜ (a => 1, c => 3); 5.20's Best Change??

my %hash = (a => 1, b => 2, c
=> 3); @hash{ qw( a c ) } ➜ (1, 3) %hash{ qw( a c ) } ➜ (a => 1, c => 3); @array = qw( a b c d ); 5.20's Best Change??

my %hash = (a => 1, b => 2, c
=> 3); @hash{ qw( a c ) } ➜ (1, 3) %hash{ qw( a c ) } ➜ (a => 1, c => 3); @array = qw( a b c d ); %array[ 0, 2, 1 ] 5.20's Best Change??

my %hash = (a => 1, b => 2, c
=> 3); @hash{ qw( a c ) } ➜ (1, 3) %hash{ qw( a c ) } ➜ (a => 1, c => 3); @array = qw( a b c d ); %array[ 0, 2, 1 ] ➜ (0 => 'a', 2 => 'c', 1 => 'd' ); 5.20's Best Change??

push @{ $user->{rjbs}{goals} }, "eat pie"; 5.20's Best Change?? (the
other one)

push $user->{rjbs}{goals}->@*, "eat pie"; 5.20's Best Change?? (the other one)

push $user->{rjbs}{goals}->@*, "eat pie"; 5.20's Best Change?? (the other one)
(or worst??)

Watch What Happens When We Move These Braces And Sigils!

my $user = { ... rjbs => { ..., goals
=> [ "eat risotto", "eat pie", ] }, };

push $user

push $user->{rjbs}

push $user->{rjbs} ->{goals}

push @{ $user->{rjbs} ->{goals} }, "";

push @todo, @{ $user->{rjbs} ->{goals} } ! expects_a_list(@{$x->{y}[0]});

push @{ $user->{rjbs} ->{goals} }, "";

push $user->{rjbs} ->{goals}->@*, "";

push @todo, @{ $user->{rjbs} ->{goals} } ! expects_a_list(@{$x->{y}[0]});

push @todo, $user->{rjbs} ->{goals}->@*; ! expects_a_list($x->{y}[0]->@*);

use experimental 'postderef';

use experimental 'postderef'; $array_ref->@*;

use experimental 'postderef'; $array_ref->@*; $scalarref->$*;

use experimental 'postderef'; $array_ref->@*; $scalarref->$*; $hash__ref->%*;

use experimental 'postderef'; $array_ref->@*; $scalarref->$*; $hash__ref->%*; $code__ref->&*;

use experimental 'postderef'; $array_ref->@*; $scalarref->$*; $hash__ref->%*; $code__ref->&*; $glob__ref->**;

use experimental 'postderef'; $array_ref->@*; $scalarref->$*; $hash__ref->%*; $code__ref->&*; $glob__ref->**; $array_ref->$#*; #
Sorry!

use experimental 'postderef';

use experimental 'postderef'; $array_ref->@[ 0, 1, 5 ];

use experimental 'postderef'; $array_ref->@[ 0, 1, 5 ]; $hash__ref->@{ qw(a
b) ];

b) ]; $array_ref->%[ 0, 1, 5 ];

b) ]; $array_ref->%[ 0, 1, 5 ]; $hash__ref->%{ qw(a b) ];

b) ]; $array_ref->%[ 0, 1, 5 ]; $hash__ref->%{ qw(a b) ]; $glob_ref->*{SCALAR}; # Sorry!

use experimental 'postderef'; ! say "Todo: $user->{todo}->@*";

Think Writing A Debugger Is Hard? Learn How Wrong You
Are!

$ perl -Dspot your-program.plx

$ perl -Dspot your-program.plx $ perl -d:Xyz your-program.plx

$ perl -Dspot your-program.plx $ perl -d:Xyz your-program.plx -D is
for debugging perl's code

$ perl -Dspot your-program.plx $ perl -d:Xyz your-program.plx -D is
for debugging perl's code -d is for debugging Perl code

! ! ! $ perl -d:Stupid my-program ! !

$ perl -d:Stupid my-program use Devel::Stupid; $^P = 1855;

0x001 debug sub entry/leave 0x002 call DB::DB per statement 0x004
turn off optimizer 0x008 save more stuff 0x010 keep sub definition info 0x020 single-step 0x040 use subroutine addrs 0x080 report "goto &sub" 0x100 better eval names 0x200 better sub names 0x400 source in @{"_<$file"}

package Devel::Stupid; ! package DB { sub DB { my
($package, $filename, $line) = caller; return unless $filename eq $0; Devel::LineTimer::emit_trace($filename, $line); } }

sub emit_trace {

sub emit_trace { my ($filename, $line) = @_;

sub emit_trace { my ($filename, $line) = @_; state $prev;

@code = @{"::_<$filename"};

@code = @{"::_<$filename"}; my $now = Time::HiRes:time();

@code = @{"::_<$filename"}; my $now = Time::HiRes:time(); $line_of_code = $code[ $line ];

@code = @{"::_<$filename"}; my $now = Time::HiRes:time(); $line_of_code = $code[ $line ]; if ($prev) {

@code = @{"::_<$filename"}; my $now = Time::HiRes:time(); $line_of_code = $code[ $line ]; if ($prev) { my $took = $time - $prev{time};

@code = @{"::_<$filename"}; my $now = Time::HiRes:time(); $line_of_code = $code[ $line ]; if ($prev) { my $took = $time - $prev{time}; printf "%8.04f %s", $took, $prev{code}; }

@code = @{"::_<$filename"}; my $now = Time::HiRes:time(); $line_of_code = $code[ $line ]; if ($prev) { my $took = $time - $prev{time}; printf "%8.04f %s", $took, $prev{code}; } $prev = { time => $time, code => $line_of_code }; }

0.0093 my $email = Email::MIME->create( 0.0028 my $smtp = Transport::SMTP->new({
1.7395 $smtp->send($email, {

I Used To Write Coverage Tests, Then I Learned This
One Trick!

if ( $not_likely

if ( $not_likely && $really_rare

if ( $not_likely && $really_rare && $does_this_ever_happen ) {

if ( $not_likely && $really_rare && $does_this_ever_happen ) { #
some really # annoying-to-maintain # code }

if ( $not_likely && $really_rare && $does_this_ever_happen ) { Carp::cluck("annoying-code");
# some really # annoying-to-maintain # code ! }

if ( $not_likely && $really_rare && $does_this_ever_happen ) { syslog("annoying-code");

if ( $not_likely && $really_rare && $does_this_ever_happen ) { log_to_db("annoying-code");

if ( $not_likely && $really_rare && $does_this_ever_happen ) { alive("annoying-code");

sub alive { my ($ident) = @_; ! my $sock
= IO::Socket::INET->new( Proto => 'udp', PeerAddr => "$HOST:$PORT", ); ! unless ($sock) { warn "error opening UDP socket: $!"; return; } ! my $data = JSON->new->encode({ ident => $ident, user => getpwuid($>) || '(unknown)', }); ! $sock->send($data) or warn "couldn't send: $!"; }

my $sock = IO::Socket::INET->new( Proto => 'udp', LocalHost => 0,
LocalPort => 3030, MultiHomed => 1, ); while (1) { my $addr = $sock->recv(my $data, 1024); my (undef, $remote) = sockaddr_in($addr); my $ip_addr = inet_ntoa($remote_addr); ! ## log data and ip_addr to file }

Write More Client-Server Programs!

Fork Your Process And Load Some Code. You Won’t Believe
What Happens Next!

my $f = 20; ! # prepare for spawning! !
while ($f--) { if (fork) { next; } else { # do stuff sleep 30; exit; } } ! while (1) { my $pid = wait; last if $pid == -1; say "$pid exited"; }

1700 + 84 * 20 ≅ 3 M

while ($f--) { if (fork) { next; } else { # do stuff sleep 30; exit; } } ! while (1) { my $pid = wait; last if $pid == -1; say "$pid exited"; }

while ($f--) { if (fork) { next; } else { require Dist::Zilla; sleep 30; exit; } } ! while (1) { my $pid = wait; last if $pid == -1; say "$pid exited"; }

1900 + 25400 * 20 ≅ 510 M

while ($f--) { if (fork) { next; } else { require Dist::Zilla; sleep 30; exit; } } ! while (1) { my $pid = wait; last if $pid == -1; say "$pid exited"; }

my $f = 20; ! # prepare for spawning! require
Dist::Zilla; ! while ($f--) { if (fork) { next; } else { # do work exit; } } ! while (1) { my $pid = wait; last if $pid == -1; say "$pid exited"; }

1900 + 25400 * 20 ≅ 23 M

! use prefork;

prefork what?

(hilarious story about how rjbs found out he was loading
stuff post-fork)

package PostForkINC; ! sub import { my ($self, $code) =
@_; ! my $pid = $$; ! my $callback = sub { return if $pid == $$; my (undef, $filename) = @_; $code->($filename); return; }; ! unshift @INC, $callback; };

package PostForkINC::Alive; ! sub import { my ($class, $ident) =
@_; ! require PostForkINC; PostForkINC->import(sub { my ($filename) = @_; $filename =~ s{\.pm\z}{}; alive("postfork.$ident.$filename"); }); } use PostForkINC::Alive 'pie-eater';

postfork.riddle-mda.Class-ISA postfork.riddle-mda.Crypt-SSLeay postfork.riddle-mda.Crypt-SSLeay-CTX postfork.riddle-mda.Crypt-SSLeay-MainContext postfork.riddle-mda.Crypt-SSLeay-X509 postfork.riddle-mda.DBD-mysql-GetInfo postfork.riddle-mda.DBIx-Class-Cursor postfork.riddle-mda.DBIx-Class-SQLMaker postfork.riddle-mda.DBIx-Class-SQLMaker-LimitDialects postfork.riddle-mda.DBIx-Class-SQLMaker-MySQL
postfork.riddle-mda.DBIx-Class-Storage-DBI-Cursor postfork.riddle-mda.DBIx-Class-Storage-DBI-mysql postfork.riddle-mda.Data-Hive-PathPacker postfork.riddle-mda.Data-Hive-PathPacker-Strict postfork.riddle-mda.Email-Date-Format postfork.riddle-mda.Encode-Byte postfork.riddle-mda.Encode-CJKConstants postfork.riddle-mda.Encode-CN postfork.riddle-mda.Encode-CN-HZ postfork.riddle-mda.Encode-JP postfork.riddle-mda.Encode-JP-JIS7 postfork.riddle-mda.Encode-KR postfork.riddle-mda.Encode-KR-2022_KR postfork.riddle-mda.Encode-MIME-Header postfork.riddle-mda.Encode-TW postfork.riddle-mda.HTML-Entities postfork.riddle-mda.HTML-HeadParser postfork.riddle-mda.HTML-Parser postfork.riddle-mda.HTTP-Config postfork.riddle-mda.HTTP-Headers-Util postfork.riddle-mda.HTTP-Request-Common postfork.riddle-mda.Hash-Merge postfork.riddle-mda.LWP-Protocol-https postfork.riddle-mda.Net-DNS-RR-A postfork.riddle-mda.Net-DNS-RR-CNAME postfork.riddle-mda.Net-DNS-RR-MX postfork.riddle-mda.Net-DNS-RR-PTR postfork.riddle-mda.Net-DNS-RR-SOA postfork.riddle-mda.Net-HTTPS

These Git Tips Will Make You Hate Using CVS At
Work Even More.

[alias] ci = commit -a cl = clean -dfx cc
= cherry-pick ff = merge --ff-only fx = commit -a --amend -C HEAD ix = diff --cached st = status -sb fap = fetch --all --prune wip = commit -a -m WIP git = !git

hist = log --graph --all \ --color=always \ --decorate !
shist = log --graph \ --color=always \ --decorate

$ git hists

$ git re-edit • if there are dirty files, edit
them • otherwise, edit the files edited in last commit • or supply a commit to edit the files changed in it

if ($commit) { chomp(@changed = grep /\S/, qx{git show --pretty="format:"
--name-only $commit}); } else { chomp(@changed = qx{git status -- porcelain}); exit 1 unless $? == 0; @changed = grep !/^\?\? /, @changed unless $opt{q}; s/^.. // or die "<$_>???\n" for @changed; s/.* -> // for @changed; die "Fucking shell, how does it work?\n" if grep / /, @changed; ! chomp(@changed = qx{find @changed -type f }) if @changed; exit 1 unless $? == 0; }

extending git is easy • the git-* convention • it's
all built on mostly-simple commands • (even if some of them are sort of dumb) • look at the commands I showed for examples

https://github.com/rjbs/rjbs-dots (and https://github.com/mjdominus/git-util)

rjbs-dots??

You Won’t Believe A Program So Badly Named Could Be
So Useful

• brand new server every time!

• brand new server every time! • user accounts created
automatically

automatically • vim, emacs, whatever you need: installed

automatically • vim, emacs, whatever you need: installed • all thrown away when you're done

https://github.com/ingydotnet/pairup

automatically • vim, emacs, whatever you need: installed • all thrown away when you're done

automatically • vim, emacs, whatever you need: installed • all thrown away when you're done • but where are my dotfiles?

ask me about a referral!

dots: ! - repo: [email protected]:rjbs/rjbs-dots.git - repo: [email protected]:rjbs/rjbs-osx-dots.git - repo:
[email protected]:rjbs/rjbs-vim-dots.git - repo: [email protected]:git/rjbs-mail-dots.git - repo: [email protected]:git/rjbs-private-dots.git

! dots: ! - repo: [email protected]:rjbs/rjbs-dots.git - repo: [email protected]:rjbs/rjbs-osx-dots.git -
repo: [email protected]:rjbs/rjbs-vim-dots.git - repo: [email protected]:git/rjbs-mail-dots.git - repo: [email protected]:git/rjbs-private-dots.git ! - repo: [email protected]:git/rjbs-work-dots.git

Dude, where's my .zshrc? ! ! dots: ! - repo:
[email protected]:rjbs/rjbs-dots.git - repo: [email protected]:rjbs/rjbs-osx-dots.git - repo: [email protected]:rjbs/rjbs-vim-dots.git - repo: [email protected]:git/rjbs-mail-dots.git - repo: [email protected]:git/rjbs-private-dots.git ! ! !

dots: - repo: [email protected]:sharpsaw/loop-dots.git - repo: [email protected]:rjbs/rjbs-dots.git - repo: [email protected]:rjbs/rjbs-osx-dots.git
- repo: [email protected]:rjbs/rjbs-vim-dots.git - repo: [email protected]:git/rjbs-mail-dots.git - repo: [email protected]:git/rjbs-private-dots.git

# the meat of loop-dot/.zshrc: ! ...eachsource .zshrc ! ...sourcedircontents
~/.zsh/rc

use ...

use ... • get your dotfiles under version control

use ... • get your dotfiles under version control •
…and shared between your computers

…and shared between your computers • …but still with per-host-specific stuff

…and shared between your computers • …but still with per-host-specific stuff • …and split between shareable and private

…and shared between your computers • …but still with per-host-specific stuff • …and split between shareable and private • …so you can share your config!

…and shared between your computers • …but still with per-host-specific stuff • …and split between shareable and private • …so you can share your config! • …and maybe do more pairing!

If You Don’t Know What You Haven’t Been Doing, You
Can Help Yourself Find Out!

Life is short. Don't waste time.

Actually, I waste a lot of time.

Goal: waste less

http://tdp.me/

You know what's a great way to waste time?

Clicking "I did this!"

RunKeeper

RunKeeper Withings

RunKeeper Withings IMAP

RunKeeper Withings IMAP GitHub

RunKeeper Withings IMAP GitHub RememberTheMilk

RunKeeper Withings IMAP GitHub RememberTheMilk FeedBin

RunKeeper Withings IMAP GitHub RememberTheMilk FeedBin GoodReads

RunKeeper Withings IMAP GitHub RememberTheMilk FeedBin GoodReads Rubric

RunKeeper Withings IMAP GitHub RememberTheMilk FeedBin GoodReads Rubric Instapaper

No more clicking! (well, much less)

http://github.com/rjbs/Ywar (but that's not the point)

You already produce a lot of data, that can tell
you a lot about what you're doing! (that's the point)

sub did_reading { my ($self, $prev) = @_; # Recorded
is the number of items that were 14 days old yesterday. The # number of items 15 days old today should be fewer. my %count; # stupid passing of $self is a temporary situation -- rjbs, 2013-11-04 my @bookmarks = Ywar::Instapaper->bookmark_list($self); my $old_14 = grep { $_->{time} < $^T - 14 * 86_400 } @bookmarks; my $old_15 = grep { $_->{time} < $^T - 15 * 86_400 } @bookmarks; my $last = $prev->{measured_value}; my %result; if ($old_15 < $last) { my $closed = $last - $old_15; @result{ qw(note met_goal) } = ("items read or deleted: $closed", 1); } $result{value} = $old_14; return \%result; }

sub bookmark_list { my ($self, $configger) = @_; my $c_key
= $configger->consumer_key; my $c_secret = $configger->consumer_secret; my $ua = LWP::Authen::OAuth->new( oauth_consumer_secret => $c_secret, oauth_token => $configger->oauth_token, oauth_token_secret => $configger->oauth_token_secret, ); my $r = $ua->post( 'https://www.instapaper.com/api/1/bookmarks/list', [ limit => 200, oauth_consumer_key => $c_key, ], ); my @bookmarks = sort {; $a->{time} <=> $b->{time} } grep {; $_->{type} eq 'bookmark' } @{ JSON->new->decode($r->decoded_content) }; return @bookmarks; }

= $configger->consumer_key; my $c_secret = $configger->consumer_secret; my $ua = LWP::Authen::OAuth->new( oauth_consumer_secret => $c_secret, oauth_token => $configger->oauth_token, oauth_token_secret => $configger->oauth_token_secret, ); my $r = $ua->post( 'https://www.instapaper.com/api/1/bookmarks/list', [ limit => 200, oauth_consumer_key => $c_key, ], ); my @bookmarks = sort {; $a->{time} <=> $b->{time} } grep {; $_->{type} eq 'bookmark' } @{ JSON->new->decode($r->decoded_content) }; return @bookmarks; } LWP::Authen::OAuth

API Auth

API Auth • Basic HTTP Authentication: means sharing pw

API Auth • Basic HTTP Authentication: means sharing pw •
In-site token generation: user as token broker

In-site token generation: user as token broker • OAuth 1: strict protocol, complex helper libs

In-site token generation: user as token broker • OAuth 1: strict protocol, complex helper libs • OAuth 2: it's more like a state of mind

= $configger->consumer_key; my $c_secret = $configger->consumer_secret; my $ua = LWP::Authen::OAuth->new( oauth_consumer_secret => $c_secret, oauth_token => $configger->oauth_token, oauth_token_secret => $configger->oauth_token_secret, ); my $r = $ua->post( 'https://www.instapaper.com/api/1/bookmarks/list', [ limit => 200, oauth_consumer_key => $c_key, ], ); my @bookmarks = sort {; $a->{time} <=> $b->{time} } grep {; $_->{type} eq 'bookmark' } @{ JSON->new->decode($r->decoded_content) }; return @bookmarks; }

my $ua = LWP::Authen::OAuth->new( oauth_consumer_secret => $c_secret, oauth_token => $configger->oauth_token,
oauth_token_secret => $configger->oauth_token_secret, );

my $client = Net::OAuth::Client->new( $self->api_key, $self->secret, site => 'https://oauth.withings.com/', request_token_path
=> '/account/request_token', authorize_path => '/account/authorize', access_token_path => '/account/access_token', callback => 'oob', );

my $client = OAuth::Lite2::Client::WebServer->new( id => $id, secret => $secret,
authorize_uri => q{https://runkeeper.com/apps/authorize}, access_token_uri => q{https://runkeeper.com/apps/token}, ); ! my $url = $client->uri_to_redirect( redirect_uri => q{http://rjbs.manxome.org/}, ); ! say $url; chomp( my $code = <STDIN> ); ! my $access_token = $client->get_access_token( code => $code, redirect_uri => q{http://rjbs.manxome.org/}, ) or die $client->errstr; ! print Dumper({ access_token => $access_token->access_token, expires_at => time() + $access_token->expires_in, refresh_token => $access_token->refresh_token, });

my $auth = base64_encode("$user:$pass", ""); my $ua = LWP::UserAgent->new(keep_alive =>
1); $ua->default_header(Authorization => "Basic $auth"); my $res = $ua->get("https://api.feedbin.me/v2/entries.json");

Web service APIs have reinvigorated my love of programming. (that's
the other point)

This Code Sucks, But You’ll Wish You Could Have Written
It… And You Can Have!

# cronjob! ! if ( ! timer_running ) { send_angry_email
unless just_sent_email; }

email?!

oh no, I can't run IRC in cron!

package SampleBot; use Moses; server 'irc.perl.org'; nickname 'sample-bot'; channels '#bots';
event irc_bot_addressed => sub { my ($self, $nickstr, $channel, $msg) = @_[OBJECT, ARG0, ARG1, ARG2]; my ($nick) = split /!/, $nickstr; $self->privmsg( $channel => "$nick: Hey there." ); }; SampleBot->run;

event START => sub { my ($self) = $_[OBJECT]; $self->delay(300
=> 'consider_nagging'); }; ! event consider_nagging => sub { my ($self) = $_[OBJECT]; $self->delay(300 => 'consider_nagging'); return if $self->timer_running; return if $self->nagged_recently; $self->send_angry_privmsg; };

sometimes I don't look at IRC

…um…

well… pretend that's true…

event consider_nagging => sub { my ($self) = $_[OBJECT]; $self->delay(300
=> 'consider_nagging'); return if $self->timer_running; return if $self->nagged_recently; $self->send_angry_privmsg; };

event consider_nagging => sub { my ($self) = $_[OBJECT]; $self->delay(300
=> 'consider_nagging'); return if $self->timer_running; return if $self->nagged_recently; if ($self->being_ignored) { $self->send_angry_sms; } else { $self->send_angry_privmsg; $self->being_ignored(1); } };

(best. API. ever.)

sub sms { my ($self, $number, $msg) = @_; !
my $ua = LWP::UserAgent->new; my $res = $ua->post( "https://api.twilio.com/2010-04-01/Accounts/$SID/SMS/Messages", { From => $my_twilio_number, To => $number, Body => $msg, }, Authorization => "Basic $AUTH}", ); }

but sometimes I'm at lunch

I don't wanna get nagged through my whole meal!

OM NOM NOM

POE::Component::Server::SimpleHTTP->new( ALIAS => 'httpd', ADDRESS => 0, PORT => $self->httpd_port,
HANDLERS => [ { DIR => '^/sms$', SESSION => 'Synergy', EVENT => '_http_sms', }, ], );

POE::Component::Server::SimpleHTTP->new( ALIAS => 'httpd', ADDRESS => 0, PORT => $self->httpd_port,
HANDLERS => [ { DIR => '^/sms$', SESSION => 'Synergy', EVENT => '_http_sms', }, ], ); event _http_sms => sub { my ($kernel, $self, $req, $res) = @_[KERNEL, OBJECT, ARG0, ARG1]; $response->code(200); $response->content( $self->response_for($req) ); $kernel->call( 'httpd', 'DONE', $response ); };

http://github.com/rjbs/Synergy (but that's not the point)

If you're not mashing up web service APIs with an
asynchronous daemon…

If you're not mashing up web service APIs with an
asynchronous daemon… …you are living a half life.

http://twitter.com/UUENS

Zork Z-Machine

Zork Z-Machine ZASM

Zork Z-Machine ZASM ZSCII

Any questions?

Thank you!

1.21 Gigawatts

1.21 Gigawatts

More Decks by Ricardo Signes

Other Decks in Programming

Featured

Transcript