summaryrefslogtreecommitdiff
path: root/rt/lib/RT/Interface/Web
diff options
context:
space:
mode:
Diffstat (limited to 'rt/lib/RT/Interface/Web')
-rw-r--r--rt/lib/RT/Interface/Web/Handler.pm44
-rw-r--r--rt/lib/RT/Interface/Web/Menu.pm68
-rwxr-xr-xrt/lib/RT/Interface/Web/QueryBuilder.pm2
-rwxr-xr-xrt/lib/RT/Interface/Web/QueryBuilder/Tree.pm2
-rw-r--r--rt/lib/RT/Interface/Web/Request.pm23
-rw-r--r--rt/lib/RT/Interface/Web/Session.pm10
6 files changed, 136 insertions, 13 deletions
diff --git a/rt/lib/RT/Interface/Web/Handler.pm b/rt/lib/RT/Interface/Web/Handler.pm
index a740167c6..a1784c2cc 100644
--- a/rt/lib/RT/Interface/Web/Handler.pm
+++ b/rt/lib/RT/Interface/Web/Handler.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -205,10 +205,44 @@ sub CleanupRequest {
sub HTML::Mason::Exception::as_rt_error {
my ($self) = @_;
- $RT::Logger->error( $self->full_message );
+ $RT::Logger->error( $self->as_text );
return "An internal RT error has occurred. Your administrator can find more details in RT's log files.";
}
+=head1 CheckModPerlHandler
+
+Make sure we're not running with SetHandler perl-script.
+
+=cut
+
+sub CheckModPerlHandler{
+ my $self = shift;
+ my $env = shift;
+
+ # Plack::Handler::Apache2 masks MOD_PERL, so use MOD_PERL_API_VERSION
+ return unless( $env->{'MOD_PERL_API_VERSION'}
+ and $env->{'MOD_PERL_API_VERSION'} == 2);
+
+ my $handler = $env->{'psgi.input'}->handler;
+
+ return unless defined $handler && $handler eq 'perl-script';
+
+ $RT::Logger->critical(<<MODPERL);
+RT has problems when SetHandler is set to perl-script.
+Change SetHandler in your in httpd.conf to:
+
+ SetHandler modperl
+
+For a complete example mod_perl configuration, see:
+
+https://bestpractical.com/rt/docs/@{[$RT::VERSION =~ /^(\d\.\d)/]}/web_deployment.html#mod_perl-2.xx
+MODPERL
+
+ my $res = Plack::Response->new(500);
+ $res->content_type("text/plain");
+ $res->body("Server misconfiguration; see error log for details");
+ return $res;
+}
# PSGI App
@@ -231,6 +265,12 @@ sub PSGIApp {
return sub {
my $env = shift;
+
+ {
+ my $res = $self->CheckModPerlHandler($env);
+ return $self->_psgi_response_cb( $res->finalize ) if $res;
+ }
+
RT::ConnectToDatabase() unless RT->InstallMode;
my $req = Plack::Request->new($env);
diff --git a/rt/lib/RT/Interface/Web/Menu.pm b/rt/lib/RT/Interface/Web/Menu.pm
index 6b351e94b..e4e08d63b 100644
--- a/rt/lib/RT/Interface/Web/Menu.pm
+++ b/rt/lib/RT/Interface/Web/Menu.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -150,10 +150,12 @@ treated as relative to it's parent's path, and made absolute.
sub path {
my $self = shift;
if (@_) {
- $self->{path} = shift;
- $self->{path} = URI->new_abs($self->{path}, $self->parent->path . "/")->as_string
- if defined $self->{path} and $self->parent and $self->parent->path;
- $self->{path} =~ s!///!/! if $self->{path};
+ if (defined($self->{path} = shift)) {
+ my $base = ($self->parent and $self->parent->path) ? $self->parent->path : "";
+ $base .= "/" unless $base =~ m{/$};
+ my $uri = URI->new_abs($self->{path}, $base);
+ $self->{path} = $uri->as_string;
+ }
}
return $self->{path};
}
@@ -230,6 +232,7 @@ sub child {
if ( defined $path and length $path ) {
my $base_path = $HTML::Mason::Commands::r->path_info;
my $query = $HTML::Mason::Commands::m->cgi_object->query_string;
+ $base_path =~ s!/+!/!g;
$base_path .= "?$query" if defined $query and length $query;
$base_path =~ s/index\.html$//;
@@ -311,4 +314,59 @@ sub children {
return wantarray ? @kids : \@kids;
}
+=head2 add_after
+
+Called on a child, inserts a new menu item after it and shifts any other
+menu items at this level to the right.
+
+L<child> by default would insert at the end of the list of children, unless you
+did manual sort_order calculations.
+
+Takes all the regular arguments to L<child>.
+
+=cut
+
+sub add_after { shift->_insert_sibling("after", @_) }
+
+=head2 add_before
+
+Called on a child, inserts a new menu item at the child's location and shifts
+the child and the other menu items at this level to the right.
+
+L<child> by default would insert at the end of the list of children, unless you
+did manual sort_order calculations.
+
+Takes all the regular arguments to L<child>.
+
+=cut
+
+sub add_before { shift->_insert_sibling("before", @_) }
+
+sub _insert_sibling {
+ my $self = shift;
+ my $where = shift;
+ my $parent = $self->parent;
+ my $sort_order;
+ for my $contemporary ($parent->children) {
+ if ( $contemporary->key eq $self->key ) {
+ if ($where eq "before") {
+ # Bump the current child and the following
+ $sort_order = $contemporary->sort_order;
+ }
+ elsif ($where eq "after") {
+ # Leave the current child along, bump the rest
+ $sort_order = $contemporary->sort_order + 1;
+ next;
+ }
+ else {
+ # never set $sort_order, act no differently than ->child()
+ }
+ }
+ if ( $sort_order ) {
+ $contemporary->sort_order( $contemporary->sort_order + 1 );
+ }
+ }
+ $parent->child( @_, sort_order => $sort_order );
+}
+
1;
diff --git a/rt/lib/RT/Interface/Web/QueryBuilder.pm b/rt/lib/RT/Interface/Web/QueryBuilder.pm
index 79a0b9718..546427833 100755
--- a/rt/lib/RT/Interface/Web/QueryBuilder.pm
+++ b/rt/lib/RT/Interface/Web/QueryBuilder.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
diff --git a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm
index 2cfc88998..9bbd876e5 100755
--- a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm
+++ b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
diff --git a/rt/lib/RT/Interface/Web/Request.pm b/rt/lib/RT/Interface/Web/Request.pm
index d0865117d..cdd4594d6 100644
--- a/rt/lib/RT/Interface/Web/Request.pm
+++ b/rt/lib/RT/Interface/Web/Request.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -142,6 +142,10 @@ sub callback {
}
return @rv;
}
+
+sub clear_callback_cache {
+ %cache = %called = ();
+}
}
=head2 request_path
@@ -165,4 +169,21 @@ sub request_path {
return $path;
}
+=head2 abort
+
+Logs any recorded SQL statements for this request before calling the standard
+abort.
+
+=cut
+
+sub abort {
+ my $self = shift;
+ RT::Interface::Web::LogRecordedSQLStatements(
+ RequestData => {
+ Path => $self->request_path,
+ },
+ );
+ return $self->SUPER::abort(@_);
+}
+
1;
diff --git a/rt/lib/RT/Interface/Web/Session.pm b/rt/lib/RT/Interface/Web/Session.pm
index c5b88f127..4edd9bd2e 100644
--- a/rt/lib/RT/Interface/Web/Session.pm
+++ b/rt/lib/RT/Interface/Web/Session.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -207,8 +207,8 @@ sub _ClearOldDir {
foreach my $id( @{ $self->Ids } ) {
if( int $older_than ) {
- my $ctime = (stat(File::Spec->catfile($dir,$id)))[9];
- if( $ctime > $now - $older_than ) {
+ my $mtime = (stat(File::Spec->catfile($dir,$id)))[9];
+ if( $mtime > $now - $older_than ) {
$RT::Logger->debug("skipped session '$id', isn't old");
next;
}
@@ -224,6 +224,10 @@ sub _ClearOldDir {
tied(%session)->delete;
$RT::Logger->info("successfuly deleted session '$id'");
}
+
+ my $lock = Apache::Session::Lock::File->new;
+ $lock->clean( $dir, $older_than );
+
return;
}
generated by cgit v1.2.1 (git 2.18.0) at 2025-08-09 18:30:09 +0000