source: perl/lib/BarnOwl.pm @ d973a73

release-1.10release-1.8release-1.9
Last change on this file since d973a73 was a130fc5, checked in by Jason Gross <jgross@mit.edu>, 13 years ago
Improved ability to delete messages from perl BarnOwl::Message now has a delete_and_expunge command, and BarnOwl::queue_message returns the queued message, so that deletion actually works; there used to be no way to get the id of a queued message, and so ->delete() didn't actually do anything...
  • Property mode set to 100644
File size: 15.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 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.  Returns the queued message.  This
108is useful for, e.g., deleting a message from the message list.
109
110=head2 admin_message HEADER BODY
111
112Display a BarnOwl B<Admin> message, with the given header and body.
113
114=head2 start_question PROMPT CALLBACK
115
116Displays C<PROMPT> on the screen and lets the user enter a line of
117text, and calls C<CALLBACK>, which must be a perl subroutine
118reference, with the text the user entered
119
120=head2 start_password PROMPT CALLBACK
121
122Like C<start_question>, but echoes the user's input as C<*>s when they
123input.
124
125=head2 start_edit_win PROMPT CALLBACK
126
127Like C<start_question>, but displays C<PROMPT> on a line of its own
128and opens the editwin. If the user cancels the edit win, C<CALLBACK>
129is not invoked.
130
131=head2 get_data_dir
132
133Returns the BarnOwl system data directory, where system libraries and
134modules are stored
135
136=head2 get_config_dir
137
138Returns the BarnOwl user configuration directory, where user modules
139and configuration are stored (by default, C<$HOME/.owl>)
140
141=head2 popless_text TEXT
142
143Show a popup window containing the given C<TEXT>
144
145=head2 popless_ztext TEXT
146
147Show a popup window containing the provided zephyr-formatted C<TEXT>
148
149=head2 error STRING
150
151Reports an error and log it in `show errors'. Note that in any
152callback or hook called in perl code from BarnOwl, a C<die> will be
153caught and passed to C<error>.
154
155=head2 debug STRING
156
157Logs a debugging message to BarnOwl's debug log
158
159=head2 getnumcolors
160
161Returns the number of colors this BarnOwl is capable of displaying
162
163=head2 add_dispatch FD CALLBACK
164
165Adds a file descriptor to C<BarnOwl>'s internal C<select()>
166loop. C<CALLBACK> will be invoked whenever data is available to be
167read from C<FD>.
168
169C<add_dispatch> has been deprecated in favor of C<AnyEvent>, and is
170now a wrapper for C<add_io_dispatch> called with C<mode> set to
171C<'r'>.
172
173=cut
174
175sub add_dispatch {
176    my $fd = shift;
177    my $cb = shift;
178    add_io_dispatch($fd, 'r', $cb);
179}
180
181=head2 remove_dispatch FD
182
183Remove a file descriptor previously registered via C<add_dispatch>
184
185C<remove_dispatch> has been deprecated in favor of C<AnyEvent>.
186
187=cut
188
189*remove_dispatch = \&remove_io_dispatch;
190
191=head2 add_io_dispatch FD MODE CB
192
193Adds a file descriptor to C<BarnOwl>'s internal C<select()>
194loop. <MODE> can be 'r', 'w', or 'rw'. C<CALLBACK> will be invoked
195whenever C<FD> becomes ready, as specified by <MODE>.
196
197Only one callback can be registered per FD. If a new callback is
198registered, the old one is removed.
199
200C<add_io_dispatch> has been deprecated in favor of C<AnyEvent>.
201
202=cut
203
204our %_io_dispatches;
205
206sub add_io_dispatch {
207    my $fd = shift;
208    my $modeStr = shift;
209    my $cb = shift;
210    my @modes;
211
212    push @modes, 'r' if $modeStr =~ /r/i; # Read
213    push @modes, 'w' if $modeStr =~ /w/i; # Write
214    if (@modes) {
215        BarnOwl::remove_io_dispatch($fd);
216        for my $mode (@modes) {
217            push @{$_io_dispatches{$fd}}, AnyEvent->io(fh => $fd,
218                                                       poll => $mode,
219                                                       cb => $cb);
220        }
221    } else {
222        die("Invalid I/O Dispatch mode: $modeStr");
223    }
224}
225
226=head2 remove_io_dispatch FD
227
228Remove a file descriptor previously registered via C<add_io_dispatch>
229
230C<remove_io_dispatch> has been deprecated in favor of C<AnyEvent>.
231
232=cut
233
234sub remove_io_dispatch {
235    my $fd = shift;
236    undef $_ foreach @{$_io_dispatches{$fd}};
237    delete $_io_dispatches{$fd};
238}
239
240=head2 create_style NAME OBJECT
241
242Creates a new BarnOwl style with the given NAME defined by the given
243object. The object must have a C<description> method which returns a
244string description of the style, and a and C<format_message> method
245which accepts a C<BarnOwl::Message> object and returns a string that
246is the result of formatting the message for display.
247
248=head2 redisplay
249
250Redraw all of the messages on screen. This is useful if you've just
251changed how a style renders messages.
252
253=cut
254
255# perlconfig.c will set this to the value of the -c command-line
256# switch, if present.
257our $configfile;
258
259our @all_commands;
260
261if(!$configfile && -f $ENV{HOME} . "/.barnowlconf") {
262    $configfile = $ENV{HOME} . "/.barnowlconf";
263}
264$configfile ||= $ENV{HOME}."/.owlconf";
265
266# populate global variable space for legacy owlconf files
267sub _receive_msg_legacy_wrap {
268    my ($m) = @_;
269    $m->legacy_populate_global();
270    return &BarnOwl::Hooks::_receive_msg($m);
271}
272
273=head2 new_command NAME FUNC [{ARGS}]
274
275Add a new owl command. When owl executes the command NAME, FUNC will
276be called with the arguments passed to the command, with NAME as the
277first argument.
278
279ARGS should be a hashref containing any or all of C<summary>,
280C<usage>, or C<description> keys:
281
282=over 4
283
284=item summary
285
286A one-line summary of the purpose of the command
287
288=item usage
289
290A one-line usage synopsis, showing available options and syntax
291
292=item description
293
294A longer description of the syntax and semantics of the command,
295explaining usage and options
296
297=back
298
299=cut
300
301sub new_command {
302    my $name = shift;
303    my $func = shift;
304    my $args = shift || {};
305    my %args = (
306        summary     => "",
307        usage       => "",
308        description => "",
309        %{$args}
310    );
311
312    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
313}
314
315=head2 new_variable_int NAME [{ARGS}]
316
317=head2 new_variable_bool NAME [{ARGS}]
318
319=head2 new_variable_string NAME [{ARGS}]
320
321Add a new owl variable, either an int, a bool, or a string, with the
322specified name.
323
324ARGS can optionally contain the following keys:
325
326=over 4
327
328=item default
329
330The default and initial value for the variable
331
332=item summary
333
334A one-line summary of the variable's purpose
335
336=item description
337
338A longer description of the function of the variable
339
340=back
341
342=cut
343
344sub new_variable_int {
345    unshift @_, \&BarnOwl::Internal::new_variable_int, 0;
346    goto \&_new_variable;
347}
348
349sub new_variable_bool {
350    unshift @_, \&BarnOwl::Internal::new_variable_bool, 0;
351    goto \&_new_variable;
352}
353
354sub new_variable_string {
355    unshift @_, \&BarnOwl::Internal::new_variable_string, "";
356    goto \&_new_variable;
357}
358
359sub _new_variable {
360    my $func = shift;
361    my $default_default = shift;
362    my $name = shift;
363    my $args = shift || {};
364    my %args = (
365        summary     => "",
366        description => "",
367        default     => $default_default,
368        %{$args});
369    $func->($name, $args{default}, $args{summary}, $args{description});
370}
371
372=head2 quote LIST
373
374Quotes each of the strings in LIST and returns a string that will be
375correctly decoded to LIST by the BarnOwl command parser.  For example:
376
377    quote('zwrite', 'andersk', '-m', 'Hello, world!')
378    # returns "zwrite andersk -m 'Hello, world!'"
379
380=cut
381
382sub quote {
383    my @quoted;
384    for my $str (@_) {
385        if ($str eq '') {
386            push @quoted, "''";
387        } elsif ($str !~ /['" \n\t]/) {
388            push @quoted, "$str";
389        } elsif ($str !~ /'/) {
390            push @quoted, "'$str'";
391        } else {
392            (my $qstr = $str) =~ s/"/"'"'"/g;
393            push @quoted, '"' . $qstr . '"';
394        }
395    }
396    return join(' ', @quoted);
397}
398
399=head2 Modify filters by appending text
400
401=cut
402
403sub register_builtin_commands {
404    # Filter modification
405    BarnOwl::new_command("filterappend",
406                         sub { filter_append_helper('appending', '', @_); },
407                       {
408                           summary => "append '<text>' to filter",
409                           usage => "filterappend <filter> <text>",
410                       });
411
412    BarnOwl::new_command("filterand",
413                         sub { filter_append_helper('and-ing', 'and', @_); },
414                       {
415                           summary => "append 'and <text>' to filter",
416                           usage => "filterand <filter> <text>",
417                       });
418
419    BarnOwl::new_command("filteror",
420                         sub { filter_append_helper('or-ing', 'or', @_); },
421                       {
422                           summary => "append 'or <text>' to filter",
423                           usage => "filteror <filter> <text>",
424                       });
425
426    # Date formatting
427    BarnOwl::new_command("showdate",
428                         sub { BarnOwl::time_format('showdate', '%Y-%m-%d %H:%M'); },
429                       {
430                           summary => "Show date in timestamps for supporting styles.",
431                           usage => "showdate",
432                       });
433
434    BarnOwl::new_command("hidedate",
435                         sub { BarnOwl::time_format('hidedate', '%H:%M'); },
436                       {
437                           summary => "Don't show date in timestamps for supporting styles.",
438                           usage => "hidedate",
439                       });
440
441    BarnOwl::new_command("timeformat",
442                         \&BarnOwl::time_format,
443                       {
444                           summary => "Set the format for timestamps and re-display messages",
445                           usage => "timeformat <format>",
446                       });
447
448    # Receive window scrolling
449    BarnOwl::new_command("recv:shiftleft",
450                        \&BarnOwl::recv_shift_left,
451                        {
452                            summary => "scrolls receive window to the left",
453                            usage => "recv:shiftleft [<amount>]",
454                            description => <<END_DESCR
455By default, scroll left by 10 columns. Passing no arguments or 0 activates this default behavior.
456Otherwise, scroll by the number of columns specified as the argument.
457END_DESCR
458                        });
459
460    BarnOwl::new_command("recv:shiftright",
461                        \&BarnOwl::recv_shift_right,
462                        {
463                            summary => "scrolls receive window to the right",
464                            usage => "recv:shiftright [<amount>]",
465                            description => <<END_DESCR
466By default, scroll right by 10 columns. Passing no arguments or 0 activates this default behavior.
467Otherwise, scroll by the number of columns specified as the argument.
468END_DESCR
469                        });
470
471}
472
473$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
474
475=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
476
477Helper to append to filters.
478
479=cut
480
481sub filter_append_helper
482{
483    my $action = shift;
484    my $sep = shift;
485    my $func = shift;
486    my $filter = shift;
487    my @append = @_;
488    my $oldfilter = BarnOwl::getfilter($filter);
489    chomp $oldfilter;
490    my $newfilter = "$oldfilter $sep " . quote(@append);
491    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
492    if (BarnOwl::getvar('showfilterchange') eq 'on') {
493        BarnOwl::admin_message("Filter", $msgtext);
494    }
495    set_filter($filter, $newfilter);
496    return;
497}
498BarnOwl::new_variable_bool("showfilterchange",
499                           { default => 1,
500                             summary => 'Show modifications to filters by filterappend and friends.'});
501
502sub set_filter
503{
504    my $filtername = shift;
505    my $filtertext = shift;
506    my $cmd = 'filter ' . BarnOwl::quote($filtername) . ' ' . $filtertext;
507    BarnOwl::command($cmd);
508}
509
510=head3 time_format FORMAT
511
512Set the format for displaying times (variable timeformat) and redisplay
513messages.
514
515=cut
516
517my $timeformat = '%H:%M';
518
519sub time_format
520{
521    my $function = shift;
522    my $format = shift;
523    if(!$format)
524    {
525        return $timeformat;
526    }
527    if(shift)
528    {
529        return "Wrong number of arguments for command";
530    }
531    $timeformat = $format;
532    redisplay();
533}
534
535=head3 Receive window scrolling
536
537Permit scrolling the receive window left or right by arbitrary
538amounts (with a default of 10 characters).
539
540=cut
541
542sub recv_shift_left
543{
544    my $func = shift;
545    my $delta = shift;
546    $delta = 10 unless defined($delta) && int($delta) > 0;
547    my $shift = BarnOwl::recv_getshift();
548    if($shift > 0) {
549        BarnOwl::recv_setshift(max(0, $shift-$delta));
550    } else {
551        return "Already full left";
552    }
553}
554
555sub recv_shift_right
556{
557    my $func = shift;
558    my $delta = shift;
559    $delta = 10 unless defined($delta) && int($delta) > 0;
560    my $shift = BarnOwl::recv_getshift();
561    BarnOwl::recv_setshift($shift+$delta);
562}
563
564=head3 default_zephyr_signature
565
566Compute the default zephyr signature.
567
568=cut
569
570sub default_zephyr_signature
571{
572  my $zsig = getvar('zsig');
573  if (!defined($zsig) || $zsig eq '') {
574      my $zsigproc = getvar('zsigproc');
575      if (defined($zsigproc) && $zsigproc ne '') {
576          $zsig = `$zsigproc`;
577      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
578          $zsig = ((getpwuid($<))[6]);
579          $zsig =~ s/,.*//;
580      }
581  }
582  chomp($zsig);
583  return $zsig;
584}
585
586=head3 random_zephyr_signature
587
588Retrieve a random line from ~/.zsigs (except those beginning with '#')
589and use it as the zephyr signature.
590
591=cut
592
593sub random_zephyr_signature
594{
595    my $zsigfile = "$ENV{'HOME'}/.zsigs";
596    open my $file, '<', $zsigfile or die "Error opening file $zsigfile: $!";
597    my @lines = grep !(/^#/ || /^\s*$/), <$file>;
598    close $file;
599    return '' if !@lines;
600    my $zsig = "$lines[int(rand(scalar @lines))]";
601    chomp $zsig;
602    return $zsig;
603}
604
605# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
606# startup command. This may be redefined in a user's configfile.
607sub startup
608{
609}
610
6111;
Note: See TracBrowser for help on using the repository browser.