perllib/FVWM/Tracker/Scheduler.pm

   1 # Copyright (c) 2003-2009 Mikhael Goikhman
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16
  17 package FVWM::Tracker::Scheduler;
  18
  19 use strict;
  20
  21 use FVWM::Tracker qw(base);
  22
  23 sub observables ($) {
  24         return [
  25                 "scheduled alarm",
  26         ];
  27 }
  28
  29 sub new ($$%) {
  30         my $class = shift;
  31         my $module = shift;
  32         my %params = @_;
  33
  34         my $self = $class->FVWM::Tracker::new($module);
  35
  36         $self->{random_base_number} = 8000000 + int(rand(900000));
  37         $self->{sent_string_prefix} = "FVWM::Tracker::Scheduler alarm ";
  38         $self->{module_name} = $params{ModuleName} || $self->{module}->name;
  39         $self->{use_alarm} = (exists $params{UseAlarm}
  40                 ? $params{UseAlarm} : $module->is_dummy) ? 1 : 0;
  41
  42         return $self;
  43 }
  44
  45 sub start ($) {
  46         my $self = shift;
  47
  48         $self->{data} = {};
  49
  50         my $result = $self->SUPER::start;
  51
  52         $self->{internal_observer_id} ||= $self->observe(sub {
  53                 my $schedule_id = $_[3];
  54                 my $schedule_data = $self->data($schedule_id);
  55                 $self->{rescheduled_seconds} = -1;
  56
  57                 &{$schedule_data->{callback}}($schedule_data, @{$schedule_data->{params}});
  58
  59                 my $new_seconds = $self->{rescheduled_seconds};
  60                 if ($new_seconds >= 0) {
  61                         $schedule_data->{seconds} = $new_seconds if $new_seconds;
  62                         $self->send_schedule($schedule_id);
  63                 } else {
  64                         $self->deschedule($schedule_id);
  65                 }
  66         });
  67
  68         $self->add_handler(M_STRING, sub {
  69                 my $event = $_[1];
  70                 my $text = $event->_text;
  71                 return unless $text =~ /^$self->{sent_string_prefix}(\d+)/;
  72                 $self->notify("main", $1);
  73         });
  74
  75         return $result;
  76 }
  77
  78 sub stop ($) {
  79         my $self = shift;
  80
  81         $self->SUPER::stop;
  82         $self->deschedule_all;
  83 }
  84
  85 sub send_schedule ($$) {
  86         my $self = shift;
  87         my $schedule_id = shift;
  88         my $sd = $self->{data}->{$schedule_id};
  89
  90         my $string = "$self->{sent_string_prefix}$schedule_id";
  91         if ($self->{use_alarm}) {
  92                 $SIG{ALRM} = sub {
  93                         $self->{module}->emulate_event(M_STRING, [ 0, 0, 0, $string ]);
  94                 };
  95                 alarm($sd->{seconds});
  96         } else {
  97                 my $mseconds = $sd->{seconds} * 1000;
  98                 $self->{module}->send("Schedule $mseconds $sd->{fvwm_id} "
  99                         . "SendToModule $self->{module_name} $string");
 100         }
 101         $sd->{time_sent} = time();
 102 }
 103
 104 sub schedule ($$$;$) {
 105         my $self = shift;
 106         my $seconds = shift || $self->internal_die("schedule: no seconds");
 107         my $callback = shift || $self->internal_die("schedule: no callback");
 108
 109         my $schedule_id = ++$self->{last_schedule_num};
 110         my $fvwm_id = $self->{random_base_number} + $schedule_id;
 111         my $schedule_data = {
 112                 time_sent => 0,
 113                 seconds   => $seconds,
 114                 fvwm_id   => $fvwm_id,
 115                 callback  => $callback,
 116                 params    => [ @_ ],
 117         };
 118
 119         $self->{data}->{$schedule_id} = $schedule_data;
 120         $self->send_schedule($schedule_id);
 121
 122         return $schedule_id;
 123 }
 124
 125 sub deschedule ($$) {
 126         my $self = shift;
 127         my $schedule_id = shift;
 128         my $data = $self->{data};
 129         next unless exists $data->{$schedule_id};
 130         my $fvwm_id = $data->{$schedule_id}->{fvwm_id};
 131
 132         $self->{module}->send("Deschedule $fvwm_id")
 133                 if defined $self->{module};  # ready for DESTROY
 134         delete $data->{$schedule_id};
 135 }
 136
 137 sub reschedule ($;$) {
 138         my $self = shift;
 139         my $seconds = shift || 0;
 140         $self->{rescheduled_seconds} = $seconds;
 141 }
 142
 143 sub deschedule_all ($) {
 144         my $self = shift;
 145         my $data = $self->{data};
 146         foreach (keys %$data) {
 147                 $self->deschedule($_);
 148         }
 149 }
 150
 151 sub to_be_disconnected ($) {
 152         my $self = shift;
 153         $self->deschedule_all();
 154 }
 155
 156 sub data ($;$) {
 157         my $self = shift;
 158         my $schedule_id = shift;
 159         my $data = $self->{data};
 160         return $data unless defined $schedule_id;
 161         return $data->{$schedule_id};
 162 }
 163
 164 sub dump ($;$) {
 165         my $self = shift;
 166         my $schedule_id = shift;
 167         my $data = $self->{data};
 168         my @ids = $schedule_id ? $schedule_id : sort { $a <=> $b } keys %$data;
 169
 170         my $string = "";
 171         foreach (@ids) {
 172                 my $sd = $data->{$_};
 173                 my $time_str = localtime($sd->{time_sent});
 174                 $time_str = "$5-$2-$3 $4" if $time_str =~ /^([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+)$/;
 175
 176                 $string .= "Schedule $_: $time_str + $sd->{seconds} sec, use 'Deschedule $sd->{fvwm_id}'\n";
 177         }
 178         return $string;
 179 }
 180
 181 1;
 182
 183 __END__
 184
 185 =head1 DESCRIPTION
 186
 187 This is a subclass of B<FVWM::Tracker> that enables to define alarm callback,
 188 several at the same time.
 189
 190 This tracker defines the following observables:
 191
 192     "scheduled alarm"
 193
 194 But it is suggested not to use the usual tracker B<observe>/B<unobserve> API,
 195 but to use the B<schedule>/B<deschedule>/B<reschedule> API instead.
 196
 197 This tracker uses the I<fvwm> command B<Schedule> to get a notification.
 198 It is possible to use the perl I<alarm>. This is the default if the module
 199 is run in the dummy mode. To set it explicitly, pass I<UseAlarm> boolean
 200 value when the tracker is created. Note that alarm signals are not relable
 201 in some perl versions, on some systems and with some kind of applications,
 202 don't expect the alarm method to work at all.
 203
 204 =head1 SYNOPSYS
 205
 206 Using B<FVWM::Module> $module object:
 207
 208     # beep every 40 seconds; exit in 100 seconds
 209
 210     my $scheduler = $module->track("Scheduler");
 211     $scheduler->schedule(40,
 212         sub { $module->send("Beep"); $scheduler->reschedule; });
 213     $scheduler->schedule(100, sub { $module->terminate; });
 214
 215 =head1 PUBLIC METHODS
 216
 217 =over 4
 218
 219 =item B<schedule> I<seconds> I<callback> [I<params>]
 220
 221 Sets the alarm I<callback> that is called in about I<seconds> seconds.
 222
 223 The I<callback> parameters are: hash as returned using B<data> when called
 224 with the I<scheduled-id> parameter, and optional I<params>.
 225
 226 Returns I<scheduled-id> that may be used in B<deschedule> or B<data>.
 227
 228 =item B<deschedule> I<scheduled-id>
 229
 230 Removes the scheduled callback identified by I<scheduled-id>.
 231
 232 =item B<reschedule> [I<seconds>]
 233
 234 When the scheduled callback is called, it is possible to reinitialize the
 235 same callback using the same or different number of I<seconds>.
 236
 237 This may be useful when defining a periodical callback that should be,
 238 say, called every 10 minutes (600 seconds).
 239
 240 =item deschedule_all
 241
 242 Removes all previously scheduled callbacks.
 243
 244 =back
 245
 246 =head1 OVERRIDDEN METHODS
 247
 248 =over 4
 249
 250 =item to_be_disconnected
 251
 252 Calls B<deschedule_all>.
 253
 254 =item B<data> [I<sheduled-id>]
 255
 256 Returns either array ref of hash refs, or one hash ref if
 257 I<sheduled-id> is given. The hash keys are:
 258
 259     time_sent  - unix time (seconds since 1970)
 260     seconds    - requested alarm seconds
 261     fvwm_id    - internal I<fvwm>'s Schedule id
 262     callback   - alarm callback, CODE ref
 263     params     - ARRAY ref of optional callback parameters
 264
 265 =item B<dump> [I<sheduled-id>]
 266
 267 Works similarly to B<data>, but returns one or many debug lines (one line
 268 per scheduled alarm).
 269
 270 If no scheduled callbacks are active, the empty string is returned as expected.
 271
 272 =back
 273
 274 =head1 AUTHOR
 275
 276 Mikhael Goikhman <migo@homemail.com>.
 277
 278 =head1 SEE ALSO
 279
 280 For more information, see L<FVWM::Module> and L<FVWM::Tracker>.
 281
 282 =cut