source: perl/lib/BarnOwl.pm @ da7341e

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