source: perl/lib/BarnOwl.pm @ 3b9ca71

Last change on this file since 3b9ca71 was 3b9ca71, checked in by David Benjamin <davidben@mit.edu>, 9 years ago
Allow perl variables to participate in argumentless set/unset
  • Property mode set to 100644
File size: 18.4 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 @_, 0, "<int>", 0, sub { "$_[0]" }, # to string
429                               sub { $_[0] =~ /^-?[0-9]+$/ }, # validate
430                               sub { 0 + $_[0] }; # from string
431    goto \&_new_variable;
432}
433
434sub new_variable_bool {
435    unshift @_, 0, "on,off", 1, sub { $_[0] ? "on" : "off" }, # to string
436                                sub { $_[0] eq "on" || $_[0] eq "off" }, # validate
437                                sub { $_[0] eq "on" }; # from string
438    goto \&_new_variable;
439}
440
441sub new_variable_string {
442    unshift @_, "", "<string>", 0, sub { $_[0] }, # to string
443                                   sub { 1 }, # validate
444                                   sub { $_[0] }; # from string
445    goto \&_new_variable;
446}
447
448sub _new_variable {
449    my $default_default = shift;
450    my $validsettings = shift;
451    my $takes_on_off = shift;
452    my $tostring_fn = shift;
453    my $validate_fn = shift;
454    my $fromstring_fn = shift;
455
456    my $name = shift;
457    my $args = shift || {};
458    my %args = (
459        summary     => "",
460        description => "",
461        default     => $default_default,
462        %{$args});
463
464    # Store the value in a closure.
465    my $value = $args{default};
466
467    my $get_tostring_fn = sub { $tostring_fn->($value) };
468    my $set_fromstring_fn = sub {
469      my ($dummy, $newval) = @_;
470      return -1 unless $validate_fn->($newval);
471      $value = $fromstring_fn->($newval);
472      return 0;
473    };
474
475    BarnOwl::Internal::new_variable($name, $args{summary}, $args{description}, $validsettings,
476                                    $takes_on_off, $get_tostring_fn, $set_fromstring_fn, undef);
477}
478
479=head2 quote LIST
480
481Quotes each of the strings in LIST and returns a string that will be
482correctly decoded to LIST by the BarnOwl command parser.  For example:
483
484    quote('zwrite', 'andersk', '-m', 'Hello, world!')
485    # returns "zwrite andersk -m 'Hello, world!'"
486
487=cut
488
489sub quote {
490    my @quoted;
491    for my $str (@_) {
492        if ($str eq '') {
493            push @quoted, "''";
494        } elsif ($str !~ /['" \n\t]/) {
495            push @quoted, "$str";
496        } elsif ($str !~ /'/) {
497            push @quoted, "'$str'";
498        } else {
499            (my $qstr = $str) =~ s/"/"'"'"/g;
500            push @quoted, '"' . $qstr . '"';
501        }
502    }
503    return join(' ', @quoted);
504}
505
506=head2 Modify filters by appending text
507
508=cut
509
510sub register_builtin_commands {
511    # Filter modification
512    BarnOwl::new_command("filterappend",
513                         sub { filter_append_helper('appending', '', @_); },
514                       {
515                           summary => "append '<text>' to filter",
516                           usage => "filterappend <filter> <text>",
517                       });
518
519    BarnOwl::new_command("filterand",
520                         sub { filter_append_helper('and-ing', 'and', @_); },
521                       {
522                           summary => "append 'and <text>' to filter",
523                           usage => "filterand <filter> <text>",
524                       });
525
526    BarnOwl::new_command("filteror",
527                         sub { filter_append_helper('or-ing', 'or', @_); },
528                       {
529                           summary => "append 'or <text>' to filter",
530                           usage => "filteror <filter> <text>",
531                       });
532
533    # Date formatting
534    BarnOwl::new_command("showdate",
535                         sub { BarnOwl::time_format('showdate', '%Y-%m-%d %H:%M'); },
536                       {
537                           summary => "Show date in timestamps for supporting styles.",
538                           usage => "showdate",
539                       });
540
541    BarnOwl::new_command("hidedate",
542                         sub { BarnOwl::time_format('hidedate', '%H:%M'); },
543                       {
544                           summary => "Don't show date in timestamps for supporting styles.",
545                           usage => "hidedate",
546                       });
547
548    BarnOwl::new_command("timeformat",
549                         \&BarnOwl::time_format,
550                       {
551                           summary => "Set the format for timestamps and re-display messages",
552                           usage => "timeformat <format>",
553                       });
554
555    # Receive window scrolling
556    BarnOwl::new_command("recv:shiftleft",
557                        \&BarnOwl::recv_shift_left,
558                        {
559                            summary => "scrolls receive window to the left",
560                            usage => "recv:shiftleft [<amount>]",
561                            description => <<END_DESCR
562By default, scroll left by 10 columns. Passing no arguments or 0 activates this default behavior.
563Otherwise, scroll by the number of columns specified as the argument.
564END_DESCR
565                        });
566
567    BarnOwl::new_command("recv:shiftright",
568                        \&BarnOwl::recv_shift_right,
569                        {
570                            summary => "scrolls receive window to the right",
571                            usage => "recv:shiftright [<amount>]",
572                            description => <<END_DESCR
573By default, scroll right by 10 columns. Passing no arguments or 0 activates this default behavior.
574Otherwise, scroll by the number of columns specified as the argument.
575END_DESCR
576                        });
577
578}
579
580$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
581
582=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
583
584Helper to append to filters.
585
586=cut
587
588sub filter_append_helper
589{
590    my $action = shift;
591    my $sep = shift;
592    my $func = shift;
593    my $filter = shift;
594    my @append = @_;
595    my $oldfilter = BarnOwl::getfilter($filter);
596    chomp $oldfilter;
597    my $newfilter = "$oldfilter $sep " . quote(@append);
598    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
599    if (BarnOwl::getvar('showfilterchange') eq 'on') {
600        BarnOwl::admin_message("Filter", $msgtext);
601    }
602    set_filter($filter, $newfilter);
603    return;
604}
605BarnOwl::new_variable_bool("showfilterchange",
606                           { default => 1,
607                             summary => 'Show modifications to filters by filterappend and friends.'});
608
609sub set_filter
610{
611    my $filtername = shift;
612    my $filtertext = shift;
613    my $cmd = 'filter ' . BarnOwl::quote($filtername) . ' ' . $filtertext;
614    BarnOwl::command($cmd);
615}
616
617=head3 time_format FORMAT
618
619Set the format for displaying times (variable timeformat) and redisplay
620messages.
621
622=cut
623
624my $timeformat = '%H:%M';
625
626sub time_format
627{
628    my $function = shift;
629    my $format = shift;
630    if(!$format)
631    {
632        return $timeformat;
633    }
634    if(shift)
635    {
636        return "Wrong number of arguments for command";
637    }
638    $timeformat = $format;
639    redisplay();
640}
641
642=head3 Receive window scrolling
643
644Permit scrolling the receive window left or right by arbitrary
645amounts (with a default of 10 characters).
646
647=cut
648
649sub recv_shift_left
650{
651    my $func = shift;
652    my $delta = shift;
653    $delta = 10 unless defined($delta) && int($delta) > 0;
654    my $shift = BarnOwl::recv_getshift();
655    if($shift > 0) {
656        BarnOwl::recv_setshift(max(0, $shift-$delta));
657    } else {
658        return "Already full left";
659    }
660}
661
662sub recv_shift_right
663{
664    my $func = shift;
665    my $delta = shift;
666    $delta = 10 unless defined($delta) && int($delta) > 0;
667    my $shift = BarnOwl::recv_getshift();
668    BarnOwl::recv_setshift($shift+$delta);
669}
670
671=head3 default_zephyr_signature
672
673Compute the default zephyr signature.
674
675=cut
676
677sub default_zephyr_signature
678{
679  my $zsig = getvar('zsig');
680  if (!defined($zsig) || $zsig eq '') {
681      my $zsigproc = getvar('zsigproc');
682      if (defined($zsigproc) && $zsigproc ne '') {
683          $zsig = `$zsigproc`;
684      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
685          $zsig = ((getpwuid($<))[6]);
686          $zsig =~ s/,.*//;
687      }
688  }
689  chomp($zsig);
690  return $zsig;
691}
692
693=head3 random_zephyr_signature
694
695Retrieve a random line from ~/.zsigs (except those beginning with '#')
696and use it as the zephyr signature.
697
698=cut
699
700sub random_zephyr_signature
701{
702    my $zsigfile = "$ENV{'HOME'}/.zsigs";
703    open my $file, '<', $zsigfile or die "Error opening file $zsigfile: $!";
704    my @lines = grep !(/^#/ || /^\s*$/), <$file>;
705    close $file;
706    return '' if !@lines;
707    my $zsig = "$lines[int(rand(scalar @lines))]";
708    chomp $zsig;
709    return $zsig;
710}
711
712# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
713# startup command. This may be redefined in a user's configfile.
714sub startup
715{
716}
717
7181;
Note: See TracBrowser for help on using the repository browser.