1package Params::Callback; 2 3use strict; 4require 5.006; 5use Params::Validate (); 6use Params::CallbackRequest::Exceptions (abbr => [qw(throw_bad_params)]); 7 8use vars qw($VERSION); 9$VERSION = '1.20'; 10use constant DEFAULT_PRIORITY => 5; 11use constant REDIRECT => 302; 12 13# Set up an exception to be thrown by Params::Validate, and allow extra 14# parameters not specified, since subclasses may add others. 15Params::Validate::validation_options 16 ( on_fail => sub { throw_bad_params join '', @_ }, 17 allow_extra => 1 ); 18 19my $is_num = { 'valid priority' => sub { $_[0] =~ /^\d$/ } }; 20 21# Use Apache2?::RequestRec for mod_perl 2 22use constant APREQ_CLASS => exists $ENV{MOD_PERL_API_VERSION} 23 ? $ENV{MOD_PERL_API_VERSION} >= 2 24 ? 'Apache2::RequestRec' 25 : 'Apache::RequestRec' 26 : 'Apache'; 27 28BEGIN { 29 # The object-oriented interface is only supported with the use of 30 # Attribute::Handlers in Perl 5.6 and later. We'll use Class::ISA 31 # to get a list of all the classes that a class inherits from so 32 # that we can tell ApacheHandler::WithCallbacks that they exist and 33 # are loaded. 34 unless ($] < 5.006) { 35 require Attribute::Handlers; 36 require Class::ISA; 37 } 38 39 # Build read-only accessors. 40 for my $attr (qw( 41 cb_request 42 params 43 apache_req 44 priority 45 cb_key 46 pkg_key 47 requester 48 trigger_key 49 value 50 )) { 51 no strict 'refs'; 52 *{$attr} = sub { $_[0]->{$attr} }; 53 } 54 *class_key = \&pkg_key; 55} 56 57my %valid_params = ( 58 cb_request => { isa => 'Params::CallbackRequest' }, 59 60 params => { 61 type => Params::Validate::HASHREF, 62 }, 63 64 apache_req => { 65 isa => APREQ_CLASS, 66 optional => 1, 67 }, 68 69 priority => { 70 type => Params::Validate::SCALAR, 71 callbacks => $is_num, 72 optional => 1, 73 desc => 'Priority' 74 }, 75 76 cb_key => { 77 type => Params::Validate::SCALAR, 78 optional => 1, 79 desc => 'Callback key' 80 }, 81 82 pkg_key => { 83 type => Params::Validate::SCALAR, 84 optional => 1, 85 desc => 'Package key' 86 }, 87 88 trigger_key => { 89 type => Params::Validate::SCALAR, 90 optional => 1, 91 desc => 'Trigger key' 92 }, 93 94 value => { 95 optional => 1, 96 desc => 'Callback value' 97 }, 98 99 requester => { 100 optional => 1, 101 desc => 'Requesting object' 102 } 103); 104 105sub new { 106 my $proto = shift; 107 my %p = Params::Validate::validate(@_, \%valid_params); 108 return bless \%p, ref $proto || $proto; 109} 110 111############################################################################## 112# Subclasses must use register_subclass() to register the subclass. They can 113# also use it to set up the class key and a default priority for the subclass, 114# But base class CLASS_KEY() and DEFAULT_PRIORITY() methods can also be 115# overridden to do that. 116my (%priorities, %classes, %pres, %posts, @reqs, %isas, @classes); 117sub register_subclass { 118 shift; # Not needed. 119 my $class = caller; 120 return unless UNIVERSAL::isa($class, __PACKAGE__) 121 and $class ne __PACKAGE__; 122 my $spec = { 123 default_priority => { 124 type => Params::Validate::SCALAR, 125 optional => 1, 126 callbacks => $is_num 127 }, 128 class_key => { 129 type => Params::Validate::SCALAR, 130 optional => 1 131 }, 132 }; 133 134 my %p = Params::Validate::validate(@_, $spec); 135 136 # Grab the class key. Default to the actual class name. 137 my $ckey = $p{class_key} || $class; 138 139 # Create the CLASS_KEY method if it doesn't exist already. 140 unless (defined &{"$class\::CLASS_KEY"}) { 141 no strict 'refs'; 142 *{"$class\::CLASS_KEY"} = sub { $ckey }; 143 } 144 $classes{$class->CLASS_KEY} = $class; 145 146 if (defined $p{default_priority}) { 147 # Override any base class DEFAULT_PRIORITY methods. 148 no strict 'refs'; 149 *{"$class\::DEFAULT_PRIORITY"} = sub { $p{default_priority} }; 150 } 151 152 # Push the class into an array so that we can be sure to process it in 153 # the proper order later. 154 push @classes, $class; 155} 156 157############################################################################## 158 159# This method is called by subclassed methods that want to be 160# parameter-triggered callbacks. 161 162sub Callback : ATTR(CODE, BEGIN) { 163 my ($class, $symbol, $coderef, $attr, $data, $phase) = @_; 164 # Validate the arguments. At this point, there's only one allowed, 165 # priority. This is to set a priority for the callback method that 166 # overrides that set for the class. 167 my $spec = { 168 priority => { 169 type => Params::Validate::SCALAR, 170 optional => 1, 171 callbacks => $is_num 172 }, 173 }; 174 my %p = Params::Validate::validate(@$data, $spec); 175 # Get the priority. 176 my $priority = exists $p{priority} ? $p{priority} : 177 $class->DEFAULT_PRIORITY; 178 # Store the priority under the code reference. 179 $priorities{$coderef} = $priority; 180} 181 182############################################################################## 183 184# These methods are called by subclassed methods that want to be request 185# callbacks. 186 187sub PreCallback : ATTR(CODE, BEGIN) { 188 my ($class, $symbol, $coderef) = @_; 189 # Just return if we've been here before. This is to prevent hiccups when 190 # mod_perl loads packages twice. 191 return if $pres{$class} and ref $pres{$class}->[0]; 192 # Store a reference to the code in a temporary location and a pointer to 193 # it in the array. 194 push @reqs, $coderef; 195 push @{$pres{$class}}, $#reqs; 196} 197 198sub PostCallback : ATTR(CODE, BEGIN) { 199 my ($class, $symbol, $coderef) = @_; 200 # Just return if we've been here before. This is to prevent hiccups when 201 # mod_perl loads packages twice. 202 return if $posts{$class} and ref $posts{$class}->[0]; 203 # Store a reference to the code in a temporary location and a pointer to 204 # it in the array. 205 push @reqs, $coderef; 206 push @{$posts{$class}}, $#reqs; 207} 208 209############################################################################## 210# This method is called by Params::CallbackRequest to find the names of all 211# the callback methods declared with the PreCallback and PostCallback 212# attributes (might handle those declared with the Callback attribute at some 213# point, as well -- there's some of it in CVS Revision 1.21 of 214# MasonX::CallbackHandler). This is necessary because, in a BEGIN block, the 215# symbol isn't defined when the attribute callback is called. I would use a 216# CHECK or INIT block, but mod_perl ignores them. So the solution is to have 217# the callback methods save the code references for the methods, make sure 218# that Params::CallbackRequest is loaded _after_ all the classes that inherit 219# from Params::Callback, and have it call this function to go back and find 220# the names of the callback methods. The method names will then of course be 221# used for the callback names. In mod_perl2, we'll likely be able to call this 222# method from a PerlPostConfigHandler instead of making 223# Params::CallbackRequest do it, thus relieving the enforced loading order. 224# http://perl.apache.org/docs/2.0/user/handlers/server.html#PerlPostConfigHandler 225 226sub _find_names { 227 foreach my $class (@classes) { 228 # Find the names of the request callback methods. 229 foreach my $type (\%pres, \%posts) { 230 # We've stored an index pointing to each method in the @reqs 231 # array under __TMP in PreCallback() and PostCallback(). 232 for (@{$type->{$class}}) { 233 my $code = $reqs[$_]; 234 # Grab the symbol hash for this code reference. 235 my $sym = Attribute::Handlers::findsym($class, $code) 236 or die "Anonymous subroutines not supported. Make " . 237 "sure that Params::CallbackRequest loads last"; 238 # Params::CallbackRequest wants an array reference. 239 $_ = [ sub { goto $code }, $class, *{$sym}{NAME} ]; 240 } 241 } 242 # Copy any request callbacks from their parent classes. This is to 243 # ensure that rquest callbacks act like methods, even though, 244 # technically, they're not. 245 $isas{$class} = _copy_meths($class); 246 } 247 # We don't need these anymore. 248 @classes = (); 249 @reqs = (); 250} 251 252############################################################################## 253# This little gem, called by _find_names(), mimics inheritance by copying the 254# request callback methods declared for parent class keys into the children. 255# Any methods declared in the children will, of course, override. This means 256# that the parent methods can never actually be called, since request 257# callbacks are called for every request, and thus don't have a class 258# association. They still get the correct object passed as their first 259# parameter, however. 260 261sub _copy_meths { 262 my $class = shift; 263 my %seen_class; 264 # Grab all of the super classes. 265 foreach my $super (grep { UNIVERSAL::isa($_, __PACKAGE__) } 266 Class::ISA::super_path($class)) { 267 # Skip classes we've already seen. 268 unless ($seen_class{$super}) { 269 # Copy request callback code references. 270 foreach my $type (\%pres, \%posts) { 271 if ($type->{$class} and $type->{$super}) { 272 # Copy the methods, but allow newer ones to override. 273 my %seen_meth; 274 $type->{$class} = 275 [ grep { not $seen_meth{$_->[2]}++ } 276 @{$type->{$class}}, @{$type->{$super}} ]; 277 } elsif ($type->{$super}) { 278 # Just copy the methods. 279 $type->{$class} = [ @{ $type->{$super} } ]; 280 } 281 } 282 $seen_class{$super} = 1; 283 } 284 } 285 286 # Return an array ref of the super classes. 287 return [keys %seen_class]; 288} 289 290############################################################################## 291# This method is called by Params::CallbackRequest to find methods for 292# callback classes. This is because Params::Callback stores this list of 293# callback classes, not Params::CallbackRequest. Its arguments are the 294# callback class, the name of the method (callback), and a reference to the 295# priority. We'll only assign the priority if it hasn't been assigned one 296# already -- that is, it hasn't been _called_ with a priority. 297 298sub _get_callback { 299 my ($class, $meth, $p) = @_; 300 # Get the callback code reference. 301 my $c = UNIVERSAL::can($class, $meth) or return; 302 # Get the priority for this callback. If there's no priority, it's not 303 # a callback method, so skip it. 304 return unless defined $priorities{$c}; 305 my $priority = $priorities{$c}; 306 # Reformat the callback code reference. 307 my $code = sub { goto $c }; 308 # Assign the priority, if necessary. 309 $$p = $priority unless $$p ne ''; 310 # Create and return the callback. 311 return $code; 312} 313 314############################################################################## 315# This method is also called by Params::CallbackRequest, where the cb_classes 316# parameter passes in a list of callback class keys or the string "ALL" to 317# indicate that all of the callback classes should have their callbacks loaded 318# for use by Params::CallbacRequest. 319 320sub _load_classes { 321 my ($pkg, $ckeys) = @_; 322 # Just return success if there are no classes to be loaded. 323 return unless defined $ckeys; 324 my ($cbs, $pres, $posts); 325 # Process the class keys in the order they're given, or just do all of 326 # them if $ckeys eq 'ALL' or $ckeys->[0] eq '_ALL_' (checked by 327 # Params::CallbackRequest). 328 foreach my $ckey ( 329 ref $ckeys && $ckeys->[0] ne '_ALL_' ? @$ckeys : keys %classes 330 ) { 331 my $class = $classes{$ckey} or 332 die "Class with class key '$ckey' not loaded. Did you forget use" 333 . " it or to call register_subclass()?"; 334 # Map the class key to the class for the class and all of its parent 335 # classes, all for the benefit of Params::CallbackRequest. 336 $cbs->{$ckey} = $class; 337 foreach my $c (@{$isas{$class}}) { 338 next if $c eq __PACKAGE__; 339 $cbs->{$c->CLASS_KEY} = $c; 340 } 341 # Load request callbacks in the order they're defined. Methods 342 # inherited from parents have already been copied, so don't worry 343 # about them. 344 push @$pres, @{ $pres{$class} } if $pres{$class}; 345 push @$posts, @{ $posts{$class} } if $posts{$class}; 346 } 347 return ($cbs, $pres, $posts); 348} 349 350############################################################################## 351 352sub redirect { 353 my ($self, $url, $wait, $status) = @_; 354 $status ||= REDIRECT; 355 my $cb_request = $self->cb_request; 356 $cb_request->{_status} = $status; 357 $cb_request->{redirected} = $url; 358 359 if (my $r = $self->apache_req) { 360 $r->method('GET'); 361 $r->headers_in->unset('Content-length'); 362 $r->err_headers_out->add( Location => $url ); 363 } 364 $self->abort($status) unless $wait; 365} 366 367############################################################################## 368 369sub redirected { $_[0]->cb_request->redirected } 370 371############################################################################## 372 373sub abort { 374 my ($self, $aborted_value) = @_; 375 $self->cb_request->{_status} = $aborted_value; 376 Params::Callback::Exception::Abort->throw 377 ( error => ref $self . '->abort was called', 378 aborted_value => $aborted_value ); 379} 380 381############################################################################## 382 383sub aborted { 384 my ($self, $err) = @_; 385 $err = $@ unless defined $err; 386 return Params::CallbackRequest::Exceptions::isa_cb_exception( $err, 'Abort' ); 387} 388 389############################################################################## 390 391sub notes { 392 shift->{cb_request}->notes(@_); 393} 394 3951; 396__END__ 397 398=head1 NAME 399 400Params::Callback - Parameter callback base class 401 402=head1 SYNOPSIS 403 404Functional callback interface: 405 406 sub my_callback { 407 # Sole argument is a Params::Callback object. 408 my $cb = shift; 409 my $params = $cb->params; 410 my $value = $cb->value; 411 # Do stuff with above data. 412 } 413 414Object-oriented callback interface: 415 416 package MyApp::Callback; 417 use base qw(Params::Callback); 418 use constant CLASS_KEY => 'MyHandler'; 419 use strict; 420 421 sub my_callback : Callback { 422 my $self = shift; 423 my $params = $self->params; 424 my $value = $self->value; 425 # Do stuff with above data. 426 } 427 428=head1 DESCRIPTION 429 430Params::Callback provides the interface for callbacks to access parameter 431hashes Params::CallbackRequest object, and callback metadata, as well as for 432executing common request actions, such as aborting a callback execution 433request. There are two ways to use Params::Callback: via functional-style 434callback subroutines and via object-oriented callback methods. 435 436For functional callbacks, a Params::Callback object is constructed by 437Params::CallbackRequest for each call to its C<request()> method, and passed 438as the sole argument for every execution of a callback function. See 439L<Params::CallbackRequest|Params::CallbackRequest> for details on how to 440create a Params::CallbackRequest object to execute your callback code. 441 442In the object-oriented callback interface, Params::Callback is the parent 443class from which all callback classes inherit. Callback methods are declared 444in such subclasses via C<Callback>, C<PreCallback>, and C<PostCallback> 445attributes to each method declaration. Methods and subroutines declared 446without one of these callback attributes are not callback methods, but normal 447methods or subroutines of the subclass. Read L<subclassing|"SUBCLASSING"> for 448details on subclassing Params::Callback. 449 450=head1 INTERFACE 451 452Params::Callback provides the parameter hash accessors and utility methods that 453will help manage a callback request (where a "callback request" is considered 454a single call to the C<request()> method on a Params::CallbackRequest object). 455Functional callbacks always get a Params::Callback object passed as their 456first argument; the same Params::Callback object will be used for all 457callbacks in a single request. For object-oriented callback methods, the first 458argument will of course always be an object of the class corresponding to the 459class key used in the callback key (or, for request callback methods, an 460instance of the class for which the request callback method was loaded), and 461the same object will be reused for all subsequent callbacks to the same class 462in a single request. 463 464=head2 Accessor Methods 465 466All of the Params::Callback accessor methods are read-only. Feel free to add 467other attributes in your Params::Callback subclasses if you're using the 468object-oriented callback interface. 469 470=head3 cb_request 471 472 my $cb_request = $cb->cb_request; 473 474Returns a reference to the Params::CallbackRequest object that executed the 475callback. 476 477=head3 params 478 479 my $params = $cb->params; 480 481Returns a reference to the request parameters hash. Any changes you make to 482this hash will propagate beyond the lifetime of the request. 483 484=head3 apache_req 485 486 my $r = $cb->apache_req; 487 488Returns the Apache request object for the current request, provided you've 489passed one to C<< Params::CallbackRequest->request >>. This will be most 490useful in a mod_perl environment, of course. Use Apache:FakeRequest in 491tests to emmulate the behavior of an Apache request object. 492 493=head3 requester 494 495 my $r = $cb->requester; 496 497Returns the object that executed the callback by calling C<request()> on a 498Params::CallbackRequest object. Only available if the C<requester> parameter 499is passed to C<< Params::CallbackRequest->request >>. This can be useful for 500callbacks to get access to the object that executed the callbacks. 501 502=head3 priority 503 504 my $priority = $cb->priority; 505 506Returns the priority level at which the callback was executed. Possible values 507range from "0" to "9", and may be set by a default priority setting, by the 508callback configuration or method declaration, or by the parameter callback 509trigger key. See L<Params::CallbackRequest|Params::CallbackRequest> for 510details. 511 512=head3 cb_key 513 514 my $cb_key = $cb->cb_key; 515 516Returns the callback key that triggered the execution of the callback. For 517example, this callback-triggering parameter hash: 518 519 my $params = { "DEFAULT|save_cb" => 'Save' }; 520 521Will cause the C<cb_key()> method in the relevant callback to return "save". 522 523=head3 pkg_key 524 525 my $pkg_key = $cb->pkg_key; 526 527Returns the package key used in the callback trigger parameter key. For 528example, this callback-triggering parameter hash: 529 530 my $params = { "MyCBs|save_cb" => 'Save' }; 531 532Will cause the C<pkg_key()> method in the relevant callback to return "MyCBs". 533 534=head3 class_key 535 536 my $class_key = $cb->class_key; 537 538An alias for C<pkg_key>, only perhaps a bit more appealing for use in 539object-oriented callback methods. 540 541=head3 trigger_key 542 543 my $trigger_key = $cb->trigger_key; 544 545Returns the complete parameter key that triggered the callback. For example, 546if the parameter key that triggered the callback looks like this: 547 548 my $params = { "MyCBs|save_cb6" => 'Save' }; 549 550Then the value returned by C<trigger_key()> method will be "MyCBs|save_cb6". 551 552B<Note:> Most browsers will submit "image" input fields with two arguments, 553one with ".x" appended to its name, and the other with ".y" appended to its 554name. Because Params::CallbackRequest is designed to be used with Web form 555fields populating a parameter hash, it will ignore these fields and either use 556the field that's named without the ".x" or ".y", or create a field with that 557name and give it a value of "1". The reasoning behind this approach is that 558the names of the callback-triggering fields should be the same as the names 559that appear in the HTML form fields. If you want the actual x and y image 560click coordinates, access them directly from the request parameters: 561 562 my $params = $cb->params; 563 my $trigger_key = $cb->trigger_key; 564 my $x = $params->{"$trigger_key.x"}; 565 my $y = $params->{"$trigger_key.y"}; 566 567=head3 value 568 569 my $value = $cb->value; 570 571Returns the value of the parameter that triggered the callback. This value can 572be anything that can be stored in a hash value -- that is, any scalar 573value. Thus, in this example: 574 575 my $params = { "DEFAULT|save_cb" => 'Save', 576 "DEFAULT|open_cb" => [qw(one two)] }; 577 578C<value()> will return the string "Save" in the save callback, but the array 579reference C<['one', 'two']> in the open callback. 580 581Although you may often be able to retrieve the value directly from the hash 582reference returned by C<params()>, if multiple callback keys point to the same 583subroutine or if the parameter that triggered the callback overrode the 584priority, you may not be able to determine which value was submitted for a 585particular callback execution. So Params::Callback kindly provides the value 586for you. The exception to this rule is values submitted under keys named for 587HTML "image" input fields. See the note about this under the documentation for 588the C<trigger_key()> method. 589 590=head3 redirected 591 592 $cb->redirect($url) unless $cb->redirected; 593 594If the request has been redirected, this method returns the redirection 595URL. Otherwise, it returns false. This method is useful for conditions in 596which one callback has called C<< $cb->redirect >> with the optional C<$wait> 597argument set to a true value, thus allowing subsequent callbacks to continue 598to execute. If any of those subsequent callbacks want to call 599C<< $cb->redirect >> themselves, they can check the value of 600C<< $cb->redirected >> to make sure it hasn't been done already. 601 602=head2 Other Methods 603 604Params::Callback offers has a few other publicly accessible methods. 605 606=head3 notes 607 608 $cb->notes($key => $value); 609 my $val = $cb->notes($key); 610 my $notes = $cb->notes; 611 612Shortcut for C<< $cb->cb_request->notes >>. It provides a place to store 613application data, giving developers a way to share data among multiple 614callbacks. See L<C<notes()>|Params::CallbackRequest/"notes"> for more 615information. 616 617=head3 redirect 618 619 $cb->redirect($url); 620 $cb->redirect($url, $wait); 621 $cb->redirect($url, $wait, $status); 622 623This method can be used to redirect a request in a mod_perl environment, 624provided that an Apache request object has been passed to 625C<< Params::CallbackRequest->new >>. 626Outide of a mod_perl environment or without an Apache request object, 627C<redirect()> will still set the proper value for the the C<redirected()> 628method to return, and will still abort the callback request. 629 630Given a URL, this method generates a proper HTTP redirect for that URL. By 631default, the status code used is "302", but this can be overridden via the 632C<$status> argument. If the optional C<$wait> argument is true, any callbacks 633scheduled to be executed after the call to C<redirect> will continue to be 634executed. In that case, C<< $cb->abort >> will not be called; rather, 635Params::CallbackRequest will finish executing all remaining callbacks and then 636return the abort status. If the C<$wait> argument is unspecified or false, 637then the request will be immediately terminated without executing subsequent 638callbacks or. This approach relies on the execution of C<< $cb->abort >>. 639 640Since C<< $cb->redirect >> calls C<< $cb->abort >>, it will be trapped by an 641C<eval {}> block. If you are using an C<eval {}> block in your code to trap 642exceptions, you need to make sure to rethrow these exceptions, like this: 643 644 eval { 645 ... 646 }; 647 648 die $@ if $cb->aborted; 649 650 # handle other exceptions 651 652=head3 abort 653 654 $cb->abort($status); 655 656Aborts the current request without executing any more callbacks. The 657C<$status> argument specifies a request status code to be returned to by 658C<< Params::CallbackRequest->request() >>. 659 660C<abort()> is implemented by throwing a Params::Callback::Exception::Abort 661object and can thus be caught by C<eval{}>. The C<aborted()> method is a 662shortcut for determining whether an exception was generated by C<abort()>. 663 664=head3 aborted 665 666 die $err if $cb->aborted; 667 die $err if $cb->aborted($err); 668 669Returns true or C<undef> to indicate whether the specified C<$err> was 670generated by C<abort()>. If no C<$err> argument is passed, C<aborted()> 671examines C<$@>, instead. 672 673In this code, we catch and process fatal errors while letting C<abort()> 674exceptions pass through: 675 676 eval { code_that_may_die_or_abort() }; 677 if (my $err = $@) { 678 die $err if $cb->aborted($err); 679 680 # handle fatal errors... 681 } 682 683C<$@> can lose its value quickly, so if you're planning to call 684C<< $cb->aborted >> more than a few lines after the C<eval>, you should save 685C<$@> to a temporary variable and explicitly pass it to C<aborted()> as in the 686above example. 687 688=head1 SUBCLASSING 689 690Under Perl 5.6.0 and later, Params::Callback offers an object-oriented 691callback interface. The object-oriented approach is to subclass 692Params::Callback, add the callback methods you need, and specify a class key 693that uniquely identifies your subclass across all Params::Callback subclasses 694in your application. The key is to use Perl method attributes to identify 695methods as callback methods, so that Params::Callback can find them and 696execute them when the time comes. Here's an example: 697 698 package MyApp::CallbackHandler; 699 use base qw(Params::Callback); 700 use strict; 701 702 __PACKAGE__->register_subclass( class_key => 'MyHandler' ); 703 704 sub build_utc_date : Callback( priority => 2 ) { 705 my $self = shift; 706 my $params = $self->params; 707 $params->{date} = sprintf "%04d-%02d-%02dT%02d:%02d:%02d", 708 delete @{$params}{qw(year month day hour minute second)}; 709 } 710 711This parameter-triggered callback can then be executed via a parameter hash 712such as this: 713 714 my $params = { "MyHandler|build_utc_date_cb" => 1 }; 715 716Think of the part of the name preceding the pipe (the package key) as the 717class name, and the part of the name after the pipe (the callback key) as the 718method to call (plus '_cb'). If multiple parameters use the "MyHandler" class 719key in a single request, then a single MyApp::CallbackHandler object instance 720will be used to execute each of those callback methods for that request. 721 722To configure your Params::CallbackRequest object to use this callback, use its 723C<cb_classes> constructor parameter: 724 725 my $cb_request = Params::CallbackRequest->new 726 ( cb_classes => [qw(MyHandler)] ); 727 $cb_request->request($params); 728 729Now, there are a few of things to note in the above callback class example. 730The first is the call to C<< __PACKAGE__->register_subclass >>. This step is 731B<required> in all callback subclasses in order that Params::Callback will 732know about them, and thus they can be loaded into an instance of a 733Params::CallbackRequest object via its C<cb_classes> constructor parameter. 734 735Second, a callback class key B<must> be declared for the class. This can be 736done either by implementing the C<CLASS_KEY()> class method or constant in 737your subclass, or by passing the C<class_key> parameter to 738C<< __PACKAGE__->register_subclass >>, which will then create the 739C<CLASS_KEY()> method for you. If no callback key is declared, then 740Params::Callback will throw an exception when you try to load your subclass' 741callback methods into a Params::CallbackRequest object. 742 743One other, optional parameter, C<default_priority>, may also be passed to 744C<register_subclass()>. The value of this parameter (an integer between 0 and 7459) will be used to create a C<DEFAULT_PRIORITY()> class method in the 746subclass. You can also explicitly implement the C<DEFAULT_PRIORITY()> class 747method or constant in the subclass, if you'd rather. All parameter-triggered 748callback methods in that class will have their priorities set to the value 749returned by C<DEFAULT_PRIORITY()>, unless they override it via their 750C<Callback> attributes. 751 752And finally, notice the C<Callback> attribute on the C<build_utc_date> method 753declaration in the example above. This attribute is what identifies 754C<build_utc_date> as a parameter-triggered callback. Without the C<Callback> 755attribute, any subroutine declaration in your subclass will just be a 756subroutine or a method; it won't be a callback, and it will never be executed 757by Params::CallbackRequest. One parameter, C<priority>, can be passed via the 758C<Callback> attribute. In the above example, we pass C<< priority => 2 >>, 759which sets the priority for the callback. Without the C<priority> parameter, 760the callback's priority will be set to the value returned by the 761C<DEFAULT_PRIORITY()> class method. Of course, the priority can still be 762overridden by adding it to the callback trigger key. For example, here we 763force the callback priority for the execution of the C<build_utc_date> 764callback method for this one field to be the highest priority, "0": 765 766 my $params = { "MyHandler|build_utc_date_cb0" => 1 }; 767 768Other parameters to the C<Callback> attribute may be added in future versions 769of Params::Callback. 770 771Request callbacks can also be implemented as callback methods using the 772C<PreCallback> and C<PostCallback> attributes, which currently support no 773parameters. 774 775=head2 Subclassing Examples 776 777At this point, you may be wondering what advantage the object-oriented 778callback interface offer over functional callbacks. There are a number of 779advantages. First, it allows you to make use of callbacks provided by other 780users without having to reinvent the wheel for yourself. Say someone has 781implemented the above class with its exceptionally complex C<build_utc_date()> 782callback method. You need to have the same functionality, only with fractions 783of a second added to the date format so that you can insert them into your 784database without an error. (This is admittedly a contrived example, but you 785get the idea.) To make it happen, you merely have to subclass the above class 786and override the C<build_utc_date()> method to do what you need: 787 788 package MyApp::Callback::Subclass; 789 use base qw(MyApp::CallbackHandler); 790 use strict; 791 792 __PACKAGE__->register_subclass; 793 794 # Implement CLASS_KEY ourselves. 795 use constant CLASS_KEY => 'SubHandler'; 796 797 sub build_utc_date : Callback( priority => 1 ) { 798 my $self = shift; 799 $self->SUPER::build_utc_date; 800 my $params = $self->params; 801 $params->{date} .= '.000000'; 802 } 803 804This callback can then be triggered by a parameter hash such as this: 805 806 my $params = { "SubHandler|build_utc_date_cb" => 1 }; 807 808Note that we've used the "SubHandler" class key. If we used the "MyHandler" 809class key, then the C<build_utc_date()> method would be called on an instance 810of the MyApp::CallbackHandler class, instead. 811 812=head3 Request Callback Methods 813 814I'll admit that the case for request callback methods is a bit more 815tenuous. Granted, a given application may have 100s or even 1000s of 816parameter-triggered callbacks, but only one or two request callbacks, if 817any. But the advantage of request callback methods is that they encourage code 818sharing, in that Params::Callback creates a kind of plug-in architecture Perl 819templating architectures. 820 821For example, say someone has kindly created a Params::Callback subclass, 822Params::Callback::Unicodify, with the request callback method C<unicodify()>, 823which translates character sets, allowing you to always store data in the 824database in Unicode. That's all well and good, as far as it goes, but let's 825say that you want to make sure that your Unicode strings are actually encoded 826using the Perl C<\x{..}> notation. Again, just subclass: 827 828 package Params::Callback::Unicodify::PerlEncode; 829 use base qw(Params::Callback::Unicodify); 830 use strict; 831 832 __PACKAGE__->register_subclass( class_key => 'PerlEncode' ); 833 834 sub unicodify : PreCallback { 835 my $self = shift; 836 $self->SUPER::unicodify; 837 my $params = $self->params; 838 encode_unicode($params); # Hand waving. 839 } 840 841Now you can just tell Params::CallbackRequest to use your subclassed callback 842handler: 843 844 my $cb_request = Params::CallbackRequest->new 845 ( cb_classes => [qw(PerlEncode)] ); 846 847Yeah, okay, you could just create a second pre-callback request callback to 848encode the Unicode characters using the Perl C<\x{..}> notation. But you get 849the idea. Better examples welcome. 850 851=head3 Overriding the Constructor 852 853Another advantage to using callback classes is that you can override the 854Params::Callback C<new()> constructor. Since every callback for a single class 855will be executed on the same instance object in a single request, you can set 856up object properties in the constructor that subsequent callback methods in 857the same request can then access. 858 859For example, say you had a series of pages that all do different things to 860manage objects in your application. Each of those pages might have a number of 861parameters in common to assist in constructing an object: 862 863 my $params = { class => "MyApp::Spring", 864 obj_id => 10, 865 # ... 866 }; 867 868Then the remaining parameters created for each of these pages have different 869key/value pairs for doing different things with the object, perhaps with 870numerous parameter-triggered callbacks. Here's where subclassing comes in 871handy: you can override the constructor to construct the object when the 872callback object is constructed, so that each of your callback methods doesn't 873have to: 874 875 package MyApp::Callback; 876 use base qw(Params::Callback); 877 use strict; 878 __PACKAGE__->register_subclass( class_key => 'MyCBHandler' ); 879 880 sub new { 881 my $class = shift; 882 my $self = $class->SUPER::new(@_); 883 my $params = $self->params; 884 $self->object($params->{class}->lookup( id => $params->{obj_id} )); 885 } 886 887 sub object { 888 my $self = shift; 889 if (@_) { 890 $self->{object} = shift; 891 } 892 return $self->{object}; 893 } 894 895 sub save : Callback { 896 my $self = shift; 897 $self->object->save; 898 } 899 900=head1 SUBCLASSING INTERFACE 901 902Much of the interface for subclassing Params::Callback is evident in the above 903examples. Here is a reference to the complete callback subclassing API. 904 905=head2 Callback Class Declaration 906 907Callback classes always subclass Params::Callback, so of course they must 908always declare such. In addition, callback classes must always call 909C<< __PACKAGE__->register_subclass >> so that Params::Callback is aware of 910them and can tell Params::CallbackRequest about them. 911 912Second, callback classes B<must> have a class key. The class key can be 913created either by implementing a C<CLASS_KEY()> class method or constant that 914returns the class key, or by passing the C<class_key> parameter to 915C<register_subclass()> method. If no C<class_key> parameter is passed to 916C<register_subclass()> and no C<CLASS_KEY()> method exists, 917C<register_subclass()> will create the C<CLASS_KEY()> class method to return 918the actual class name. So here are a few example callback class declarations: 919 920 package MyApp::Callback; 921 use base qw(Params::Callback); 922 __PACKAGE__->register_subclass( class_key => 'MyCBHandler' ); 923 924In this declaration C<register_subclass()> will create a C<CLASS_KEY()> class 925method returning "MyCBHandler" in the MyApp::CallbackHandler class. 926 927 package MyApp::AnotherCallback; 928 use base qw(MyApp::Callback); 929 __PACKAGE__->register_subclass; 930 use constant CLASS_KEY => 'AnotherCallback'; 931 932In this declaration, we've created an explicit C<CLASS_KEY()> class method 933(using the handy C<use constant> syntax, so that C<register_subclass()> 934doesn't have to. 935 936 package MyApp::Callback::Foo; 937 use base qw(Params::Callback); 938 __PACKAGE__->register_subclass; 939 940And in this callback class declaration, we've specified neither a C<class_key> 941parameter to C<register_subclass()>, nor created a C<CLASS_KEY()> class 942method. This causes C<register_subclass()> to create the C<CLASS_KEY()> class 943method returning the name of the class itself, i.e., "MyApp::FooHandler". Thus 944any parameter-triggered callbacks in this class can be triggered by using the 945class name in the trigger key: 946 947 my $params = { "MyApp::Callback::Foo|take_action_cb" => 1 }; 948 949A second, optional parameter, C<default_priority>, may also be passed to 950C<register_subclass()> in order to set a default priority for all of the 951methods in the class (and for all the methods in subclasses that don't declare 952their own C<default_priority>s): 953 954 package MyApp::Callback; 955 use base qw(Params::Callback); 956 __PACKAGE__->register_subclass( class_key => 'MyCB', 957 default_priority => 7 ); 958 959As with the C<class_key> parameter, the C<default_priority> parameter creates 960a class method, C<DEFAULT_PRIORITY()>. If you'd rather, you can create this 961class method yourself; just be sure that its value is a valid priority -- that 962is, an integer between "0" and "9": 963 964 package MyApp::Callback; 965 use base qw(Params::Callback); 966 use constant DEFAULT_PRIORITY => 7; 967 __PACKAGE__->register_subclass( class_key => 'MyCB' ); 968 969Any callback class that does not specify a default priority via the 970C<default_priority> or by implementing a <DEFAULT_PRIORITY()> class method 971will simply inherit the priority returned by 972C<< Params::Callback->DEFAULT_PRIORITY >>, which is "5". 973 974B<Note:> In a mod_perl environment, it's important that you C<use> any and all 975Params::Callback subclasses I<before> you C<use Params::CallbackRequest>. This is 976to get around an issue with identifying the names of the callback methods in 977mod_perl. Read the comments in the source code if you're interested in 978learning more. 979 980=head2 Method Attributes 981 982These method attributes are required to create callback methods in 983Params::Callback subclasses. 984 985=head3 Callback 986 987 sub take_action : Callback { 988 my $self = shift; 989 # Do stuff. 990 } 991 992This attribute identifies a parameter-triggered callback method. The callback 993key is the same as the method name ("take_action" in this example). The 994priority for the callback may be set via an optional C<priority> parameter to 995the C<Callback> attribute, like so: 996 997 sub take_action : Callback( priority => 5 ) { 998 my $self = shift; 999 # Do stuff. 1000 } 1001 1002Otherwise, the priority will be that returned by C<< $self->DEFAULT_PRIORITY >>. 1003 1004B<Note:> The priority set via the C<priority> parameter to the C<Callback> 1005attribute is not inherited by any subclasses that override the callback 1006method. This may change in the future. 1007 1008=head3 PreCallback 1009 1010 sub early_action : PreCallback { 1011 my $self = shift; 1012 # Do stuff. 1013 } 1014 1015This attribute identifies a method as a request callback that gets executed 1016for every request I<before> any parameter-triggered callbacks are executed . 1017No parameters to C<PreCallback> are currently supported. 1018 1019=head3 PostCallback 1020 1021 sub late_action : PostCallback { 1022 my $self = shift; 1023 # Do stuff. 1024 } 1025 1026This attribute identifies a method as a request callback that gets executed 1027for every request I<after> any parameter-triggered callbacks are executed . No 1028parameters to C<PostCallback> are currently supported. 1029 1030=head1 TODO 1031 1032=over 1033 1034=item * 1035 1036Allow methods that override parent methods to inherit the parent method's 1037priority? 1038 1039=back 1040 1041=head1 SEE ALSO 1042 1043L<Params::CallbackRequest|Params::CallbackRequest> constructs Params::Callback 1044objects and executes the appropriate callback functions and/or methods. It's 1045worth a read. 1046 1047=head1 SUPPORT 1048 1049This module is stored in an open repository at the following address: 1050 1051L<https://svn.kineticode.com/Params-CallbackRequest/trunk/> 1052 1053Patches against Params::CallbackRequest are welcome. Please send bug reports 1054to <bug-params-callbackrequest@rt.cpan.org>. 1055 1056=head1 AUTHOR 1057 1058David E. Wheeler <david@justatheory.com> 1059 1060=head1 COPYRIGHT AND LICENSE 1061 1062Copyright 2003-2011 David E. Wheeler. Some Rights Reserved. 1063 1064This library is free software; you can redistribute it and/or modify it under 1065the same terms as Perl itself. 1066 1067=cut 1068