diff options
Diffstat (limited to 'rt/lib/RT/Interface/Web/Request.pm')
| -rw-r--r-- | rt/lib/RT/Interface/Web/Request.pm | 207 |
1 files changed, 207 insertions, 0 deletions
diff --git a/rt/lib/RT/Interface/Web/Request.pm b/rt/lib/RT/Interface/Web/Request.pm new file mode 100644 index 0000000..e179464 --- /dev/null +++ b/rt/lib/RT/Interface/Web/Request.pm @@ -0,0 +1,207 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +package RT::Interface::Web::Request; + +use strict; +use warnings; + +our $VERSION = '0.30'; +use base qw(HTML::Mason::Request); + +sub new { + my $class = shift; + + my $new_class = $HTML::Mason::ApacheHandler::VERSION ? + 'HTML::Mason::Request::ApacheHandler' : + $HTML::Mason::CGIHandler::VERSION ? + 'HTML::Mason::Request::CGI' : + 'HTML::Mason::Request'; + + $class->alter_superclass( $new_class ); + $class->valid_params( %{ $new_class->valid_params } ); + return $class->SUPER::new(@_); +} + +# XXX TODO: This alter_superclass replaces teh funcitonality in Mason 1.39 +# with code which doesn't trigger a bug in Perl 5.10. +# (Perl 5.10.0 does NOT take kindly to having its @INC entries changed) +# http://rt.perl.org/rt3/Public/Bug/Display.html?id=54566 +# +# This routine can be removed when either: +# * RT depends on a version of mason which contains this fix +# * Perl 5.10.0 is not supported for running RT +sub alter_superclass { + my $class = shift; + my $new_super = shift; + my $isa_ref; + { no strict 'refs'; my @entries = @{$class."::ISA"}; $isa_ref = \@entries; } + + # handles multiple inheritance properly and preserve + # inheritance order + for ( my $x = 0; $x <= $#{$isa_ref} ; $x++ ) { + if ( $isa_ref->[$x]->isa('HTML::Mason::Request') ) { + my $old_super = $isa_ref->[$x]; + $isa_ref->[$x] = $new_super + if ( $old_super ne $new_super ); + last; + } + } + + { no strict 'refs'; @{$class."::ISA"} = @$isa_ref; } + $class->valid_params( %{ $class->valid_params } ); +} + + +=head2 callback + +Method replaces deprecated component C<Element/Callback>. + +Takes hash with optional C<CallbackPage>, C<CallbackName> +and C<CallbackOnce> arguments, other arguments are passed +throught to callback components. + +=over 4 + +=item CallbackPage + +Page path relative to the root, leading slash is mandatory. +By default is equal to path of the caller component. + +=item CallbackName + +Name of the callback. C<Default> is used unless specified. + +=item CallbackOnce + +By default is false, otherwise runs callbacks only once per +process of the server. Such callbacks can be used to fill +structures. + +=back + +Searches for callback components in +F<< /Callbacks/<any dir>/CallbackPage/CallbackName >>, for +example F</Callbacks/MyExtension/autohandler/Default> would +be called as default callback for F</autohandler>. + +=cut + +{ +my %cache = (); +my %called = (); +sub callback { + my ($self, %args) = @_; + + my $name = delete $args{'CallbackName'} || 'Default'; + my $page = delete $args{'CallbackPage'} || $self->callers(0)->path; + unless ( $page ) { + $RT::Logger->error("Couldn't get a page name for callbacks"); + return; + } + + my $CacheKey = "$page--$name"; + return 1 if delete $args{'CallbackOnce'} && $called{ $CacheKey }; + $called{ $CacheKey } = 1; + + my $callbacks = $cache{ $CacheKey }; + unless ( $callbacks ) { + $callbacks = []; + my $path = "/Callbacks/*$page/$name"; + my @roots = map $_->[1], + $HTML::Mason::VERSION <= 1.28 + ? $self->interp->resolver->comp_root_array + : $self->interp->comp_root_array; + + my %seen; + @$callbacks = ( + sort grep defined && length, + # Skip backup files, files without a leading package name, + # and files we've already seen + grep !$seen{$_}++ && !m{/\.} && !m{~$} && m{^/Callbacks/[^/]+\Q$page/$name\E$}, + map $self->interp->resolver->glob_path($path, $_), + @roots + ); + foreach my $comp (keys %seen) { + next unless $seen{$comp} > 1; + $RT::Logger->error("Found more than one occurrence of the $comp callback. This may cause only one of the callbacks to run. Look for the duplicate Callback in your @roots"); + } + + $cache{ $CacheKey } = $callbacks unless RT->Config->Get('DevelMode'); + } + + my @rv; + foreach my $cb ( @$callbacks ) { + push @rv, scalar $self->comp( $cb, %args ); + } + return @rv; +} +} + +=head2 request_path + +Returns path of the request. + +Very close to C<< $m->request_comp->path >>, but if called in a dhandler returns +path of the request without dhandler name, but with dhandler arguments instead. + +=cut + +sub request_path { + my $self = shift; + + my $path = $self->request_comp->path; + # disabled dhandlers, not RT case, but anyway + return $path unless my $dh_name = $self->dhandler_name; + # not a dhandler + return $path unless substr($path, -length("/$dh_name")) eq "/$dh_name"; + substr($path, -length $dh_name) = $self->dhandler_arg; + return $path; +} + +1; |