X-Git-Url: https://git.decadent.org.uk/gitweb/?p=maypole.git;a=blobdiff_plain;f=lib%2FMaypole.pm;h=d476b56a46e55ed9dad22695f8a10e33b9e0db5d;hp=9f1af35366433899221fa6cf1fe191eb42dd8cfa;hb=1c8db728a3fb5adb4f0ea876ea1316457700edf8;hpb=dc0c8b4a91ac443404c0a397cd53d2a78f23f97e diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 9f1af35..d476b56 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -3,12 +3,17 @@ use base qw(Class::Accessor::Fast Class::Data::Inheritable); use UNIVERSAL::require; use strict; use warnings; +use Data::Dumper; use Maypole::Config; use Maypole::Constants; use Maypole::Headers; use URI(); +use URI::QueryParam; +use NEXT; +use File::MMagic::XS qw(:compat); our $VERSION = '2.11'; +our $mmagic = File::MMagic::XS->new(); # proposed privacy conventions: # - no leading underscore - public to custom application code and plugins @@ -30,6 +35,9 @@ The canonical example used in the Maypole documentation is the beer database: # choose a frontend, initialise the config object, and load a plugin use Maypole::Application qw/Relationship/; + + # set everything up + __PACKAGE__->setup("dbi:SQLite:t/beerdb.db"); # get the empty config object created by Maypole::Application my $config = __PACKAGE__->config; @@ -38,7 +46,7 @@ The canonical example used in the Maypole documentation is the beer database: $config->uri_base("http://localhost/beerdb"); $config->template_root("/path/to/templates"); $config->rows_per_page(10); - $config->display_tables([qw[beer brewery pub style]]); + $config->display_tables([qw/beer brewery pub style/]); # table relationships $config->relationships([ @@ -57,8 +65,8 @@ The canonical example used in the Maypole documentation is the beer database: date => [ qw/date/], ); - # set everything up - __PACKAGE__->setup("dbi:SQLite:t/beerdb.db"); + # note : set up model before calling this method + BeerDB::Beer->required_columns([qw/name/]); 1; @@ -86,7 +94,7 @@ configuration (B calling setup.) Note that some details in some of these resources may be out of date. -=over 4 +=over 4 =item The Maypole Manual @@ -115,7 +123,7 @@ may be out of date. =item Web applications with Maypole A tutorial written by Simon Cozens for YAPC::EU 2005 - -http://www.droogs.org/perl/maypole/maypole-tutorial.pdf [228KB]. +http://www.aarontrevena.co.uk/opensource/maypole/maypole-tutorial.pdf [228KB]. =item A Database-Driven Web Application in 18 Lines of Code @@ -143,7 +151,7 @@ http://www.perl.com/pub/a/2004/04/15/maypole.html =item Authentication Some notes written by Simon Cozens. A little bit out of date, but still -very useful: http://www.droogs.org/perl/maypole/authentication.html +very useful: http://www.aarontrevena.co.uk/opensource/maypole/authentication.html =item CheatSheet @@ -168,44 +176,22 @@ http://cpanratings.perl.org/dist/Maypole =back -=head1 DEMOS - -A couple of demos are available, sometimes with source code and configs. - -=over 4 - -=item http://maypole.perl.org/beerdb/ - -The standard BeerDB example, using the TT factory templates supplied in the -distribution. - -=item beerdb.riverside-cms.co.uk - -The standard BeerDB example, running on Mason, using the factory templates -supplied in the L distribution. - -=item beerfb.riverside-cms.co.uk - -A demo of L. This site is running on the set of Mason -templates included in the L distribution. See the -synopsis of L for an example driver - -=back - =cut -__PACKAGE__->mk_classdata($_) for qw( config init_done view_object ); +__PACKAGE__->mk_classdata($_) for qw( config init_done view_object model_classes_loaded); __PACKAGE__->mk_accessors( qw( params query objects model_class template_args output path args action template error document_encoding content_type table - headers_in headers_out stash session) + headers_in headers_out stash status parent) ); __PACKAGE__->config( Maypole::Config->new() ); __PACKAGE__->init_done(0); +__PACKAGE__->model_classes_loaded(0); + =head1 HOOKABLE METHODS As a framework, Maypole provides a number of B - methods that are @@ -243,9 +229,12 @@ enable/disable debugging. You can also set the C flag via L. +Some packages respond to higher debug levels, try increasing it to 2 or 3. + + =cut -sub debug { 0 } +sub debug { 0 } =item config @@ -253,20 +242,34 @@ Returns the L object =item setup - My::App->setup($data_source, $user, $password, \%attr); - -Initialise the Maypole application and plugins and model classes - see -L. - -If your model is based on L, the C<\%attr> hashref can -contain options that are passed directly to L, to control -how the model hierarchy is constructed. + My::App->setup($data_source, $user, $password, \%attr); +Initialise the Maypole application and plugins and model classes. Your application should call this B setting up configuration data via L<"config">. +It calls the hook C to setup the model. The %attr hash contains +options and arguments used to set up the model. See the particular model's +documentation. However here is the most usage of setup where +Maypole::Model::CDBI is the base class. + + My::App->setup($data_source, $user, $password, + { options => { # These are DB connection options + AutoCommit => 0, + RaiseError => 1, + ... + }, + # These are Class::DBI::Loader arguments. + relationships => 1, + ... + } + ); + +Also, see L. + =cut + sub setup { my $class = shift; @@ -285,38 +288,31 @@ don't need to load them in the driver. =cut -sub setup_model -{ - my $class = shift; - - $class = ref $class if ref $class; - - my $config = $class->config; - - $config->model || $config->model('Maypole::Model::CDBI'); - - $config->model->require or die sprintf - "Couldn't load the model class %s: %s", $config->model, $@; - - # among other things, this populates $config->classes - $config->model->setup_database($config, $class, @_); - - foreach my $subclass ( @{ $config->classes } ) - { - no strict 'refs'; - unshift @{ $subclass . "::ISA" }, $config->model; - - # Load custom model code, if it exists - nb this must happen after the - # unshift, to allow code attributes to work, but before adopt(), - # in case adopt() calls overridden methods on $subclass - $class->load_model_subclass($subclass); - - $config->model->adopt($subclass) if $config->model->can("adopt"); +sub setup_model { + my $class = shift; + $class = ref $class if ref $class; + my $config = $class->config; + $config->model || $config->model('Maypole::Model::CDBI'); + $config->model->require or die sprintf + "Couldn't load the model class %s: %s", $config->model, $@; + + # among other things, this populates $config->classes + $config->model->setup_database($config, $class, @_); + + foreach my $subclass ( @{ $config->classes } ) { + next if $subclass->isa("Maypole::Model::Base"); + no strict 'refs'; + unshift @{ $subclass . "::ISA" }, $config->model; + } + + # Load custom model code, if it exists - nb this must happen after the + # unshift, to allow code attributes to work, but before adopt(), + # in case adopt() calls overridden methods on $subclass + foreach my $subclass ( @{ $config->classes } ) { + $class->load_model_subclass($subclass) unless ($class->model_classes_loaded()); + $config->model->adopt($subclass) if $config->model->can("adopt"); + } -# eval "use $subclass"; -# die "Error loading $subclass: $@" -# if $@ and $@ !~ /Can\'t locate \S+ in \@INC/; - } } =item load_model_subclass($subclass) @@ -325,32 +321,32 @@ This method is called from C. It attempts to load the C<$subclass> package, if one exists. So if you make a customized C package, you don't need to explicitly load it. -If, perhaps during development, you don't want to load up custom classes, you +If automatic loading causes problems, Override load_model_subclass in your driver. + +sub load_model_subclass {}; + +Or perhaps during development, if you don't want to load up custom classes, you can override this method and load them manually. =cut -sub load_model_subclass -{ - my ($class, $subclass) = @_; - - my $config = $class->config; - - # Load any external files for the model base class or subclasses - # (e.g. BeerDB/DBI.pm or BeerDB/Beer.pm) based on code borrowed from - # Maypole::Plugin::Loader and Class::DBI. - if ( $subclass->require ) - { - warn "Loaded external module for '$subclass'\n" if $class->debug > 1; - } - else - { - (my $filename = $subclass) =~ s!::!/!g; - die "Loading '$subclass' failed: $@\n" - unless $@ =~ /Can\'t locate \Q$filename\E\.pm/; - warn "Did not find external module for '$subclass'\n" - if $class->debug > 1; - } +sub load_model_subclass { + my ($class, $subclass) = @_; + + my $config = $class->config; + + # Load any external files for the model base class or subclasses + # (e.g. BeerDB/DBI.pm or BeerDB/Beer.pm) based on code borrowed from + # Maypole::Plugin::Loader and Class::DBI. + if ( $subclass->require ) { + warn "Loaded external module for '$subclass'\n" if $class->debug > 1; + } else { + (my $filename = $subclass) =~ s!::!/!g; + die "Loading '$subclass' failed: $@\n" + unless $@ =~ /Can\'t locate \Q$filename\E\.pm/; + warn "No external module for '$subclass'" + if $class->debug > 1; + } } =item init @@ -384,11 +380,16 @@ Constructs a very minimal new Maypole request object. sub new { my ($class) = @_; - my $self = bless { - template_args => {}, config => $class->config, }, $class; + + $self->stash({}); + $self->params({}); + $self->query({}); + $self->template_args({}); + $self->args([]); + $self->objects([]); return $self; } @@ -417,39 +418,121 @@ leaves the dirty work to C. # BeerDB::handler() and so this inherited implementation will be # found. See e.g. "Practical mod_perl" by Bekman & Cholet for # more information -sub handler : method -{ - # See Maypole::Workflow before trying to understand this. - my ($class, $req) = @_; - - $class->init unless $class->init_done; +sub handler : method { + # See Maypole::Workflow before trying to understand this. + my ($class, $req) = @_; + + $class->init unless $class->init_done; + + my $self = $class->new; + + # initialise the request + $self->headers_out(Maypole::Headers->new); + $self->get_request($req); + + $self->parse_location; + + # hook useful for declining static requests e.g. images, or perhaps for + # sanitizing request parameters + $self->status(Maypole::Constants::OK()); # set the default + $self->__call_hook('start_request_hook'); + return $self->status unless $self->status == Maypole::Constants::OK(); + die "status undefined after start_request_hook()" unless defined + $self->status; + $self->get_session; + $self->get_user; + my $status = $self->handler_guts; + return $status unless $status == OK; + # TODO: require send_output to return a status code + $self->send_output; + return $status; +} - my $self = $class->new; - - # initialise the request - $self->headers_out(Maypole::Headers->new); - $self->get_request($req); - $self->parse_location; - - # hook useful for declining static requests e.g. images, or perhaps for - # sanitizing request parameters - my $status = $self->start_request_hook; - return $status unless $status == Maypole::Constants::OK(); - - $self->session($self->get_session); - - $status = $self->handler_guts; - - # moving this here causes unit test failures - need to check why - # before committing the move - #$status = $self->__call_process_view unless $self->output; +=item component + + Run Maypole sub-requests as a component of the request + + [% request.component("/beer/view_as_component/20") %] + + Allows you to integrate the results of a Maypole request into an existing +request. You'll need to set up actions and templates +which return fragments of HTML rather than entire pages, but once you've +done that, you can use the C method of the Maypole request object +to call those actions. You may pass a query string in the usual URL style. + +You should not fully qualify the Maypole URLs. + +Note: any HTTP POST or URL parameters passed to the parent are not passed to the +component sub-request, only what is included in the url passed as an argyument +to the method + +=cut + +sub component { + my ( $r, $path ) = @_; + my $self = bless { parent => $r, config => $r->{config}, } , ref $r; + $self->stash({}); + $self->params({}); + $self->query({}); + $self->template_args({}); + $self->args([]); + $self->objects([]); + + $self->get_user; + my $url = URI->new($path); + warn "path : $path\n"; + $self->{path} = $url->path; + $self->parse_path; + $self->params( $url->query_form_hash ); + $self->handler_guts; + return $self->output; +} + +sub get_template_root { + my $self = shift; + my $r = shift; + return $r->parent->get_template_root if $r->{parent}; + return $self->NEXT::DISTINCT::get_template_root( $r, @_ ); +} + +sub view_object { + my $self = shift; + my $r = shift; + return $r->parent->view_object if $r->{parent}; + return $self->NEXT::DISTINCT::view_object( $r, @_ ); +} + +# Instead of making plugin authors use the NEXT::DISTINCT hoopla to ensure other +# plugins also get to call the hook, we can cycle through the application's +# @ISA and call them all here. Doesn't work for setup() though, because it's +# too ingrained in the stack. We could add a run_setup() method, but we'd break +# lots of existing code. +sub __call_hook +{ + my ($self, $hook) = @_; - return $status unless $status == OK; + my @plugins; + { + my $class = ref($self); + no strict 'refs'; + @plugins = @{"$class\::ISA"}; + } - # TODO: require send_output to return a status code - $self->send_output; + # this is either a custom method in the driver, or the method in the 1st + # plugin, or the 'null' method in the frontend (i.e. inherited from + # Maypole.pm) - we need to be careful to only call it once + my $first_hook = $self->can($hook); + $self->$first_hook; - return $status; + my %seen = ( $first_hook => 1 ); + + # @plugins includes the frontend + foreach my $plugin (@plugins) + { + next unless my $plugin_hook = $plugin->can($hook); + next if $seen{$plugin_hook}++; + $self->$plugin_hook; + } } =item handler_guts @@ -468,18 +551,15 @@ sub handler_guts $self->__load_request_model; - my $applicable = $self->is_model_applicable; - - $self->__setup_plain_template unless $applicable; + my $applicable = $self->is_model_applicable == OK; my $status; + # handle authentication eval { $status = $self->call_authenticate }; - if ( my $error = $@ ) { - $status = $self->call_exception($error); - + $status = $self->call_exception($error, "authentication"); if ( $status != OK ) { warn "caught authenticate error: $error"; @@ -487,55 +567,88 @@ sub handler_guts $self->view_object->error($self, $error) : ERROR; } } - if ( $self->debug and $status != OK and $status != DECLINED ) { $self->view_object->error( $self, "Got unexpected status $status from calling authentication" ); } - + return $status unless $status == OK; # We run additional_data for every request $self->additional_data; - - if ($applicable) - { - eval { $self->model_class->process($self) }; - - if ( my $error = $@ ) + + if ($applicable) { + eval { $self->model_class->process($self) }; + if ( my $error = $@ ) { - $status = $self->call_exception($error); - - if ( $status != OK ) + $status = $self->call_exception($error, "model"); + if ( $status != OK ) { - warn "caught model error: $error"; - return $self->debug ? - $self->view_object->error($self, $error) : ERROR; + warn "caught model error: $error"; + return $self->debug ? + $self->view_object->error($self, $error) : ERROR; } } + } else { + $self->__setup_plain_template; } - + # less frequent path - perhaps output has been set to an error message return OK if $self->output; - + # normal path - no output has been generated yet - return $self->__call_process_view; + my $processed_view_ok = $self->__call_process_view; + + $self->{content_type} ||= $self->__get_mime_type(); + $self->{document_encoding} ||= "utf-8"; + + + return $processed_view_ok; +} + +my %filetypes = ( + 'js' => 'text/javascript', + 'css' => 'text/css', + 'htm' => 'text/html', + 'html' => 'text/html', + ); + +sub __get_mime_type { + my $self = shift; + my $type = 'text/html'; + if ($self->path =~ m/.*\.(\w{3,4})$/) { + $type = $filetypes{$1}; + } else { + my $output = $self->output; + if (defined $output) { + $type = $mmagic->checktype_contents($output); + } + } + return $type; } sub __load_request_model { my ($self) = @_; - $self->model_class( $self->config->model->class_of($self, $self->table) ); + # We may get a made up class from class_of + my $mclass = $self->config->model->class_of($self, $self->table); + if ( eval {$mclass->isa('Maypole::Model::Base')} ) { + $self->model_class( $mclass ); + } + elsif ($self->debug) { + warn "***Warning: No $mclass class appropriate for model. @_"; + } } + # is_applicable() returned false, so set up a plain template. Model processing # will be skipped, but need to remove the model anyway so the template can't # access it. sub __setup_plain_template { my ($self) = @_; - + # It's just a plain template $self->model_class(undef); @@ -548,27 +661,24 @@ sub __setup_plain_template # The model has been processed or skipped (if is_applicable returned false), # any exceptions have been handled, and there's no content in $self->output -sub __call_process_view -{ - my ($self) = @_; - - my $status; - - eval { $status = $self->view_object->process($self) }; - - if ( my $error = $@ ) - { - $status = $self->call_exception($error); - - if ( $status != OK ) - { - warn "caught view error: $error" if $self->debug; - return $self->debug ? - $self->view_object->error($self, $error) : ERROR; - } +sub __call_process_view { + my ($self) = @_; + + my $status = eval { $self->view_object->process($self) }; + + my $error = $@ || $self->{error}; + + if ( $error ) { + $status = $self->call_exception($error, "view"); + + if ( $status != OK ) { + warn "caught view error: $error" if $self->debug; + return $self->debug ? + $self->view_object->error($self, $error) : ERROR; } - - return $status; + } + + return $status; } =item get_request @@ -601,23 +711,45 @@ sub parse_location =item start_request_hook This is called immediately after setting up the basic request. The default -method simply returns C. +method does nothing. -Any other return value causes Maypole to abort further processing of the -request. This is useful for filtering out requests for static files, e.g. -images, which should not be processed by Maypole or by the templating engine: +The value of C<< $r->status >> is set to C before this hook is run. Your +implementation can change the status code, or leave it alone. + +After this hook has run, Maypole will check the value of C. For any +value other than C, Maypole returns the C immediately. + +This is useful for filtering out requests for static files, e.g. images, which +should not be processed by Maypole or by the templating engine: sub start_request_hook { my ($r) = @_; - return Maypole::Constants::DECLINED if $r->path =~ /\.jpg$/; - return Maypole::Constants::OK; + $r->status(DECLINED) if $r->path =~ /\.jpg$/; } + +Multiple plugins, and the driver, can define this hook - Maypole will call all +of them. You should check for and probably not change any non-OK C +value: + package Maypole::Plugin::MyApp::SkipFavicon; + + sub start_request_hook + { + my ($r) = @_; + + # check if a previous plugin has already DECLINED this request + # - probably unnecessary in this example, but you get the idea + return unless $r->status == OK; + + # then do our stuff + $r->status(DECLINED) if $r->path =~ /favicon\.ico/; + } + =cut -sub start_request_hook { Maypole::Constants::OK } +sub start_request_hook { } =item is_applicable @@ -627,6 +759,10 @@ from a Maypole:Constant to a true/false value. Returns a Maypole::Constant to indicate whether the request is valid. +=cut + +sub is_applicable { return shift->is_model_applicable(@_); } + =item is_model_applicable Returns true or false to indicate whether the request is valid. @@ -637,17 +773,8 @@ C<< $r->action >>. =cut -sub is_model_applicable -{ +sub is_model_applicable { my ($self) = @_; - - # cater for applications that are using obsolete version - if ($self->can('is_applicable')) - { - warn "DEPRECATION WARNING: rewrite is_applicable to the interface ". - "of Maypole::is_model_applicable\n"; - return $self->is_applicable == OK; - } # Establish which tables should be processed by the model my $config = $self->config; @@ -676,27 +803,45 @@ sub is_model_applicable . join( ",", keys %$ok_tables ) if $self->debug and not $ok_tables->{$table}; - return 0; + return DECLINED; } # Is the action public? my $action = $self->action; - return 1 if $self->model_class->is_public($action); + return OK if $self->model_class->is_public($action); - warn "The action '$action' is not applicable to the table $table" - if $self->debug; + warn "The action '$action' is not applicable to the table '$table'" + if $self->debug; - return 0; + return DECLINED; } =item get_session +Called immediately after C. + +This method should return a session, which will be stored in the request's +C attribute. + The default method is empty. =cut sub get_session { } +=item get_user + +Called immediately after C. + +This method should return a user, which will be stored in the request's C +attribute. + +The default method is empty. + +=cut + +sub get_user {} + =item call_authenticate This method first checks if the relevant model class @@ -746,16 +891,16 @@ exception method of your Maypole application. sub call_exception { - my ($self, $error) = @_; + my ($self, $error, $when) = @_; # Check if we have a model class with an exception() to delegate to if ( $self->model_class && $self->model_class->can('exception') ) { - my $status = $self->model_class->exception( $self, $error ); + my $status = $self->model_class->exception( $self, $error, $when ); return $status if $status == OK; } - return $self->exception($error); + return $self->exception($error, $when); } @@ -768,7 +913,14 @@ processed. =cut -sub exception { return ERROR } +sub exception { + my ($self, $error, $when) = @_; + if (ref $self->view_object && $self->view_object->can("report_error") and $self->debug) { + $self->view_object->report_error($self, $error, $when); + return OK; + } + return ERROR; +} =item additional_data @@ -790,8 +942,6 @@ sub send_output { } - - =back =head2 Path processing and manipulation @@ -812,13 +962,12 @@ properties. Calls C before parsing path and setting properties. sub parse_path { my ($self) = @_; - + # Previous versions unconditionally set table, action and args to whatever # was in @pi (or else to defaults, if @pi is empty). # Adding preprocess_path(), and then setting table, action and args # conditionally, broke lots of tests, hence this: $self->$_(undef) for qw/action table args/; - $self->preprocess_path; $self->path || $self->path('frontpage'); @@ -960,8 +1109,6 @@ backend. Otherwise, see L =cut -sub get_template_root {'.'} - =back =head2 Request properties @@ -983,15 +1130,38 @@ If the first item in C<$self-Eargs> can be Cd by the model class, it will be removed from C and the retrieved object will be added to the C list. See L for more information. + +=item object + +Alias to get/set the first/only model object. The object will be accessible +in the view templates. + +When used to set the object, will overwrite the request objects +with a single object. + +=cut + +sub object { + my ($r,$object) = @_; + $r->objects([$object]) if ($object); + return undef unless $r->objects(); + return $r->objects->[0]; +} + =item template_args $self->template_args->{foo} = 'bar'; Get/set a hash of template variables. +Maypole reserved words for template variables will over-ride values in template_variables. + +Reserved words are : r, request, object, objects, base, config and errors, as well as the +current class or object name. + =item stash -A place to put custom application data. Not used by Maypole itself. +A place to put custom application data. Not used by Maypole itself. =item template @@ -1200,7 +1370,7 @@ calls during processing of a request. This is a brief summary: | | | |-----+ init | | ||<---+ | | - || | new | view_object: e.g + || | new | view_object: e.g. ||---------------------------------------------> Maypole::View::TT | | | | | | | | @@ -1230,6 +1400,9 @@ calls during processing of a request. This is a brief summary: | ||-----+ get_session | | | | |||<---+ | | | | || | | | + | ||-----+ get_user | | | + | |||<---+ | | | + | || | | | | ||-----+ handler_guts | | | | |||<---+ | | | | ||| class_of($table) | | | @@ -1245,14 +1418,14 @@ calls during processing of a request. This is a brief summary: | ||| | | | | |||-----+ additional_data | | | | ||||<---+ | | | - | ||| process | | fetch_objects - | |||--------------------------------->||-----+ | + | ||| process | | | + | |||--------------------------------->|| fetch_objects + | ||| | ||-----+ | | ||| | |||<---+ | | ||| | || | | ||| | || $action | ||| | ||-----+ | - | ||| | |||<---+ | - | ||| | | | + | ||| | |||<---+ | | ||| process | | | | |||------------------------------------------->|| template | ||| | | ||-----+ @@ -1282,8 +1455,7 @@ L, L, L. =head1 AUTHOR -Maypole is currently maintained by Aaron Trevena, David Baird, Dave Howorth and -Peter Speltz. +Maypole is currently maintained by Aaron Trevena. =head1 AUTHOR EMERITUS @@ -1306,3 +1478,55 @@ You may distribute this code under the same terms as Perl itself. =cut 1; + +__END__ + + =item register_cleanup($coderef) + +Analogous to L's C. If an Apache request object is +available, this call simply redispatches there. If not, the cleanup is +registered in the Maypole request, and executed when the request is +Ced. + +This method is only useful in persistent environments, where you need to ensure +that some code runs when the request finishes, no matter how it finishes (e.g. +after an unexpected error). + + =cut + +{ + my @_cleanups; + + sub register_cleanup + { + my ($self, $cleanup) = @_; + + die "register_cleanup() is an instance method, not a class method" + unless ref $self; + die "Cleanup must be a coderef" unless ref($cleanup) eq 'CODE'; + + if ($self->can('ar') && $self->ar) + { + $self->ar->register_cleanup($cleanup); + } + else + { + push @_cleanups, $cleanup; + } + } + + sub DESTROY + { + my ($self) = @_; + + while (my $cleanup = shift @_cleanups) + { + eval { $cleanup->() }; + if ($@) + { + warn "Error during request cleanup: $@"; + } + } + } +} +