source: perl/lib/BarnOwl.pm @ c323405

release-1.10release-1.8release-1.9
Last change on this file since c323405 was bcde7926, checked in by David Benjamin <davidben@mit.edu>, 13 years ago
Reimplement BarnOwl::add_io_dispatch with AnyEvent We can emulate the interesting semantics with perl. The one difference is that perl code can now register an IO dispatch on file descriptors C code was interested in. This isn't a big deal was Glib can handle multiple watches on the same FD. Granted, more than one reader on an FD would cause trouble, but there was nothing stopping perl code from reading from an FD we cared about anyway. AnyEvent also does not support select's exceptfd, so this is a slight behavior change, but probably an uninteresting one.
  • Property mode set to 100644
File size: 15.6 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl;
5
6use base qw(Exporter);
7our @EXPORT_OK = qw(command getcurmsg getnumcols getidletime
8                    zephyr_getsender zephyr_getrealm zephyr_zwrite
9                    zephyr_stylestrip zephyr_smartstrip_user zephyr_getsubs
10                    queue_message admin_message
11                    start_question start_password start_edit_win
12                    get_data_dir get_config_dir popless_text popless_ztext
13                    error debug
14                    create_style getnumcolors wordwrap
15                    add_dispatch remove_dispatch
16                    add_io_dispatch remove_io_dispatch
17                    new_command
18                    new_variable_int new_variable_bool new_variable_string
19                    quote redisplay);
20our %EXPORT_TAGS = (all => \@EXPORT_OK);
21
22BEGIN {
23# bootstrap in C bindings and glue
24    *owl:: = \*BarnOwl::;
25    bootstrap BarnOwl 1.2;
26};
27
28use lib(get_data_dir() . "/lib");
29use lib(get_config_dir() . "/lib");
30
31use Glib;
32use AnyEvent;
33
34use BarnOwl::Hook;
35use BarnOwl::Hooks;
36use BarnOwl::Message;
37use BarnOwl::Style;
38use BarnOwl::Zephyr;
39use BarnOwl::Timer;
40use BarnOwl::Editwin;
41use BarnOwl::Completion;
42use BarnOwl::Help;
43
44use List::Util qw(max);
45
46=head1 NAME
47
48BarnOwl
49
50=head1 DESCRIPTION
51
52The BarnOwl module contains the core of BarnOwl's perl
53bindings. Source in this module is also run at startup to bootstrap
54barnowl by defining things like the default style.
55
56=for NOTE
57These following functions are defined in perlglue.xs. Keep the
58documentation here in sync with the user-visible commands defined
59there!
60
61=head2 command STRING
62
63Executes a BarnOwl command in the same manner as if the user had
64executed it at the BarnOwl command prompt. If the command returns a
65value, return it as a string, otherwise return undef.
66
67=head2 getcurmsg
68
69Returns the current message as a C<BarnOwl::Message> subclass, or
70undef if there is no message selected
71=head2 getnumcols
72
73Returns the width of the display window BarnOwl is currently using
74
75=head2 getidletime
76
77Returns the length of time since the user has pressed a key, in
78seconds.
79
80=head2 zephyr_getrealm
81
82Returns the zephyr realm barnowl is running in
83
84=head2 zephyr_getsender
85
86Returns the fully-qualified name of the zephyr sender barnowl is
87running as, e.g. C<nelhage@ATHENA.MIT.EDU>
88
89=head2 zephyr_zwrite COMMAND MESSAGE
90
91Sends a zephyr programmatically. C<COMMAND> should be a C<zwrite>
92command line, and C<MESSAGE> is the zephyr body to send.
93
94=head2 ztext_stylestrip STRING
95
96Strips zephyr formatting from a string and returns the result
97
98=head2 zephyr_getsubs
99
100Returns the list of subscription triples <class,instance,recipient>,
101separated by newlines.
102
103=head2 queue_message MESSAGE
104
105Enqueue a message in the BarnOwl message list, logging it and
106processing it appropriately. C<MESSAGE> should be an instance of
107BarnOwl::Message or a subclass.
108
109=head2 admin_message HEADER BODY
110
111Display a BarnOwl B<Admin> message, with the given header and body.
112
113=head2 start_question PROMPT CALLBACK
114
115Displays C<PROMPT> on the screen and lets the user enter a line of
116text, and calls C<CALLBACK>, which must be a perl subroutine
117reference, with the text the user entered
118
119=head2 start_password PROMPT CALLBACK
120
121Like C<start_question>, but echoes the user's input as C<*>s when they
122input.
123
124=head2 start_edit_win PROMPT CALLBACK
125
126Like C<start_question>, but displays C<PROMPT> on a line of its own
127and opens the editwin. If the user cancels the edit win, C<CALLBACK>
128is not invoked.
129
130=head2 get_data_dir
131
132Returns the BarnOwl system data directory, where system libraries and
133modules are stored
134
135=head2 get_config_dir
136
137Returns the BarnOwl user configuration directory, where user modules
138and configuration are stored (by default, C<$HOME/.owl>)
139
140=head2 popless_text TEXT
141
142Show a popup window containing the given C<TEXT>
143
144=head2 popless_ztext TEXT
145
146Show a popup window containing the provided zephyr-formatted C<TEXT>
147
148=head2 error STRING
149
150Reports an error and log it in `show errors'. Note that in any
151callback or hook called in perl code from BarnOwl, a C<die> will be
152caught and passed to C<error>.
153
154=head2 debug STRING
155
156Logs a debugging message to BarnOwl's debug log
157
158=head2 getnumcolors
159
160Returns the number of colors this BarnOwl is capable of displaying
161
162=head2 add_dispatch FD CALLBACK
163
164Adds a file descriptor to C<BarnOwl>'s internal C<select()>
165loop. C<CALLBACK> will be invoked whenever data is available to be
166read from C<FD>.
167
168C<add_dispatch> has been deprecated in favor of C<AnyEvent>, and is
169now a wrapper for C<add_io_dispatch> called with C<mode> set to
170C<'r'>.
171
172=cut
173
174sub add_dispatch {
175    my $fd = shift;
176    my $cb = shift;
177    add_io_dispatch($fd, 'r', $cb);
178}
179
180=head2 remove_dispatch FD
181
182Remove a file descriptor previously registered via C<add_dispatch>
183
184C<remove_dispatch> has been deprecated in favor of C<AnyEvent>.
185
186=cut
187
188*remove_dispatch = \&remove_io_dispatch;
189
190=head2 add_io_dispatch FD MODE CB
191
192Adds a file descriptor to C<BarnOwl>'s internal C<select()>
193loop. <MODE> can be 'r', 'w', or 'rw'. C<CALLBACK> will be invoked
194whenever C<FD> becomes ready, as specified by <MODE>.
195
196Only one callback can be registered per FD. If a new callback is
197registered, the old one is removed.
198
199C<add_io_dispatch> has been deprecated in favor of C<AnyEvent>.
200
201=cut
202
203our %_io_dispatches;
204
205sub add_io_dispatch {
206    my $fd = shift;
207    my $modeStr = shift;
208    my $cb = shift;
209    my @modes;
210
211    push @modes, 'r' if $modeStr =~ /r/i; # Read
212    push @modes, 'w' if $modeStr =~ /w/i; # Write
213    if (@modes) {
214        BarnOwl::remove_io_dispatch($fd);
215        for my $mode (@modes) {
216            push @{$_io_dispatches{$fd}}, AnyEvent->io(fh => $fd,
217                                                       poll => $mode,
218                                                       cb => $cb);
219        }
220    } else {
221        die("Invalid I/O Dispatch mode: $modeStr");
222    }
223}
224
225=head2 remove_io_dispatch FD
226
227Remove a file descriptor previously registered via C<add_io_dispatch>
228
229C<remove_io_dispatch> has been deprecated in favor of C<AnyEvent>.
230
231=cut
232
233sub remove_io_dispatch {
234    my $fd = shift;
235    undef $_ foreach @{$_io_dispatches{$fd}};
236    delete $_io_dispatches{$fd};
237}
238
239=head2 create_style NAME OBJECT
240
241Creates a new barnowl style with the given NAME defined by the given
242object. The object must have a C<description> method which returns a
243string description of the style, and a and C<format_message> method
244which accepts a C<BarnOwl::Message> object and returns a string that
245is the result of formatting the message for display.
246
247=head2 redisplay
248
249Redraw all of the messages on screen. This is useful if you've just
250changed how a style renders messages.
251
252=cut
253
254# perlconfig.c will set this to the value of the -c command-line
255# switch, if present.
256our $configfile;
257
258our @all_commands;
259
260if(!$configfile && -f $ENV{HOME} . "/.barnowlconf") {
261    $configfile = $ENV{HOME} . "/.barnowlconf";
262}
263$configfile ||= $ENV{HOME}."/.owlconf";
264
265# populate global variable space for legacy owlconf files
266sub _receive_msg_legacy_wrap {
267    my ($m) = @_;
268    $m->legacy_populate_global();
269    return &BarnOwl::Hooks::_receive_msg($m);
270}
271
272=head2 new_command NAME FUNC [{ARGS}]
273
274Add a new owl command. When owl executes the command NAME, FUNC will
275be called with the arguments passed to the command, with NAME as the
276first argument.
277
278ARGS should be a hashref containing any or all of C<summary>,
279C<usage>, or C<description> keys:
280
281=over 4
282
283=item summary
284
285A one-line summary of the purpose of the command
286
287=item usage
288
289A one-line usage synopsis, showing available options and syntax
290
291=item description
292
293A longer description of the syntax and semantics of the command,
294explaining usage and options
295
296=back
297
298=cut
299
300sub new_command {
301    my $name = shift;
302    my $func = shift;
303    my $args = shift || {};
304    my %args = (
305        summary     => "",
306        usage       => "",
307        description => "",
308        %{$args}
309    );
310
311    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
312}
313
314=head2 new_variable_int NAME [{ARGS}]
315
316=head2 new_variable_bool NAME [{ARGS}]
317
318=head2 new_variable_string NAME [{ARGS}]
319
320Add a new owl variable, either an int, a bool, or a string, with the
321specified name.
322
323ARGS can optionally contain the following keys:
324
325=over 4
326
327=item default
328
329The default and initial value for the variable
330
331=item summary
332
333A one-line summary of the variable's purpose
334
335=item description
336
337A longer description of the function of the variable
338
339=back
340
341=cut
342
343sub new_variable_int {
344    unshift @_, \&BarnOwl::Internal::new_variable_int, 0;
345    goto \&_new_variable;
346}
347
348sub new_variable_bool {
349    unshift @_, \&BarnOwl::Internal::new_variable_bool, 0;
350    goto \&_new_variable;
351}
352
353sub new_variable_string {
354    unshift @_, \&BarnOwl::Internal::new_variable_string, "";
355    goto \&_new_variable;
356}
357
358sub _new_variable {
359    my $func = shift;
360    my $default_default = shift;
361    my $name = shift;
362    my $args = shift || {};
363    my %args = (
364        summary     => "",
365        description => "",
366        default     => $default_default,
367        %{$args});
368    $func->($name, $args{default}, $args{summary}, $args{description});
369}
370
371=head2 quote LIST
372
373Quotes each of the strings in LIST and returns a string that will be
374correctly decoded to LIST by the BarnOwl command parser.  For example:
375
376    quote('zwrite', 'andersk', '-m', 'Hello, world!')
377    # returns "zwrite andersk -m 'Hello, world!'"
378
379=cut
380
381sub quote {
382    my @quoted;
383    for my $str (@_) {
384        if ($str eq '') {
385            push @quoted, "''";
386        } elsif ($str !~ /['" \n\t]/) {
387            push @quoted, "$str";
388        } elsif ($str !~ /'/) {
389            push @quoted, "'$str'";
390        } else {
391            (my $qstr = $str) =~ s/"/"'"'"/g;
392            push @quoted, '"' . $qstr . '"';
393        }
394    }
395    return join(' ', @quoted);
396}
397
398=head2 Modify filters by appending text
399
400=cut
401
402sub register_builtin_commands {
403    # Filter modification
404    BarnOwl::new_command("filterappend",
405                         sub { filter_append_helper('appending', '', @_); },
406                       {
407                           summary => "append '<text>' to filter",
408                           usage => "filterappend <filter> <text>",
409                       });
410
411    BarnOwl::new_command("filterand",
412                         sub { filter_append_helper('and-ing', 'and', @_); },
413                       {
414                           summary => "append 'and <text>' to filter",
415                           usage => "filterand <filter> <text>",
416                       });
417
418    BarnOwl::new_command("filteror",
419                         sub { filter_append_helper('or-ing', 'or', @_); },
420                       {
421                           summary => "append 'or <text>' to filter",
422                           usage => "filteror <filter> <text>",
423                       });
424
425    # Date formatting
426    BarnOwl::new_command("showdate",
427                         sub { BarnOwl::time_format('showdate', '%Y-%m-%d %H:%M'); },
428                       {
429                           summary => "Show date in timestamps for supporting styles.",
430                           usage => "showdate",
431                       });
432
433    BarnOwl::new_command("hidedate",
434                         sub { BarnOwl::time_format('hidedate', '%H:%M'); },
435                       {
436                           summary => "Don't show date in timestamps for supporting styles.",
437                           usage => "hidedate",
438                       });
439
440    BarnOwl::new_command("timeformat",
441                         \&BarnOwl::time_format,
442                       {
443                           summary => "Set the format for timestamps and re-display messages",
444                           usage => "timeformat <format>",
445                       });
446
447    # Receive window scrolling
448    BarnOwl::new_command("recv:shiftleft",
449                        \&BarnOwl::recv_shift_left,
450                        {
451                            summary => "scrolls receive window to the left",
452                            usage => "recv:shiftleft [<amount>]",
453                            description => <<END_DESCR
454By default, scroll left by 10 columns. Passing no arguments or 0 activates this default behavior.
455Otherwise, scroll by the number of columns specified as the argument.
456END_DESCR
457                        });
458
459    BarnOwl::new_command("recv:shiftright",
460                        \&BarnOwl::recv_shift_right,
461                        {
462                            summary => "scrolls receive window to the right",
463                            usage => "recv:shiftright [<amount>]",
464                            description => <<END_DESCR
465By default, scroll right by 10 columns. Passing no arguments or 0 activates this default behavior.
466Otherwise, scroll by the number of columns specified as the argument.
467END_DESCR
468                        });
469
470}
471
472$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
473
474=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
475
476Helper to append to filters.
477
478=cut
479
480sub filter_append_helper
481{
482    my $action = shift;
483    my $sep = shift;
484    my $func = shift;
485    my $filter = shift;
486    my @append = @_;
487    my $oldfilter = BarnOwl::getfilter($filter);
488    chomp $oldfilter;
489    my $newfilter = "$oldfilter $sep " . quote(@append);
490    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
491    if (BarnOwl::getvar('showfilterchange') eq 'on') {
492        BarnOwl::admin_message("Filter", $msgtext);
493    }
494    set_filter($filter, $newfilter);
495    return;
496}
497BarnOwl::new_variable_bool("showfilterchange",
498                           { default => 1,
499                             summary => 'Show modifications to filters by filterappend and friends.'});
500
501sub set_filter
502{
503    my $filtername = shift;
504    my $filtertext = shift;
505    my $cmd = 'filter ' . BarnOwl::quote($filtername) . ' ' . $filtertext;
506    BarnOwl::command($cmd);
507}
508
509=head3 time_format FORMAT
510
511Set the format for displaying times (variable timeformat) and redisplay
512messages.
513
514=cut
515
516my $timeformat = '%H:%M';
517
518sub time_format
519{
520    my $function = shift;
521    my $format = shift;
522    if(!$format)
523    {
524        return $timeformat;
525    }
526    if(shift)
527    {
528        return "Wrong number of arguments for command";
529    }
530    $timeformat = $format;
531    redisplay();
532}
533
534=head3 Receive window scrolling
535
536Permit scrolling the receive window left or right by arbitrary
537amounts (with a default of 10 characters).
538
539=cut
540
541sub recv_shift_left
542{
543    my $func = shift;
544    my $delta = shift;
545    $delta = 10 unless defined($delta) && int($delta) > 0;
546    my $shift = BarnOwl::recv_getshift();
547    if($shift > 0) {
548        BarnOwl::recv_setshift(max(0, $shift-$delta));
549    } else {
550        return "Already full left";
551    }
552}
553
554sub recv_shift_right
555{
556    my $func = shift;
557    my $delta = shift;
558    $delta = 10 unless defined($delta) && int($delta) > 0;
559    my $shift = BarnOwl::recv_getshift();
560    BarnOwl::recv_setshift($shift+$delta);
561}
562
563=head3 default_zephyr_signature
564
565Compute the default zephyr signature.
566
567=cut
568
569sub default_zephyr_signature
570{
571  my $zsig = getvar('zsig');
572  if (!$zsig) {
573      if (my $zsigproc = getvar('zsigproc')) {
574          $zsig = `$zsigproc`;
575      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
576          $zsig = ((getpwuid($<))[6]);
577          $zsig =~ s/,.*//;
578      }
579  }
580  chomp($zsig);
581  return $zsig;
582}
583
584=head3 random_zephyr_signature
585
586Retrieve a random line from ~/.zsigs (except those beginning with '#')
587and use it as the zephyr signature.
588
589=cut
590
591sub random_zephyr_signature
592{
593    my $zsigfile = "$ENV{'HOME'}/.zsigs";
594    open my $file, '<', $zsigfile or die "Error opening file $zsigfile: $!";
595    my @lines = grep !(/^#/ || /^\s*$/), <$file>;
596    close $file;
597    return '' if !@lines;
598    my $zsig = "$lines[int(rand(scalar @lines))]";
599    chomp $zsig;
600    return $zsig;
601}
602
603# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
604# startup command. This may be redefined in a user's configfile.
605sub startup
606{
607}
608
6091;
Note: See TracBrowser for help on using the repository browser.