rt/lib/RT/Interface/Web/Request.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2019 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 package RT::Interface::Web::Request;
  50
  51 use strict;
  52 use warnings;
  53
  54 use HTML::Mason::PSGIHandler;
  55 use base qw(HTML::Mason::Request::PSGI);
  56 use Params::Validate qw(:all);
  57
  58 sub new {
  59     my $class = shift;
  60     $class->valid_params( %{ $class->valid_params },cgi_request => { type => OBJECT, optional => 1 } );
  61     return $class->SUPER::new(@_);
  62 }
  63
  64
  65 =head2 callback
  66
  67 Takes hash with optional C<CallbackPage>, C<CallbackName>
  68 and C<CallbackOnce> arguments, other arguments are passed
  69 throught to callback components.
  70
  71 =over 4
  72
  73 =item CallbackPage
  74
  75 Page path relative to the root, leading slash is mandatory.
  76 By default is equal to path of the caller component.
  77
  78 =item CallbackName
  79
  80 Name of the callback. C<Default> is used unless specified.
  81
  82 =item CallbackOnce
  83
  84 By default is false, otherwise runs callbacks only once per
  85 process of the server. Such callbacks can be used to fill
  86 structures.
  87
  88 =item ReturnComponentOutput
  89
  90 By default, callback returns the status codes of all rendered components, and
  91 prints the rendered components to STDOUT. If this argument is true, callback
  92 returns the rendered components instead of printing them to STDOUT.
  93
  94 =back
  95
  96 Searches for callback components in
  97 F<< /Callbacks/<any dir>/CallbackPage/CallbackName >>, for
  98 example F</Callbacks/MyExtension/autohandler/Default> would
  99 be called as default callback for F</autohandler>.
 100
 101 =cut
 102
 103 {
 104 my %cache = ();
 105 my %called = ();
 106 sub callback {
 107     my ($self, %args) = @_;
 108
 109     my $name = delete $args{'CallbackName'} || 'Default';
 110     my $page = delete $args{'CallbackPage'} || $self->callers(0)->path;
 111     my $use_scomp = delete $args{'ReturnComponentOutput'} ? 1 : 0;
 112     unless ( $page ) {
 113         $RT::Logger->error("Couldn't get a page name for callbacks");
 114         return;
 115     }
 116
 117     my $CacheKey = "$page--$name";
 118     return 1 if delete $args{'CallbackOnce'} && $called{ $CacheKey };
 119     $called{ $CacheKey } = 1;
 120
 121     my $callbacks = $cache{ $CacheKey };
 122     unless ( $callbacks ) {
 123         $callbacks = [];
 124         my $path  = "/Callbacks/*$page/$name";
 125         my @roots = RT::Interface::Web->ComponentRoots;
 126         my %seen;
 127         @$callbacks = (
 128             grep defined && length,
 129             # Skip backup files, files without a leading package name,
 130             # and files we've already seen
 131             grep !$seen{$_}++ && !m{/\.} && !m{~$} && m{^/Callbacks/[^/]+\Q$page/$name\E$},
 132             map { sort $self->interp->resolver->glob_path($path, $_) }
 133             @roots
 134         );
 135         foreach my $comp (keys %seen) {
 136             next unless $seen{$comp} > 1;
 137             $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");
 138         }
 139
 140         $cache{ $CacheKey } = $callbacks unless RT->Config->Get('DevelMode');
 141     }
 142
 143     my @rv;
 144     my $scomp_out;
 145     foreach my $cb ( @$callbacks ) {
 146         if ( $use_scomp ) {
 147             no warnings 'uninitialized';
 148             $scomp_out .= $self->scomp( $cb, %args );
 149         } else {
 150             push @rv, scalar $self->comp( $cb, %args );
 151         }
 152     }
 153     return $use_scomp ? $scomp_out : @rv;
 154 }
 155
 156 sub clear_callback_cache {
 157     %cache = %called = ();
 158 }
 159 }
 160
 161 =head2 request_path
 162
 163 Returns path of the request.
 164
 165 Very close to C<< $m->request_comp->path >>, but if called in a dhandler returns
 166 path of the request without dhandler name, but with dhandler arguments instead.
 167
 168 =cut
 169
 170 sub request_path {
 171     my $self = shift;
 172
 173     my $path = $self->request_comp->path;
 174     # disabled dhandlers, not RT case, but anyway
 175     return $path unless my $dh_name = $self->dhandler_name;
 176     # not a dhandler
 177     return $path unless substr($path, -length("/$dh_name")) eq "/$dh_name";
 178     substr($path, -length $dh_name) = $self->dhandler_arg;
 179     return $path;
 180 }
 181
 182 =head2 abort
 183
 184 Logs any recorded SQL statements for this request before calling the standard
 185 abort.
 186
 187 =cut
 188
 189 sub abort {
 190     my $self = shift;
 191     RT::Interface::Web::LogRecordedSQLStatements(
 192         RequestData => {
 193             Path => $self->request_path,
 194         },
 195     );
 196     return $self->SUPER::abort(@_);
 197 }
 198
 199 1;