← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:09 2021

Filename/usr/local/libexec/sympa/Sympa/Crash.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sSympa::Crash::::BEGIN@30Sympa::Crash::BEGIN@30
0000s0sSympa::Crash::::BEGIN@31Sympa::Crash::BEGIN@31
0000s0sSympa::Crash::::BEGIN@32Sympa::Crash::BEGIN@32
0000s0sSympa::Crash::::BEGIN@33Sympa::Crash::BEGIN@33
0000s0sSympa::Crash::::BEGIN@34Sympa::Crash::BEGIN@34
0000s0sSympa::Crash::::BEGIN@36Sympa::Crash::BEGIN@36
0000s0sSympa::Crash::::BEGIN@37Sympa::Crash::BEGIN@37
0000s0sSympa::Crash::::INITSympa::Crash::INIT
0000s0sSympa::Crash::::__ANON__[:60]Sympa::Crash::__ANON__[:60]
0000s0sSympa::Crash::::_crash_handlerSympa::Crash::_crash_handler
0000s0sSympa::Crash::::_default_hookSympa::Crash::_default_hook
0000s0sSympa::Crash::::importSympa::Crash::import
0000s0sSympa::Crash::::register_handlerSympa::Crash::register_handler
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# -*- indent-tabs-mode: nil; -*-
2# vim:ft=perl:et:sw=4
3# $Id$
4
5# Sympa - SYsteme de Multi-Postage Automatique
6#
7# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
8# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
9# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
10# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
11# Copyright 2019 The Sympa Community. See the AUTHORS.md file at
12# the top-level directory of this distribution and at
13# <https://github.com/sympa-community/sympa.git>.
14#
15# This program is free software; you can redistribute it and/or modify
16# it under the terms of the GNU General Public License as published by
17# the Free Software Foundation; either version 2 of the License, or
18# (at your option) any later version.
19#
20# This program is distributed in the hope that it will be useful,
21# but WITHOUT ANY WARRANTY; without even the implied warranty of
22# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23# GNU General Public License for more details.
24#
25# You should have received a copy of the GNU General Public License
26# along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28package Sympa::Crash;
29
30use strict;
31use warnings;
32use Carp qw();
33use Encode qw();
34use Scalar::Util qw();
35
36BEGIN {
37 no warnings;
38
39 *Carp::format_arg = sub {
40 my $arg = shift;
41
42 if (Scalar::Util::blessed($arg) and $arg->can('get_id')) {
43 $arg = sprintf('%s <%s>', ref $arg, $arg->get_id);
44 } elsif (ref $arg) {
45 $arg =
46 defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
47 } elsif (defined $arg) {
48 unless (Scalar::Util::looks_like_number($arg)) {
49 $arg = Carp::str_len_trim($arg, $Carp::MaxArgLen);
50 $arg =~ s/([\\\'])/\\$1/g;
51 $arg = "'$arg'";
52 }
53 } else {
54 $arg = 'undef';
55 }
56
57 $arg =~ s/([^\x20-\x7E])/sprintf "\\x{%x}", ord $1/eg;
58 Encode::_utf8_off($arg);
59 return $arg;
60 };
61}
62
63our $hook;
64
65sub import {
66 my $pkg = shift;
67 my %options = @_;
68
69 if (exists $options{Hook} and ref $options{Hook} eq 'CODE') {
70 $hook = $options{Hook};
71 }
72}
73
74INIT {
75 ## Register crash handler. This is done during INIT phase so that
76 ## compilation errors won't be captured.
77 register_handler();
78}
79
80sub register_handler {
81 $SIG{__DIE__} = \&_crash_handler;
82}
83
84# Handler for $SIG{__DIE__} to generate traceback.
85# IN : error message
86# OUT : none. This function exits with status 255 or (if invoked from inside
87# eval) simply returns.
88our @CARP_NOT = qw(Carp);
89
90sub _crash_handler {
91 return if $^S; # invoked from inside eval.
92
93 my $mess = "$_[0]";
94 chomp $mess;
95 $mess =~ s/\r\n|\r|\n/ /g;
96
97 local @CARP_NOT = qw(Carp);
98 my $longmess = Carp::longmess("DIED: $mess\n");
99 $longmess =~ s/(?<!\A)\n at \S+ line \d+\n/\n/;
100
101 # Cleanup.
102 # If any of corresponding modules have not been loaded, they are ignored.
103 eval { Sympa::Log->instance->syslog('err', 'DIED: %s', $mess); };
104 eval { Sympa::Spool::Listmaster->instance->flush(purge => 1); };
105 eval { Sympa::DatabaseManager->disconnect(); }; # unlock database
106 eval { Sys::Syslog::closelog(); }; # flush log
107 eval { Sympa::Log->instance->{level} = -1; }; # disable log
108
109 # Call hook
110 ($hook || \&_default_hook)->($_[0], $longmess);
111
112 # If hook returns
113 print STDERR $_[0];
114 exit 255;
115}
116
117sub _default_hook {
118 my ($mess, $longmess) = @_;
119
120 print STDERR $longmess;
121 exit 255;
122}
123
1241;
125__END__