source: XMLIO_V2/tools/FCM/examples/lib/FCM/Admin/Runner.pm @ 81

Last change on this file since 81 was 81, checked in by ymipsl, 11 years ago

ajout FCM 1.5

File size: 8.4 KB
Line 
1# ------------------------------------------------------------------------------
2# (C) Crown copyright Met Office. All rights reserved.
3# For further details please refer to the file COPYRIGHT.txt
4# which you should have received as part of this distribution.
5# ------------------------------------------------------------------------------
6
7use strict;
8use warnings;
9
10package FCM::Admin::Runner;
11
12use IO::Handle;
13
14# The default values of the attributes
15my %DEFAULT = (
16    exceptions     => [],
17    max_attempts   => 3,
18    retry_interval => 5,
19    stderr_handle  => \*STDERR,
20    stdout_handle  => \*STDOUT,
21);
22
23my $INSTANCE;
24
25# ------------------------------------------------------------------------------
26# Returns a unique instance of this class. Creates the instance on first call.
27sub instance {
28    my ($class) = @_;
29    if (!defined($INSTANCE)) {
30        $INSTANCE = bless({%DEFAULT}, $class);
31    }
32    return $INSTANCE;
33}
34
35# ------------------------------------------------------------------------------
36# Adds a new exception to the list of exceptions.
37sub _add_exception {
38    my ($self, $exception) = @_;
39    push(@{$self->get_exceptions()}, $exception);
40}
41
42# ------------------------------------------------------------------------------
43# Returns the list of exceptions (or a reference to the list in scalar context).
44sub get_exceptions {
45    my ($self) = @_;
46    return (wantarray() ? @{$self->{exceptions}} : $self->{exceptions});
47}
48
49# ------------------------------------------------------------------------------
50# Returns the latest exception in the exception list.
51sub get_latest_exception {
52    my ($self) = @_;
53    if (exists($self->get_exceptions()->[-1])) {
54        return $self->get_exceptions()->[-1];
55    }
56    else {
57        return;
58    }
59}
60
61# ------------------------------------------------------------------------------
62# Returns the maximum number of attempts for the "run_with_retries" method.
63sub get_max_attempts {
64    my ($self) = @_;
65    return $self->{max_attempts};
66}
67
68# ------------------------------------------------------------------------------
69# Returns the retry interval for the "run_with_retries" method.
70sub get_retry_interval {
71    my ($self) = @_;
72    return $self->{retry_interval};
73}
74
75# ------------------------------------------------------------------------------
76# Returns the file handle for STDERR.
77sub get_stderr_handle {
78    my ($self) = @_;
79    if (!IO::Handle::opened($self->{stderr_handle})) {
80        $self->{stderr_handle} = $DEFAULT{stderr_handle};
81    }
82    return $self->{stderr_handle};
83}
84
85# ------------------------------------------------------------------------------
86# Returns the file handle for STDOUT.
87sub get_stdout_handle {
88    my ($self) = @_;
89    if (!IO::Handle::opened($self->{stdout_handle})) {
90        $self->{stdout_handle} = $DEFAULT{stdout_handle};
91    }
92    return $self->{stdout_handle};
93}
94
95# ------------------------------------------------------------------------------
96# Runs $sub_ref->(@arguments) with a diagnostic $message. Dies on error.
97sub run {
98    my ($self, $message, $sub_ref, @arguments) = @_;
99    printf(
100        {$self->get_stdout_handle()}
101        qq{%s: %s\n},
102        scalar(localtime()), $message,
103    );
104    eval {
105        if (!$sub_ref->(@arguments)) {
106            die(qq{\n});
107        }
108    };
109    if ($@) {
110        my $e = $@;
111        chomp($e);
112        my $exception
113            = sprintf(qq{ERROR %s%s\n}, $message, ($e ? qq{ - $e} : qq{}));
114        $self->_add_exception($exception);
115        die($exception);
116    }
117    return 1;
118}
119
120# ------------------------------------------------------------------------------
121# Runs $sub_ref->(@arguments) with a diagnostic $message. Warns on error.
122sub run_continue {
123    my ($self, $message, $sub_ref, @arguments) = @_;
124    my $rc;
125    eval {
126        $rc = $self->run($message, $sub_ref, @arguments);
127    };
128    if ($@) {
129        print({$self->get_stderr_handle()} $@);
130        return;
131    }
132    return $rc;
133}
134
135# ------------------------------------------------------------------------------
136# Runs $sub_ref->(@arguments) with a diagnostic $message. Retries on error.
137sub run_with_retries {
138    my ($self, $message, $sub_ref, @arguments) = @_;
139    for my $i_attempt (1 .. $self->get_max_attempts()) {
140        my $attempt_message = sprintf(
141            qq{%s, attempt %d of %d},
142            $message, $i_attempt, $self->get_max_attempts(),
143        );
144        if ($i_attempt == $self->get_max_attempts()) {
145            return $self->run($attempt_message, $sub_ref, @arguments);
146        }
147        else {
148            if ($self->run_continue($attempt_message, $sub_ref, @arguments)) {
149                return 1;
150            }
151            sleep($self->get_retry_interval());
152        }
153    }
154}
155
156# ------------------------------------------------------------------------------
157# Sets the maximum number of attempts for the "run_with_retries" method.
158sub set_max_attempts {
159    my ($self, $value) = @_;
160    $self->{max_attempts} = $value;
161}
162
163# ------------------------------------------------------------------------------
164# Sets the retry interval for the "run_with_retries" method.
165sub set_retry_interval {
166    my ($self, $value) = @_;
167    $self->{retry_interval} = $value;
168}
169
170# ------------------------------------------------------------------------------
171# Sets the file handle for STDERR.
172sub set_stderr_handle {
173    my ($self, $value) = @_;
174    if (defined($value) && IO::Handle::opened($value)) {
175        $self->{stderr_handle} = $value;
176    }
177}
178
179# ------------------------------------------------------------------------------
180# Sets the file handle for STDOUT.
181sub set_stdout_handle {
182    my ($self, $value) = @_;
183    if (defined($value) && IO::Handle::opened($value)) {
184        $self->{stdout_handle} = $value;
185    }
186}
187
1881;
189__END__
190
191=head1 NAME
192
193FCM::Admin::Runner
194
195=head1 SYNOPSIS
196
197    $runner = FCM::Admin::Runner->instance();
198    $runner->run($message, sub { ... });
199
200=head1 DESCRIPTION
201
202Provides a simple way to run a piece of code with a time-stamped diagnostic
203message.
204
205=head1 METHODS
206
207=over 4
208
209=item FCM::Admin::Runner->instance()
210
211Returns a unique instance of FCM::Admin::Runner.
212
213=item $runner->get_exceptions()
214
215Returns a list containing all the exceptions captured by the previous
216invocations of the $runner->run() method. In SCALAR context, returns a reference
217to the list.
218
219=item $runner->get_latest_exception()
220
221Returns the latest exception captured by the $runner->run() method. Returns
222undef if there is no captured exception in the list.
223
224=item $runner->get_max_attempts()
225
226Returns the number of maximum retries for the
227$runner->run_with_retries($message,$sub_ref,@arguments) method. (Default: 3)
228
229=item $runner->get_retry_interval()
230
231Returns the interval (in seconds) between retries for the
232$runner->run_with_retries($message,$sub_ref,@arguments) method. (Default: 5)
233
234=item $runner->get_stderr_handle()
235
236Returns the file handle for standard error output. (Default: \*STDERR)
237
238=item $runner->get_stdout_handle()
239
240Returns the file handle for standard output. (Default: \*STDOUT)
241
242=item $runner->run($message,$sub_ref,@arguments)
243
244Prints the diagnostic $message and runs $sub_ref (with extra @arguments).
245Returns true if $sub_ref returns true. die() with a message that looks like
246"ERROR $message\n" if $sub_ref returns false or die().
247
248=item $runner->run_continue($message,$sub_ref,@arguments)
249
250Same as $runner->run($message,$sub_ref,@arguments), but only issue a warning
251(and returns false) if $sub_ref returns false or die().
252
253=item $runner->run_with_retries($message,$sub_ref,@arguments)
254
255Attempts $runner->run($message,$sub_ref,@arguments) for a number of times up to
256$runner->get_max_attempts(), with a delay of $runner->get_retry_interval()
257between each attempt. die() if $sub_ref still returns false in the final
258attempt. Returns true on success.
259
260=item $runner->set_max_attempts($value)
261
262Sets the maximum number of attempts in the
263$runner->run_with_retries($message,$sub_ref,@arguments) method.
264
265=item $runner->set_retry_interval($value)
266
267Sets the interval (in seconds) between retries for the
268$runner->run_with_retries($message,$sub_ref,@arguments) method.
269
270=item $runner->set_stderr_handle($value)
271
272Sets the file handle for standard error output to an alternate file handle. The
273$value must be a valid file descriptor.
274
275=item $runner->set_stdout_handle($value)
276
277Sets the file handle for standard output to an alternate file handle. The $value
278must be a valid file descriptor.
279
280=back
281
282=head1 COPYRIGHT
283
284E<169> Crown copyright Met Office. All rights reserved.
285
286=cut
Note: See TracBrowser for help on using the repository browser.