← 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:12 2021

Filename/usr/local/lib/perl5/site_perl/MIME/Tools.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMIME::Tools::::BEGIN@13MIME::Tools::BEGIN@13
0000s0sMIME::Tools::::BEGIN@14MIME::Tools::BEGIN@14
0000s0sMIME::Tools::::BEGIN@15MIME::Tools::BEGIN@15
0000s0sMIME::Tools::::BEGIN@8MIME::Tools::BEGIN@8
0000s0sMIME::Tools::::BEGIN@9MIME::Tools::BEGIN@9
0000s0sMIME::Tools::::configMIME::Tools::config
0000s0sMIME::Tools::::debugMIME::Tools::debug
0000s0sMIME::Tools::::debuggingMIME::Tools::debugging
0000s0sMIME::Tools::::errorMIME::Tools::error
0000s0sMIME::Tools::::quietMIME::Tools::quiet
0000s0sMIME::Tools::::textual_typeMIME::Tools::textual_type
0000s0sMIME::Tools::::tmpopenMIME::Tools::tmpopen
0000s0sMIME::Tools::::usageMIME::Tools::usage
0000s0sMIME::Tools::::versionMIME::Tools::version
0000s0sMIME::Tools::::whineMIME::Tools::whine
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package MIME::Tools;
2
3#------------------------------
4# Because the POD documentation is pretty extensive, it follows
5# the __END__ statement below...
6#------------------------------
7
8use strict;
9use vars (qw(@ISA %CONFIG @EXPORT_OK %EXPORT_TAGS $VERSION $ME
10 $M_DEBUG $M_WARNING $M_ERROR ));
11
12require Exporter;
13use IO::File;
14use File::Temp 0.18 ();
15use Carp;
16
17$ME = "MIME-tools";
18
19@ISA = qw(Exporter);
20
21# Exporting (importing should only be done by modules in this toolkit!):
22%EXPORT_TAGS = (
23 'config' => [qw(%CONFIG)],
24 'msgs' => [qw(usage debug whine error)],
25 'msgtypes'=> [qw($M_DEBUG $M_WARNING $M_ERROR)],
26 'utils' => [qw(textual_type tmpopen )],
27 );
28Exporter::export_ok_tags('config', 'msgs', 'msgtypes', 'utils');
29
30# The TOOLKIT version, both in 1.23 style *and* usable by MakeMaker:
31$VERSION = "5.509";
32
33# Configuration (do NOT alter this directly)...
34# All legal CONFIG vars *must* be in here, even if only to be set to undef:
35%CONFIG =
36 (
37 DEBUGGING => 0,
38 QUIET => 1,
39 );
40
41# Message-logging constants:
42$M_DEBUG = 'debug';
43$M_WARNING = 'warning';
44$M_ERROR = 'error';
45
- -
48#------------------------------
49#
50# CONFIGURATION... (see below)
51#
52#------------------------------
53
54sub config {
55 my $class = shift;
56 usage("config() is obsolete");
57
58 # No args? Just return list:
59 @_ or return keys %CONFIG;
60 my $method = lc(shift);
61 return $class->$method(@_);
62}
63
64sub debugging {
65 my ($class, $value) = @_;
66 $CONFIG{'DEBUGGING'} = $value if (@_ > 1);
67 return $CONFIG{'DEBUGGING'};
68}
69
70sub quiet {
71 my ($class, $value) = @_;
72 $CONFIG{'QUIET'} = $value if (@_ > 1);
73 return $CONFIG{'QUIET'};
74}
75
76sub version {
77 my ($class, $value) = @_;
78 return $VERSION;
79}
80
- -
83#------------------------------
84#
85# MESSAGES...
86#
87#------------------------------
88
89#------------------------------
90#
91# debug MESSAGE...
92#
93# Function, private.
94# Output a debug message.
95#
96sub debug {
97 print STDERR "$ME: $M_DEBUG: ", @_, "\n" if $CONFIG{DEBUGGING};
98}
99
100#------------------------------
101#
102# whine MESSAGE...
103#
104# Function, private.
105# Something doesn't look right: issue a warning.
106# Only output if $^W (-w) is true, and we're not being QUIET.
107#
108sub whine {
109 my $msg = "$ME: $M_WARNING: ".join('', @_)."\n";
110 warn $msg if ($^W && !$CONFIG{QUIET});
111 return (wantarray ? () : undef);
112}
113
114#------------------------------
115#
116# error MESSAGE...
117#
118# Function, private.
119# Something failed, but not so badly that we want to throw an
120# exception. Just report our general unhappiness.
121# Only output if $^W (-w) is true, and we're not being QUIET.
122#
123sub error {
124 my $msg = "$ME: $M_ERROR: ".join('', @_)."\n";
125 warn $msg if ($^W && !$CONFIG{QUIET});
126 return (wantarray ? () : undef);
127}
128
129#------------------------------
130#
131# usage MESSAGE...
132#
133# Register unhappiness about usage.
134#
135sub usage {
136 my ( $p, $f, $l, $s) = caller(1);
137 my ($cp, $cf, $cl, $cs) = caller(2);
138 my $msg = join('', (($s =~ /::/) ? "$s() " : "${p}::$s() "), @_, "\n");
139 my $loc = ($cf ? "\tin code called from $cf l.$cl" : '');
140
141 warn "$msg$loc\n" if ($^W && !$CONFIG{QUIET});
142 return (wantarray ? () : undef);
143}
144
- -
147#------------------------------
148#
149# UTILS...
150#
151#------------------------------
152
153#------------------------------
154#
155# textual_type MIMETYPE
156#
157# Function. Does the given MIME type indicate a textlike document?
158#
159sub textual_type {
160 ($_[0] =~ m{^(text|message)(/|\Z)}i);
161}
162
163#------------------------------
164#
165# tmpopen
166#
167#
168sub tmpopen
169{
170 my ($args) = @_;
171 $args ||= {};
172 return File::Temp->new( %{$args} );
173}
174
175#------------------------------
1761;
177__END__