source: perl/lib/BarnOwl.pm @ c068c03

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