source: perl/lib/BarnOwl.pm @ f6413c3

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