/usr/share/perl5/IO/Async/Timer.pm is in libio-async-perl 0.61-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 181 182 183 184 185 186 187 | # You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2009-2012 -- leonerd@leonerd.org.uk
package IO::Async::Timer;
use strict;
use warnings;
use base qw( IO::Async::Notifier );
our $VERSION = '0.61';
use Carp;
=head1 NAME
C<IO::Async::Timer> - base class for Notifiers that use timed delays
=head1 DESCRIPTION
This module provides a subclass of L<IO::Async::Notifier> for implementing
notifiers that use timed delays. For specific implementations, see one of the
subclasses:
=over 8
=item *
L<IO::Async::Timer::Absolute> - event callback at a fixed future time
=item *
L<IO::Async::Timer::Countdown> - event callback after a fixed delay
=item *
L<IO::Async::Timer::Periodic> - event callback at regular intervals
=back
=cut
=head1 CONSTRUCTOR
=cut
=head2 $timer = IO::Async::Timer->new( %args )
Constructs a particular subclass of C<IO::Async::Timer> object, and returns
it. This constructor is provided for backward compatibility to older code
which doesn't use the subclasses. New code should directly construct a
subclass instead.
=over 8
=item mode => STRING
The type of timer to create. Currently the only allowed mode is C<countdown>
but more types may be added in the future.
=back
Once constructed, the C<Timer> will need to be added to the C<Loop> before it
will work. It will also need to be started by the C<start> method.
=cut
sub new
{
my $class = shift;
my %args = @_;
if( my $mode = delete $args{mode} ) {
# Might define some other modes later
$mode eq "countdown" or croak "Expected 'mode' to be 'countdown'";
require IO::Async::Timer::Countdown;
return IO::Async::Timer::Countdown->new( %args );
}
return $class->SUPER::new( %args );
}
sub _add_to_loop
{
my $self = shift;
$self->start if delete $self->{pending};
}
sub _remove_from_loop
{
my $self = shift;
$self->stop;
}
=head1 METHODS
=cut
=head2 $running = $timer->is_running
Returns true if the Timer has been started, and has not yet expired, or been
stopped.
=cut
sub is_running
{
my $self = shift;
defined $self->{id};
}
=head2 $timer->start
Starts the Timer. Throws an error if it was already running.
If the Timer is not yet in a Loop, the actual start will be deferred until it
is added. Once added, it will be running, and will expire at the given
duration after the time it was added.
As a convenience, C<$timer> is returned. This may be useful for starting
timers at construction time:
$loop->add( IO::Async::Timer->new( ... )->start );
=cut
sub start
{
my $self = shift;
my $loop = $self->loop;
if( !defined $loop ) {
$self->{pending} = 1;
return $self;
}
defined $self->{id} and croak "Cannot start a Timer that is already running";
if( !$self->{cb} ) {
$self->{cb} = $self->_make_cb;
}
$self->{id} = $loop->watch_time(
$self->_make_enqueueargs,
code => $self->{cb},
);
return $self;
}
=head2 $timer->stop
Stops the Timer if it is running. If it has not yet been added to the C<Loop>
but there is a start pending, this will cancel it.
=cut
sub stop
{
my $self = shift;
if( $self->{pending} ) {
delete $self->{pending};
return;
}
return if !$self->is_running;
my $loop = $self->loop or croak "Cannot stop a Timer that is not in a Loop";
defined $self->{id} or return; # nothing to do but no error
$loop->unwatch_time( $self->{id} );
undef $self->{id};
}
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
0x55AA;
|