1.21 Gigawatts

1.

1.21 Gigawatts

2.

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

3.

None

4.

None

5.

use List::Util;

6.

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

7.

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

8.

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

9.

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

10.

None

11.

use List::MoreUtils;

12.

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

13.

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

14.

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

15.

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

16.

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

17.

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

18.

! use List::AllUtils;

19.

use Pobox; ! ! ! ! ! !

20.

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

21.

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

22.

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

23.

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

24.

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

25.

! use aliased;

26.

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

27.

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

28.

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

29.

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

30.

! use autodie;

31.

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

32.

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

33.

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

34.

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

35.

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

36.

! use PerlIO::gzip;

37.

None

38.

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

39.

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

40.

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

41.

! use if;

42.

$ cpan Dist::Zilla ! ! !

43.

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

44.

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

45.

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

46.

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

47.

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

48.

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

49.

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

50.

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

51.

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

52.

! ! $ cpan Dist::Zilla ! ! !

53.

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

54.

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

55.

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

56.

! use TAP::Harness::Restricted;

57.

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

58.

system(cowsay => $motto); ! !

59.

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

60.

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

61.

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

62.

None

63.

use Process::Status;

64.

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

65.

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

66.

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

67.

! use Process::Status;

68.

my @todo = stuff_i_gotta_do; ! ! ! ! !

69.

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

70.

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

71.

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 );

72.

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 );

73.

! use Sort::ByExample;

74.

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

75.

not ok - matching text !

76.

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

77.

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

78.

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

79.

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

80.


81.


82.

! use Test::BinaryData;

83.

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

84.

None

85.

• locking over NFS is "interesting

86.

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

87.

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

88.

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

89.

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

90.

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 );

91.

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 );

92.

! use DBIx::Locker;

93.

use less 'cpu'; ! ! ! ! !

94.

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

95.

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

96.

'stack'; ! use less 'processes';

97.

'stack'; ! use fewer 'processes';

98.

! use fewer;

99.

See This Amazing Language Change And Learn How You Gain!

100.

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

101.

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

102.

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

103.

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

104.

$x ~~ $y 5.10's Worst Change

105.

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

106.

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

107.

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

108.

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

109.

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

110.

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

111.

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)

112.

... 5.12's Worst Change

113.

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

114.

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)

115.

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)

116.

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

117.

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

118.

(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)

119.

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

120.

???? 5.14's Worst Change

121.

5.16's Best Change

122.

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

123.

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

124.

5.16's Best Change (the other one)

125.

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

126.

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

127.

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

128.

5.20's Best Change??

129.

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

130.

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

131.

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??

132.

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??

133.

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??

134.

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??

135.

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

136.

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

137.

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

138.

Watch What Happens When We Move These Braces And Sigils!

139.

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

140.

push $user

141.

push $user->{rjbs}

142.

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

143.

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

144.


145.

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

146.


147.


148.

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

149.

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

150.

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

151.

None

152.

use experimental 'postderef';

153.

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

154.

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

155.

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

156.

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

157.

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

158.

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

159.

None

160.

use experimental 'postderef';

161.

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

162.

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

163.

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

164.

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

165.

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

166.

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

167.

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

168.

None

169.

$ perl -Dspot your-program.plx

170.

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

171.

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

172.

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

173.

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

174.

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

175.

None

176.

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

177.

$^P

178.

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"}

179.


180.


181.

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

182.

None

183.

sub emit_trace {

184.

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

185.

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

186.

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

187.

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

188.

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

189.

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

190.

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

191.

@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}; }

192.

@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 }; }

193.

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

194.

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

195.

None

196.

if ( $not_likely

197.

if ( $not_likely && $really_rare

198.

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

199.

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

200.

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

201.

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

202.

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

203.

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

204.

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: $!"; }

205.

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 }

206.

Write More Client-Server Programs!

207.

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

208.

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"; }

209.

1700 + 84 * 20 ≅ 3 M

210.

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

211.

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

212.

1900 + 25400 * 20 ≅ 510 M

213.

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

214.

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"; }

215.

1900 + 25400 * 20 ≅ 23 M

216.

! use prefork;

217.

prefork what?

218.

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

219.

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

220.

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';

221.

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

222.

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

223.

[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

224.

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

225.

None

226.

$ git hists

227.

None

228.

$ 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

229.

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; }

230.

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

231.

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

232.

rjbs-dots??

233.

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

234.

None

235.

None

236.

None

237.

None

238.

None

239.

None

240.

None

241.

None

242.

None

243.

• brand new server every time!

244.

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

245.

automatically • vim, emacs, whatever you need: installed

246.

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

247.

https://github.com/ingydotnet/pairup

248.

None

249.

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

250.

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

251.

None

252.

ask me about a referral!

253.

dots: ! - repo: git@github.com:rjbs/rjbs-dots.git - repo: git@github.com:rjbs/rjbs-osx-dots.git - repo:
git@github.com:rjbs/rjbs-vim-dots.git - repo: rjbs@git.rj.bs:git/rjbs-mail-dots.git - repo: rjbs@git.rj.bs:git/rjbs-private-dots.git

254.


255.


256.


257.

! dots: ! - repo: git@github.com:rjbs/rjbs-dots.git - repo: git@github.com:rjbs/rjbs-osx-dots.git -
repo: git@github.com:rjbs/rjbs-vim-dots.git - repo: rjbs@git.rj.bs:git/rjbs-mail-dots.git - repo: rjbs@git.rj.bs:git/rjbs-private-dots.git ! - repo: rjbs@git.wo.rk:git/rjbs-work-dots.git

258.

Dude, where's my .zshrc? ! ! dots: ! - repo:
git@github.com:rjbs/rjbs-dots.git - repo: git@github.com:rjbs/rjbs-osx-dots.git - repo: git@github.com:rjbs/rjbs-vim-dots.git - repo: rjbs@git.rj.bs:git/rjbs-mail-dots.git - repo: rjbs@git.rj.bs:git/rjbs-private-dots.git ! ! !

259.

dots: - repo: git@github.com:sharpsaw/loop-dots.git - repo: git@github.com:rjbs/rjbs-dots.git - repo: git@github.com:rjbs/rjbs-osx-dots.git
- repo: git@github.com:rjbs/rjbs-vim-dots.git - repo: rjbs@git.rj.bs:git/rjbs-mail-dots.git - repo: rjbs@git.rj.bs:git/rjbs-private-dots.git

260.

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

261.

use ...

262.

use ... • get your dotfiles under version control

263.

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

264.

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

265.

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

266.

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

267.

…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!

268.

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

269.

Life is short. Don't waste time.

270.

Actually, I waste a lot of time.

271.

Goal: waste less

272.

http://tdp.me/

273.

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

274.

Clicking "I did this!"

275.

None

276.

RunKeeper

277.

RunKeeper Withings

278.

RunKeeper Withings IMAP

279.

RunKeeper Withings IMAP GitHub

280.

RunKeeper Withings IMAP GitHub RememberTheMilk

281.

RunKeeper Withings IMAP GitHub RememberTheMilk FeedBin

282.

RunKeeper Withings IMAP GitHub RememberTheMilk FeedBin GoodReads

283.

RunKeeper Withings IMAP GitHub RememberTheMilk FeedBin GoodReads Rubric

284.

RunKeeper Withings IMAP GitHub RememberTheMilk FeedBin GoodReads Rubric Instapaper

285.

No more clicking! (well, much less)

286.

None

287.

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

288.

None

289.

None

290.

None

291.

None

292.

None

293.

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

294.

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; }

295.

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; }

296.

= $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

297.

API Auth

298.

API Auth • Basic HTTP Authentication: means sharing pw

299.

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

300.

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

301.

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

302.

= $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; }

303.

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

304.

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', );

305.

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, });

306.

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");

307.

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

308.

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

309.

None

310.

None

311.

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

312.

email?!

313.

IRC!

314.

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

315.

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;

316.

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; };

317.

sometimes I don't look at IRC

318.

…um…

319.

well… pretend that's true…

320.

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; };

321.

=> '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); } };

322.

=> '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); } };

323.

(best. API. ever.)

324.

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}", ); }

325.

but sometimes I'm at lunch

326.

None

327.

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

328.

None

329.

None

330.

OM NOM NOM

331.

None

332.

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

333.

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 ); };

334.

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

335.

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

336.

asynchronous daemon… …you are living a half life.

337.

asynchronous daemon… …you are living a half life.

338.

http://twitter.com/UUENS

339.

None

340.

Zork

341.

Zork Z-Machine

342.

Zork Z-Machine ZASM

343.

Zork Z-Machine ZASM ZSCII

344.

None

345.

Any questions?

346.

Thank you!

1.21 Gigawatts

1.21 Gigawatts

Want more?

Transcript