source: perl/lib/BarnOwl.pm @ ecd4edf

Last change on this file since ecd4edf was ecd4edf, checked in by Edward Z. Yang <ezyang@mit.edu>, 8 years ago
Added perl methods to register and unregister idle watchers.
  • Property mode set to 100644
File size: 23.7 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl;
5
6use base qw(Exporter);
7our @EXPORT_OK = qw(command getcurmsg getnumcols getnumlines getidletime
8                    register_idle_watcher unregister_idle_watcher
9                    zephyr_getsender zephyr_getrealm zephyr_zwrite
10                    zephyr_stylestrip zephyr_smartstrip_user zephyr_getsubs
11                    queue_message admin_message
12                    start_edit
13                    start_question start_password start_edit_win
14                    get_data_dir get_config_dir popless_text popless_ztext
15                    error debug
16                    create_style getnumcolors wordwrap
17                    message_matches_filter
18                    add_dispatch remove_dispatch
19                    add_io_dispatch remove_io_dispatch
20                    new_command
21                    new_variable_int new_variable_bool new_variable_string
22                    new_variable_enum
23                    quote redisplay);
24our %EXPORT_TAGS = (all => \@EXPORT_OK);
25
26BEGIN {
27# bootstrap in C bindings and glue
28    *owl:: = \*BarnOwl::;
29    bootstrap BarnOwl 1.2;
30};
31
32use lib(get_data_dir() . "/lib");
33use lib(get_config_dir() . "/lib");
34
35use Glib;
36use AnyEvent;
37
38use BarnOwl::Hook;
39use BarnOwl::Hooks;
40use BarnOwl::Message;
41use BarnOwl::Style;
42use BarnOwl::Zephyr;
43use BarnOwl::Timer;
44use BarnOwl::Editwin;
45use BarnOwl::Completion;
46use BarnOwl::Help;
47
48use List::Util qw(max);
49use Tie::RefHash;
50
51=head1 NAME
52
53BarnOwl
54
55=head1 DESCRIPTION
56
57The BarnOwl module contains the core of BarnOwl's perl
58bindings. Source in this module is also run at startup to bootstrap
59BarnOwl by defining things like the default style.
60
61=for NOTE
62These following functions are defined in perlglue.xs. Keep the
63documentation here in sync with the user-visible commands defined
64there!
65
66=head2 command STRING
67
68Executes a BarnOwl command in the same manner as if the user had
69executed it at the BarnOwl command prompt. If the command returns a
70value, return it as a string, otherwise return undef.
71
72=head2 getcurmsg
73
74Returns the current message as a C<BarnOwl::Message> subclass, or
75undef if there is no message selected
76=head2 getnumcols
77
78Returns the width of the display window BarnOwl is currently using
79
80=head2 getidletime
81
82Returns the length of time since the user has pressed a key, in
83seconds.
84
85=head2 zephyr_getrealm
86
87Returns the zephyr realm BarnOwl is running in
88
89=head2 zephyr_getsender
90
91Returns the fully-qualified name of the zephyr sender BarnOwl is
92running as, e.g. C<nelhage@ATHENA.MIT.EDU>
93
94=head2 zephyr_zwrite COMMAND MESSAGE
95
96Sends a zephyr programmatically. C<COMMAND> should be a C<zwrite>
97command line, and C<MESSAGE> is the zephyr body to send.
98
99=cut
100
101sub zephyr_zwrite {
102    my ($command, $message) = @_;
103    my $ret = BarnOwl::Internal::zephyr_zwrite($command, $message);
104    die "Error sending zephyr" unless $ret == 0;
105}
106
107=head2 ztext_stylestrip STRING
108
109Strips zephyr formatting from a string and returns the result
110
111=head2 zephyr_getsubs
112
113Returns the list of subscription triples <class,instance,recipient>,
114separated by newlines.
115
116=head2 queue_message MESSAGE
117
118Enqueue a message in the BarnOwl message list, logging it and
119processing it appropriately. C<MESSAGE> should be an instance of
120BarnOwl::Message or a subclass.
121
122=head2 admin_message HEADER BODY
123
124Display a BarnOwl B<Admin> message, with the given header and body.
125
126=head2 start_edit %ARGS
127
128Displays a prompt on the screen and lets the user enter text,
129and calls a callback when the editwin is closed.
130
131C<%ARGS> must contain the following keys:
132
133=over 4
134
135=item prompt
136
137The line to display on the screen
138
139=item type
140
141One of:
142
143=over 4
144
145=item edit_win
146
147Displays the prompt on a line of its own and opens the edit_win.
148
149=item question
150
151Displays prompt on the screen and lets the user enter a line of
152text.
153
154=item password
155
156Like question, but echoes the user's input as C<*>s when they
157input.
158
159=back
160
161=item callback
162
163A Perl subroutine that is called when the user closes the edit_win.
164C<CALLBACK> gets called with two parameters: the text the user entered,
165and a C<SUCCESS> boolean parameter which is false if the user canceled
166the edit_win and true otherwise.
167
168=back
169
170=head2 start_question PROMPT CALLBACK
171
172=head2 start_password PROMPT CALLBACK
173
174=head2 start_edit_win PROMPT CALLBACK
175
176Roughly equivalent to C<start_edit> called with the appropriate parameters.
177C<CALLBACK> is only called on success, for compatibility.
178
179These are deprecated wrappers around L<BarnOwl::start_edit>, and should not
180be uesd in new code.
181
182=cut
183
184sub start_edit {
185    my %args = (@_);
186    BarnOwl::Internal::start_edit($args{type}, $args{prompt}, $args{callback});
187}
188
189sub start_question {
190    my ($prompt, $callback) = @_;
191    BarnOwl::start_edit(type => 'question', prompt => $prompt, callback => sub {
192            my ($text, $success) = @_;
193            $callback->($text) if $success;
194        });
195}
196
197sub start_password {
198    my ($prompt, $callback) = @_;
199    BarnOwl::start_edit(type => 'password', prompt => $prompt, callback => sub {
200            my ($text, $success) = @_;
201            $callback->($text) if $success;
202        });
203}
204
205sub start_edit_win {
206    my ($prompt, $callback) = @_;
207    BarnOwl::start_edit(type => 'edit_win', prompt => $prompt, callback => sub {
208            my ($text, $success) = @_;
209            $callback->($text) if $success;
210        });
211}
212
213=head2 get_data_dir
214
215Returns the BarnOwl system data directory, where system libraries and
216modules are stored
217
218=head2 get_config_dir
219
220Returns the BarnOwl user configuration directory, where user modules
221and configuration are stored (by default, C<$HOME/.owl>)
222
223=head2 popless_text TEXT
224
225Show a popup window containing the given C<TEXT>
226
227=head2 popless_ztext TEXT
228
229Show a popup window containing the provided zephyr-formatted C<TEXT>
230
231=head2 error STRING
232
233Reports an error and log it in `show errors'. Note that in any
234callback or hook called in perl code from BarnOwl, a C<die> will be
235caught and passed to C<error>.
236
237=head2 debug STRING
238
239Logs a debugging message to BarnOwl's debug log
240
241=head2 getnumcolors
242
243Returns the number of colors this BarnOwl is capable of displaying
244
245=head2 message_matches_filter MESSAGE FILTER_NAME [QUIET = 0]
246
247Returns 1 if C<FILTER_NAME> is the name of a valid filter, and
248C<MESSAGE> matches that filter.  Returns 0 otherwise.  If
249C<QUIET> is false, this method displays an error message if
250if C<FILTER_NAME> does not name a valid filter.
251
252=head2 add_dispatch FD CALLBACK
253
254Adds a file descriptor to C<BarnOwl>'s internal C<select()>
255loop. C<CALLBACK> will be invoked whenever data is available to be
256read from C<FD>.
257
258C<add_dispatch> has been deprecated in favor of C<AnyEvent>, and is
259now a wrapper for C<add_io_dispatch> called with C<mode> set to
260C<'r'>.
261
262=cut
263
264sub add_dispatch {
265    my $fd = shift;
266    my $cb = shift;
267    add_io_dispatch($fd, 'r', $cb);
268}
269
270=head2 remove_dispatch FD
271
272Remove a file descriptor previously registered via C<add_dispatch>
273
274C<remove_dispatch> has been deprecated in favor of C<AnyEvent>.
275
276=cut
277
278*remove_dispatch = \&remove_io_dispatch;
279
280=head2 add_io_dispatch FD MODE CB
281
282Adds a file descriptor to C<BarnOwl>'s internal C<select()>
283loop. <MODE> can be 'r', 'w', or 'rw'. C<CALLBACK> will be invoked
284whenever C<FD> becomes ready, as specified by <MODE>.
285
286Only one callback can be registered per FD. If a new callback is
287registered, the old one is removed.
288
289C<add_io_dispatch> has been deprecated in favor of C<AnyEvent>.
290
291=cut
292
293our %_io_dispatches;
294
295sub add_io_dispatch {
296    my $fd = shift;
297    my $modeStr = shift;
298    my $cb = shift;
299    my @modes;
300
301    push @modes, 'r' if $modeStr =~ /r/i; # Read
302    push @modes, 'w' if $modeStr =~ /w/i; # Write
303    if (@modes) {
304        BarnOwl::remove_io_dispatch($fd);
305        for my $mode (@modes) {
306            push @{$_io_dispatches{$fd}}, AnyEvent->io(fh => $fd,
307                                                       poll => $mode,
308                                                       cb => $cb);
309        }
310    } else {
311        die("Invalid I/O Dispatch mode: $modeStr");
312    }
313}
314
315=head2 remove_io_dispatch FD
316
317Remove a file descriptor previously registered via C<add_io_dispatch>
318
319C<remove_io_dispatch> has been deprecated in favor of C<AnyEvent>.
320
321=cut
322
323sub remove_io_dispatch {
324    my $fd = shift;
325    undef $_ foreach @{$_io_dispatches{$fd}};
326    delete $_io_dispatches{$fd};
327}
328
329=head2 create_style NAME OBJECT
330
331Creates a new BarnOwl style with the given NAME defined by the given
332object. The object must have a C<description> method which returns a
333string description of the style, and a and C<format_message> method
334which accepts a C<BarnOwl::Message> object and returns a string that
335is the result of formatting the message for display.
336
337=head2 redisplay
338
339Redraw all of the messages on screen. This is useful if you've just
340changed how a style renders messages.
341
342=cut
343
344# perlconfig.c will set this to the value of the -c command-line
345# switch, if present.
346our $configfile;
347
348our @all_commands;
349
350if(!$configfile) {
351    if (-f get_config_dir() . "/init.pl") {
352        $configfile = get_config_dir() . "/init.pl";
353    } elsif (-f $ENV{HOME} . "/.barnowlconf") {
354        $configfile = $ENV{HOME} . "/.barnowlconf";
355    } else {
356        $configfile = $ENV{HOME}."/.owlconf";
357    }
358}
359
360# populate global variable space for legacy owlconf files
361sub _receive_msg_legacy_wrap {
362    my ($m) = @_;
363    $m->legacy_populate_global();
364    return &BarnOwl::Hooks::_receive_msg($m);
365}
366
367=head2 new_command NAME FUNC [{ARGS}]
368
369Add a new owl command. When owl executes the command NAME, FUNC will
370be called with the arguments passed to the command, with NAME as the
371first argument.
372
373ARGS should be a hashref containing any or all of C<summary>,
374C<usage>, or C<description> keys:
375
376=over 4
377
378=item summary
379
380A one-line summary of the purpose of the command
381
382=item usage
383
384A one-line usage synopsis, showing available options and syntax
385
386=item description
387
388A longer description of the syntax and semantics of the command,
389explaining usage and options
390
391=back
392
393=cut
394
395sub new_command {
396    my $name = shift;
397    my $func = shift;
398    my $args = shift || {};
399    my %args = (
400        summary     => "",
401        usage       => "",
402        description => "",
403        %{$args}
404    );
405
406    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
407}
408
409=head2 new_variable_int NAME [{ARGS}]
410
411=head2 new_variable_bool NAME [{ARGS}]
412
413=head2 new_variable_string NAME [{ARGS}]
414
415=head2 new_variable_enum NAME [{ARGS}]
416
417Add a new owl variable, either an int, a bool, a string, or an enum with the
418specified name.
419
420For new_variable_enum, ARGS is required to contain a validsettings key pointing
421to an array reference. For all four, it can optionally contain the following
422keys:
423
424=over 4
425
426=item default
427
428The default and initial value for the variable
429
430=item summary
431
432A one-line summary of the variable's purpose
433
434=item description
435
436A longer description of the function of the variable
437
438=back
439
440In addition, new_variable_string optionally accepts a string validsettings
441parameter, in case people want to set it to "<path>".
442
443=cut
444
445sub new_variable_int {
446    my ($name, $args) = @_;
447    my $storage = defined($args->{default}) ? $args->{default} : 0;
448    BarnOwl::new_variable_full($name, {
449            %{$args},
450            get_tostring => sub { "$storage" },
451            set_fromstring => sub {
452                die "Expected integer" unless $_[0] =~ /^-?[0-9]+$/;
453                $storage = 0 + $_[0];
454            },
455            validsettings => "<int>",
456            takes_on_off => 0,
457        });
458}
459
460sub new_variable_bool {
461    my ($name, $args) = @_;
462    my $storage = defined($args->{default}) ? $args->{default} : 0;
463    BarnOwl::new_variable_full($name, {
464            %{$args},
465            get_tostring => sub { $storage ? "on" : "off" },
466            set_fromstring => sub {
467                die "Valid settings are on/off" unless $_[0] eq "on" || $_[0] eq "off";
468                $storage = $_[0] eq "on";
469            },
470            validsettings => "on,off",
471            takes_on_off => 1,
472        });
473}
474
475sub new_variable_string {
476    my ($name, $args) = @_;
477    my $storage = defined($args->{default}) ? $args->{default} : "";
478    BarnOwl::new_variable_full($name, {
479            # Allow people to override this one if they /reaaally/ want to for
480            # some reason. Though we still reserve the right to interpret this
481            # value in interesting ways for tab-completion purposes.
482            validsettings => "<string>",
483            %{$args},
484            get_tostring => sub { $storage },
485            set_fromstring => sub { $storage = $_[0]; },
486            takes_on_off => 0,
487        });
488}
489
490sub new_variable_enum {
491    my ($name, $args) = @_;
492
493    # Gather the valid settings.
494    die "validsettings is required" unless defined($args->{validsettings});
495    my %valid;
496    map { $valid{$_} = 1 } @{$args->{validsettings}};
497
498    my $storage = (defined($args->{default}) ?
499                   $args->{default} :
500                   $args->{validsettings}->[0]);
501    BarnOwl::new_variable_full($name, {
502            %{$args},
503            get_tostring => sub { $storage },
504            set_fromstring => sub {
505                die "Invalid input" unless $valid{$_[0]};
506                $storage = $_[0];
507            },
508            validsettings => join(",", @{$args->{validsettings}})
509        });
510}
511
512=head2 new_variable_full NAME {ARGS}
513
514Create a variable, in full generality. The keyword arguments have types below:
515
516 get_tostring : ()  -> string
517 set_fromstring : string -> int
518 -- optional --
519 summary : string
520 description : string
521 validsettings : string
522 takes_on_off : int
523
524The get/set functions are required. Note that the caller manages storage for the
525variable. get_tostring/set_fromstring both convert AND store the value.
526set_fromstring dies on failure.
527
528If the variable takes parameters 'on' and 'off' (i.e. is boolean-looking), set
529takes_on_off to 1. This makes :set VAR and :unset VAR work. set_fromstring will
530be called with those arguments.
531
532=cut
533
534sub new_variable_full {
535    my $name = shift;
536    my $args = shift || {};
537    my %args = (
538        summary => "",
539        description => "",
540        takes_on_off => 0,
541        validsettings => "<string>",
542        %{$args});
543
544    die "get_tostring required" unless $args{get_tostring};
545    die "set_fromstring required" unless $args{set_fromstring};
546
547    # Strip off the bogus dummy argument. Aargh perl-Glib.
548    my $get_tostring_fn = sub { $args{get_tostring}->() };
549    my $set_fromstring_fn = sub {
550      my ($dummy, $val) = @_;
551      # Translate from user-supplied die-on-failure callback to expected
552      # non-zero on error. Less of a nuisance than interacting with ERRSV.
553      eval { $args{set_fromstring}->($val) };
554      # TODO: Consider changing B::I::new_variable to expect string|NULL with
555      # string as the error message. That can then be translated to a GError in
556      # owl_variable_set_fromstring. For now the string is ignored.
557      return ($@ ? -1 : 0);
558    };
559
560    BarnOwl::Internal::new_variable($name, $args{summary}, $args{description}, $args{validsettings},
561                                    $args{takes_on_off}, $get_tostring_fn, $set_fromstring_fn, undef);
562}
563
564=head2 quote LIST
565
566Quotes each of the strings in LIST and returns a string that will be
567correctly decoded to LIST by the BarnOwl command parser.  For example:
568
569    quote('zwrite', 'andersk', '-m', 'Hello, world!')
570    # returns "zwrite andersk -m 'Hello, world!'"
571
572=cut
573
574sub quote {
575    my @quoted;
576    for my $str (@_) {
577        if ($str eq '') {
578            push @quoted, "''";
579        } elsif ($str !~ /['" \n\t]/) {
580            push @quoted, "$str";
581        } elsif ($str !~ /'/) {
582            push @quoted, "'$str'";
583        } else {
584            (my $qstr = $str) =~ s/"/"'"'"/g;
585            push @quoted, '"' . $qstr . '"';
586        }
587    }
588    return join(' ', @quoted);
589}
590
591=head2 Modify filters by appending text
592
593=cut
594
595sub register_builtin_commands {
596    # Filter modification
597    BarnOwl::new_command("filterappend",
598                         sub { filter_append_helper('appending', '', @_); },
599                       {
600                           summary => "append '<text>' to filter",
601                           usage => "filterappend <filter> <text>",
602                       });
603
604    BarnOwl::new_command("filterand",
605                         sub { filter_append_helper('and-ing', 'and', @_); },
606                       {
607                           summary => "append 'and <text>' to filter",
608                           usage => "filterand <filter> <text>",
609                       });
610
611    BarnOwl::new_command("filteror",
612                         sub { filter_append_helper('or-ing', 'or', @_); },
613                       {
614                           summary => "append 'or <text>' to filter",
615                           usage => "filteror <filter> <text>",
616                       });
617
618    # Date formatting
619    BarnOwl::new_command("showdate",
620                         sub { BarnOwl::time_format('showdate', '%Y-%m-%d %H:%M'); },
621                       {
622                           summary => "Show date in timestamps for supporting styles.",
623                           usage => "showdate",
624                       });
625
626    BarnOwl::new_command("hidedate",
627                         sub { BarnOwl::time_format('hidedate', '%H:%M'); },
628                       {
629                           summary => "Don't show date in timestamps for supporting styles.",
630                           usage => "hidedate",
631                       });
632
633    BarnOwl::new_command("timeformat",
634                         \&BarnOwl::time_format,
635                       {
636                           summary => "Set the format for timestamps and re-display messages",
637                           usage => "timeformat <format>",
638                       });
639
640    # Receive window scrolling
641    BarnOwl::new_command("recv:shiftleft",
642                        \&BarnOwl::recv_shift_left,
643                        {
644                            summary => "scrolls receive window to the left",
645                            usage => "recv:shiftleft [<amount>]",
646                            description => <<END_DESCR
647By default, scroll left by 10 columns. Passing no arguments or 0 activates this default behavior.
648Otherwise, scroll by the number of columns specified as the argument.
649END_DESCR
650                        });
651
652    BarnOwl::new_command("recv:shiftright",
653                        \&BarnOwl::recv_shift_right,
654                        {
655                            summary => "scrolls receive window to the right",
656                            usage => "recv:shiftright [<amount>]",
657                            description => <<END_DESCR
658By default, scroll right by 10 columns. Passing no arguments or 0 activates this default behavior.
659Otherwise, scroll by the number of columns specified as the argument.
660END_DESCR
661                        });
662
663}
664
665$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
666
667=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
668
669Helper to append to filters.
670
671=cut
672
673sub filter_append_helper
674{
675    my $action = shift;
676    my $sep = shift;
677    my $func = shift;
678    my $filter = shift;
679    my @append = @_;
680    my $oldfilter = BarnOwl::getfilter($filter);
681    chomp $oldfilter;
682    my $newfilter = "$oldfilter $sep " . quote(@append);
683    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
684    if (BarnOwl::getvar('showfilterchange') eq 'on') {
685        BarnOwl::admin_message("Filter", $msgtext);
686    }
687    set_filter($filter, $newfilter);
688    return;
689}
690BarnOwl::new_variable_bool("showfilterchange",
691                           { default => 1,
692                             summary => 'Show modifications to filters by filterappend and friends.'});
693
694sub set_filter
695{
696    my $filtername = shift;
697    my $filtertext = shift;
698    my $cmd = 'filter ' . BarnOwl::quote($filtername) . ' ' . $filtertext;
699    BarnOwl::command($cmd);
700}
701
702=head3 time_format FORMAT
703
704Set the format for displaying times (variable timeformat) and redisplay
705messages.
706
707=cut
708
709my $timeformat = '%H:%M';
710
711sub time_format
712{
713    my $function = shift;
714    my $format = shift;
715    if(!$format)
716    {
717        return $timeformat;
718    }
719    if(shift)
720    {
721        return "Wrong number of arguments for command";
722    }
723    $timeformat = $format;
724    redisplay();
725}
726
727=head3 Receive window scrolling
728
729Permit scrolling the receive window left or right by arbitrary
730amounts (with a default of 10 characters).
731
732=cut
733
734sub recv_shift_left
735{
736    my $func = shift;
737    my $delta = shift;
738    $delta = 10 unless defined($delta) && int($delta) > 0;
739    my $shift = BarnOwl::recv_getshift();
740    if($shift > 0) {
741        BarnOwl::recv_setshift(max(0, $shift-$delta));
742    } else {
743        return "Already full left";
744    }
745}
746
747sub recv_shift_right
748{
749    my $func = shift;
750    my $delta = shift;
751    $delta = 10 unless defined($delta) && int($delta) > 0;
752    my $shift = BarnOwl::recv_getshift();
753    BarnOwl::recv_setshift($shift+$delta);
754}
755
756=head3 default_zephyr_signature
757
758Compute the default zephyr signature.
759
760=cut
761
762sub default_zephyr_signature
763{
764  my $zsig = getvar('zsig');
765  if (!defined($zsig) || $zsig eq '') {
766      my $zsigproc = getvar('zsigproc');
767      if (defined($zsigproc) && $zsigproc ne '') {
768          $zsig = `$zsigproc`;
769      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
770          $zsig = ((getpwuid($<))[6]);
771          $zsig =~ s/,.*//;
772      }
773  }
774  chomp($zsig);
775  return $zsig;
776}
777
778=head3 random_zephyr_signature
779
780Retrieve a random line from ~/.zsigs (except those beginning with '#')
781and use it as the zephyr signature.
782
783=cut
784
785sub random_zephyr_signature
786{
787    my $zsigfile = "$ENV{'HOME'}/.zsigs";
788    open my $file, '<', $zsigfile or die "Error opening file $zsigfile: $!";
789    my @lines = grep !(/^#/ || /^\s*$/), <$file>;
790    close $file;
791    return '' if !@lines;
792    my $zsig = "$lines[int(rand(scalar @lines))]";
793    chomp $zsig;
794    return $zsig;
795}
796
797=head3 register_idle_watcher %ARGS
798
799Call a callback whenever the amount of time the user becomes idle or comes
800back from being idle.
801
802You must include the following parameters:
803
804=over 4
805
806=item name
807
808The name given to the idle watcher
809
810=item after
811
812How long the user must be idle, in seconds, before the callback is called.
813If the value is too small, you may have spurious or inaccurate calls.
814(The current lower limit is about 1 second.)
815
816=item callback
817
818The Perl subroutine that gets called when the user has been idle for C<AFTER>
819seconds, or comes back from being idle.  The subroutine is passed one parameter,
820which is true if the user is currently idle, and false otherwise.
821
822=back
823
824This method returns a unique identifier which may be passed to
825L<BarnOwl::unregister_idle_watcher>.
826
827=cut
828
829=head3 unregister_idle_watcher UNIQUE_ID [...]
830
831Removed and returns the idle watcher specified by C<UNIQUE_ID>.
832You may specify multiple unique ids.
833
834=cut
835
836my %idle_watchers;
837tie %idle_watchers, 'Tie::RefHash';
838
839$BarnOwl::Hooks::wakeup->add(sub {
840        foreach my $idle_watcher (values %idle_watchers) {
841            _wakeup_idle_watcher($idle_watcher);
842        }
843    });
844
845sub _wakeup_idle_watcher {
846    my ($idle_watcher, $offset) = @_;
847    $offset = 0 unless defined $offset;
848    # go unidle
849    $idle_watcher->{idle_timer}->stop if $idle_watcher->{idle_timer};
850    undef $idle_watcher->{idle_timer};
851    $idle_watcher->{callback}->(0) if $idle_watcher->{is_idle};
852    $idle_watcher->{is_idle} = 0;
853
854    # queue going idle
855    $idle_watcher->{idle_timer} = BarnOwl::Timer->new({
856        name  => $idle_watcher->{name},
857        after => $idle_watcher->{after} - $offset,
858        cb    => sub {
859            $idle_watcher->{is_idle} = 1;
860            $idle_watcher->{callback}->(1);
861        }
862    });
863}
864
865sub register_idle_watcher {
866    my %args = (@_);
867    $idle_watchers{\%args} = \%args;
868    _wakeup_idle_watcher(\%args, BarnOwl::getidletime); # make sure to queue up the idle/unidle events from this idle watcher
869    return \%args;
870}
871
872sub unregister_idle_watcher {
873    my ($id) = @_;
874    $idle_watchers{$id}->{idle_timer}->stop if $idle_watchers{$id}->{idle_timer};
875    return delete $idle_watchers{$id};
876}
877
878# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
879# startup command. This may be redefined in a user's configfile.
880sub startup
881{
882}
883
8841;
Note: See TracBrowser for help on using the repository browser.