rt 4.0.23

[freeside.git] / rt / lib / RT.pm

diff --git a/rt/lib/RT.pm b/rt/lib/RT.pm
index 063f7f7..8174505 100644 (file)
--- a/rt/lib/RT.pm
+++ b/rt/lib/RT.pm
@@ -2,7 +2,7 @@
 #
 # COPYRIGHT:
 #
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
@@ -52,6 +52,7 @@ use warnings;
 package RT;
 
 
+use Encode ();
 use File::Spec ();
 use Cwd ();
 
@@ -83,12 +84,56 @@ RT - Request Tracker
 
 =head1 SYNOPSIS
 
-A fully featured request tracker package
+A fully featured request tracker package.
+
+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<https://bestpractical.com/rt>.
 
 =head1 DESCRIPTION
 
 =head2 INITIALIZATION
 
+If you're using RT's Perl libraries, you need to initialize RT before using any
+of the modules.
+
+You have the option of handling the timing of config loading and the actual
+init sequence yourself with:
+
+    use RT;
+    BEGIN {
+        RT->LoadConfig;
+        RT->Init;
+    }
+
+or you can let RT do it all:
+
+    use RT -init;
+
+This second method is particular useful when writing one-liners to interact with RT:
+
+    perl -MRT=-init -e '...'
+
+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.
+
+=cut
+
+{
+    my $DID_IMPORT_INIT;
+    sub import {
+        my $class  = shift;
+        my $action = shift || '';
+
+        if ($action eq "-init" and not $DID_IMPORT_INIT) {
+            $class->LoadConfig;
+            $class->Init;
+            $DID_IMPORT_INIT = 1;
+        }
+    }
+}
+
 =head2 LoadConfig
 
 Load RT's config file.  First, the site configuration file
@@ -137,6 +182,8 @@ up logging|/InitLogging>, and L<loads plugins|/InitPlugins>.
 =cut
 
 sub Init {
+    shift if @_%2; # code is inconsistent about calling as method
+    my %args = (@_);
 
     CheckPerlRequirements();
 
@@ -145,8 +192,8 @@ sub Init {
     #Get a database connection
     ConnectToDatabase();
     InitSystemObjects();
-    InitClasses();
-    InitLogging();
+    InitClasses(%args);
+    InitLogging(%args);
     InitPlugins();
     RT::I18N->Init;
     RT->Config->PostLoadCheck;
@@ -174,6 +221,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.
@@ -215,8 +264,11 @@ sub InitLogging {
             $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
             my ($package, $filename, $line) = caller($frame);
 
+            # Encode to bytes, so we don't send wide characters
+            $p{message} = Encode::encode("UTF-8", $p{message});
+
             $p{'message'} =~ s/(?:\r*\n)+$//;
-            return "[". gmtime(time) ."] [". $p{'level'} ."]: "
+            return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: "
                 . $p{'message'} ." ($filename:$line)\n";
         };
 
@@ -230,14 +282,14 @@ sub InitLogging {
             $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
             my ($package, $filename, $line) = caller($frame);
 
-            # syswrite() cannot take utf8; turn it off here.
-            Encode::_utf8_off($p{message});
+            # Encode to bytes, so we don't send wide characters
+            $p{message} = Encode::encode("UTF-8", $p{message});
 
             $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";
             }
         };
 
@@ -309,11 +361,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
@@ -321,14 +386,9 @@ sub InitSignalHandlers {
 ## mechanism (see above).
 
     $SIG{__WARN__} = sub {
-        # The 'wide character' warnings has to be silenced for now, at least
-        # until HTML::Mason offers a sane way to process both raw output and
-        # unicode strings.
         # use 'goto &foo' syntax to hide ANON sub from stack
-        if( index($_[0], 'Wide character in ') != 0 ) {
-            unshift @_, $RT::Logger, qw(level warning message);
-            goto &Log::Dispatch::log;
-        }
+        unshift @_, $RT::Logger, qw(level warning message);
+        goto &Log::Dispatch::log;
     };
 
 #When we call die, trap it and log->crit with the value of the die.
@@ -641,7 +701,9 @@ sub InitPluginPaths {
     my @tmp_inc;
     my $added;
     for (@INC) {
-        if ( Cwd::realpath($_) eq $RT::LocalLibPath) {
+        my $realpath = Cwd::realpath($_);
+        next unless defined $realpath;
+        if ( $realpath eq $RT::LocalLibPath) {
             push @tmp_inc, $_, @lib_dirs;
             $added = 1;
         } else {