![Filter::Util::Call
package MyFilter;
use Filter::Util::Call;
sub import
{ my ($type, @arguments) = @_ ;
filter_add([ ]) ;
}
sub filter
{ my ($self) = @_ ;
my ($status) ;
$status = filter_read();
#Do magic with $_ if $status > 0
return $status;
}
1;](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-37-320.jpg)
![Filter::Util::Call
package MyFilter;
use Filter::Util::Call;
import is called when module is “used”
sub import
{ my ($type, @arguments) = @_ ;
filter_add([ ]) ;
}
sub filter
{ my ($self) = @_ ;
my ($status) ;
$status = filter_read();
#Do magic with $_ if $status > 0
return $status;
}
1;](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-38-320.jpg)
![Filter::Util::Call
package MyFilter;
use Filter::Util::Call;
sub import
{ my ($type, @arguments) = @_ ;
filter_add([ ]) ;
}
sub filter
{ my ($self) = @_ ;
my ($status) ;
$status = filter_read();
if ($status) { $_ =~ s/World/Belgian Perl Workshop/g; }
return $status;
}
1; # Hello World -> Hello Belgian Perl Workshop](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-39-320.jpg)
![Filter::NumberLines
package Filter::NumberLines;
use Filter::Util::Call;
sub import
{ my ($type, @arguments) = @_ ;
filter_add([ ]) ;
}
sub filter
{ my ($self) = @_ ;
my ($status) ;
$status = filter_read();
if ($status) { $_ =~ s/^d+:t//gm; }
return $status;
}
1;](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-40-320.jpg)
![Acme::Bleach
package Acme::Bleach;
my $tie = " t"x8;
sub whiten { local $_ = unpack "b*", pop; tr/01/ t/; s/(.{9})/$1n/g; $tie.$_ }
sub brighten { local $_ = pop; s/^$tie|[^ t]//g; tr/ t/01/; pack "b*", $_ }
sub dirty { $_[0] =~ /S/ }
sub dress { $_[0] =~ /^$tie/ }
open 0 or print "Can't rebleach '$0'n" and exit;
(my $shirt = join "", <0>) =~ s/.*^s*uses+Acme::Bleachs*;n//sm;
local $SIG{__WARN__} = &dirty;
do { eval brighten $shirt; exit } unless dirty $shirt && not dress $shirt;
open 0, ">$0" or print "Cannot bleach '$0'n" and exit;
print {0} "use Acme::Bleach;n", whiten $shirt and exit;](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-76-320.jpg)
![Acme::Buffy
my $horns = “BUffY bUFFY” x 2;
my $i = 0;
sub _slay {
my $willow = unpack "b*", pop;
my @buffy = ( 'b', 'u', 'f', 'f', 'y', ' ' );
my @BUFFY = ( 'B', 'U', 'F', 'F', 'Y', "t" );
my $demons = $horns;
foreach ( split //, $willow ) {
$demons .= $_ ? $BUFFY[$i] : $buffy[$i];
$i++;
$i = 0 if $i > 5;
}
return $demons;
}
sub _unslay {
my $demons = pop;
$demons =~ s/^$horns//g;
my @willow;
foreach ( split //, $demons ) {
push @willow, /[buffy ]/ ? 0 : 1;
}
return pack "b*", join '', @willow;
}](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-85-320.jpg)
![Acme::Buffy
sub _evil {
return $_[0] =~ /S/;
}
sub _punch {
return $_[0] =~ /^$horns/;
}
sub import {
open 0 or print "Can't rebuffy '$0'n" and exit;
( my $demon = join "", <0> ) =~ s/.*^s*uses+Acme::Buffys*;n//sm;
local $SIG{__WARN__} = &evil;
do { eval _unslay $demon; exit }
unless _evil $demon and not _punch $demon;
open my $fh, ">$0" or print "Cannot buffy '$0'n" and exit;
print $fh "use Acme::Buffy;n", _slay $demon and exit;
print "use Acme::Buffy;n", _slay $demon and exit;
return;
}
"Grrr, arrrgh";](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-87-320.jpg)
![Filter::CBC
my $blank = “This space is left blank intentionally”;
sub import
{ my ($type) = shift @_;
my $algorithm = shift || "Rijndael";
$algorithm = $Ciphers{uc $algorithm} || $algorithm;
my $key = shift || $blank; my ($ref) = [ ];
$cipher = Crypt::CBC->new(-key => $key,-cipher => $algorithm);
if (defined $algorithm && defined $key)
{ open(F,"<$0") || die $!; flock(F,2); seek(F,0,0);
my @CODE = (); my $past_use;
while(<F>)
{ if (/^# $blank/ && !$past_use) { close(F); last; }
if (/use Filter::CBC/) { push(@CODE,$_); $past_use++; next; }
if (!$past_use) { push(@CODE,$_); }
else](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-98-320.jpg)
![Switch
use Switch;
switch ($val) {
case 1 { print "number 1"; }
case "a" { print "string a"; }
case [1..10,42] { print "number in list"; }
case /w+/ { print "pattern"; }
else { print "previous case not true"; }
}](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-103-320.jpg)
![Switch
use Switch;
switch ($val) {
case 1 { print "number 1"; }
case "a" { print "string a"; }
case [1..10,42] { print "number in list"; }
case /w+/ { print "pattern"; }
else { print "previous case not true"; }
}
is turned into](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-104-320.jpg)
![Switch
use Switch;
switch ($val) {
case 1 { print "number 1"; }
case "a" { print "string a"; }
case [1..10,42] { print "number in list"; }
case /w+/ { print "pattern"; }
else { print "previous case not true"; }
}
is turned into
if ($var == 1) { print “number 1”; }
elsif ($var eq “a”) { print “string a”; }
elsif (grep /$var [1..10,42]) { print "number in list" }
elsif ($var=~ /w+/) { print “pattern”; }
else { print “previous case not true”; }](https://image.slidesharecdn.com/sf2010-100626032435-phpapp02/85/Source-Filters-in-Perl-2010-105-320.jpg)
![[E-Dev-Day 2014][4/16] Review of Eolian, Eo, Bindings, Interfaces and What's ...](https://cdn.slidesharecdn.com/ss_thumbnails/eoeolian-150413082336-conversion-gate01-thumbnail.jpg?width=560&fit=bounds)
![Diving into HHVM Extensions (php[tek] 2016)](https://cdn.slidesharecdn.com/ss_thumbnails/160525-divingintohhvmextensionsphptek2016-16x10-160525201430-thumbnail.jpg?width=560&fit=bounds)
Ad
More Related Content
What's hot (20)
Viewers also liked (8)
Ad
Similar to Source Filters in Perl 2010 (20)
Ad
Recently uploaded (20)
Source Filters in Perl 2010
- 1. Source Filters in perl Belgian perl workshop 2010 hendrik van belleghem
- 2. Source Filters in perl Belgian perl workshop 2010 hendrik van belleghem Spoiler warning: This talk might ruin the magic behind Acme::bleach and acme::buffy
- 3. Eh?
- 4. Eh? • What are Source Filters?
- 5. Eh? • What are Source Filters? • Writing Source Filters
- 6. Eh? • What are Source Filters? • Writing Source Filters • Magic revealed!
- 7. What are source filters?
- 8. What are source filters? • Manipulate code during compile time
- 9. What are source filters? • Manipulate code during compile time • Modules loaded during compile time
- 10. What are source filters? • Manipulate code during compile time • Modules loaded during compile time • Only works on main::
- 11. What are source filters? • Manipulate code during compile time • Modules loaded during compile time • Only works on main:: • Only parses $0
- 13. Example Acme::bleach before after For *really* clean programs
- 14. Example Acme::bleach Before
- 15. Example Acme::bleach Before #!/usr/bin/perl use Acme::Bleach; print “Hello World”;
- 16. Example Acme::bleach After
- 17. Example Acme::bleach After #!/usr/bin/perl use Acme::Bleach;
- 18. Example Acme::bleach After #!/usr/bin/perl use Acme::Bleach;
- 19. Example Acme::bleach • Live demo?
- 21. Writing source filters • Approaches:
- 22. Writing source filters • Approaches: • Filter::Util::Call
- 23. Writing source filters • Approaches: • Filter::Util::Call • Filter::Simple
- 24. Writing source filters • Approaches: • Filter::Util::Call • Filter::Simple • From scratch
- 25. Writing source filters • Approaches: • Filter::Util::Call • Filter::Simple • From scratch • Our example: Line numbers
- 27. Writing source filters • Problem: Filter the code first
- 28. Writing source filters • Problem: Filter the code first • Adding line numbers
- 29. Writing source filters • Problem: Filter the code first • Adding line numbers • Bleaching (Acme::Bleach)
- 30. Writing source filters • Problem: Filter the code first • Adding line numbers • Bleaching (Acme::Bleach) • Buffy’ing (Acme::Buffy)
- 31. Writing source filters • Problem: Filter the code first • Adding line numbers • Bleaching (Acme::Bleach) • Buffy’ing (Acme::Buffy) • Encrypting (Filter::CBC)
- 32. Writing source filters • Problem: Filter the code first • Adding line numbers • Bleaching (Acme::Bleach) • Buffy’ing (Acme::Buffy) • Encrypting (Filter::CBC) • Problem: Don’t filter filtered code again
- 34. Filter::Util::Call • Module by Paul Marquess
- 35. Filter::Util::Call • Module by Paul Marquess • Part of Perl core
- 36. Filter::Util::Call • Module by Paul Marquess • Part of Perl core • Could be easier
- 37. Filter::Util::Call package MyFilter; use Filter::Util::Call; sub import { my ($type, @arguments) = @_ ; filter_add([ ]) ; } sub filter { my ($self) = @_ ; my ($status) ; $status = filter_read(); #Do magic with $_ if $status > 0 return $status; } 1;
- 38. Filter::Util::Call package MyFilter; use Filter::Util::Call; import is called when module is “used” sub import { my ($type, @arguments) = @_ ; filter_add([ ]) ; } sub filter { my ($self) = @_ ; my ($status) ; $status = filter_read(); #Do magic with $_ if $status > 0 return $status; } 1;
- 39. Filter::Util::Call package MyFilter; use Filter::Util::Call; sub import { my ($type, @arguments) = @_ ; filter_add([ ]) ; } sub filter { my ($self) = @_ ; my ($status) ; $status = filter_read(); if ($status) { $_ =~ s/World/Belgian Perl Workshop/g; } return $status; } 1; # Hello World -> Hello Belgian Perl Workshop
- 40. Filter::NumberLines package Filter::NumberLines; use Filter::Util::Call; sub import { my ($type, @arguments) = @_ ; filter_add([ ]) ; } sub filter { my ($self) = @_ ; my ($status) ; $status = filter_read(); if ($status) { $_ =~ s/^d+:t//gm; } return $status; } 1;
- 43. Filter::NumberLines • One Problem.. • We have to add the line numbers manually
- 44. Filter::NumberLines • One Problem.. • We have to add the line numbers manually • Introducing auto-filtering code...
- 45. Filter::NumberLines Add this at the bottom..
- 46. Filter::NumberLines open(INFILE,"<$0") || die $!; open(OUTFILE,">$0.bak") || die $!; my $line = 0; my $no_go = 0; my $past_use = 0; $|++; while(<INFILE>) { $line++; if ($past_use && /^d+:t/) { $no_go++; last; } if ($past_use) { $_ =sprintf("%03d",$line).":t".$_; } if (/use Filter::NumberLines;/) { $past_use++; } print OUTFILE $_; } close(OUTFILE); close (INFILE); if (!$no_go) { unlink($0) || die $!; rename ("$0.bak",$0); exit; } else { unlink("$0.bak") || die $!; }
- 48. Filter::Simple
- 49. Filter::Simple • Module by Damian Conway
- 50. Filter::Simple • Module by Damian Conway • Part of Perl core
- 51. Filter::Simple • Module by Damian Conway • Part of Perl core • Much easier than Filter::Util::Call
- 52. Filter::Simple package MyFilter; use Filter::Simple; FILTER { do_some_magic(); }; 1;
- 53. Filter::NumberLines package Filter::NumberLines::Simple; use Filter::Simple; FILTER { s/^d+:t//gm; } 1;
- 56. Filter::NumberLines • One Problem.. • We have to add the line numbers again
- 57. Filter::NumberLines • One Problem.. • We have to add the line numbers again • Introducing auto-filtering code...
- 58. Filter::NumberLines Add this at the bottom..
- 59. Filter::NumberLines open(INFILE,"<$0") || die $!; open(OUTFILE,">$0.bak") || die $!; my $line = 0; my $no_go = 0; my $past_use = 0; $|++; while(<INFILE>) { $line++; if ($past_use && /^d+:t/) { $no_go++; last; } if ($past_use) { $_ =sprintf("%03d",$line).":t".$_; } if (/use Filter::NumberLines::Simple;/) { $past_use++; } print OUTFILE $_; } close(OUTFILE); close (INFILE); if (!$no_go) { unlink($0) || die $!; rename ("$0.bak",$0); exit; } else { unlink("$0.bak") || die $!; }
- 61. From Scratch package Filter::NumberLines::Scratch; sub scratch { local $_ = pop; s/^d+:t//gm; return $_; } sub import { open 0 or print "Can't number '$0'n" and exit; my $line = 0; my $no_go = 0; my $past_use = 0; my $file; while(<0>) { $line++; if ($past_use && /^d+:t/) { $no_go++; $file = join "",$_,<0>; last; } if ($past_use) { $_ =sprintf("%03d",$line).":t".$_; } if (/use Filter::NumberLines::Scratch;/) { { $past_use++; } $file .= $_; } if ($no_go) { do { eval scratch $file; exit; } } else { open 0, ">$0" or print "Cannot number '$0'n" and exit; print {0} $file and exit; } } 1;
- 62. From Scratch • Live demo?
- 63. From Scratch
- 64. From Scratch Easy Bree zy!
- 65. From Scratch Easy Bree zy! • Filter code..
- 66. From Scratch Easy Bree zy! • Filter code.. • and eval’uate it.
- 67. Magic Revealed
- 68. Acme::Bleach
- 70. Acme::Bleach • Bleaches code • Step 1: Convert code to bit stream
- 71. Acme::Bleach • Bleaches code • Step 1: Convert code to bit stream • Step 2: Convert bits into tabs (1) and spaces (0)
- 72. Acme::Bleach • Bleaches code • Step 1: Convert code to bit stream • Step 2: Convert bits into tabs (1) and spaces (0) • Reverse to unbleach
- 73. Acme::Bleach • Bleaches code • Step 1: Convert code to bit stream • Step 2: Convert bits into tabs (1) and spaces (0) • Reverse to unbleach • Written by Damian Conway
- 74. Acme::Bleach • Bleaches code • Step 1: Convert code to bit stream • Step 2: Convert bits into tabs (1) and spaces (0) • Reverse to unbleach • Written by Damian Conway • from scratch
- 75. Acme::Bleach
- 76. Acme::Bleach package Acme::Bleach; my $tie = " t"x8; sub whiten { local $_ = unpack "b*", pop; tr/01/ t/; s/(.{9})/$1n/g; $tie.$_ } sub brighten { local $_ = pop; s/^$tie|[^ t]//g; tr/ t/01/; pack "b*", $_ } sub dirty { $_[0] =~ /S/ } sub dress { $_[0] =~ /^$tie/ } open 0 or print "Can't rebleach '$0'n" and exit; (my $shirt = join "", <0>) =~ s/.*^s*uses+Acme::Bleachs*;n//sm; local $SIG{__WARN__} = &dirty; do { eval brighten $shirt; exit } unless dirty $shirt && not dress $shirt; open 0, ">$0" or print "Cannot bleach '$0'n" and exit; print {0} "use Acme::Bleach;n", whiten $shirt and exit;
- 78. Acme::Buffy
- 80. Acme::Buffy • Buffies code • Step 1: Convert code to bit stream
- 81. Acme::Buffy • Buffies code • Step 1: Convert code to bit stream • Step 2: Convert bits into uppercase and lowercase letters from the word Buffy
- 82. Acme::Buffy • Buffies code • Step 1: Convert code to bit stream • Step 2: Convert bits into uppercase and lowercase letters from the word Buffy • Written by Leon Brocard
- 83. Acme::Buffy • Buffies code • Step 1: Convert code to bit stream • Step 2: Convert bits into uppercase and lowercase letters from the word Buffy • Written by Leon Brocard • Written from scratch
- 84. Acme::Buffy
- 85. Acme::Buffy my $horns = “BUffY bUFFY” x 2; my $i = 0; sub _slay { my $willow = unpack "b*", pop; my @buffy = ( 'b', 'u', 'f', 'f', 'y', ' ' ); my @BUFFY = ( 'B', 'U', 'F', 'F', 'Y', "t" ); my $demons = $horns; foreach ( split //, $willow ) { $demons .= $_ ? $BUFFY[$i] : $buffy[$i]; $i++; $i = 0 if $i > 5; } return $demons; } sub _unslay { my $demons = pop; $demons =~ s/^$horns//g; my @willow; foreach ( split //, $demons ) { push @willow, /[buffy ]/ ? 0 : 1; } return pack "b*", join '', @willow; }
- 86. Acme::Buffy
- 87. Acme::Buffy sub _evil { return $_[0] =~ /S/; } sub _punch { return $_[0] =~ /^$horns/; } sub import { open 0 or print "Can't rebuffy '$0'n" and exit; ( my $demon = join "", <0> ) =~ s/.*^s*uses+Acme::Buffys*;n//sm; local $SIG{__WARN__} = &evil; do { eval _unslay $demon; exit } unless _evil $demon and not _punch $demon; open my $fh, ">$0" or print "Cannot buffy '$0'n" and exit; print $fh "use Acme::Buffy;n", _slay $demon and exit; print "use Acme::Buffy;n", _slay $demon and exit; return; } "Grrr, arrrgh";
- 89. Filter::CBC
- 90. Filter::CBC • Encrypts code using Crypt::CBC
- 91. Filter::CBC • Encrypts code using Crypt::CBC • Can use any algorithm that uses CBC cipher
- 92. Filter::CBC • Encrypts code using Crypt::CBC • Can use any algorithm that uses CBC cipher • Hardcoded or external algorithm & key phrase
- 93. Filter::CBC • Encrypts code using Crypt::CBC • Can use any algorithm that uses CBC cipher • Hardcoded or external algorithm & key phrase • Pass parameters in use statement
- 94. Filter::CBC • Encrypts code using Crypt::CBC • Can use any algorithm that uses CBC cipher • Hardcoded or external algorithm & key phrase • Pass parameters in use statement • Based on Filter::Util::Call
- 95. Filter::CBC • Encrypts code using Crypt::CBC • Can use any algorithm that uses CBC cipher • Hardcoded or external algorithm & key phrase • Pass parameters in use statement • Based on Filter::Util::Call • Written by uhm me
- 96. Filter::CBC • Encrypts code using Crypt::CBC • Can use any algorithm that uses CBC cipher • Hardcoded or external algorithm & key phrase • Pass parameters in use statement • Based on Filter::Util::Call • Written by uhm me use Filter::CBC "Rijndael","my secret key";
- 97. Filter::CBC
- 98. Filter::CBC my $blank = “This space is left blank intentionally”; sub import { my ($type) = shift @_; my $algorithm = shift || "Rijndael"; $algorithm = $Ciphers{uc $algorithm} || $algorithm; my $key = shift || $blank; my ($ref) = [ ]; $cipher = Crypt::CBC->new(-key => $key,-cipher => $algorithm); if (defined $algorithm && defined $key) { open(F,"<$0") || die $!; flock(F,2); seek(F,0,0); my @CODE = (); my $past_use; while(<F>) { if (/^# $blank/ && !$past_use) { close(F); last; } if (/use Filter::CBC/) { push(@CODE,$_); $past_use++; next; } if (!$past_use) { push(@CODE,$_); } else
- 99. Filter::CBC
- 100. Filter::CBC { my $code = $_; local $/ = undef; $code .= <F>; splice(@CODE,-2,0,"# $blank"); $code = $cipher->encrypt($code); open(OUTFILE,">$0.bak") || die $!; binmode(OUTFILE); print OUTFILE @CODE,$code; close(OUTFILE); close(F); unlink("$0") || die $!; rename ("$0.bak",$0) || die $!; exit; } } } filter_add(bless $ref) ; } sub filter { my ($self) = @_ ; my ($status); local $/ = undef; if (($status = filter_read()) > 0) { $_ = $cipher->decrypt($_); } return $status ; } 1;
- 101. Questions? • Time for bonus slides?
- 102. Switch
- 103. Switch use Switch; switch ($val) { case 1 { print "number 1"; } case "a" { print "string a"; } case [1..10,42] { print "number in list"; } case /w+/ { print "pattern"; } else { print "previous case not true"; } }
- 104. Switch use Switch; switch ($val) { case 1 { print "number 1"; } case "a" { print "string a"; } case [1..10,42] { print "number in list"; } case /w+/ { print "pattern"; } else { print "previous case not true"; } } is turned into
- 105. Switch use Switch; switch ($val) { case 1 { print "number 1"; } case "a" { print "string a"; } case [1..10,42] { print "number in list"; } case /w+/ { print "pattern"; } else { print "previous case not true"; } } is turned into if ($var == 1) { print “number 1”; } elsif ($var eq “a”) { print “string a”; } elsif (grep /$var [1..10,42]) { print "number in list" } elsif ($var=~ /w+/) { print “pattern”; } else { print “previous case not true”; }
- 106. Acme::Pony