perllib/FVWM/Tracker.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;
  18
  19 use 5.004;
  20 use strict;
  21
  22 use FVWM::Constants;
  23
  24 sub import ($@) {
  25         my $class = shift;
  26         my $caller = caller;
  27
  28         while (@_) {
  29                 my $name = shift;
  30                 if ($name eq 'base') {
  31                         next if UNIVERSAL::isa($caller, __PACKAGE__);
  32                         eval "
  33                                 package $caller;
  34                                 use vars qw(\@ISA);
  35                                 use FVWM::Constants;
  36                                 \@ISA = qw(FVWM::Tracker);
  37                         ";
  38                         if ($@) {
  39                                 die "Internal error:\n$@";
  40                         }
  41                 }
  42         }
  43 }
  44
  45 sub new ($$) {
  46         my $class = shift;
  47         my $module = shift;
  48         die "$class: no FVWM::Module object given in constructor\n"
  49                 unless UNIVERSAL::isa($module, "FVWM::Module");
  50         my $self = {
  51                 module => $module,
  52                 data   => undef,
  53                 active => 0,
  54                 handler_types => {},
  55                 handler_ids => {},
  56                 observers => {},
  57         };
  58         bless $self, $class;
  59
  60         return $self;
  61 }
  62
  63 sub masks ($) {
  64         my $self = shift;
  65         my $mask = 0;
  66         my $xmask = 0;
  67         while (my ($id, $type) = each %{$self->{handler_types}}) {
  68                 (($type & M_EXTENDED_MSG) ? $xmask : $mask) |= $type;
  69         }
  70         $self->internal_die("Inactive mask is not zero")
  71                 unless $self->{active} || !$mask && !$xmask;
  72         my @list = ($mask, $xmask);
  73         return wantarray ? @list : \@list;
  74 }
  75
  76 sub add_handler ($$$) {
  77         my $self = shift;
  78         my $type = shift;
  79         my $handler = shift;
  80
  81         my $handler_id = $self->{module}->add_handler($type, $handler, 1);
  82         $self->{handler_types}->{$handler_id} = $type;
  83         $self->{handler_ids}->{$handler_id} = $handler_id;
  84         return $handler_id;
  85 }
  86
  87 sub delete_handlers ($;$) {
  88         my $self = shift;
  89         my $handler_ids = ref($_[0]) eq 'ARRAY'
  90                 ? shift() : [ keys %{$self->{handler_ids}} ];
  91
  92         foreach (@$handler_ids) {
  93                 next unless defined delete $self->{handler_types}->{$_};
  94                 my $handler_id = delete $self->{handler_ids}->{$_}
  95                         or die "Internal #1";
  96                 if ($self->{module}) {
  97                         $self->{module}->delete_handler($handler_id)
  98                                 or die "Internal #2";
  99                 }
 100         }
 101 }
 102
 103 sub observe ($$;$) {
 104         my $self = shift;
 105         my $observable = ref($_[0]) eq "" ? shift : "main";
 106         my $callback = shift;
 107
 108         my $observables = $self->observables;
 109         $observable = $observables->[0] if $observable eq "main";
 110
 111         $self->{module}->debug(qq(observe "$observable"), 3);
 112         # TODO: check observable existence
 113
 114         $self->{observers}->{$observable} ||= [];
 115         push @{$self->{observers}->{$observable}}, $callback;
 116
 117         return [ $observable, @{$self->{observers}->{$observable}} - 1 ];
 118 }
 119
 120 sub unobserve ($;$$) {
 121         my $self = shift;
 122         my $observable = ref($_) eq "" ? shift : "*";
 123         my $observer_id = shift || "*";
 124
 125         ### TODO
 126         #$self->{observers}->{$observable} = [];
 127 }
 128
 129 sub notify ($$@) {
 130         my $self = shift;
 131         my $observable = shift;
 132
 133         my $observables = $self->observables;
 134         $observable = $observables->[0] if $observable eq "main";
 135
 136         $self->{module}->debug(qq(notify "$observable"), 3);
 137         # TODO: check observable existence
 138
 139         my @callbacks = ();
 140         push @callbacks, @{$self->{observers}->{$observable}}
 141                 if exists $self->{observers}->{$observable};
 142         push @callbacks, @{$self->{observers}->{'all'}}
 143                 if exists $self->{observers}->{'all'} && $observable ne 'all';
 144
 145         foreach (@callbacks) {
 146                 $_->($self->{module}, $self, $self->data, @_);
 147         }
 148 }
 149
 150 sub start ($) {
 151         my $self = shift;
 152         return if $self->{active};
 153
 154         $self->{active} = 1;
 155
 156         $self->{module}->FVWM::Module::event_loop(1)
 157                 if %{$self->{handler_ids}};
 158
 159         return $self->data;
 160 }
 161
 162 sub stop ($) {
 163         my $self = shift;
 164         return unless $self->{active};
 165         $self->delete_handlers;
 166         $self->{active} = 0;
 167 }
 168
 169 sub restart ($) {
 170         my $self = shift;
 171         $self->stop;
 172         $self->start;
 173 }
 174
 175 sub to_be_disconnected ($) {
 176 }
 177
 178 sub data ($) {
 179         my $self = shift;
 180         return $self->{data};
 181 }
 182
 183 sub dump ($) {
 184         my $self = shift;
 185         return "";
 186 }
 187
 188 sub request_windowlist_events ($) {
 189         my $self = shift;
 190         my $module = $self->{module};
 191         warn "request_windowlist_events() called after start()" if $self->{active};
 192
 193         $self->add_handler(M_END_WINDOWLIST, sub { $_[0]->terminate; });
 194         $module->emulate_event(M_END_WINDOWLIST, []) if $module->is_dummy;
 195         $module->postpone_send("Send_WindowList");
 196 }
 197
 198 sub request_configinfo_events ($;$) {
 199         my $self = shift;
 200         my $name = shift;
 201         my $module = $self->{module};
 202         warn "request_configinfo_events() called after start()" if $self->{active};
 203
 204         $self->add_handler(M_END_CONFIG_INFO, sub { $_[0]->terminate; });
 205         $module->emulate_event(M_END_CONFIG_INFO, []) if $module->is_dummy;
 206         $module->postpone_send("Send_ConfigInfo" . ($name ? " *$name" : ""));
 207 }
 208
 209 sub internal_die ($$) {
 210         my $self = shift;
 211         my $msg = shift;
 212         my $class = ref($self);
 213         $self->{module}->internal_die("$class: $msg")
 214 }
 215
 216 sub DESTROY ($) {
 217         my $self = shift;
 218         $self->stop;
 219 }
 220
 221 # class method, should be overwritten
 222 sub observables ($) {
 223         return [];
 224 }
 225
 226 use vars qw($AUTOLOAD);
 227
 228 # support old API, like addHandler, dispatch to add_handler
 229 sub AUTOLOAD ($;@) {
 230         my $self = shift;
 231         my @params = @_;
 232
 233         my $autoload_method = $AUTOLOAD;
 234         my $method = $autoload_method;
 235
 236         # remove the package name
 237         $method =~ s/.*://g;
 238
 239         $method =~ s/XMask/Xmask/;
 240         $method =~ s/([a-z])([A-Z])/${1}_\L$2/g;
 241
 242         die "No method $method in $self as guessed from $autoload_method"
 243                 unless $self->can($method);
 244
 245         $self->$method(@params);
 246 }
 247
 248 1;
 249
 250 __END__
 251
 252 =head1 DESCRIPTION
 253
 254 Tracker is an object that automatically listens to certain fvwm events and
 255 gathers an information in the background.
 256
 257 When a tracker is created it may enter its own event loop to gather an
 258 initial data, so the returned tracker object already has the initial data.
 259 It also continues to update the data automatically until it is stopped.
 260
 261 This package is a superclass for the concrete tracker implementations.
 262 It defines the common Tracker API, including a way to access the tracked data
 263 and to define high level events for the tracker caller to observe.
 264
 265 =head1 SYNOPSYS
 266
 267 Using B<FVWM::Module> $module object:
 268
 269     my $tracker = $module->track("TrackerName", @params);
 270     my $initial_data = $tracker->data;
 271     $tracker->observe("observable1", sub { shift->data });
 272     $tracker->observe("observable2", sub { shift->stop });
 273
 274 In the future this syntax will probably work too:
 275
 276     my $tracker = new FVWM::Tracker::TrackerName($module, @params);
 277     my $initial_data = $tracker->start;
 278     $tracker->observe("observable1", sub { shift->data });
 279     $tracker->observe("observable2", sub { shift->stop });
 280
 281 =head1 PUBLIC METHODS
 282
 283 =over 4
 284
 285 =item B<start>
 286
 287 Makes the tracker actually work, i.e. listen to I<fvwm> events,
 288 gather data and forms high level events, so called observables.
 289
 290 This method is usually automatically called when the tracker is created
 291 unless specifically asked not to.
 292
 293 =item B<stop>
 294
 295 Stops the tracker activity. The corresponding I<fvwm> events are not listened,
 296 data is not updated and no observers called.
 297
 298 To return the tracker to the normal activity, call B<start> method.
 299
 300 =item B<restart>
 301
 302 This is a shortcut method to B<stop> and then B<start> the tracker.
 303 The following scenatio is possible. You start the tracker, read its
 304 data and immediately stop it (to reduce event tracker to the module).
 305 At some point you may want to read the updated data, so you restart the
 306 tracker and optionally stop it again.
 307
 308 Note that no observers are removed during B<stop>, so the tracker
 309 theoretically may be restarted without any side effect even if some
 310 observers are defined.
 311
 312 =item B<observe> [I<observable>] I<observer-callback>
 313
 314 Defines an observer that will be called every time the tracker I<observable>
 315 happens. The I<observer-callback> is a CODE reference that gets the
 316 following parameters: $module (B<FVWM::Module> object), $tracker (this object),
 317 $data (the same as returned by B<data> method) and optional observable
 318 parameters that are specific to this I<observable>.
 319
 320 A special I<observable> value "main" means the first observable defined
 321 in the tracker, it is the default value when no I<observable> is given.
 322
 323 =item B<unobserve> [I<observable> [I<observer-id>]]
 324
 325 Stops an observing using the I<observer-id> that is returned by B<observe>
 326 method.
 327
 328 A special I<observable> value "main" means the first observable defined
 329 in the tracker. A special I<observable> value "*" means all defined
 330 observables.
 331
 332 =item B<data>
 333
 334 Returns the whole data collected by the tracker.
 335
 336 Usually subclasses add an optional parameter I<key> that limits the whole
 337 data to the given key.
 338
 339 =item B<dump>
 340
 341 Returns the string representing the whole tracker data in the human readable
 342 form, useful for debugging.
 343
 344 Usually subclasses add an optional parameter I<key> that limits the whole
 345 data to the given key.
 346
 347 =back
 348
 349 =head1 METHODS FOR SUBCLASSES
 350
 351 =over 4
 352
 353 =item B<observables>
 354
 355 A subclass should define a list of observables that a caller may listen to
 356 using B<observe> method. It is the subclass responsiblity to actually signal
 357 every observable listed using B<notify> method.
 358
 359 Returns a reference to a string array.
 360
 361 =item B<new> I<module> I<param-hash>
 362
 363 This superclass method should be called by subclasses.
 364 Please do not use this class method in programs, use the first syntax shown
 365 in the I<SYNOPSYS> section instead.
 366
 367 I<module> is an B<FVWM::Module> instance.
 368 I<param-hash> is specific to the concrete Tracker class.
 369
 370 =item B<add_handler> I<type> I<handler>
 371
 372 A wrapper to B<FVWM::Module>::B<add_handler>, has the same syntax, but stores
 373 all handlers so they may be deleted at once using B<delete_handlers>.
 374
 375 =item B<delete_handlers> [I<handler-ids>]
 376
 377 Deletes all handlers defined using add_handler or the ones specified
 378 using an optional I<handler-ids> array ref.
 379
 380 =item B<notify> I<observable> [I<observable-params>]
 381
 382 Notifies all listeners that were defined using B<observe>, by calling their
 383 observer function with the following parameters: $module, $tracker, $data,
 384 I<observable-params>.
 385
 386 =item B<request_windowlist_events>
 387
 388 Subclasses that work using I<fvwm> events sent in responce to
 389 B<Send_WindowList> command should call this shortcut method.
 390 Automatically sends the needed command (after the tracker event mask is
 391 counted) and defines a handler that terminates the initial tracker event
 392 loop in response to I<M_END_WINDOWLIST> event.
 393
 394 =item B<request_configinfo_events>
 395
 396 Subclasses that work using I<fvwm> events sent in responce to
 397 B<Send_ConfigInfo> command should call this shortcut method.
 398 Automatically sends the needed command (after a tracker event mask is
 399 counted) and defines a handler that terminates the initial tracker event
 400 loop in response to I<M_END_CONFIG_INFO> event.
 401
 402 =item B<internal_die>
 403
 404 Subclasses may call this method when something wrong happens.
 405 This is a wrapper to B<FVWM::Module>::B<internal_die>.
 406
 407 =item B<to_be_disconnected>
 408
 409 Does nothing by default. Subclasses may implement this method if something
 410 should be sent to I<fvwm> just before the module disconnects itself.
 411
 412 =back
 413
 414 =head1 AUTHOR
 415
 416 Mikhael Goikhman <migo@homemail.com>.
 417
 418 =head1 SEE ALSO
 419
 420 For more information, see L<FVWM::Module> and the concrete tracker
 421 implementations: L<FVWM::Tracker::Colorsets>, L<FVWM::Tracker::GlobalConfig>,
 422 L<FVWM::Tracker::ModuleConfig>, L<FVWM::Tracker::PageInfo>,
 423 L<FVWM::Tracker::Scheduler>, L<FVWM::Tracker::WindowList>.
 424
 425 =cut