Crafting Custom Interfaces with Sub Exporter

Everybody knows about Exporter.pm: you use it, and if someone uses your module, they don't have to type quite as much. We'll look at how the Exporter works, and how it fails to take advantage of the powerful concepts on which it's built. We'll see how you can provide flexible import routines that allow your module's user to type even less and get code that behaves much more like part of his own program. You can avoid repeating unnecessary parameters to every overly-generic routine and can avoid collision-prone global configuration. All of this is made possible -- and easy -- by Sub::Exporter.

Subroutine generators -- routines that build routines -- can produce customized code, built to each importer's specifications. Sub::Exporter lets you build and provide customized routines easily. You'll learn how to write generators, and how to use them with Sub::Exporter . In its simplest form, it's as easy to use as Exporter.pm. With just a bit more configuration, it can build, group, rename, and julienne routines easily. With this tool, you'll be able to provide interfaces that are both simpler and more powerful than those provided by the stock Exporter.

Transcript

1. Sub::Exporter Crafting Custom Interfaces
2. rjbs @cpan.org Ricardo SIGNES
3. What’s an Exporter? •Something that takes care of the annoying details of importing.
4. What is Importing?
5. What is Importing? •Build it over there, then bring it here.
6. What is Importing? •Build it over there, then bring it here. •For our purposes, “it” is code.
7. Why Do We Import?
8. Why Do We Import? •We want someone else to do the hard, boring work.
9. Why Do We Import? •We want someone else to do the hard, boring work. •And we want it done cheap.
10. sub strftime { my($pkg,$fmt,$time); ($pkg,$fmt,$time,$tzname) = @_; my $me = ref($pkg) ? $pkg : bless []; if(defined $tzname) { $tzname = uc $tzname; $tzname = sprintf(“%+05d”,$tzname) unless($tzname =~ /\D/); $epoch = timegm(@{$time}[0..5]); @$me = gmtime($epoch + tz_offset($tzname) - tz_offset()); } else { @$me = @$time; undef $epoch; } _subs($me,$fmt); }
11. Date::Format::strftime
12. strftime
13. How Importing Works
14. How Importing Works •the client use-s a module
15. How Importing Works •the client use-s a module •the module’s import method is called
16. How Importing Works •the client use-s a module •the module’s import method is called •something ugly happens
17. How Importing Works •the client use-s a module •the module’s import method is called •something ugly happens •the client has more named subs
18. How Importing Works •usually that ugliness is Exporter.pm
19. How Importing Works •usually that ugliness is Exporter.pm # the dark and twisted heart of Exporter.pm *{“${callpkg}::$sym”} = \&{“${pkg}::$sym”};
20. *{"$::$"} = \&{"$::$"}; •the caller gets the same code •with the same name
21. *{"$::$"} = \&{"$::$"}; •Exporter.pm churns out identically named and constructed products.
22. The Factory Model
23. The Factory Model •One size fits all
24. The Factory Model •One size fits all •If it doesn’t fit your code, adjust your code.
25. The Factory Model •One size fits all •If it doesn’t fit your code, adjust your code. •Or abuse the Exporter
26. The Factory Model •There’s Only One Way To Do It
27. The Tool Metaphor
28. The Tool Metaphor •“You can’t write good code without good tools.”
29. The Tool Metaphor •“You can’t write good code without good tools.” •Exporters are tools for making tools.
30. The Tool Metaphor •“You can’t write good code without good tools.” •Exporters are tools for making tools. •Their quality has an impact all the way down the line.
31. Craftsman Tools
32. Craftsman Tools •We want adaptable tools, customized for our current needs.
33. Craftsman Tools •We want adaptable tools, customized for our current needs. •We want tools hand-crafted to our specifications.
34. Craftsman Tools •We want adaptable tools, customized for our current needs. •We want tools hand-crafted to our specifications. •We want to reduce our labor by having someone else do the boring work.
35. Sub::Exporter!
36. Basic Exporting
37. The Basics •String::Truncate •trunc: truncate a string to length •elide: truncate, ending in “...”
38. String::Truncate
39. String::Truncate $string = “This string is 34 characters long.”;
40. String::Truncate $string = “This string is 34 characters long.”; trunc($string, 10); # This strin
41. String::Truncate $string = “This string is 34 characters long.”; trunc($string, 10); # This strin elide($string, 10); # This st...
42. Basic Exports use String::Truncate qw(elide trunc); To let your client write:
43. Basic Exports package String::Truncate; use Sub::Exporter -setup => { exports => [ qw(elide trunc) ], };
44. Basic Groups use String::Truncate qw(:all) To let your client write:
45. Basic Groups package String::Truncate; use Sub::Exporter -setup => { exports => [ qw(elide trunc) ], };
46. Basic Groups package String::Truncate; use Sub::Exporter -setup => { exports => [ qw(elide trunc) ], groups => { all => [qw(elide trunc)] }, };
47. Basic Groups use String::Truncate qw(:basic) To let your client write:
48. Basic Groups package String::Truncate; use Sub::Exporter -setup => { exports => [ qw(elide trunc) ], groups => { basic => [qw(elide trunc)] } };
49. Basic Defaults use String::Truncate; # imports “trunc” To let your client write:
50. Basic Defaults package String::Truncate; use Sub::Exporter -setup => { exports => [ qw(elide trunc) ], groups => { basic => [ qw(elide trunc) ], default => [ qw(trunc) ] }, };
51. package String::Truncate; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @ISA = qw(Exporter); @EXPORT = qw(trunc); @EXPORT_OK = qw(elide trunc); %EXPORT_TAGS = ( all => \@EXPORT_OK, basic => [ qw(elide trunc) ], ); Using Exporter.pm
52. Renaming Exports
53. Renaming Exports •avoid namespace collisions
54. Renaming Exports use CGI qw(:standard); use LWP::Simple; my $head = head(...); # what happens?
55. Renaming Exports •avoid unclear or ambiguous names
56. Renaming Exports use File::Basename; use XML::Parser; my $file = fileparse($ARGV[0]); $parser->parsefile($file);
57. Renaming Exports •“privatize” subs imported to classes
58. Renaming Exports package XML::Parser::Hypothetical; use File::Basename;
59. Renaming Exports use Exporter::Renaming; use String::Truncate qw(elide), Renaming => [ trunc => ‘trunc_str’ ]; no Exporter::Renaming; Using Exporter::Renaming
60. Renaming Exports use String::Truncate qw(trunc), trunc => { -as => ‘trunc_str’ }; To let your client write:
61. Renaming Exports package String::Truncate; use Sub::Exporter -setup => { exports => [ qw(elide trunc) ], groups => { basic => [ qw(elide trunc) ], default => [ qw(trunc) ] }, };
62. Wait a second... use String::Truncate qw(trunc), trunc => { -as => ‘trunc_str’ };
63. Data::OptList Quick and Dirty Data Structures
64. Data::OptList @optlist = ( qw(alfa bravo), charlie => [ 0, 1, 2 ], delta => { a => 1 }, ‘echo’, foxtrox => undef, ‘gulf’, );
65. Data::OptList @optlist = ( qw(alfa bravo), charlie => [ 0, 1, 2 ], delta => { a => 1 }, ‘echo’, foxtrox => undef, ‘gulf’, ); $as_href = { alfa => undef, bravo => undef, charlie => [ 0, 1, 2], delta => { a => 1 }, echo => undef, foxtrot => undef, gulf => undef, ];
66. Data::OptList @optlist = ( qw(alfa bravo), charlie => [ 0, 1, 2 ], delta => { a => 1 }, ‘echo’, foxtrox => undef, ‘gulf’, ); $as_aref = [ [ alfa => undef ], [ bravo => undef ], [ charlie => [0,1,2] ], [ delta => {a => 1}], [ echo => undef ], [ foxtrot => undef ], [ gulf => undef ], ];
67. Data::OptList @optlist = ( qw(aye aye) love => [ qw(chex) ], love => [ qw(milk) ], aye => { sir => ‘!’ }, );
68. Data::OptList @optlist = ( qw(aye aye) love => [ qw(chex) ], love => [ qw(milk) ], aye => { sir => ‘!’ }, ); $as_aref = [ [ aye => undef ], [ aye => undef ], [ love => [qw(chex)] ], [ love => [qw(milk)] ], [ aye => {sir => ‘!’}] ];
69. Data::OptList $as_href = die “...”; @optlist = ( qw(aye aye) love => [ qw(chex) ], love => [ qw(milk) ], aye => { sir => ‘!’ }, );
70. Customizing Exports
71. Subclassed Exporters
72. Subclassed Exporters •import is a method
73. Subclassed Exporters •import is a method •that implies that exporters are classes
74. Subclassed Exporters •import is a method •that implies that exporters are classes •and that we can subclass them
75. package String::Truncate::Split; use base qw(String::Truncate); sub trunc { my ($string, $length) = @_; # ... return ($head, $tail); }
76. Subclassed Exporters
77. Subclassed Exporters • *{“$::$”} = \&{“$::$”};
78. Subclassed Exporters • *{“$::$”} = \&{“$::$”}; • @EXPORT has to be defined in the derived class
79. Subclassed Exporters • *{“$::$”} = \&{“$::$”}; • @EXPORT has to be defined in the derived class •the export has to be defined in the exporting package
80. package String::Truncate::Split; use base qw(String::Truncate); sub trunc { my ($string, $length) = @_; # ... return ($head, $tail); } 1;
81. package String::Truncate::Split; use base qw(String::Truncate); our @EXPORT_OK = @String::Truncate::EXPORT_OK; our @EXPORT = @String::Truncate::EXPORT; our %EXPORT_TAGS = %String::Truncate::EXPORT_TAGS; sub trunc { my ($string, $length) = @_; # ... return ($head, $tail); }
82. package String::Truncate::Split; use base qw(String::Truncate); our @EXPORT_OK = @String::Truncate::EXPORT_OK; our @EXPORT = @String::Truncate::EXPORT; our %EXPORT_TAGS = %String::Truncate::EXPORT_TAGS; sub trunc { my ($string, $length) = @_; # ... return ($head, $tail); } *$_ = \&{“String::Truncate::$_”} for grep { not defined &{__PACKAGE__.“::$_”} } @EXPORT;
83. package String::Truncate::Split; use base qw(String::Truncate); our @EXPORT_OK = @String::Truncate::EXPORT_OK; our @EXPORT = @String::Truncate::EXPORT; our %EXPORT_TAGS = %String::Truncate::EXPORT_TAGS; sub trunc { my ($string, $length) = @_; # ... return ($head, $tail); } do { no strict ‘refs’; *$_ = \&{“String::Truncate::$_”} for grep { not defined &{__PACKAGE__.“::$_”} } @EXPORT; }
84. Subclassed Exporters
85. Subclassed Exporters •Sub::Exporter finds exports with “can”
86. Subclassed Exporters •Sub::Exporter finds exports with “can” •this means you can subclass exporting toolkits, replacing just pieces
87. package String::Truncate::Split; use base qw(String::Truncate); sub trunc { my ($string, $length) = @_; # ... return ($head, $tail); }
88. Customizing Exports
89. Customizing Exports •What if you want trunc to work differently when you use it?
90. Customizing Exports •Some modules do this with package variables.
91. Package-Level Config use String::Truncate qw(:all); $String::Truncate::DEFAULT_LENGTH = 20; $String::Truncate::DEFAULT_MARKER = “--”;
92. Package-Level Config use String::Truncate qw(:all); $String::Truncate::DEFAULT_LENGTH = 20; $String::Truncate::DEFAULT_MARKER = “--”; use Tools::Useful;
93. Package-Level Config use String::Truncate (); use Tools::Useful; sub trunc { my ($string, $length) = @_; $length //= 20; String::Truncate::trunc($string, $length) }
94. Package-Level Config use String::Truncate (); use Tools::Useful; sub trunc { local $String::Truncate::DEFAULT_LENGTH = 20; String::Truncate::trunc(@_); }
95. Custom Imports use String::Truncate qw(trunc), elide => { -as => ‘trail_off’, marker => ‘etc’, };
96. Custom Imports use String::Truncate qw(trunc elide), elide => { -as => ‘trail_off’, marker => ‘etc’, };
97. Custom Imports use String::Truncate trunc => { -as => ‘trunc_str’, length => 10 }, elide => { -as => ‘elide_str’, length => 10 };
98. Custom Imports use String::Truncate -all => { -suffix => ‘_str’, length => 10 };
99. Exports to Order package String::Truncate; use Sub::Exporter -setup => { exports => [ qw(elide trunc) ], groups => { basic => [ qw(elide trunc) ], default => [ qw(trunc) ] }, };
100. Exports to Order package String::Truncate; use Sub::Exporter -setup => { exports => [ qw(elide trunc) ], groups => { basic => [ qw(elide trunc) ], default => [ qw(trunc) ] }, };
101. Exports to Order package String::Truncate; use Sub::Exporter -setup => { exports => [ elide => undef, trunc => undef, ], groups => { basic => [ qw(elide trunc) ], default => [ qw(trunc) ] }, };
102. Exports to Order package String::Truncate; use Sub::Exporter -setup => { exports => [ elide => \’_build_elide’, trunc => \’_build_trunc’, ], groups => { basic => [ qw(elide trunc) ], default => [ qw(trunc) ] }, };
103. Generating Routines
104. Generating Routines sub _build_trunc {
105. Generating Routines sub _build_trunc { my ($class, $name, $arg) = @_;
106. Generating Routines sub _build_trunc { my ($class, $name, $arg) = @_; my $_length = $arg->{length};
107. Generating Routines sub _build_trunc { my ($class, $name, $arg) = @_; my $_length = $arg->{length}; return sub {
108. Generating Routines sub _build_trunc { my ($class, $name, $arg) = @_; my $_length = $arg->{length}; return sub { my ($string, $length, @rest) = @_;
109. Generating Routines sub _build_trunc { my ($class, $name, $arg) = @_; my $_length = $arg->{length}; return sub { my ($string, $length, @rest) = @_; $length //= $_length;
110. Generating Routines sub _build_trunc { my ($class, $name, $arg) = @_; my $_length = $arg->{length}; return sub { my ($string, $length, @rest) = @_; $length //= $_length; trunc($string, $length, @rest);
111. Generating Routines sub _build_trunc { my ($class, $name, $arg) = @_; my $_length = $arg->{length}; return sub { my ($string, $length, @rest) = @_; $length //= $_length; trunc($string, $length, @rest); }
112. Generating Routines sub _build_trunc { my ($class, $name, $arg) = @_; my $_length = $arg->{length}; return sub { my ($string, $length, @rest) = @_; $length //= $_length; trunc($string, $length, @rest); } }
113. Routines ex nihilo
114. Routines ex nihilo use Cypher::Trivial qw(cyphers);
115. Routines ex nihilo use Cypher::Trivial qw(cyphers); my ($encyph, $decyph) = cyphers(“secret”);
116. Routines ex nihilo use Cypher::Trivial qw(cyphers); my ($encyph, $decyph) = cyphers(“secret”); $cyphertext
117. Routines ex nihilo use Cypher::Trivial qw(cyphers); my ($encyph, $decyph) = cyphers(“secret”); $cyphertext = $encyph->(“Top secret message.”);
118. Routines ex nihilo use Cypher::Trivial qw(cyphers); my ($encyph, $decyph) = cyphers(“secret”); $cyphertext = $encyph->(“Top secret message.”); sub encypher {
119. Routines ex nihilo use Cypher::Trivial qw(cyphers); my ($encyph, $decyph) = cyphers(“secret”); $cyphertext = $encyph->(“Top secret message.”); sub encypher { my $text = shift; $encyph->($text);
120. Routines ex nihilo use Cypher::Trivial qw(cyphers); my ($encyph, $decyph) = cyphers(“secret”); $cyphertext = $encyph->(“Top secret message.”); sub encypher { my $text = shift; $encyph->($text); }
121. Routines ex nihilo
122. Routines ex nihilo use Cypher::Trivial
123. Routines ex nihilo use Cypher::Trivial encypher => { secret => “secret” };
124. Routines ex nihilo use Cypher::Trivial encypher => { secret => “secret” }; encypher(“Top secret message”);
125. Routines ex nihilo sub _build_encypher { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return $enc; } sub _build_decypher { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return $dec; }
126. Routines ex nihilo sub _build_encypher { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return $enc; } sub _build_decypher { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return $dec; }
127. Routines ex nihilo package Cypher::Trivial; use Sub::Exporter -setup => { exports => [ encypher => \’_build_encypher’, decypher => \’_build_decypher’, cyphers => undef, ], groups => { cyphers => [ qw(encypher decypher) ], } };
128. Routines ex nihilo use Cypher::Trivial encypher => { secret => “secret” }; encypher(“Top secret message”);
129. Routines ex nihilo use Cypher::Trivial -cyphers => { secret => “secret” }; encypher(“Top secret message”); decypher(“Gbc frperg zrffntr”);
130. Generating Groups package Cypher::Trivial; use Sub::Exporter -setup => { exports => [ encypher => \’_build_encypher’, decypher => \’_build_decypher’, cyphers => undef, ], groups => { cyphers => [ qw(encypher decypher) ], } };
131. Generating Groups sub _build_encypher { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return $enc; } sub _build_decypher { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return $dec; }
132. Generating Groups package Cypher::Trivial; use Sub::Exporter -setup => { exports => [ encypher => \’_build_encypher’, decypher => \’_build_decypher’, cyphers => undef, ], groups => { cyphers => \’_build_cyphers’, } };
133. Generating Groups
134. Generating Groups sub _build_cyphers {
135. Generating Groups sub _build_cyphers { my ($class, $name, $arg) = @_;
136. Generating Groups sub _build_cyphers { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret});
137. Generating Groups sub _build_cyphers { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return {
138. Generating Groups sub _build_cyphers { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return { encypher => $enc,
139. Generating Groups sub _build_cyphers { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return { encypher => $enc, decypher => $dec,
140. Generating Groups sub _build_cyphers { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return { encypher => $enc, decypher => $dec, };
141. Generating Groups sub _build_cyphers { my ($class, $name, $arg) = @_; my ($enc, $dec) = cyphers($arg->{secret}); return { encypher => $enc, decypher => $dec, }; }
142. Generating Groups use Cypher::Trivial -cyphers => { secret => “secret” };
143. Generating Groups use Cypher::Trivial -cyphers => { secret => “secret” }, -cyphers => { secret => ‘Secret1234’, -suffix => ‘_strong’ } ;
144. Exporting Methods
145. ZOMG O NO!
146. Methods & Exporter.pm
147. Methods & Exporter.pm •Exporter.pm: “Do not export method names!”
148. Methods & Exporter.pm •Exporter.pm: “Do not export method names!” • *{“$::$”} = \&{“$::$”};
149. package Object::Hybrid; use Exporter; @Object::Exporter::ISA = qw(Exporter); @Object::Exporter::EXPORT_OK = qw(retrieve); sub retrieve { my ($class, $id) = @_; my $row = $class->get_row(id => $id); bless $row => $class; } Methods & Exporter.pm
150. use Object::Hybrid qw(retrieve); my $object = retrieve(42); my $object = retrieve(49); Methods & Exporter.pm
151. package Object::Hybrid; use Exporter; @Object::Exporter::ISA = qw(Exporter); @Object::Exporter::EXPORT_OK = qw(object); sub retrieve { my ($class, $id) = @_; my $row = $class->get_row(id => $id); bless $row => $class; } sub object { __PACKAGE__->retrieve(@_) } Methods & Exporter.pm
152. use Object::Hybrid qw(object); my $object = object(42); my $object = object(49); Methods & Exporter.pm
153. use Object::Hybrid; my $object = Object::Hybrid->object(42); Methods & Exporter.pm
154. Methods & Exporter.pm
155. use Object::Hybrid; Methods & Exporter.pm
156. use Object::Hybrid; use Object::Hybrid::With::Much::Derivation; Methods & Exporter.pm
157. use Object::Hybrid; use Object::Hybrid::With::Much::Derivation; my $object = Object::Hybrid->retrieve(42); Methods & Exporter.pm
158. use Object::Hybrid; use Object::Hybrid::With::Much::Derivation; my $object = Object::Hybrid->retrieve(42); my $thing = Methods & Exporter.pm
159. use Object::Hybrid; use Object::Hybrid::With::Much::Derivation; my $object = Object::Hybrid->retrieve(42); my $thing = Object::Hybrid::With::Much::Derivation Methods & Exporter.pm
160. use Object::Hybrid; use Object::Hybrid::With::Much::Derivation; my $object = Object::Hybrid->retrieve(42); my $thing = Object::Hybrid::With::Much::Derivation ->retrieve(49); Methods & Exporter.pm
161. package Object::Hybrid; use Exporter; @Object::Exporter::ISA = qw(Exporter); @Object::Exporter::EXPORT_OK = qw(object); sub retrieve { my ($class, $id) = @_; my $row = $class->get_row(id => $id); bless $row => $class; } sub object { __PACKAGE__->retrieve(@_) } Methods & Exporter.pm
162. Currying Methods use Object::Hybrid qw(object); use Object::Hybrid::With::Much::Derivation object => { -as => ‘derived_object’ }; my $object = object(42); my $thing = derived_object(49);
163. Currying Methods use Object::Hybrid qw(object); my $object = Object::Hybrid->object(49);
164. Currying Methods
165. Currying Methods
166. Currying Methods use Sub::Exporter -setup => {
167. Currying Methods use Sub::Exporter -setup => { exports => [ object => \&_build_object ],
168. Currying Methods use Sub::Exporter -setup => { exports => [ object => \&_build_object ], };
169. Currying Methods use Sub::Exporter -setup => { exports => [ object => \&_build_object ], }; sub _build_object {
170. Currying Methods use Sub::Exporter -setup => { exports => [ object => \&_build_object ], }; sub _build_object { my ($class, $name, $arg) = @_;
171. Currying Methods use Sub::Exporter -setup => { exports => [ object => \&_build_object ], }; sub _build_object { my ($class, $name, $arg) = @_; return sub { $class->new(@_); }
172. Currying Methods use Sub::Exporter -setup => { exports => [ object => \&_build_object ], }; sub _build_object { my ($class, $name, $arg) = @_; return sub { $class->new(@_); } }
173. Currying Methods use Sub::Exporter -setup => { exports => [ object => curry_class(‘new’) ], }
174. Currying Methods use Sub::Exporter::Util qw(curry_class); use Sub::Exporter -setup => { exports => [ object => curry_class(‘new’) ], }
175. Exporting Methods
176. Exporting Methods •Sometimes you want to export methods without currying the class.
177. Exporting Methods •Sometimes you want to export methods without currying the class. •Exporters can serve as method crafters.
178. Exporting Methods package Mixin::Dumper; use Sub::Exporter -setup => { exports => [ qw(dump) ], groups => { default => [ qw(dump) ] }, }; sub dump { my ($self) = @_; require Data::Dumper; Data::Dumper::Dumper($self); }
179. Exporting Methods package Email::Simple::mixin:ReplyText; use Sub::Exporter -setup => { exports => [ qw(reply_text) ], groups => { defaults => [ qw(reply_text) ] }, }; sub reply_text { my ($self) = @_; join “\n”, map “>$_”, split /\n/, $self->body; }
180. Exporting Methods package Email::Simple::mixin:ReplyText; use Sub::Exporter -setup => { into => ‘Email::Simple’, exports => [ qw(reply_text) ], groups => { defaults => [ qw(reply_text) ] }, }; sub reply_text { my ($self) = @_; join “\n”, map “>$_”, split /\n/, $self->body; }
181. Exporting Methods use Email::Simple; use Email::Simple::mixin::ReplyText;
182. Exporting Methods use Email::Simple; use Email::Simple::mixin::ReplyText; use Email::Simple::Mock; use Email::Simple::mixin::ReplyText { into => ‘Email::Simple::Mock’ };
183. Emulating mixin.pm
184. Emulating mixin.pm •Don’t import into my namespace...
185. Emulating mixin.pm •Don’t import into my namespace... •...import to a new namespace...
186. Emulating mixin.pm •Don’t import into my namespace... •...import to a new namespace... •...and add it to my @ISA.
187. Emulating mixin.pm
188. Emulating mixin.pm •This makes it easy to import a chunk of methods and override just a few...
189. Emulating mixin.pm •This makes it easy to import a chunk of methods and override just a few... •...and those few can call SUPER.
190. Emulating mixin.pm package Email::Simple::mixin:ReplyText; use Sub::Exporter -setup => { into => ‘Email::Simple’, exports => [ qw(reply_text) ], groups => { defaults => [ qw(reply_text) ] }, }; sub reply_text { my ($self) = @_; join “\n”, map “>$_”, split /\n/, $self->body; }
191. Emulating mixin.pm package Email::Simple::mixin:ReplyText; use Sub::Exporter -setup => { into => ‘Email::Simple’, exporter=> mixin_exporter, exports => [ qw(reply_text) ], groups => { defaults => [ qw(reply_text) ] }, }; sub reply_text { my ($self) = @_; join “\n”, map “>$_”, split /\n/, $self->body; }
192. Collectors
193. Collectors
194. Collectors •Arguments that don’t export anything.
195. Collectors •Arguments that don’t export anything. •They collect data for generators to use.
196. Collectors package String::Truncate; use Sub::Exporter -setup => { exports => [ elide => \’_build_elide’, trunc => \’_build_trunc’, ], collectors => [ qw(defaults) ], };
197. Collectors
198. Collectors use String::Truncate
199. Collectors use String::Truncate defaults => { length => 10 },
200. Collectors use String::Truncate defaults => { length => 10 }, qw(-all),
201. Collectors use String::Truncate defaults => { length => 10 }, qw(-all), trunc => { length => 1, -as => ‘onechar’ },
202. Collectors use String::Truncate defaults => { length => 10 }, qw(-all), trunc => { length => 1, -as => ‘onechar’ }, elide => { marker => ‘&c’, -as => ‘yul’ },
203. Collectors use String::Truncate defaults => { length => 10 }, qw(-all), trunc => { length => 1, -as => ‘onechar’ }, elide => { marker => ‘&c’, -as => ‘yul’ }, ;
204. Collectors sub _build_trunc { my ($class, $name, $arg) = @_; my $_length = $arg->{length}; return sub { my ($string, $length, @rest) = @_; $length = $_length if !defined $length; trunc($string, $length, @rest); } }
205. Collectors sub _build_trunc { my ($class, $name, $arg, $col) = @_; my $_length = $arg->{length}; return sub { my ($string, $length, @rest) = @_; $length = $_length if !defined $length; trunc($string, $length, @rest); } }
206. Collectors sub _build_trunc { my ($class, $name, $arg, $col) = @_; my $_length = $arg->{length}; $_length = $col->{defaults}{length} if !defined $_length; return sub { my ($string, $length, @rest) = @_; $length = $_length if !defined $length; trunc($string, $length, @rest); } }
207. Collectors
208. Collectors •Arguments that don’t export. •They collect data for generators to use.
209. Collectors •Arguments that don’t export. •They collect data for generators to use. •They can validate the collected data.
210. Collectors package String::Truncate; use Sub::Exporter -setup => { exports => [ elide => \’_build_elide’, trunc => \’_build_trunc’, ], collectors => { defaults => \’_validate_defaults’, }, };
211. Collectors sub _validate_defaults { my ($class, $value, $data) = @_; return (ref $value eq ‘HASH’); }
212. Collectors
213. Collectors •Arguments that don’t export. •They collect data for generators to use. •They can validate the collected data.
214. Collectors •Arguments that don’t export. •They collect data for generators to use. •They can validate the collected data. •They can do Almost Anything Else.
215. Collectors sub _validate_defaults { my ($class, $value, $data) = @_; return (ref $value eq ‘HASH’); }
216. Collectors
217. Collectors •name - name of the collection
218. Collectors •name - name of the collection •class - invocant of import method
219. Collectors •name - name of the collection •class - invocant of import method •config - exporter configuration
220. Collectors •name - name of the collection •class - invocant of import method •config - exporter configuration •into - the package that’s importing
221. Collectors •name - name of the collection •class - invocant of import method •config - exporter configuration •into - the package that’s importing •import_args - args to import method
222. Collectors
223. Collectors •name - the name of the collection
224. Collectors •name - the name of the collection •class - import’s invocant
225. Collectors
226. Collectors •config - the Sub::Exporter config
227. Collectors •config - the Sub::Exporter config •find out what exports exist
228. Collectors •config - the Sub::Exporter config •find out what exports exist •validate collection value based on config
229. use LWP::Simple “/^is_/”; is_success($res); is_failure($res);
230. use LWP::Simpleton; use Sub::Exporter -setup => { collectors => { like => Sub::Exporter::Util::like }, };
231. use LWP::Simple like => qr/^is_/; is_success($res); is_failure($res);
232. use LWP::Simple like => [ qr/^is_/, undef, qr/^get/, { -prefix => ‘https_’, ssl => 1 } ]; is_success($res); is_failure($res); https_get(“https://codesimply.com”)
233. Collectors
234. Collectors •into - the target to which exports go
235. Collectors •into - the target to which exports go •alter the class directly
236. Collectors •into - the target to which exports go •alter the class directly •particularly useful: @ISA
238. sub _make_base { my ($class, $value, $data) = @_; my $target = $data->{into}; push @{“$target\::ISA”}, $class; }
239. sub _make_base { my ($class, $value, $data) = @_; my $target = $data->{into}; push @{“$target\::ISA”}, $class; } use Sub::Exporter -setup => { collectors => { -base => \’_make_base’ }, };
240. sub _make_base { my ($class, $value, $data) = @_; my $target = $data->{into}; push @{“$target\::ISA”}, $class; } use Sub::Exporter -setup => { collectors => { -base => \’_make_base’ }, }; use Magic::Superclass -base;
242. package Email::Constants; sub _set_constants { my ($class, $value, $data) = @_; Package::Generator->assign_symbols( $data->{into}, [ EX_TEMPFAIL => 75, FORMATS => [ qw(Maildir mbox mh) ], ], ); }
243. package Email::Constants; sub _set_constants { my ($class, $value, $data) = @_; Package::Generator->assign_symbols( $data->{into}, [ EX_TEMPFAIL => 75, FORMATS => [ qw(Maildir mbox mh) ], ], ); } use Sub::Exporter -setup => { collectors => { constants => \’_set_constants’ }, };
244. use Email::Constants qw(constants);
245. Collectors
246. Collectors •import_args - the arguments to import
247. Collectors •import_args - the arguments to import •rewrite the arguments list
248. Collectors •import_args - the arguments to import •rewrite the arguments list •add new imports
250. sub _setup {
251. sub _setup { my ($class, $value, $data) = @_;
252. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) {
253. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} },
254. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, %$value } ];
255. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, %$value } ]; return 1;
256. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, %$value } ]; return 1; } elsif (ref $value eq ‘ARRAY’) {
257. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, %$value } ]; return 1; } elsif (ref $value eq ‘ARRAY’) { push @{ $data->{import_args} },
258. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, %$value } ]; return 1; } elsif (ref $value eq ‘ARRAY’) { push @{ $data->{import_args} }, [ _import => {
259. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, %$value } ]; return 1; } elsif (ref $value eq ‘ARRAY’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, exports => $value } ];
260. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, %$value } ]; return 1; } elsif (ref $value eq ‘ARRAY’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, exports => $value } ]; return 1;
261. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, %$value } ]; return 1; } elsif (ref $value eq ‘ARRAY’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, exports => $value } ]; return 1; }
262. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, %$value } ]; return 1; } elsif (ref $value eq ‘ARRAY’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, exports => $value } ]; return 1; } return;
263. sub _setup { my ($class, $value, $data) = @_; if (ref $value eq ‘HASH’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, %$value } ]; return 1; } elsif (ref $value eq ‘ARRAY’) { push @{ $data->{import_args} }, [ _import => { -as => ‘import’, exports => $value } ]; return 1; } return; }
265. use Sub::Exporter -setup => {
266. use Sub::Exporter -setup => { collectors => { -setup => \’_setup’ },
267. use Sub::Exporter -setup => { collectors => { -setup => \’_setup’ }, exports => [ _import => \’_build_import’ ],
268. use Sub::Exporter -setup => { collectors => { -setup => \’_setup’ }, exports => [ _import => \’_build_import’ ], });
269. -setup => { into_level => 2, exports => [qw(foo)] }
270. -setup => { into_level => 2, exports => [qw(foo)] } _import => { -as => ‘import’, into_level => 2, exports => [qw(foo)] }
271. -setup => [ qw(foo bar baz) ]
272. -setup => [ qw(foo bar baz) ] _import => { -as => ‘import’, exports => [qw(foo bar baz)] }
273. use Sub::Exporter -setup => { collectors => { -setup => \’_setup’ }, exports => [ _import => \’_build_import’ ], });
274. use Sub::Exporter -setup => { collectors => { -setup => \’_setup’ }, exports => [ _import => sub { my ($class, $name, $arg) = @_; build_exporter($arg); }, ], });
275. package Sub::Exporter; use Sub::Exporter -setup => { collectors => { -setup => \&_setup }, exports => [ _import => sub { my ($class, $name, $arg) = @_; build_exporter($arg); }, ], });
276. RJBS’s Advice
277. RJBS’s Advice •Write the client code first.
278. RJBS’s Advice •Write the client code first. •Make as many assumptions as possible.
279. RJBS’s Advice •Write the client code first. •Make as many assumptions as possible. •Let most of them be refuted.
280. Any Questions?
281. Random Tricks
282. Mixed-in Helpers $object->complex_method($arg);
283. Mixed-in Helpers sub _build_cplx_method { my ($mixin) = @_; sub { my ($self, $arg) = @_; $mixin->validate_arg($arg); $mixin->do_stuff($self, $arg); return $mixin->analyze($self); } } sub validate_arg {...}
284. Mixed-in Helpers package Mixin::Helper; use Sub::Exporter -setup => { exports => [ complex_method => \’_build_cplx_method’, ], }; sub _build_cplx_method { ...
285. Mixed-in Helpers sub _build_cplx_method { my ($mixin) = @_; sub { my ($self, $arg) = @_; $mixin->validate_arg($arg); $mixin->do_stuff($self, $arg); return $mixin->analyze($self); } } sub validate_arg {...}
286. Mixed-in Helpers package Mixin::Helper::Faster; use base qw(Mixin::Helper); sub analyze { my ($mixin, $object) = @_; return 1; } 1;
287. A Coderef Generator
288. A Coderef Generator use String::Truncate ();
289. A Coderef Generator use String::Truncate (); my $trunc;
290. A Coderef Generator use String::Truncate (); my $trunc; String::Truncate->import(
291. A Coderef Generator use String::Truncate (); my $trunc; String::Truncate->import(trunc =>
292. A Coderef Generator use String::Truncate (); my $trunc; String::Truncate->import(trunc => { -as => \$trunc });
293. package YAPC::Slideshow; use Accessors::Simple -setup => { fields => [ qw(topic presenter timeslot room) ], }; Accessors sans ISA
294. Accessors sans ISA
295. sub _make_accessor { Accessors sans ISA
296. sub _make_accessor { my ($field) = @_; Accessors sans ISA
297. sub _make_accessor { my ($field) = @_; sub { Accessors sans ISA
298. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; Accessors sans ISA
299. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; Accessors sans ISA
300. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; return $self->{$field}; Accessors sans ISA
301. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; return $self->{$field}; } Accessors sans ISA
302. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; return $self->{$field}; } } Accessors sans ISA
303. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; return $self->{$field}; } } sub _make_many_accessors { Accessors sans ISA
304. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; return $self->{$field}; } } sub _make_many_accessors { my @fields = @{ $arg->{fields} }; Accessors sans ISA
305. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; return $self->{$field}; } } sub _make_many_accessors { my @fields = @{ $arg->{fields} }; my %sub = map { $_ => _make_accessor($_) } @fields; Accessors sans ISA
306. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; return $self->{$field}; } } sub _make_many_accessors { my @fields = @{ $arg->{fields} }; my %sub = map { $_ => _make_accessor($_) } @fields; return \%sub; Accessors sans ISA
307. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; return $self->{$field}; } } sub _make_many_accessors { my @fields = @{ $arg->{fields} }; my %sub = map { $_ => _make_accessor($_) } @fields; return \%sub; } Accessors sans ISA
308. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; return $self->{$field}; } } sub _make_many_accessors { my @fields = @{ $arg->{fields} }; my %sub = map { $_ => _make_accessor($_) } @fields; return \%sub; } use Sub::Exporter -setup => Accessors sans ISA
309. sub _make_accessor { my ($field) = @_; sub { my ($self) = shift; $self->{field} = shift if @_; return $self->{$field}; } } sub _make_many_accessors { my @fields = @{ $arg->{fields} }; my %sub = map { $_ => _make_accessor($_) } @fields; return \%sub; } use Sub::Exporter -setup => { groups => { setup => \&_make_many_accessors } }; Accessors sans ISA
310. Eat Exporter’s Brain
311. sub exporter_upgrade { Eat Exporter’s Brain
312. sub exporter_upgrade { my ($pkg) = @_; Eat Exporter’s Brain
313. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Eat Exporter’s Brain
314. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ Eat Exporter’s Brain
315. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, Eat Exporter’s Brain
316. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, Eat Exporter’s Brain
317. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], Eat Exporter’s Brain
318. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { Eat Exporter’s Brain
319. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, Eat Exporter’s Brain
320. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], Eat Exporter’s Brain
321. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], }, Eat Exporter’s Brain
322. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], }, }); Eat Exporter’s Brain
323. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], }, }); push @{“$new_pkg\::ISA”}, $class; Eat Exporter’s Brain
324. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], }, }); push @{“$new_pkg\::ISA”}, $class; return $new_pkg; Eat Exporter’s Brain
325. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], }, }); push @{“$new_pkg\::ISA”}, $class; return $new_pkg; } Eat Exporter’s Brain
327. package UNIVERSAL;
328. package UNIVERSAL; sub exporter_upgrade {
329. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_;
330. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”;
331. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg);
332. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({
333. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’,
334. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg,
335. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ],
336. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => {
337. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”},
338. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ],
339. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], },
340. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], }, });
341. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], }, }); push @{“$new_pkg\::ISA”}, $class;
342. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], }, }); push @{“$new_pkg\::ISA”}, $class; return $new_pkg;
343. package UNIVERSAL; sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = “$pkg\::SE”; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => ‘import’, into => $new_pkg, exports => [ @{“$pkg\::EXPORT_OK”} ], groups => { %{“$pkg\::EXPORT_TAGS”}, default => [ @{“$pkg\::EXPORTS”} ], }, }); push @{“$new_pkg\::ISA”}, $class; return $new_pkg; }
344. Fixing caller
345. Fixing caller sub default_exporter {
346. Fixing caller sub default_exporter { my ($class, $gen, $name, $arg, $col, $as, $into)
347. Fixing caller sub default_exporter { my ($class, $gen, $name, $arg, $col, $as, $into) = @_;
348. Fixing caller sub default_exporter { my ($class, $gen, $name, $arg, $col, $as, $into) = @_; _install(
349. Fixing caller sub default_exporter { my ($class, $gen, $name, $arg, $col, $as, $into) = @_; _install( _generate($class, $generator, $name, $arg, $col),
350. Fixing caller sub default_exporter { my ($class, $gen, $name, $arg, $col, $as, $into) = @_; _install( _generate($class, $generator, $name, $arg, $col), $into,
351. Fixing caller sub default_exporter { my ($class, $gen, $name, $arg, $col, $as, $into) = @_; _install( _generate($class, $generator, $name, $arg, $col), $into, $as,
352. Fixing caller sub default_exporter { my ($class, $gen, $name, $arg, $col, $as, $into) = @_; _install( _generate($class, $generator, $name, $arg, $col), $into, $as, );
353. Fixing caller sub default_exporter { my ($class, $gen, $name, $arg, $col, $as, $into) = @_; _install( _generate($class, $generator, $name, $arg, $col), $into, $as, ); }
355. sub evil_eval_exporter { # TOTALLY UNTESTED!
356. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into)
357. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_;
358. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_;
359. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do {
360. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out;
361. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/;
362. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/; $g = “package $into;\n$g”;
363. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/; $g = “package $into;\n$g”; eval $g;
364. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/; $g = “package $into;\n$g”; eval $g; \&{“$into\::_generate”};
365. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/; $g = “package $into;\n$g”; eval $g; \&{“$into\::_generate”}; };
366. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/; $g = “package $into;\n$g”; eval $g; \&{“$into\::_generate”}; }; _install(
367. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/; $g = “package $into;\n$g”; eval $g; \&{“$into\::_generate”}; }; _install( $col->{_g}($class, $generator, $name, $arg, $col),
368. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/; $g = “package $into;\n$g”; eval $g; \&{“$into\::_generate”}; }; _install( $col->{_g}($class, $generator, $name, $arg, $col), $into,
369. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/; $g = “package $into;\n$g”; eval $g; \&{“$into\::_generate”}; }; _install( $col->{_g}($class, $generator, $name, $arg, $col), $into, $as,
370. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/; $g = “package $into;\n$g”; eval $g; \&{“$into\::_generate”}; }; _install( $col->{_g}($class, $generator, $name, $arg, $col), $into, $as, );
371. sub evil_eval_exporter { # TOTALLY UNTESTED! my ($class, $gen, $name, $arg, $col, $as, $into) = @_; $col->{_g} ||= do { my $g = Dump(\&_generate)->Names(‘GEN’)->Out; $g =~ s/\A\$GEN = sub/sub _generate/; $g = “package $into;\n$g”; eval $g; \&{“$into\::_generate”}; }; _install( $col->{_g}($class, $generator, $name, $arg, $col), $into, $as, ); }
372. Thank You!