source: perl/lib/BarnOwl.pm @ 21bab95

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