diff options
Diffstat (limited to 'rt/lib/RT/Interface/Web')
-rw-r--r-- | rt/lib/RT/Interface/Web/Handler.pm | 229 | ||||
-rw-r--r-- | rt/lib/RT/Interface/Web/Menu.pm | 69 | ||||
-rw-r--r-- | rt/lib/RT/Interface/Web/Menu/Item.pm | 87 | ||||
-rwxr-xr-x | rt/lib/RT/Interface/Web/QueryBuilder.pm | 59 | ||||
-rwxr-xr-x | rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm | 293 | ||||
-rw-r--r-- | rt/lib/RT/Interface/Web/Request.pm | 207 | ||||
-rw-r--r-- | rt/lib/RT/Interface/Web/Session.pm | 285 | ||||
-rwxr-xr-x | rt/lib/RT/Interface/Web/Standalone.pm | 117 | ||||
-rw-r--r-- | rt/lib/RT/Interface/Web/Standalone/PreFork.pm | 103 |
9 files changed, 0 insertions, 1449 deletions
diff --git a/rt/lib/RT/Interface/Web/Handler.pm b/rt/lib/RT/Interface/Web/Handler.pm deleted file mode 100644 index 6a0660670..000000000 --- a/rt/lib/RT/Interface/Web/Handler.pm +++ /dev/null @@ -1,229 +0,0 @@ -# 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::Handler; - -use CGI qw/-private_tempfiles/; -use MIME::Entity; -use Text::Wrapper; -use CGI::Cookie; -use Time::ParseDate; -use Time::HiRes; -use HTML::Entities; -use HTML::Scrubber; -use RT::Interface::Web::Handler; -use RT::Interface::Web::Request; -use File::Path qw( rmtree ); -use File::Glob qw( bsd_glob ); -use File::Spec::Unix; - -sub DefaultHandlerArgs { ( - comp_root => [ - [ local => $RT::MasonLocalComponentRoot ], - (map {[ "plugin-".$_->Name => $_->ComponentRoot ]} @{RT->Plugins}), - [ standard => $RT::MasonComponentRoot ] - ], - default_escape_flags => 'h', - data_dir => "$RT::MasonDataDir", - allow_globals => [qw(%session)], - # Turn off static source if we're in developer mode. - static_source => (RT->Config->Get('DevelMode') ? '0' : '1'), - use_object_files => (RT->Config->Get('DevelMode') ? '0' : '1'), - autoflush => 0, - error_format => (RT->Config->Get('DevelMode') ? 'html': 'brief'), - request_class => 'RT::Interface::Web::Request', - named_component_subs => $INC{'Devel/Cover.pm'} ? 1 : 0, -) }; - -# {{{ sub new - -=head2 new - - Constructs a web handler of the appropriate class. - Takes options to pass to the constructor. - -=cut - -sub new { - my $class = shift; - $class->InitSessionDir; - - if ( ($mod_perl::VERSION && $mod_perl::VERSION >= 1.9908) || $CGI::MOD_PERL) { - goto &NewApacheHandler; - } - else { - goto &NewCGIHandler; - } -} - -sub InitSessionDir { - # Activate the following if running httpd as root (the normal case). - # Resets ownership of all files created by Mason at startup. - # Note that mysql uses DB for sessions, so there's no need to do this. - unless ( RT->Config->Get('DatabaseType') =~ /(?:mysql|Pg)/ ) { - - # Clean up our umask to protect session files - umask(0077); - - if ($CGI::MOD_PERL and $CGI::MOD_PERL < 1.9908 ) { - - chown( Apache->server->uid, Apache->server->gid, - $RT::MasonSessionDir ) - if Apache->server->can('uid'); - } - - # Die if WebSessionDir doesn't exist or we can't write to it - stat($RT::MasonSessionDir); - die "Can't read and write $RT::MasonSessionDir" - unless ( ( -d _ ) and ( -r _ ) and ( -w _ ) ); - } - -} - -# }}} - -# {{{ sub NewApacheHandler - -=head2 NewApacheHandler - - Takes extra options to pass to HTML::Mason::ApacheHandler->new - Returns a new Mason::ApacheHandler object - -=cut - -sub NewApacheHandler { - require HTML::Mason::ApacheHandler; - return NewHandler('HTML::Mason::ApacheHandler', args_method => "CGI", @_); -} - -# }}} - -# {{{ sub NewCGIHandler - -=head2 NewCGIHandler - - Returns a new Mason::CGIHandler object - -=cut - -sub NewCGIHandler { - require HTML::Mason::CGIHandler; - return NewHandler('HTML::Mason::CGIHandler', @_); -} - -sub NewHandler { - my $class = shift; - my $handler = $class->new( - DefaultHandlerArgs(), - @_ - ); - - $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 ); - $handler->interp->set_escape( u => \&RT::Interface::Web::EscapeURI ); - return($handler); -} - -=head2 CleanupRequest - -Clean ups globals, caches and other things that could be still -there from previous requests: - -=over 4 - -=item Rollback any uncommitted transaction(s) - -=item Flush the ACL cache - -=item Flush records cache of the L<DBIx::SearchBuilder> if -WebFlushDbCacheEveryRequest option is enabled, what is true by default -and is not recommended to change. - -=item Clean up state of RT::Action::SendEmail using 'CleanSlate' method - -=item Flush tmp GnuPG key preferences - -=back - -=cut - -sub CleanupRequest { - - if ( $RT::Handle && $RT::Handle->TransactionDepth ) { - $RT::Handle->ForceRollback; - $RT::Logger->crit( - "Transaction not committed. Usually indicates a software fault." - . "Data loss may have occurred" ); - } - - # Clean out the ACL cache. the performance impact should be marginal. - # Consistency is imprived, too. - RT::Principal->InvalidateACLCache(); - DBIx::SearchBuilder::Record::Cachable->FlushCache - if ( RT->Config->Get('WebFlushDbCacheEveryRequest') - and UNIVERSAL::can( - 'DBIx::SearchBuilder::Record::Cachable' => 'FlushCache' ) ); - - # cleanup global squelching of the mails - require RT::Action::SendEmail; - RT::Action::SendEmail->CleanSlate; - - if (RT->Config->Get('GnuPG')->{'Enable'}) { - require RT::Crypt::GnuPG; - RT::Crypt::GnuPG::UseKeyForEncryption(); - RT::Crypt::GnuPG::UseKeyForSigning( undef ); - } - - %RT::Ticket::MERGE_CACHE = ( effective => {}, merged => {} ); - - # Explicitly remove any tmpfiles that GPG opened, and close their - # filehandles. - File::Temp::cleanup; -} -# }}} - -1; diff --git a/rt/lib/RT/Interface/Web/Menu.pm b/rt/lib/RT/Interface/Web/Menu.pm deleted file mode 100644 index 35699429e..000000000 --- a/rt/lib/RT/Interface/Web/Menu.pm +++ /dev/null @@ -1,69 +0,0 @@ -# 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::Menu; - - -sub new { - my $class = shift; - my $self = bless {}, $class; - $self->{'root_node'} = RT::Interface::Web::Menu::Item->new(); - return $self; -} - - -sub as_hash_of_hashes { - -} - -sub root { - my $self = shift; - return $self->{'root_node'}; -} - -1; diff --git a/rt/lib/RT/Interface/Web/Menu/Item.pm b/rt/lib/RT/Interface/Web/Menu/Item.pm deleted file mode 100644 index 8eb4120c6..000000000 --- a/rt/lib/RT/Interface/Web/Menu/Item.pm +++ /dev/null @@ -1,87 +0,0 @@ -# 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::Menu::Item; - - -sub new { - my $class = shift; - my $self = bless {},$class; - $self->{'_attributes'} = {}; - return($self); -} - -sub label { my $self = shift; $self->_accessor( label => @_) } ; -sub absolute_url { my $self = shift; $self->_accessor( absolute_url => @_) } ; -sub rt_path { my $self = shift; $self->_accessor( rt_path => @_) } ; -sub hilight { my $self = shift; $self->_accessor( hilight => @_); - $self->parent->hilight(1); - } ; -sub sort_order { my $self = shift; $self->_accessor( sort_order => @_) } ; - -sub add_child { -} - -sub delete { -} - -sub children { - -} - -sub _accessor { - my $self = shift; - my $key = shift; - if (@_){ - $self->{'attributes'}->{$key} = shift; - - } - return $self->{'_attributes'}->{$key}; -} - -1; diff --git a/rt/lib/RT/Interface/Web/QueryBuilder.pm b/rt/lib/RT/Interface/Web/QueryBuilder.pm deleted file mode 100755 index 29d12b464..000000000 --- a/rt/lib/RT/Interface/Web/QueryBuilder.pm +++ /dev/null @@ -1,59 +0,0 @@ -# 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::QueryBuilder; - -use strict; -use warnings; - -eval "require RT::Interface::Web::QueryBuilder_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web/QueryBuilder_Vendor.pm}); -eval "require RT::Interface::Web::QueryBuilder_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web/QueryBuilder_Local.pm}); - -1; diff --git a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm deleted file mode 100755 index e672d8e4c..000000000 --- a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm +++ /dev/null @@ -1,293 +0,0 @@ -# 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::QueryBuilder::Tree; - -use strict; -use warnings; - -use Tree::Simple qw/use_weak_refs/; -use base qw/Tree::Simple/; - -=head1 NAME - - RT::Interface::Web::QueryBuilder::Tree - subclass of Tree::Simple used in Query Builder - -=head1 DESCRIPTION - -This class provides support functionality for the Query Builder (Search/Build.html). -It is a subclass of L<Tree::Simple>. - -=head1 METHODS - -=head2 TraversePrePost PREFUNC POSTFUNC - -Traverses the tree depth-first. Before processing the node's children, -calls PREFUNC with the node as its argument; after processing all of the -children, calls POSTFUNC with the node as its argument. - -(Note that unlike Tree::Simple's C<traverse>, it actually calls its functions -on the root node passed to it.) - -=cut - -sub TraversePrePost { - my ($self, $prefunc, $postfunc) = @_; - - # XXX: if pre or post action changes siblings (delete or adds) - # we could have problems - $prefunc->($self) if $prefunc; - - foreach my $child ($self->getAllChildren()) { - $child->TraversePrePost($prefunc, $postfunc); - } - - $postfunc->($self) if $postfunc; -} - -=head2 GetReferencedQueues - -Returns a hash reference with keys each queue name referenced in a clause in -the key (even if it's "Queue != 'Foo'"), and values all 1. - -=cut - -sub GetReferencedQueues { - my $self = shift; - - my $queues = {}; - - $self->traverse( - sub { - my $node = shift; - - return if $node->isRoot; - return unless $node->isLeaf; - - my $clause = $node->getNodeValue(); - - if ( $clause->{Key} eq 'Queue' ) { - $queues->{ $clause->{Value} } = 1; - }; - } - ); - - return $queues; -} - -=head2 GetQueryAndOptionList SELECTED_NODES - -Given an array reference of tree nodes that have been selected by the user, -traverses the tree and returns the equivalent SQL query and a list of hashes -representing the "clauses" select option list. Each has contains the keys -TEXT, INDEX, SELECTED, and DEPTH. TEXT is the displayed text of the option -(including parentheses, not including indentation); INDEX is the 0-based -index of the option in the list (also used as its CGI parameter); SELECTED -is either 'SELECTED' or '', depending on whether the node corresponding -to the select option was in the SELECTED_NODES list; and DEPTH is the -level of indentation for the option. - -=cut - -sub GetQueryAndOptionList { - my $self = shift; - my $selected_nodes = shift; - - my $list = $self->__LinearizeTree; - foreach my $e( @$list ) { - $e->{'DEPTH'} = $e->{'NODE'}->getDepth; - $e->{'SELECTED'} = (grep $_ == $e->{'NODE'}, @$selected_nodes)? qq[ selected="selected"] : ''; - } - - return (join ' ', map $_->{'TEXT'}, @$list), $list; -} - -=head2 PruneChildLessAggregators - -If tree manipulation has left it in a state where there are ANDs, ORs, -or parenthesizations with no children, get rid of them. - -=cut - -sub PruneChildlessAggregators { - my $self = shift; - - $self->TraversePrePost( - undef, - sub { - my $node = shift; - return unless $node->isLeaf; - - # We're only looking for aggregators (AND/OR) - return if ref $node->getNodeValue; - - return if $node->isRoot; - - # OK, this is a childless aggregator. Remove self. - $node->getParent->removeChild($node); - $node->DESTROY; - } - ); -} - -=head2 GetDisplayedNodes - -This function returns a list of the nodes of the tree in depth-first -order which correspond to options in the "clauses" multi-select box. -In fact, it's all of them but the root and its child. - -=cut - -sub GetDisplayedNodes { - return map $_->{NODE}, @{ (shift)->__LinearizeTree }; -} - - -sub __LinearizeTree { - my $self = shift; - - my ($list, $i) = ([], 0); - - $self->TraversePrePost( sub { - my $node = shift; - return if $node->isRoot; - - my $str = ''; - if( $node->getIndex > 0 ) { - $str .= " ". $node->getParent->getNodeValue ." "; - } - - unless( $node->isLeaf ) { - $str .= '( '; - } else { - - my $clause = $node->getNodeValue; - $str .= $clause->{Key}; - $str .= " ". $clause->{Op}; - $str .= " ". $clause->{Value}; - - } - $str =~ s/^\s+|\s+$//; - - push @$list, { - NODE => $node, - TEXT => $str, - INDEX => $i, - }; - - $i++; - }, sub { - my $node = shift; - return if $node->isRoot; - return if $node->isLeaf; - $list->[-1]->{'TEXT'} .= ' )'; - }); - - return $list; -} - -sub ParseSQL { - my $self = shift; - my %args = ( - Query => '', - CurrentUser => '', #XXX: Hack - @_ - ); - my $string = $args{'Query'}; - - my @results; - - my %field = %{ RT::Tickets->new( $args{'CurrentUser'} )->FIELDS }; - my %lcfield = map { ( lc($_) => $_ ) } keys %field; - - my $node = $self; - - my %callback; - $callback{'OpenParen'} = sub { - $node = __PACKAGE__->new( 'AND', $node ); - }; - $callback{'CloseParen'} = sub { $node = $node->getParent }; - $callback{'EntryAggregator'} = sub { $node->setNodeValue( $_[0] ) }; - $callback{'Condition'} = sub { - my ($key, $op, $value) = @_; - - my ($main_key) = split /[.]/, $key; - - my $class; - if ( exists $lcfield{ lc $main_key } ) { - $class = $field{ $main_key }->[0]; - $key =~ s/^[^.]+/ $lcfield{ lc $main_key } /e; - } - unless( $class ) { - push @results, [ $args{'CurrentUser'}->loc("Unknown field: [_1]", $key), -1 ] - } - - $value =~ s/'/\\'/g; - if ( lc $op eq 'is' || lc $op eq 'is not' ) { - $value = 'NULL'; # just fix possible mistakes here - } elsif ( $value !~ /^[+-]?[0-9]+$/ ) { - $value = "'$value'"; - } - $key = "'$key'" if $key =~ /^CF./; - - my $clause = { Key => $key, Op => $op, Value => $value }; - $node->addChild( __PACKAGE__->new( $clause ) ); - }; - $callback{'Error'} = sub { push @results, @_ }; - - require RT::SQL; - RT::SQL::Parse($string, \%callback); - return @results; -} - -eval "require RT::Interface::Web::QueryBuilder::Tree_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web/QueryBuilder/Tree_Vendor.pm}); -eval "require RT::Interface::Web::QueryBuilder::Tree_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web/QueryBuilder/Tree_Local.pm}); - -1; diff --git a/rt/lib/RT/Interface/Web/Request.pm b/rt/lib/RT/Interface/Web/Request.pm deleted file mode 100644 index ba626a091..000000000 --- a/rt/lib/RT/Interface/Web/Request.pm +++ /dev/null @@ -1,207 +0,0 @@ -# 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 = ( - 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 { sort $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; diff --git a/rt/lib/RT/Interface/Web/Session.pm b/rt/lib/RT/Interface/Web/Session.pm deleted file mode 100644 index 1e0e6d5f0..000000000 --- a/rt/lib/RT/Interface/Web/Session.pm +++ /dev/null @@ -1,285 +0,0 @@ -# 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::Session; -use warnings; -use strict; - -use RT::CurrentUser; - -=head1 NAME - -RT::Interface::Web::Session - RT web session class - -=head1 SYNOPSYS - - -=head1 DESCRIPTION - -RT session class and utilities. - -CLASS METHODS can be used without creating object instances, -it's mainly utilities to clean unused session records. - -Object is tied hash and can be used to access session data. - -=head1 METHODS - -=head2 CLASS METHODS - -=head3 Class - -Returns name of the class that is used as sessions storage. - -=cut - -sub Class { - my $self = shift; - - my $class = RT->Config->Get('WebSessionClass') - || $self->Backends->{RT->Config->Get('DatabaseType')} - || 'Apache::Session::File'; - eval "require $class"; - die $@ if $@; - return $class; -} - -=head3 Backends - -Returns hash reference with names of the databases as keys and -sessions class names as values. - -=cut - -sub Backends { - return { - mysql => 'Apache::Session::MySQL', - Pg => 'Apache::Session::Postgres', - }; -} - -=head3 Attributes - -Returns hash reference with attributes that are used to create -new session objects. - -=cut - -sub Attributes { - my $class = $_[0]->Class; - return !$class->isa('Apache::Session::File') ? { - Handle => $RT::Handle->dbh, - LockHandle => $RT::Handle->dbh, - Transaction => 1, - } : { - Directory => $RT::MasonSessionDir, - LockDirectory => $RT::MasonSessionDir, - Transaction => 1, - }; -} - -=head3 Ids - -Returns array ref with list of the session IDs. - -=cut - -sub Ids { - my $self = shift || __PACKAGE__; - my $attributes = $self->Attributes; - if( $attributes->{Directory} ) { - return $self->_IdsDir( $attributes->{Directory} ); - } else { - return $self->_IdsDB( $RT::Handle->dbh ); - } -} - -sub _IdsDir { - my ($self, $dir) = @_; - require File::Find; - my %file; - File::Find::find( - sub { return unless /^[a-zA-Z0-9]+$/; - $file{$_} = (stat($_))[9]; - }, - $dir, - ); - - return [ sort { $file{$a} <=> $file{$b} } keys %file ]; -} - -sub _IdsDB { - my ($self, $dbh) = @_; - my $ids = $dbh->selectcol_arrayref("SELECT id FROM sessions ORDER BY LastUpdated DESC"); - die "couldn't get ids: ". $dbh->errstr if $dbh->errstr; - return $ids; -} - -=head3 ClearOld - -Takes seconds and deletes all sessions that are older. - -=cut - -sub ClearOld { - my $class = shift || __PACKAGE__; - my $attributes = $class->Attributes; - if( $attributes->{Directory} ) { - return $class->_CleariOldDir( $attributes->{Directory}, @_ ); - } else { - return $class->_ClearOldDB( $RT::Handle->dbh, @_ ); - } -} - -sub _ClearOldDB { - my ($self, $dbh, $older_than) = @_; - my $rows; - unless( int $older_than ) { - $rows = $dbh->do("DELETE FROM sessions"); - die "couldn't delete sessions: ". $dbh->errstr unless defined $rows; - } else { - require POSIX; - my $date = POSIX::strftime("%Y-%m-%d %H:%M", localtime( time - int $older_than ) ); - - my $sth = $dbh->prepare("DELETE FROM sessions WHERE LastUpdated < ?"); - die "couldn't prepare query: ". $dbh->errstr unless $sth; - $rows = $sth->execute( $date ); - die "couldn't execute query: ". $dbh->errstr unless defined $rows; - } - - $RT::Logger->info("successfuly deleted $rows sessions"); - return; -} - -sub _ClearOldDir { - my ($self, $dir, $older_than) = @_; - - require File::Spec if int $older_than; - - my $now = time; - my $class = $self->Class; - my $attrs = $self->Attributes; - - foreach my $id( @{ $self->Ids } ) { - if( int $older_than ) { - my $ctime = (stat(File::Spec->catfile($dir,$id)))[9]; - if( $ctime > $now - $older_than ) { - $RT::Logger->debug("skipped session '$id', isn't old"); - next; - } - } - - my %session; - local $@; - eval { tie %session, $class, $id, $attrs }; - if( $@ ) { - $RT::Logger->debug("skipped session '$id', couldn't load: $@"); - next; - } - tied(%session)->delete; - $RT::Logger->info("successfuly deleted session '$id'"); - } - return; -} - -=head3 ClearByUser - -Checks all sessions and if user has more then one session -then leave only the latest one. - -=cut - -sub ClearByUser { - my $self = shift || __PACKAGE__; - my $class = $self->Class; - my $attrs = $self->Attributes; - - my %seen = (); - foreach my $id( @{ $self->Ids } ) { - my %session; - local $@; - eval { tie %session, $class, $id, $attrs }; - if( $@ ) { - $RT::Logger->debug("skipped session '$id', couldn't load: $@"); - next; - } - if( $session{'CurrentUser'} && $session{'CurrentUser'}->id ) { - unless( $seen{ $session{'CurrentUser'}->id }++ ) { - $RT::Logger->debug("skipped session '$id', first user's session"); - next; - } - } - tied(%session)->delete; - $RT::Logger->info("successfuly deleted session '$id'"); - } -} - -sub TIEHASH { - my $self = shift; - my $id = shift; - - my $class = $self->Class; - my $attrs = $self->Attributes; - - my %session; - - local $@; - eval { tie %session, $class, $id, $attrs }; - eval { tie %session, $class, undef, $attrs } if $@; - if ( $@ ) { - die loc("RT couldn't store your session.") . "\n" - . loc("This may mean that that the directory '[_1]' isn't writable or a database table is missing or corrupt.", - $RT::MasonSessionDir) - . "\n\n" - . $@; - } - - return tied %session; -} - -1; diff --git a/rt/lib/RT/Interface/Web/Standalone.pm b/rt/lib/RT/Interface/Web/Standalone.pm deleted file mode 100755 index 12bd276e1..000000000 --- a/rt/lib/RT/Interface/Web/Standalone.pm +++ /dev/null @@ -1,117 +0,0 @@ -# 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 }}} - -use strict; -use warnings; -package RT::Interface::Web::Standalone; - -use base 'HTTP::Server::Simple::Mason'; -use RT::Interface::Web::Handler; -use RT::Interface::Web; -use URI; - -sub handler_class { "RT::Interface::Web::Handler" } - -sub setup_escapes { - my $self = shift; - my $handler = shift; - - # Override HTTP::Server::Simple::Mason's version of this method to do - # nothing. (RT::Interface::Web::Handler does this already for us in - # NewHandler.) -} - -sub default_mason_config { - return RT->Config->Get('MasonParameters'); -} - -sub handle_request { - - my $self = shift; - my $cgi = shift; - - Module::Refresh->refresh if RT->Config->Get('DevelMode'); - RT::ConnectToDatabase() unless RT->InstallMode; - $self->SUPER::handle_request($cgi); - $RT::Logger->crit($@) if $@ && $RT::Logger; - warn $@ if $@ && !$RT::Logger; - RT::Interface::Web::Handler->CleanupRequest(); -} - -sub net_server { - my $self = shift; - $self->{rt_net_server} = shift if @_; - return $self->{rt_net_server}; -} - - -=head2 print_banner - -This routine prints a banner before the server request-handling loop -starts. - -Methods below this point are probably not terribly useful to define -yourself in subclasses. - -=cut - -sub print_banner { - my $self = shift; - - my $url = URI->new( RT->Config->Get('WebBaseURL')); - $url->host('127.0.0.1') if ($url->host() eq 'localhost'); - $url->port($self->port); - print( - "You can connect to your server at " - . $url->canonical - . "\n" ); - -} - - -1; diff --git a/rt/lib/RT/Interface/Web/Standalone/PreFork.pm b/rt/lib/RT/Interface/Web/Standalone/PreFork.pm deleted file mode 100644 index c00f8cd64..000000000 --- a/rt/lib/RT/Interface/Web/Standalone/PreFork.pm +++ /dev/null @@ -1,103 +0,0 @@ -# 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 }}} - -use warnings; -use strict; - -package RT::Interface::Web::Standalone::PreFork; -use base qw/Net::Server::PreFork/; - -my %option_map = ( - min_servers => 'StandaloneMinServers', - max_servers => 'StandaloneMaxServers', - min_spare_servers => 'StandaloneMinSpareServers', - max_spare_servers => 'StandaloneMaxSpareServers', - max_requests => 'StandaloneMaxRequests', -); - -=head2 default_values - -Produces the default values for L<Net::Server> configuration from RT's config -files. - -=cut - -sub default_values { - my %forking = ( - map { $_ => RT->Config->Get( $option_map{$_} ) } - grep { defined( RT->Config->Get( $option_map{$_} ) ) } - keys %option_map, - ); - - return { - %forking, - log_level => 1, - RT->Config->Get('NetServerOptions') - }; -} - -=head2 post_bind_hook - -After binding to the specified ports, let the user know that the server is -prepared to handle connections. - -=cut - -sub post_bind_hook { - my $self = shift; - my @ports = @{ $self->{server}->{port} }; - - print $0 - . ": You can connect to your server at " - . (join ' , ', map { "http://localhost:$_/" } @ports) - . "\n"; - - $self->SUPER::post_bind_hook(@_); -} - -1; |