[Rt-commit] rt branch 5.0/add-scrip-logging created. rt-5.0.4-144-g47eac07b3f
BPS Git Server
git at git.bestpractical.com
Wed Aug 30 17:23:27 UTC 2023
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "rt".
The branch, 5.0/add-scrip-logging has been created
at 47eac07b3f83d24b4e929790773db88dd4d7dc02 (commit)
- Log -----------------------------------------------------------------
commit 47eac07b3f83d24b4e929790773db88dd4d7dc02
Author: Brad Embree <brad at bestpractical.com>
Date: Mon Jul 31 14:59:08 2023 -0700
Add tests
diff --git a/t/web/scrips.t b/t/web/scrips.t
index 1e9ee4e3fc..fff74c5a89 100644
--- a/t/web/scrips.t
+++ b/t/web/scrips.t
@@ -2,6 +2,7 @@ use strict;
use warnings;
use RT::Test tests => undef;
+use Test::Warn;
RT->Config->Set( UseTransactionBatch => 1 );
@@ -296,4 +297,108 @@ note "apply scrip in different stage to different queues";
is scalar @matches, 1, 'scrip mentioned only once';
}
+note "test scrip logging";
+{
+ my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $RT::VarPath, 'log' );
+ $logdir = File::Spec->catdir( $logdir, 'scrips' );
+
+ my %test_scrips = (
+ 'No Errors' => [ 'return 1;', 'return 1;', 'return 1;' ],
+ 'IsApplicable Error' => [ 'return $undefined;', 'return 1;', 'return 1;' ],
+ 'Prepare Error' => [ 'return 1;', 'return $undefined;', 'return 1;' ],
+ 'Commit Error' => [ 'return 1;', 'return 1;', 'return $undefined;' ],
+ );
+ my %test_scrip_logfile_should_exist = (
+ 'No Errors' => { IsApplicable => 0, Prepare => 0, Commit => 0, },
+ 'IsApplicable Error' => { IsApplicable => 1, Prepare => 0, Commit => 0, },
+ 'Prepare Error' => { IsApplicable => 0, Prepare => 1, Commit => 0, },
+ 'Commit Error' => { IsApplicable => 0, Prepare => 0, Commit => 1, },
+ );
+
+ my %id_for_scrip;
+ foreach my $test_scrip ( sort keys %test_scrips ) {
+ diag "Create Scrip (Test Scrip Logging - $test_scrip)" if $ENV{TEST_VERBOSE};
+ $m->follow_link_ok({id => 'admin-global-scrips-create'});
+ $m->form_name('CreateScrip');
+ $m->set_fields(
+ 'Description' => "Test Scrip Logging - $test_scrip",
+ 'ScripCondition' => 'User Defined',
+ 'ScripAction' => 'User Defined',
+ 'Template' => 'Blank',
+ 'CustomIsApplicableCode' => $test_scrips{$test_scrip}->[0],
+ 'CustomPrepareCode' => $test_scrips{$test_scrip}->[1],
+ 'CustomCommitCode' => $test_scrips{$test_scrip}->[2],
+ );
+ $m->click('Create');
+ $m->content_like(qr{Scrip Created});
+
+ my ($sid) = ($m->content =~ /Modify scrip #(\d+)/);
+ ok $sid, "found scrip id on the page";
+
+ $id_for_scrip{$test_scrip} = $sid;
+ }
+
+ # creating a ticket should fire off all test scrips
+ diag "Create Ticket (Test Scrip Logging No Config)" if $ENV{TEST_VERBOSE};
+ warnings_like {
+ RT::Test->create_ticket(
+ Subject => 'Test Scrip Logging',
+ Content => 'stuff',
+ Queue => 1,
+ );
+ } [ qr/Global symbol .* requires explicit package name/,
+ qr/Global symbol .* requires explicit package name/,
+ qr/Global symbol .* requires explicit package name/,
+ qr/Global symbol .* requires explicit package name/,
+ qr/Global symbol .* requires explicit package name/,
+ qr/Global symbol .* requires explicit package name/,
+ ];
+
+ # without any config specified there should be no log files
+ foreach my $test_scrip ( sort keys %id_for_scrip ) {
+ foreach my $mode ( qw( IsApplicable Prepare Commit ) ) {
+ my $filename = 'scrip-' . $id_for_scrip{$test_scrip} . '-' . $mode . '.log';
+ my $fullpath = File::Spec->catfile( $logdir, $filename );
+
+ ok ! -e $fullpath, "Scrip log file '$filename' should not exist";
+ }
+ }
+
+ # now set config and create another ticket
+ # need to stop server, change config, restart server
+ # to avoid warning about changing config with running server
+ RT::Test->stop_server;
+ RT->Config->Set( LogScripsForUser => { root => 'warn', RT_System => 'warn' } );
+ ( $baseurl, $m ) = RT::Test->started_ok;
+ ok( $m->login(), 'logged in' );
+
+ diag "Create Ticket (Test Scrip Logging With Config)" if $ENV{TEST_VERBOSE};
+ warnings_like {
+ RT::Test->create_ticket(
+ Subject => 'Test Scrip Logging',
+ Content => 'stuff',
+ Queue => 1,
+ );
+ } [ qr/Global symbol .* requires explicit package name/,
+ qr/Global symbol .* requires explicit package name/,
+ qr/Global symbol .* requires explicit package name/,
+ qr/Global symbol .* requires explicit package name/,
+ qr/Global symbol .* requires explicit package name/,
+ qr/Global symbol .* requires explicit package name/,
+ ];
+
+ foreach my $test_scrip ( sort keys %id_for_scrip ) {
+ foreach my $mode ( qw( IsApplicable Prepare Commit ) ) {
+ my $filename = 'scrip-' . $id_for_scrip{$test_scrip} . '-' . $mode . '.log';
+ my $fullpath = File::Spec->catfile( $logdir, $filename );
+
+ if ( $test_scrip_logfile_should_exist{$test_scrip}->{$mode} ) {
+ ok -e $fullpath, "Scrip log file '$filename' should exist";
+ } else {
+ ok ! -e $fullpath, "Scrip log file '$filename' should not exist";
+ }
+ }
+ }
+}
+
done_testing;
commit 80ba1a7bf65942216454b912e7b5e0856f8d29ab
Author: Brad Embree <brad at bestpractical.com>
Date: Mon Jul 31 14:58:22 2023 -0700
Show Scrip errors for UserDefined code
diff --git a/share/html/Admin/Scrips/Elements/EditCustomCode b/share/html/Admin/Scrips/Elements/EditCustomCode
index 201a8c292f..9bbe740ba9 100644
--- a/share/html/Admin/Scrips/Elements/EditCustomCode
+++ b/share/html/Admin/Scrips/Elements/EditCustomCode
@@ -65,6 +65,18 @@
<textarea spellcheck="false" cols="80" class="form-control" rows="<% $lines %>" name="<% $method %>"><% $code %></textarea>
</div>
</div>
+
+% if ( $errors{$method} ) {
+<div class="form-row">
+ <div class="label col-2 labeltop">
+ <span style="color:red"><% loc('Log Output') %></span>:
+ </div>
+ <div class="value col-9">
+ <textarea spellcheck="false" cols="80" rows="5" class="form-control" readonly><% $errors{$method} %></textarea>
+ </div>
+</div>
+% }
+
% }
</&>
@@ -79,4 +91,34 @@ my @list = (
);
my $min_lines = 10;
+
+my %errors = (
+ 'CustomIsApplicableCode' => '',
+ 'CustomPrepareCode' => '',
+ 'CustomCommitCode' => '',
+);
+
+if ( $Scrip->id ) {
+ my @stages = ();
+ if ( $Scrip->ConditionObj->ExecModule eq 'UserDefined' ) {
+ push @stages, 'IsApplicable';
+ }
+ if ( $Scrip->ActionObj->ExecModule eq 'UserDefined' ) {
+ push @stages, 'Prepare', 'Commit';
+ }
+
+ my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $RT::VarPath, 'log' );
+ $logdir = File::Spec->catdir( $logdir, 'scrips' );
+ foreach my $stage ( @stages ) {
+ my $filename = File::Spec->catfile( $logdir, 'scrip-' . $Scrip->id . '-' . $stage . '.log' );
+ if ( -e $filename ) {
+ if ( -s $filename ) {
+ local $/;
+ open ( my $f, '<:encoding(UTF-8)', $filename )
+ or die "Cannot open initialdata file '$filename' for read: $@";
+ $errors{ 'Custom' . $stage . 'Code' } = <$f>;
+ }
+ }
+ }
+}
</%INIT>
commit 5b3b709b74b2ed06cc2e91bedd837fd879dca9b7
Author: Brad Embree <brad at bestpractical.com>
Date: Mon Jul 31 14:56:25 2023 -0700
Add Logging tab to Scrip Admin menu
diff --git a/lib/RT/Interface/Web/MenuBuilder.pm b/lib/RT/Interface/Web/MenuBuilder.pm
index 7a6fa3a4ea..19d0e68920 100644
--- a/lib/RT/Interface/Web/MenuBuilder.pm
+++ b/lib/RT/Interface/Web/MenuBuilder.pm
@@ -1571,6 +1571,7 @@ sub _BuildAdminMenu {
$page->child( basics => title => loc('Basics') => path => "/Admin/Scrips/Modify.html?id=" . $id . $from_query_param );
$page->child( 'applies-to' => title => loc('Applies to'), path => "/Admin/Scrips/Objects.html?id=" . $id . $from_query_param );
+ $page->child( 'logging' => title => loc('Log Output'), path => "/Admin/Scrips/Logging.html?id=" . $id . $from_query_param );
}
elsif ( $request_path =~ m{^/Admin/Scrips/(index\.html)?$} ) {
HTML::Mason::Commands::PageMenu->child( select => title => loc('Select') => path => "/Admin/Scrips/" );
commit 8d99f2d411abe1b8f82365ac21fd2b5fb3aebc1b
Author: Brad Embree <brad at bestpractical.com>
Date: Mon Jul 31 14:55:57 2023 -0700
Add Scrip Logging page
diff --git a/share/html/Admin/Scrips/Logging.html b/share/html/Admin/Scrips/Logging.html
new file mode 100644
index 0000000000..0e261a5df4
--- /dev/null
+++ b/share/html/Admin/Scrips/Logging.html
@@ -0,0 +1,113 @@
+%# BEGIN BPS TAGGED BLOCK {{{
+%#
+%# COPYRIGHT:
+%#
+%# This software is Copyright (c) 1996-2023 Best Practical Solutions, LLC
+%# <sales at 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 }}}
+<& /Admin/Elements/Header, Title => loc("Logging for scrip #[_1]", $id) &>
+<& /Elements/Tabs &>
+
+<div class="mx-auto max-width-xl">
+
+<&| /Widgets/TitleBox, title => loc('Logging') &>
+
+<div class="form-row">
+ <div class="label col-3">
+ <span class="prev-icon-helper"><% loc('Condition') %>:</span>
+ </div>
+ <div class="value col-9">
+ <textarea cols="15" rows="5" name="Condition" class="form-control" readonly><% $errors{IsApplicable} %></textarea>
+ </div>
+</div>
+<div class="form-row">
+ <div class="label col-3">
+ <span class="prev-icon-helper"><% loc('Action preparation')%>:</span>
+ </div>
+ <div class="value col-9">
+ <textarea cols="15" rows="5" name="Prepare" class="form-control" readonly><% $errors{Prepare} %></textarea>
+ </div>
+</div>
+<div class="form-row">
+ <div class="label col-3">
+ <span class="prev-icon-helper"><% loc('Action commit') %>:</span>
+ </div>
+ <div class="value col-9">
+ <textarea cols="15" rows="5" name="Commit" class="form-control" readonly><% $errors{Commit} %></textarea>
+ </div>
+</div>
+
+</div>
+
+</&>
+
+<%ARGS>
+$id => undef
+$From => undef
+</%ARGS>
+<%INIT>
+my $scrip = RT::Scrip->new( $session{'CurrentUser'} );
+$scrip->Load( $id );
+Abort(loc("Couldn't load scrip #[_1]", $id))
+ unless $scrip->id;
+
+my %errors = (
+ 'IsApplicable' => '',
+ 'Prepare' => '',
+ 'Commit' => '',
+);
+
+my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $RT::VarPath, 'log' );
+$logdir = File::Spec->catdir( $logdir, 'scrips' );
+foreach my $stage ( qw( IsApplicable Prepare Commit ) ) {
+ my $filename = File::Spec->catfile( $logdir, 'scrip-' . $scrip->id . '-' . $stage . '.log' );
+ if ( -e $filename ) {
+ if ( -s $filename ) {
+ local $/;
+ open ( my $f, '<:encoding(UTF-8)', $filename )
+ or die "Cannot open initialdata file '$filename' for read: $@";
+ $errors{$stage} = <$f>;
+ }
+ }
+}
+</%INIT>
commit dcd4d9792ce9508cc27a0e6bd5a6822067e372cb
Author: Brad Embree <brad at bestpractical.com>
Date: Mon Jul 31 14:54:39 2023 -0700
Add HasLogs to Scrip AdminSearchResultFormat
diff --git a/etc/RT_Config.pm.in b/etc/RT_Config.pm.in
index e76797447e..a6880e3c3f 100644
--- a/etc/RT_Config.pm.in
+++ b/etc/RT_Config.pm.in
@@ -3989,7 +3989,7 @@ Set(%AdminSearchResultFormat,
Scrips =>
q{'<a href="__WebPath__/Admin/Scrips/Modify.html?id=__id____From__">__id__</a>/TITLE:#'}
.q{,'<a href="__WebPath__/Admin/Scrips/Modify.html?id=__id____From__">__Description__</a>/TITLE:Description'}
- .q{,__Condition__, __Action__, __Template__, __Disabled__},
+ .q{,__Condition__, __Action__, __Template__, __Disabled__,__HasLogs__},
Templates =>
q{'<a href="__WebPath__/__WebRequestPathDir__/Template.html?Queue=__QueueId__&Template=__id__">__id__</a>/TITLE:#'}
commit e4b57cd1585d085b70561b1c95e1136ade8d997b
Author: Brad Embree <brad at bestpractical.com>
Date: Mon Jul 31 14:50:01 2023 -0700
Add HasLogs column for Scrips
diff --git a/share/html/Elements/RT__Scrip/ColumnMap b/share/html/Elements/RT__Scrip/ColumnMap
index 1edac2a6d9..6f2ab5ca06 100644
--- a/share/html/Elements/RT__Scrip/ColumnMap
+++ b/share/html/Elements/RT__Scrip/ColumnMap
@@ -181,6 +181,21 @@ my $COLUMN_MAP = {
return $_[0]->loc( $os->FriendlyStage );
},
},
+ HasLogs => {
+ title => 'Log Output', # loc
+ value => sub {
+ my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $RT::VarPath, 'log' );
+ $logdir = File::Spec->catdir( $logdir, 'scrips' );
+ foreach my $stage ( qw( IsApplicable Prepare Commit ) ) {
+ my $filename = File::Spec->catfile( $logdir, 'scrip-' . $_[0]->id . '-' . $stage . '.log' );
+ if ( -e $filename && -s $filename ) {
+ my $return = '<a href="' . RT->Config->Get('WebPath') . '/Admin/Scrips/Logging.html?id=' . $_[0]->id . '"><span style="color:red">' . $_[0]->loc('Has Log') . '</span></a>';
+ return \$return;
+ }
+ }
+ return '';
+ },
+ },
};
</%ONCE>
commit 9ce407a66bd4693b829235b718246903cbdc48c5
Author: Brad Embree <brad at bestpractical.com>
Date: Thu Jul 13 19:16:27 2023 -0700
Add logging of all scrip stages
diff --git a/lib/RT/Scrip.pm b/lib/RT/Scrip.pm
index ed56cafc61..a0fda89766 100644
--- a/lib/RT/Scrip.pm
+++ b/lib/RT/Scrip.pm
@@ -584,6 +584,9 @@ sub IsApplicable {
return (undef);
}
my $ConditionObj = $self->ConditionObj;
+
+ $self->_AddFileLogger('IsApplicable');
+
foreach my $TransactionObj ( @Transactions ) {
# in TxnBatch stage we can select scrips that are not applicable to all txns
my $txn_type = $TransactionObj->Type;
@@ -602,6 +605,7 @@ sub IsApplicable {
}
}
};
+ $self->_RemoveFileLogger('IsApplicable');
if ($@) {
$RT::Logger->error( "Scrip IsApplicable " . $self->Id . " died. - " . $@ );
@@ -635,8 +639,12 @@ sub Prepare {
TemplateObj => $self->TemplateObj( $args{'TicketObj'}->Queue ),
);
+ $self->_AddFileLogger('Prepare');
+
$return = $self->ActionObj->Prepare();
};
+ $self->_RemoveFileLogger('Prepare');
+
if ($@) {
$RT::Logger->error( "Scrip Prepare " . $self->Id . " died. - " . $@ );
return (undef);
@@ -660,10 +668,13 @@ sub Commit {
TransactionObj => undef,
@_ );
- my $return;
+ my $return;
eval {
+ $self->_AddFileLogger('Commit');
+
$return = $self->ActionObj->Commit();
};
+ $self->_RemoveFileLogger('Commit');
#Searchbuilder caching isn't perfectly coherent. got to reload the ticket object, since it
# may have changed
@@ -680,9 +691,72 @@ sub Commit {
return ($return);
}
+=head2 _logger_filename
+
+Helper method to generate the filename for a file logger for Scrip
+logging.
+=cut
+sub _logger_filename {
+ my $self = shift;
+ my $mode = shift;
+
+ return 'scrip-' . $self->id . "-$mode.log";
+};
+
+=head2 _AddFileLogger
+
+Checks the C<LogScripsForUser> config option to determine if Scrip
+logging is enabled for the current user and if so it calls
+RT::AddFileLogger to add a short lived file logger used for Scrip
+logging.
+
+=cut
+
+sub _AddFileLogger {
+ my $self = shift;
+ my $mode = shift;
+ my $config = RT->Config->Get('LogScripsForUser');
+ my $current_user = $HTML::Mason::Commands::session{CurrentUser} || $self->CurrentUser;
+
+ return unless $config;
+ return unless $current_user;
+ return unless $config->{ $current_user->Name };
+
+ RT::AddFileLogger(
+ filename => $self->_logger_filename($mode),
+ log_level => $config->{ $current_user->Name },
+ );
+}
+
+=head2 _RemoveFileLogger
+
+Calls RT::RemoveFileLogger to remove a short lived file logger used for
+Scrip logging.
+
+Passes RT::RemoveFileLogger a final log message that includes the date
+the log was created and the user it was created for.
+
+=cut
+
+sub _RemoveFileLogger {
+ my $self = shift;
+ my $mode = shift;
+
+ my $config = RT->Config->Get('LogScripsForUser');
+ my $current_user = $HTML::Mason::Commands::session{CurrentUser} || $self->CurrentUser;
+
+ return unless $config;
+ return unless $current_user;
+ return unless $config->{ $current_user->Name };
+
+ my $log_level = $config->{ $current_user->Name };
+ my $final_log = "\nLog created on " . gmtime(time) . " for " . $current_user->Name . " at log level $log_level\n";
+
+ RT::RemoveFileLogger( $self->_logger_filename($mode), $final_log );
+}
# does an acl check and then passes off the call
sub _Set {
commit 2d6a36f444a9857c12e9f0038be582f11f8876ac
Author: Brad Embree <brad at bestpractical.com>
Date: Mon Jul 31 14:49:00 2023 -0700
Add LogScripsForUser config option
diff --git a/etc/RT_Config.pm.in b/etc/RT_Config.pm.in
index 6b945a72ba..e76797447e 100644
--- a/etc/RT_Config.pm.in
+++ b/etc/RT_Config.pm.in
@@ -378,6 +378,34 @@ See the L<Log::Dispatch::Syslog> documentation for more information.
Set(@LogToSyslogConf, ());
+=item C<$LogScripsForUser>
+
+Enables logging for each Scrip, and log output can then be found in the
+Scrip Admin web interface. Log output is shown for the most recent run
+of each scrip.
+
+Accepts a hashref with username and log level. Output is generated only
+when that user performs an action that runs the scrip. Log levels are
+the same as for other RT logging. For example:
+
+ Set($LogScripsForUser, { 'Username1' => 'debug', 'Username2' => 'warning' });
+
+This allows you to enable debug logging just for yourself as you test
+a new scrip.
+
+If you have set the C<LogDir> option it needs to be writeable by the
+webserver user for Scrip logging to work.
+
+NOTICE: The Ticket Update page that is used to add a Reply or Comment
+will run all relevant Scrips in a dry run mode that executes the
+Scrip Condition and Scrip Prepare code. This means log files might be
+created just by loading the Ticket Update page if Scip logging is
+enabled.
+
+=cut
+
+Set($LogScripsForUser, {});
+
=back
diff --git a/lib/RT/Config.pm b/lib/RT/Config.pm
index ffd504a36e..1be99dfa86 100644
--- a/lib/RT/Config.pm
+++ b/lib/RT/Config.pm
@@ -2245,6 +2245,9 @@ our %META;
LogToSyslogConf => {
Immutable => 1,
},
+ LogScripsForUser => {
+ Type => 'HASH',
+ },
ShowMobileSite => {
Widget => '/Widgets/Form/Boolean',
},
commit 400abab25efc082f9ff4a8d3d83adecee63085bc
Author: Brad Embree <brad at bestpractical.com>
Date: Thu Jul 13 19:15:32 2023 -0700
Add methods for adding and removing a logger
diff --git a/lib/RT.pm b/lib/RT.pm
index ea47927889..85a9fa9349 100644
--- a/lib/RT.pm
+++ b/lib/RT.pm
@@ -229,6 +229,24 @@ Create the Logger object and set up signal handlers.
=cut
+my $simple_cb = sub {
+ # if this code throw any warnings we can get segfault
+ no warnings;
+ my %p = @_;
+
+ # skip Log::* stack frames
+ my $frame = 0;
+ $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'} ."]: "
+ . $p{'message'} ." ($filename:$line)\n";
+};
+
sub InitLogging {
# We have to set the record separator ($, man perlvar)
@@ -266,24 +284,6 @@ sub InitLogging {
$stack_from_level = 99; # don't log
}
- my $simple_cb = sub {
- # if this code throw any warning we can get segfault
- no warnings;
- my %p = @_;
-
- # skip Log::* stack frames
- my $frame = 0;
- $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'} ."]: "
- . $p{'message'} ." ($filename:$line)\n";
- };
-
my $syslog_cb = sub {
# if this code throw any warning we can get segfault
no warnings;
@@ -412,6 +412,111 @@ sub InitSignalHandlers {
};
}
+=head2 AddFileLogger
+
+ RT::AddFileLogger(
+ filename => 'filename.log', # will be created in C<$LogDir>
+ log_level => 'warn', # Log::Dispatch log level
+ );
+
+Add a new file logger at runtime. Used to add short lived file loggers
+that are currently only used for logging Scrip errors.
+
+Note that the log file will be opened in write mode and will overwrite
+an existing file with the same name.
+
+To remove the file logger use C<RemoveFileLogger>.
+
+=cut
+
+sub AddFileLogger {
+ my %args = (
+ log_level => 'warn',
+ @_
+ );
+
+ return unless $args{filename};
+
+ # return if there is a already a logger with this name
+ if ( $RT::Logger->output( $args{filename} ) ) {
+ RT->Logger->error("File Logger '$args{filename}' already exists.");
+ return;
+ }
+
+ my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' );
+ $logdir = File::Spec->catdir( $logdir, 'scrips' );
+ my $filename = File::Spec->catfile( $logdir, $args{filename} );
+
+ unless ( -e $logdir ) {
+ mkdir $logdir;
+ }
+ unless ( -d $logdir && -w $logdir ) {
+ RT->Logger->error("Log dir '$logdir' is not writeable.");
+ return;
+ }
+
+ require Log::Dispatch::File;
+ $RT::Logger->add(
+ Log::Dispatch::File->new(
+ name => $args{filename},
+ min_level => $args{log_level},
+ filename => $filename,
+ mode => 'write',
+ callbacks => [ $simple_cb ],
+ )
+ );
+
+ return 1;
+}
+
+=head2 RemoveFileLogger
+
+ RT::RemoveFileLogger(
+ 'filename.log',
+ 'an optional final log message',
+ );
+
+Remove a file logger that was added at runtime. Used to remove file
+loggers added with C<AddFileLogger>.
+
+Acccepts an optional second argument to add a final log message that is
+only appended to the log file if the log file is not empty.
+
+If the log file is empty it is deleted to avoid empty log files in the
+log directory.
+
+=cut
+
+sub RemoveFileLogger {
+ my $filename = shift;
+ my $final_log = shift;
+
+ return unless $filename;
+
+ # return if there is not a logger with this name
+ return unless $RT::Logger->output($filename);
+
+ $RT::Logger->remove($filename);
+
+ # if the log file is empty delete it
+ my $logdir = RT->Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' );
+ $logdir = File::Spec->catdir( $logdir, 'scrips' );
+ $filename = File::Spec->catfile( $logdir, $filename );
+
+ if ( ( -e $filename ) && ( -s $filename == 0 ) ) {
+ unlink $filename;
+ }
+ elsif ( ( -e $filename ) && ( -s $filename > 0 ) && $final_log ) {
+ # add a final message with log details
+ if ( open my $fh, '>>', $filename ) {
+ print $fh $final_log;
+ close $fh;
+ }
+ else {
+ RT->Logger->error("Cannot write to '$filename': $!");
+ }
+ }
+}
sub CheckPerlRequirements {
eval {require 5.010_001};
-----------------------------------------------------------------------
hooks/post-receive
--
rt
More information about the rt-commit
mailing list