Good Evils In Perl (Yapc Asia)

Good Evils in Perl
Kang-min Liu <gugod@gugod.org>
YAPC::Asia::2009

TIMTOWTDI
There is more then one way to do it

warnings
gives you good warning messages

Can anyone tell me if
there’s any problem in
this small program ?

foo.pl

#!/usr/bin/perl -l

print $foo;
print "Hello";

#!/usr/bin/perl -l

print $foo;
print "Hello";

#!/usr/bin/perl -l
use warnings;
print $foo;
print "Hello";

#!/usr/bin/perl -l
use warnings;
print $foo;
print "Hello";

Use of uninitialized value $foo in print

switch
given ($foo) {
when (1) { say "$foo == 1" }
when ([2,3]) {
say "$foo == 2 || $foo == 3"
}
when (/^a[bc]d$/) {
say "$foo eq 'abd' || $foo eq 'acd'"
}
when ($_ > 100) { say "$foo > 100" }
default { say "None of the above" }
}

state variables

sub counter {
state $counts = 0;
$counts += 1;
}

Perl6::*
Perl6 functions implemented in Perl5

Perl6::Junctions
any, all, one, none

Q:
How to test if an
array contains a
speciﬁc value ?

my $found = 0;
for my $a (@a) {
if ($a == 42) {
$found = 1;
last;
}
}
if ($found) {
...
}

if ( grep { $_ == 42 } @a ) {
...
}

if ( grep /^42$/ @a ) {
...
}

use Perl6::Junction qw/ all any none one /;

if ( any(@ar) == 42 ) {
...
}

if ( all(@ar) > 42 ) {
...
}

if (none(@ar) > 42 ) {
...
}

if ( one(@ar) > 42 ) {
...
}

any(values %params) == undef

html form validation

any(@birthdays) < str2time("1980/01/01")

Can anyone see what it
does now ?

Can anyone write a
nested loop version in 10
seconds ?

if ( any(@a) == any(@b) ) {
...
}

• Perl6::Junction (any, all)
• Perl6::Perl
• Perl6::Builtins (system, caller)
• Perl6::Form
• Perl6::Gather

my $range = 10−>to(1);
# => [ 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 ]

"Hello, world!"−>uc();
# => "HELLO, WORLD!"

TryCatch
ﬁrst class try catch semantics

sub foo {
eval {
# some code that might die
return "return value from foo";
};
if ($@) {
...
}
}

sub foo {
try {
# some code that might die
return "return value from foo";
}
catch (Some::Error $e where { $_->code > 100 } ) {
...
}
}

Sub::Alias
easier function alias

sub name { "gugod" }

alias get_name => 'name';
alias getName => 'name';

package MyClass;

sub myMethod {
my $self = shift;
...
}

package MyClass;
use self;

sub myMethod {

...
}

package Point;
use Moose;

has 'x' => (is => 'rw', isa => 'Int');
has 'y' => (is => 'rw', isa => 'Int');

sub clear {
my $self = shift;
$self->x(0);
$self->y(0);
}

class BankAccunt {
has 'balance' => (
isa => 'Num', is => 'rw', default => 0
);

method deposit (Num $amount) {
$self->balance( $self−>balance + $amount );
}

method withdraw (Num $amount) {
my $current_balance = $self−>balance();
( $current_balance >= $amount )
|| confess "Account overdrawn";
$self->balance( $current_balance − $amount );
}
}

h1 {
attr { id => "lipsum" };
outs "Lorem Ipsum";
};

# => <h1 id="lipsum">Lorem Ipsum></h1>

h1(id => "lipsum") {
outs "Lorem Ipsum";
};

# => <h1 id="lipsum">Lorem Ipsum></h1>

package Cat;
use Rubyish;

attr_accessor "name", "color";

def sound { "meow, meow" }

def speak {
print "A cat goes " . $self−>sound . "n";
}

sub doMyWork {
my ($arr1, $arr2) = @_;
my @arr1 = @$arr1;
my @arr2 = @$arr2;
...
}

doMyWork(@foo, @bar);

sub doMyWork(@@) {
my ($arr1, $arr2) = @_;
my @arr1 = @$arr1;
my @arr2 = @$arr2;
...
}

doMyWork(@foo, @bar);

if (many { $_ > 50 } @arr) {
...
}

sub many(&@) {
my ($test_sub, @arr) = @_;
...
}

Good Evils In Perl (Yapc Asia)

sub AUTOLOAD {
my $program = $AUTOLOAD;
$program =~ s/.*:://;
system($program, @_);
}
date();
who('am', 'i');
ls('−l');

Android.pm
sub AUTOLOAD {
my ($method) = ($AUTOLOAD =~ /::(w+)$/);
return if $method eq 'DESTROY';
# print STDERR "$0: installing proxy method '$method'n";
my $rpc = rpc_maker($method);
{
# Install the RPC proxy method, we will not came here
# any more for the same method name.
no strict 'refs';
*$method = $rpc;
}
goto &$rpc; # Call the RPC now.
}

package BANG;
use Filter::Simple;

FILTER {
s/BANGs+BANG!!!/die 'BANG' if $BANG/g;
};

1;

use Acme::Morse;
.--.-..--..---.-.--..--.-..--..---.-.--.
.-.-........---..-..---.-..-.--..---.--.
..-.---......-...-...-..--..-.-.-.--.-..
----..-.-.--.-..--..-.-...---.-..---.--.
.-...-..--.---...-.-....

perl -MModule::Compile Foo.pm
# => Foo.pmc

DB
inheritable built-in debugger

# from self.pm
sub _args {
my $level = 2;
my @c = ();
package DB;
@c = caller($level++)
while !defined($c[3]) || $c[3] eq '(eval)';
return @DB::args;
}

sub self { (_args)[0] }

Furthermore, when called from within the DB package, caller
returns more detailed information: it sets the list variable
@DB::args to be the arguments with which the subroutine was
invoked.
# from self.pm – perldoc caller
sub _args {
my $level = 2;
my @c = ();
package DB;
@c = caller($level++)
while !defined($c[3]) || $c[3] eq '(eval)';
return @DB::args;
}

sub self { (_args)[0] }

PadWalker
runtime stack traveler

sub inc_x {
my $h = peek_my(1);
${ $h->{'$x'} }++;
}

Binding
easier PadWalker (Rubyish)

use Binding;

sub inc_x {
my $b = Binding->of_caller;
$b->eval('$x + 1');
}

sub two {
my $x = 1;
inc_x;
}

Devel::Declare
compile-time magician

Devel::Declare
compile-time magician

Florian Ragwitz
id:ﬂora

How it works

• you deﬁne “declarator” keywords
• it let compiler stop at the keywords
• your code parse the current line in your way,
maybe re-write it

• you replace current line with the new one
• resumes the compiler on the current line

def foo($arg1, $arg2) {
....
}

def foo($arg1, $arg2) {
....
}

sub foo {
my ($arg1, $arg2) = @_;
}

Perl6 is perfect
by Larry Wall
youtube: “Larry Wall Speaks at Google”

• DB
• Devel::Declare, B::*
• prototype

Good Evil

Template::Declare prototype

Markapl Devel::Declare

self DB, B::*

TryCatch Devel::Declare

Try::Tiny prototype

some Perl6::* source ﬁlter

Perl is like the
Force. It has a light
side, a dark side,
and it holds the
universe together.
Larry Wall

It needs add some
“mondern” traits

Extend Perl5 with any
“Modern Sense” of a
modern programming
language.

Thanks for Listening
http://youtube.com/gugod/ for cat videos

Good Evils In Perl (Yapc Asia)

Recommended

More Related Content

What's hot (20)

Viewers also liked (9)

Similar to Good Evils In Perl (Yapc Asia) (20)

More from Kang-min Liu (15)

Recently uploaded (20)

Good Evils In Perl (Yapc Asia)

Editor's Notes