source: perl/lib/BarnOwl.pm @ 4fd3c04

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