source: perl/lib/BarnOwl.pm @ 4772817

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