X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT.pm;h=0f0c79a55facc3f5fd5efaa0c8dcbbbdb32b529d;hp=ddfb04162f73cb125fea9d7c94fc3eee7573ecff;hb=e9e0cf0989259b94d9758eceff448666a2e5a5cc;hpb=e70abd21bab68b23488f7ef1ee2e693a3b365691 diff --git a/rt/lib/RT.pm b/rt/lib/RT.pm index ddfb04162..0f0c79a55 100644 --- a/rt/lib/RT.pm +++ b/rt/lib/RT.pm @@ -1,40 +1,40 @@ # BEGIN BPS TAGGED BLOCK {{{ -# +# # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# -# +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# +# # (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 @@ -43,7 +43,7 @@ # 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; @@ -55,82 +55,83 @@ package RT; use File::Spec (); use Cwd (); -use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_INSTALL_MODE); +use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE); -our $VERSION = '3.8.8'; +use vars qw($BasePath + $EtcPath + $BinPath + $SbinPath + $VarPath + $LexiconPath + $PluginPath + $LocalPath + $LocalEtcPath + $LocalLibPath + $LocalLexiconPath + $LocalPluginPath + $MasonComponentRoot + $MasonLocalComponentRoot + $MasonDataDir + $MasonSessionDir); +RT->LoadGeneratedData(); -our $BasePath = '/opt/rt3'; -our $EtcPath = 'etc'; -our $BinPath = 'bin'; -our $SbinPath = 'sbin'; -our $VarPath = 'var'; -our $PluginPath = 'plugins'; -our $LocalPath = 'local'; -our $LocalEtcPath = 'local/etc'; -our $LocalLibPath = 'local/lib'; -our $LocalLexiconPath = 'local/po'; -our $LocalPluginPath = $LocalPath."/plugins"; - - -# $MasonComponentRoot is where your rt instance keeps its mason html files +=head1 NAME -our $MasonComponentRoot = 'share/html'; +RT - Request Tracker -# $MasonLocalComponentRoot is where your rt instance keeps its site-local -# mason html files. +=head1 SYNOPSIS -our $MasonLocalComponentRoot = 'local/html'; +A fully featured request tracker package. -# $MasonDataDir Where mason keeps its datafiles +This documentation describes the point-of-entry for RT's Perl API. To learn +more about what RT is and what it can do for you, visit +L. -our $MasonDataDir = 'var/mason_data'; +=head1 DESCRIPTION -# RT needs to put session data (for preserving state between connections -# via the web interface) -our $MasonSessionDir = 'var/session_data'; +=head2 INITIALIZATION -unless ( File::Spec->file_name_is_absolute($EtcPath) ) { +If you're using RT's Perl libraries, you need to initialize RT before using any +of the modules. -# if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}. -# otherwise RT.pm will make src dir(where we configure RT) be the BasePath -# instead of the --prefix one - unless ( -d $BasePath && File::Spec->file_name_is_absolute($BasePath) ) { - my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; +You have the option of handling the timing of config loading and the actual +init sequence yourself with: - # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'} - # is not always absolute - $BasePath = - File::Spec->rel2abs( - File::Spec->catdir( $pm_path, File::Spec->updir ) ); + use RT; + BEGIN { + RT->LoadConfig; + RT->Init; } - $BasePath = Cwd::realpath( $BasePath ); +or you can let RT do it all: - for my $path ( qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath - LocalLibPath LocalLexiconPath PluginPath LocalPluginPath - MasonComponentRoot MasonLocalComponentRoot MasonDataDir - MasonSessionDir/ ) { - no strict 'refs'; - # just change relative ones - $$path = File::Spec->catfile( $BasePath, $$path ) - unless File::Spec->file_name_is_absolute( $$path ); - } -} + use RT -init; +This second method is particular useful when writing one-liners to interact with RT: -=head1 NAME - -RT - Request Tracker + perl -MRT=-init -e '...' -=head1 SYNOPSIS +The first method is necessary if you need to delay or conditionalize +initialization or if you want to fiddle with C<< RT->Config >> between loading +the config files and initializing the RT environment. -A fully featured request tracker package +=cut -=head1 DESCRIPTION +{ + my $DID_IMPORT_INIT; + sub import { + my $class = shift; + my $action = shift || ''; -=head2 INITIALIZATION + if ($action eq "-init" and not $DID_IMPORT_INIT) { + $class->LoadConfig; + $class->Init; + $DID_IMPORT_INIT = 1; + } + } +} =head2 LoadConfig @@ -149,7 +150,7 @@ have not been set already. sub LoadConfig { require RT::Config; - $Config = new RT::Config; + $Config = RT::Config->new; $Config->LoadConfigs; require RT::I18N; @@ -167,18 +168,21 @@ sub LoadConfig { unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) { $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} ); } - - RT::I18N->Init; + + return $Config; } =head2 Init -L, L, -L and L. +L, L, L, L, and L. =cut sub Init { + shift if @_%2; # code is inconsistent about calling as method + my %args = (@_); CheckPerlRequirements(); @@ -187,22 +191,23 @@ sub Init { #Get a database connection ConnectToDatabase(); InitSystemObjects(); - InitClasses(); - InitLogging(); + InitClasses(%args); + InitLogging(%args); InitPlugins(); + RT::I18N->Init; RT->Config->PostLoadCheck; } =head2 ConnectToDatabase -Get a database connection. See also . +Get a database connection. See also L. =cut sub ConnectToDatabase { require RT::Handle; - $Handle = new RT::Handle unless $Handle; + $Handle = RT::Handle->new unless $Handle; $Handle->Connect; return $Handle; } @@ -215,6 +220,8 @@ Create the Logger object and set up signal handlers. sub InitLogging { + my %arg = @_; + # We have to set the record separator ($, man perlvar) # or Log::Dispatch starts getting # really pissy, as some other module we use unsets it. @@ -229,7 +236,7 @@ sub InitLogging { warning => 3, error => 4, 'err' => 4, critical => 5, crit => 5, - alert => 6, + alert => 6, emergency => 7, emerg => 7, ); @@ -257,7 +264,7 @@ sub InitLogging { my ($package, $filename, $line) = caller($frame); $p{'message'} =~ s/(?:\r*\n)+$//; - return "[". gmtime(time) ."] [". $p{'level'} ."]: " + return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: " . $p{'message'} ." ($filename:$line)\n"; }; @@ -276,9 +283,9 @@ sub InitLogging { $p{message} =~ s/(?:\r*\n)+$//; if ($p{level} eq 'debug') { - return "$p{message}\n"; + return "[$$] $p{message} ($filename:$line)\n"; } else { - return "$p{message} ($filename:$line)\n"; + return "[$$] $p{message}\n"; } }; @@ -286,7 +293,7 @@ sub InitLogging { no warnings; my %p = @_; return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level; - + require Devel::StackTrace; my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] ); return $p{'message'} . $trace->as_string; @@ -350,11 +357,24 @@ sub InitLogging { )); } } - InitSignalHandlers(); + InitSignalHandlers(%arg); +} + +{ # Work around bug in Log::Dispatch < 2.30, wherein the short forms + # of ->warn, ->err, and ->crit do not usefully propagate out, unlike + # ->warning, ->error, and ->critical + package Log::Dispatch; + no warnings 'redefine'; + sub warn { shift->warning(@_) } + sub err { shift->error(@_) } + sub crit { shift->critical(@_) } } sub InitSignalHandlers { + my %arg = @_; + return if $arg{'NoSignalHandlers'}; + # Signal handlers ## This is the default handling of warnings and die'ings in the code ## (including other used modules - maybe except for errors catched by @@ -370,6 +390,11 @@ sub InitSignalHandlers { unshift @_, $RT::Logger, qw(level warning message); goto &Log::Dispatch::log; } + # Return value is used only by RT::Test to filter warnings from + # reaching the Test::NoWarnings catcher. If Log::Dispatch::log() ever + # starts returning 'IGNORE', we'll need to switch to something more + # clever. I don't expect that to happen. + return 'IGNORE'; }; #When we call die, trap it and log->crit with the value of the die. @@ -388,27 +413,34 @@ sub InitSignalHandlers { sub CheckPerlRequirements { if ($^V < 5.008003) { - die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V; + die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V; } - local ($@); - eval { - my $x = ''; - my $y = \$x; - require Scalar::Util; Scalar::Util::weaken($y); - }; - if ($@) { + # use $error here so the following "die" can still affect the global $@ + my $error; + { + local $@; + eval { + my $x = ''; + my $y = \$x; + require Scalar::Util; + Scalar::Util::weaken($y); + }; + $error = $@; + } + + if ($error) { die <<"EOF"; RT requires the Scalar::Util module be built with support for the 'weaken' -function. +function. -It is sometimes the case that operating system upgrades will replace +It is sometimes the case that operating system upgrades will replace a working Scalar::Util with a non-working one. If your system was working correctly up until now, this is likely the cause of the problem. -Please reinstall Scalar::Util, being careful to let it build with your C -compiler. Ususally this is as simple as running the following command as +Please reinstall Scalar::Util, being careful to let it build with your C +compiler. Usually this is as simple as running the following command as root. perl -MCPAN -e'install Scalar::Util' @@ -447,11 +479,27 @@ sub InitClasses { require RT::Attributes; require RT::Dashboard; require RT::Approval; + require RT::Lifecycle; + require RT::Link; + require RT::Links; + require RT::Article; + require RT::Articles; + require RT::Class; + require RT::Classes; + require RT::ObjectClass; + require RT::ObjectClasses; + require RT::ObjectTopic; + require RT::ObjectTopics; + require RT::Topic; + require RT::Topics; # on a cold server (just after restart) people could have an object # in the session, as we deserialize it so we never call constructor # of the class, so the list of accessible fields is empty and we die # with "Method xxx is not implemented in RT::SomeClass" + + # without this, we also can never call _ClassAccessible, because we + # won't have filled RT::Record::_TABLE_ATTR $_->_BuildTableAttributes foreach qw( RT::Ticket RT::Transaction @@ -470,14 +518,24 @@ sub InitClasses { RT::ObjectCustomField RT::ObjectCustomFieldValue RT::Attribute + RT::ACE + RT::Link + RT::Article + RT::Class + RT::ObjectClass + RT::ObjectTopic + RT::Topic ); if ( $args{'Heavy'} ) { # load scrips' modules - my $scrips = RT::Scrips->new($RT::SystemUser); + my $scrips = RT::Scrips->new(RT->SystemUser); $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' ); while ( my $scrip = $scrips->Next ) { - $scrip->LoadModules; + local $@; + eval { $scrip->LoadModules } or + $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ". + "You should delete or repair this Scrip in the admin UI.\n$@\n"); } foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) { @@ -488,14 +546,13 @@ sub InitClasses { ); } - RT::I18N->LoadLexicons; } } =head2 InitSystemObjects -Initializes system objects: C<$RT::System>, C<$RT::SystemUser> -and C<$RT::Nobody>. +Initializes system objects: C<$RT::System>, C<< RT->SystemUser >> +and C<< RT->Nobody >>. =cut @@ -503,11 +560,11 @@ sub InitSystemObjects { #RT's system user is a genuine database user. its id lives here require RT::CurrentUser; - $SystemUser = new RT::CurrentUser; + $SystemUser = RT::CurrentUser->new; $SystemUser->LoadByName('RT_System'); #RT's "nobody user" is a genuine database user. its ID lives here. - $Nobody = new RT::CurrentUser; + $Nobody = RT::CurrentUser->new; $Nobody->LoadByName('Nobody'); require RT::System; @@ -518,19 +575,19 @@ sub InitSystemObjects { =head2 Config -Returns the current L, but note that -you must L first otherwise this method +Returns the current L, but note that +you must L first otherwise this method returns undef. Method can be called as class method. =cut -sub Config { return $Config } +sub Config { return $Config || shift->LoadConfig(); } =head2 DatabaseHandle -Returns the current L. +Returns the current L. See also L. @@ -548,7 +605,7 @@ sub Logger { return $Logger } =head2 System -Returns the current L. See also +Returns the current L. See also L. =cut @@ -575,6 +632,23 @@ also L. sub Nobody { return $Nobody } +sub PrivilegedUsers { + if (!$_Privileged) { + $_Privileged = RT::Group->new(RT->SystemUser); + $_Privileged->LoadSystemInternalGroup('Privileged'); + } + return $_Privileged; +} + +sub UnprivilegedUsers { + if (!$_Unprivileged) { + $_Unprivileged = RT::Group->new(RT->SystemUser); + $_Unprivileged->LoadSystemInternalGroup('Unprivileged'); + } + return $_Unprivileged; +} + + =head2 Plugins Returns a listref of all Plugins currently configured for this RT instance. @@ -594,10 +668,12 @@ sub Plugins { =head2 PluginDirs -Takes optional subdir (e.g. po, lib, etc.) and return plugins' dirs that exist. +Takes an optional subdir (e.g. po, lib, etc.) and returns a list of +directories from plugins where that subdirectory exists. -This code chacke plugins names or anything else and required when main config -is loaded to load plugins' configs. +This code does not check plugin names, plugin validitity, or load +plugins (see L) in any way, and requires that RT's +configuration have been already loaded. =cut @@ -648,7 +724,8 @@ sub InitPluginPaths { =head2 InitPlugins -Initialze all Plugins found in the RT configuration file, setting up their lib and HTML::Mason component roots. +Initialize all Plugins found in the RT configuration file, setting up +their lib and L component roots. =cut @@ -668,15 +745,125 @@ sub InitPlugins { sub InstallMode { my $self = shift; if (@_) { - $_INSTALL_MODE = shift; - if($_INSTALL_MODE) { - require RT::CurrentUser; - $SystemUser = RT::CurrentUser->new(); - } + my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; + if ($_[0] and $integrity) { + # Trying to turn install mode on but we have a good DB! + require Carp; + $RT::Logger->error( + Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!") + ); + } + else { + $_INSTALL_MODE = shift; + if($_INSTALL_MODE) { + require RT::CurrentUser; + $SystemUser = RT::CurrentUser->new(); + } + } } return $_INSTALL_MODE; } +sub LoadGeneratedData { + my $class = shift; + my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; + + require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@"; + $class->CanonicalizeGeneratedPaths(); +} + +sub CanonicalizeGeneratedPaths { + my $class = shift; + unless ( File::Spec->file_name_is_absolute($EtcPath) ) { + + # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}. + # otherwise RT.pm will make the source dir(where we configure RT) be the + # BasePath instead of the one specified by --prefix + unless ( -d $BasePath + && File::Spec->file_name_is_absolute($BasePath) ) + { + my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; + + # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'} + # is not always absolute + $BasePath = File::Spec->rel2abs( + File::Spec->catdir( $pm_path, File::Spec->updir ) ); + } + + $BasePath = Cwd::realpath($BasePath); + + for my $path ( + qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath + LocalLibPath LexiconPath LocalLexiconPath PluginPath + LocalPluginPath MasonComponentRoot MasonLocalComponentRoot + MasonDataDir MasonSessionDir/ + ) + { + no strict 'refs'; + + # just change relative ones + $$path = File::Spec->catfile( $BasePath, $$path ) + unless File::Spec->file_name_is_absolute($$path); + } + } + +} + +=head2 AddJavaScript + +helper method to add js files to C config. +to add extra js files, you can add the following line +in the plugin's main file: + + RT->AddJavaScript( 'foo.js', 'bar.js' ); + +=cut + +sub AddJavaScript { + my $self = shift; + + my @old = RT->Config->Get('JSFiles'); + RT->Config->Set( 'JSFiles', @old, @_ ); + return RT->Config->Get('JSFiles'); +} + +=head2 AddStyleSheets + +helper method to add css files to C config + +to add extra css files, you can add the following line +in the plugin's main file: + + RT->AddStyleSheets( 'foo.css', 'bar.css' ); + +=cut + +sub AddStyleSheets { + my $self = shift; + my @old = RT->Config->Get('CSSFiles'); + RT->Config->Set( 'CSSFiles', @old, @_ ); + return RT->Config->Get('CSSFiles'); +} + +=head2 JavaScript + +helper method of RT->Config->Get('JSFiles') + +=cut + +sub JavaScript { + return RT->Config->Get('JSFiles'); +} + +=head2 StyleSheets + +helper method of RT->Config->Get('CSSFiles') + +=cut + +sub StyleSheets { + return RT->Config->Get('CSSFiles'); +} =head1 BUGS @@ -690,12 +877,9 @@ If you're not sure what's going on, report them rt-devel@lists.bestpractical.com L L - =cut -eval "require RT_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT_Vendor.pm}); -eval "require RT_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT_Local.pm}); +require RT::Base; +RT::Base->_ImportOverlays(); 1;