1package WWW::Mechanize::Pluggable; 2use strict; 3use WWW::Mechanize; 4use Data::Dump::Streamer; 5use Carp qw(croak); 6 7use Module::Pluggable search_path => [ qw(WWW::Mechanize::Plugin) ], 8 'require' => 1; 9 10our $AUTOLOAD; 11 12BEGIN { 13 use vars qw ($VERSION); 14 $VERSION = "1.14"; 15} 16 17=head1 NAME 18 19WWW::Mechanize::Pluggable - A WWW::Mechanize that's custmomizable via plugins 20 21=head1 SYNOPSIS 22 23 use WWW::Mechanize::Pluggable; 24 # plugins now automatically loaded 25 26=head1 DESCRIPTION 27 28This module provides all of the same functionality of C<WWW::Mechanize>, but 29adds support for I<plugins> using C<Module::Pluggable>; this means that 30any module named C<WWW::Mechanize::Plugin::I<whatever...>> will 31be found and loaded when C<WWW::Mechanize::Pluggable> is loaded. 32 33Big deal, you say. Well, it I<becomes> a big deal in conjunction with 34C<WWW::Mechanize::Pluggable>'s other feature: I<plugin hooks>. When plugins 35are loaded, their C<import()> methods can call C<WWW::Mechanize::Pluggable>'s 36C<prehook> and C<posthook> methods. These methods add callbacks to the 37plugin code in C<WWW::Mechanize::Pluggable>'s methods. These callbacks can 38act before a method or after it, and have to option of short-circuiting the 39call to the C<WWW::Mechanize::Pluggable> method altogether. 40 41These methods receive whatever parameters the C<WWW::Mechanize::Pluggable> 42methods received, plus a reference to the actvive C<Mech> object. 43 44All other extensions to C<WWW::Mechanize::Pluggable> are handled by the 45plugins. 46 47=head1 SUBCLASSING 48 49Subclassing this class is not recommended; partly because the method 50redispatch we need to do internally doesn't play well with the standard 51Perl OO model, and partly because you should be using plugins and hooks 52instead. 53 54In C<WWW::Mechanize>, it is recommended that you extend functionality by 55subclassing C<WWW::Mechanize>, because there's no other way to extend the 56class. With C<Module::Pluggable> support, it is easy to load another method 57directly into C<WWW::Mechanize::Pluggable>'s namespace; it then appears as 58if it had always been there. In addition, the C<pre_hook()> and C<post_hook()> 59methods provide a way to intercept a call and replace it with your output, or 60to tack on further processing at the end of a standard method (or even a 61plugin!). 62 63The advantage of this is in not having a large number of subclasses, all of 64which add or alter C<WWW::Mechanize>'s function, and all of which have to be 65loaded if you want them available in your code. With 66C<WWW::Mechanize::Pluggable>, one simply installs the desired plugins and they 67are all automatically available when you C<use WWW::Mechanize::Pluggable>. 68 69Configuration is a possible problem area; if three different plugins all 70attempt to replace C<get()>, only one will win. It's better to create more 71sophisticated methods that call on lower-level ones than to alter existing 72known behavior. 73 74=head1 USAGE 75 76See the synopsis for an example use of the base module; extended behavior is 77documented in the plugin classes. 78 79=head1 BUGS 80 81None known. 82 83=head1 SUPPORT 84 85Contact the author at C<mcmahon@yahoo-inc.com>. 86 87=head1 AUTHOR 88 89 Joe McMahon 90 mcmahon@yahoo-inc.com 91 92=head1 COPYRIGHT 93 94This program is free software; you can redistribute 95it and/or modify it under the same terms as Perl itself. 96 97The full text of the license can be found in the 98LICENSE file included with this module. 99 100 101=head1 SEE ALSO 102 103L<WWW::Mechanize> 104 105=head1 CLASS METHODS 106 107=head2 import 108 109Handles the delegation of import options to the appropriate plugins. 110 111C<import> loads the plugins (found via a call to C<__PACKAGE__->plugins>) using 112C<erquire>; it then calls each plugin's C<import> method with the parameters 113specific to it, if there are any. 114 115=head3 What your plugin sees 116 117Let's take the example 118 119 use WWW::Mechanize::Pluggable Zonk => [foo => 1, bar => [qw(a b c)]], 120 Thud => [baz => 'quux']; 121 122C<WWW::Mechanize::Plugin::Zonk>'s import() would get called like this: 123 124 WWW::Mechanize::Plugin::Zonk->import(foo => 1, bar => [qw(a b c)]); 125 126And C<WWW::Mechanize::Plugin::Thud>'s import() would get 127 128 WWW::Mechanize::Plugin::Thud->import(baz => 'quux'); 129 130So each plugin only sees what it's supposed to. 131 132=cut 133 134sub import { 135 my ($class, %plugin_args) = @_; 136 foreach my $plugin (__PACKAGE__->plugins) { 137 my ($plugin_name) = ($plugin =~ /.*::(.*)$/); 138 if ($plugin->can('import')) { 139 if (exists $plugin_args{$plugin_name}) { 140 $plugin->import( @{ $plugin_args{$plugin_name} } ); 141 } 142 else { 143 $plugin->import(); 144 } 145 } 146 } 147} 148 149=head2 init 150 151C<init> runs through all of the plugins for this class and calls 152their C<init> methods (if they exist). Not meant to be called by your 153code; it's internal-use-only. 154 155C<init> gets all of the arguments supplied to C<new>; it can 156process them or not as it pleases. 157 158=head3 What your plugin sees 159 160Your plugin's C<init> gets a reference to the C<Pluggable> object 161plus the list of parameters supplied to the C<new()> call. This is 162assumewd to be a set of zero or more key/value pairs. 163 164C<init> can return a list of keys to be deleted from the parameter 165hash; this allows plugins to process parameters themselves without 166the internal C<WWW::Mechanize> object ever seeing them. If you 167return a null list, nothing gets deleted. 168 169As an example: 170 171 my $mech = new WWW::Mechanize::Pluggable foo=>'bar'; 172 173A plugin's C<init> could process the C<foo> argument and return C<foo>; 174this parameter would then be deleted from the arguments. 175 176=cut 177 178sub init { 179 my ($self, %args) = @_; 180 # call all the inits (if defined) in all our 181 # plugins so they can all set up their defaults 182 my @deletes; 183 foreach my $plugin (__PACKAGE__->plugins) { 184 if ($plugin->can('init')) { 185 push @deletes, $plugin->init($self, %args); 186 } 187 } 188 @deletes; 189} 190 191=head2 new 192 193C<new> constructs a C<WWW::Mechanize::Pluggable> object and initializes 194its pre and port hook queues. You can add parameters to be passed to 195plugins' C<init> methods by adding them to this C<new> call. 196 197=cut 198 199sub new { 200 my ($class, %args) = @_; 201 my $self = {}; 202 bless $self, $class; 203 204 205 $self->{PreHooks} = {}; 206 $self->{PostHooks} = {}; 207 my @deletes = $self->init(%args); 208 209 local $_; 210 delete $args{$_} foreach @deletes; 211 212 213 $self->mech($self->_create_mech_object(\%args)); 214 215 $self; 216} 217 218=head2 _create_mech_object 219 220Create the WWW::Mechanize object. Optional parameter '_Pluggable_mech_class' 221specifies a different class, e.g. Test::WWW::Mechanize. 222 223=cut 224 225sub _create_mech_object { 226 my ($self, $args) = @_; 227 228 my $mech_class = delete $args->{_Pluggable_mech_class}; 229 $mech_class = 'WWW::Mechanize' if !defined($mech_class); 230 $mech_class->new(%$args); 231} 232 233=head2 mech 234 235Returns the component C<WWW::Mechanize> object. 236 237This is a simple set/get accessor; normally we'd just use L<Class::Accessor> 238to create it and forget about the details. We don't use C<Class::Accessor>, 239though, because we want the C<WWW::Mechanize::Pluggable> class to have no 240superclass (other than C<UNIVERSAL>). 241 242This is necessary because we use C<AUTOLOAD> (q.v.) to trap all of the calls 243to this class so they can be pre- and post-processed before being passed on 244to the underlying C<WWW::Mechanize> object. If we C<use base qw(Class::Accessor)>, 245as is needed to make it work properly, C<Class::Accessor>'s C<AUTOLOAD> gets control 246instead of ours, and the hooks don't work. 247 248=cut 249 250sub mech { 251 my ($self, $mech) = @_; 252 $self->{Mech} = $mech if defined $mech; 253 $self->{Mech}; 254} 255 256=head2 _insert_hook 257 258Adds a hook to a hook queue. This is a utility routine, encapsulating 259the hook queue manipulation in a single method. 260 261Needs the queue name, the method name of the method being hooked, and a 262reference to the hook sub itself. 263 264=cut 265 266sub _insert_hook { 267 my ($self, $which, $method, $hook_sub) = @_; 268 push @{$self->{$which}->{$method}}, $hook_sub; 269} 270 271=head2 _remove_hook 272 273Deletes a hook from a hook queue. 274 275Needs the queue name, the method name of the method being hooked, and a 276reference to the hook sub itself. 277 278=cut 279 280sub _remove_hook { 281 my ($self, $which, $method, $hook_sub) = @_; 282 $self->{$which}->{$method} = 283 [grep { "$_" ne "$hook_sub"} @{$self->{$which}->{$method}}] 284 if defined $self->{$which}->{$method}; 285} 286 287=head2 pre_hook 288 289Shortcut to add a hook to a method's pre queue. Needs a method name 290and a reference to a subroutine to be called as the hook. 291 292=cut 293 294sub pre_hook { 295 my $self = shift; 296 $self->_insert_hook(PreHooks=>@_); 297} 298 299=head2 post_hook 300 301Shortcut to add a hook to a method's post queue. Needs a method 302name and a reference to the subroutine to be called as the hook. 303 304=cut 305 306sub post_hook { 307 my $self = shift; 308 $self->_insert_hook(PostHooks=>@_); 309} 310 311=head2 last_method 312 313Records the last method used to call C<WWW::Mechanize::Pluggable>. 314This allows plugins to call a method again if necessary without 315having to know what method was actually called. 316 317=cut 318 319sub last_method { 320 my($self, $method) = @_; 321 $self->{LastMethod} = $method if defined $method; 322 $self->{LastMethod}; 323} 324 325=head1 AUTOLOAD 326 327This subroutine implements a mix of the "decorator" pattern and 328the "proxy" pattern. It intercepts all the calls to the underlying class, 329and also wraps them with pre-hooks (called before the method is called) 330and post-hooks (called after the method is called). This allows us to 331provide all of the functionality of C<WWW::Mechanize> in this class 332without copying any of the code, and to alter the behavior as well 333without altering the original class. 334 335Pre-hooks can cause the actual method call to the underlying class 336to be skipped altogether by returning a true value. 337 338=cut 339 340sub AUTOLOAD { 341 return if $AUTOLOAD =~ /DESTROY/; 342 343 # don't shift; this might be a straight sub call! 344 my $self = $_[0]; 345 346 # figure out what was supposed to be called. 347 (my $super_sub = $AUTOLOAD) =~ s/::Pluggable//; 348 my ($class, $plain_sub) = ($AUTOLOAD =~ /\A(.*)::(.*)$/); 349 350 # Determine if this is a class method call or a subroutine call. Getting here 351 # for either means that they haven't been defined and we don't know how to 352 # find them. 353 my $call_type; 354 if (scalar @_ == 0 or !defined $_[0] or !ref $_[0]) { 355 $call_type = ( $_[0] eq $class ? 'class method' : 'subroutine' ); 356 } 357 358 die "Can't resolve $call_type $plain_sub(). Did your plugins define it?" 359 if $call_type; 360 361 # Record the method name so plugins can check it. 362 $self->last_method($plain_sub); 363 364 my ($ret, @ret) = ""; 365 shift @_; 366 my $skip; 367 if (my $pre_hook = $self->{PreHooks}->{$plain_sub}) { 368 # skip call to actual method if pre_hook returns false. 369 # pre_hook must muck with Mech object to really return anything. 370 foreach my $hook (@$pre_hook) { 371 my $result = $hook->($self, $self->mech, @_); 372 $skip ||= (defined $result) && ($result == -1); 373 } 374 } 375 unless ($skip) { 376 if (wantarray) { 377 @ret = eval { $self->mech->$plain_sub(@_) }; 378 croak $@ if $@; 379 } 380 else { 381 $ret = eval { $self->mech->$plain_sub(@_) }; 382 croak $@ if $@; 383 } 384 } 385 if (my $post_hook = $self->{PostHooks}->{$plain_sub}) { 386 # Same deal here. Anything you want to return has to go in the object. 387 foreach my $hook (@$post_hook) { 388 $hook->($self, $self->mech, @_); 389 } 390 } 391 wantarray ? @ret : $ret; 392} 393 394=head2 clone 395 396An ovveride for C<WWW::Mechanize>'s C<clone()> method; uses YAML to make sure 397that the code references get cloned too. Note that this is important for 398later code (the cache stuff in particular); general users won't notice 399any real difference. 400 401There's been some discussion as to whether this is totally adequate (for 402instance, if the code references are closures, they won't be properly cloned). 403For now, we'll go with this and see how it works. 404 405=cut 406 407sub clone { 408 my $self = shift; 409 # Name created by eval; works out to a no-op. 410 my $value = 411 eval { no strict; 412 local $WWW_Mechanize_Pluggable1; 413 eval Dump($self)->Out(); 414 $WWW_Mechanize_Pluggable1; 415 }; 416 die "clone failed: $@\n" if $@; 417 return $value; 418} 419 420=head1 TODO 421 422The plugin mechanism is ridiculously programmer-intensive. This needs to be 423replaced with something better. 424 425=cut 426 4271; #this line is important and will help the module return a true value 428__END__ 429