1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
###########################################################################
#
# Callback.pm
#
# Copyright (C) 1999 Raphael Manfredi.
# Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org;
# all rights reserved.
#
# See the README file included with the
# distribution for license information.
#
##########################################################################
use strict;
########################################################################
package Log::Agent::Tag::Callback;
require Log::Agent::Tag;
use vars qw(@ISA);
@ISA = qw(Log::Agent::Tag);
#
# ->make
#
# Creation routine.
#
# Calling arguments: a hash table list.
#
# The keyed argument list may contain:
# -POSTFIX whether to postfix log message or prefix it.
# -SEPARATOR separator string to use between tag and message
# -NAME tag's name (optional)
# -CALLBACK Callback object
#
# Attributes:
# callback the Callback object
#
sub make {
my $self = bless {}, shift;
my (%args) = @_;
my ($name, $postfix, $separator, $callback);
my %set = (
-name => \$name,
-callback => \$callback,
-postfix => \$postfix,
-separator => \$separator,
);
while (my ($arg, $val) = each %args) {
my $vset = $set{lc($arg)};
next unless ref $vset;
$$vset = $val;
}
unless (defined $callback) {
require Carp;
Carp::croak("Argument -callback is mandatory");
}
unless (ref $callback && $callback->isa("Callback")) {
require Carp;
Carp::croak("Argument -callback needs a Callback object");
}
$self->_init($name, $postfix, $separator);
$self->{callback} = $callback;
return $self;
}
#
# Attribute access
#
sub callback { $_[0]->{callback} }
#
# Defined routines
#
#
# ->string -- defined
#
# Build tag string by invoking callback.
#
sub string {
my $self = shift;
#
# Avoid recursion, which could happen if another logxxx() call is made
# whilst within the callback.
#
# Assumes mono-threaded application.
#
return sprintf 'callback "%s" busy', $self->name if $self->{busy};
$self->{busy} = 1;
my $string = $self->callback->call();
$self->{busy} = 0;
return $string;
}
1; # for "require"
__END__
=head1 NAME
Log::Agent::Tag::Callback - a dynamic tag string
=head1 SYNOPSIS
require Log::Agent::Tag::Callback;
# Inherits from Log::Agent::Tag.
my $tag = Log::Agent::Tag::Callback->make(
-name => "session id",
-callback => Callback->new($obj, 'method', @args),
-postfix => 1,
-separator => " -- ",
);
=head1 DESCRIPTION
This class represents a dynamic tag string, whose value is determined
by invoking a pre-determined callback, which is described by a C<Callback>
object.
You need to make your application depend on the C<Callback> module from CPAN
if you make use of this tagging feature, since C<Log::Agent> does not
depend on it, on purpose (it does not really use it, it only offers an
interface to plug it in). At least version 1.02 must be used.
=head1 CREATION ROUTINE PARAMETERS
The following parameters are defined, in alphabetical order:
=over 4
=item C<-callback> => C<Callback> I<object>
The callback to invoke to determine the value of the tag. The call is
protected via a I<busy> flag, in case there is an unwanted recursion due
to a call to one of the logging routines whilst within the callback.
If the callback is busy, the tag emitted is:
callback "user" busy
assuming C<user> is the name you supplied via C<-name> for this tag.
=item C<-name> => I<name>
The name of this tag. Used to flag a callback as I<busy> in case there is
an unwanted recursion into the callback routine.
=item C<-postfix> => I<flag>
Whether tag should be placed after or before the log message.
By default, it is prepended to the log message, i.e. this parameter is false.
=item C<-separator> => I<string>
The separation string between the tag and the log message.
A single space by default.
=back
=head1 AUTHOR
Raphael Manfredi F<E<lt>Raphael_Manfredi@pobox.comE<gt>>
=head1 SEE ALSO
Callback(3), Log::Agent::Tag(3), Log::Agent::Message(3).
=cut
|
