source: perl/lib/BarnOwl.pm @ fe7ece2

Last change on this file since fe7ece2 was fe7ece2, checked in by GitHub Merge Button <merge-button@github.com>, 10 years ago
Merge caac19d40ffaea75410ce13da172590b04dae2b1 into 786a4108f9184d7c73170d373bc2cf80347b6456
  • Property mode set to 100644
File size: 15.8 KB
RevLine 
[ee183be]1use strict;
2use warnings;
3
4package BarnOwl;
5
[2be605a]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
[eede1bf]13                    error debug
[2be605a]14                    create_style getnumcolors wordwrap
[ffc4df6]15                    add_dispatch remove_dispatch
16                    add_io_dispatch remove_io_dispatch
[2be605a]17                    new_command
18                    new_variable_int new_variable_bool new_variable_string
[4df918b]19                    quote redisplay);
[2be605a]20our %EXPORT_TAGS = (all => \@EXPORT_OK);
21
[fd8dfe7]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
[9179fd7]31use Glib;
32use AnyEvent;
33
[fd8dfe7]34use BarnOwl::Hook;
35use BarnOwl::Hooks;
36use BarnOwl::Message;
37use BarnOwl::Style;
[df569c5]38use BarnOwl::Zephyr;
[fd8dfe7]39use BarnOwl::Timer;
[cf26b72]40use BarnOwl::Editwin;
[8eac1a5]41use BarnOwl::Completion;
[b30c256]42use BarnOwl::Help;
[fd8dfe7]43
[6700c605]44use List::Util qw(max);
45
[ee183be]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
[b8a3e00]54BarnOwl by defining things like the default style.
[ee183be]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
[b8a3e00]82Returns the zephyr realm BarnOwl is running in
[ee183be]83
84=head2 zephyr_getsender
85
[b8a3e00]86Returns the fully-qualified name of the zephyr sender BarnOwl is
[ee183be]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
[caac19d]107BarnOwl::Message or a subclass.  Returns the queued message.  This
108is useful for, e.g., deleting a message from the message list.
[ee183be]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
[eede1bf]155=head2 debug STRING
156
157Logs a debugging message to BarnOwl's debug log
158
[ee183be]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
[bcde7926]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'>.
[ffc4df6]172
173=cut
174
175sub add_dispatch {
176    my $fd = shift;
177    my $cb = shift;
178    add_io_dispatch($fd, 'r', $cb);
179}
180
[ee183be]181=head2 remove_dispatch FD
182
183Remove a file descriptor previously registered via C<add_dispatch>
184
[bcde7926]185C<remove_dispatch> has been deprecated in favor of C<AnyEvent>.
[ffc4df6]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
[bcde7926]200C<add_io_dispatch> has been deprecated in favor of C<AnyEvent>.
201
[ffc4df6]202=cut
203
[bcde7926]204our %_io_dispatches;
205
[ffc4df6]206sub add_io_dispatch {
207    my $fd = shift;
208    my $modeStr = shift;
209    my $cb = shift;
[bcde7926]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        }
[ffc4df6]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
[bcde7926]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
[ee183be]240=head2 create_style NAME OBJECT
241
[b8a3e00]242Creates a new BarnOwl style with the given NAME defined by the given
[ee183be]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
[4df918b]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
[ee183be]253=cut
254
255# perlconfig.c will set this to the value of the -c command-line
256# switch, if present.
257our $configfile;
258
[d7bcff8]259our @all_commands;
260
[ee183be]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
[fc92e6e2]372=head2 quote LIST
[ee183be]373
[fc92e6e2]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!'"
[ee183be]379
380=cut
381
382sub quote {
[fc92e6e2]383    my @quoted;
384    for my $str (@_) {
385        if ($str eq '') {
386            push @quoted, "''";
[ef4700c]387        } elsif ($str !~ /['" \n\t]/) {
[fc92e6e2]388            push @quoted, "$str";
389        } elsif ($str !~ /'/) {
390            push @quoted, "'$str'";
391        } else {
392            (my $qstr = $str) =~ s/"/"'"'"/g;
393            push @quoted, '"' . $qstr . '"';
394        }
[ee183be]395    }
[fc92e6e2]396    return join(' ', @quoted);
[ee183be]397}
398
[22b54a7]399=head2 Modify filters by appending text
400
401=cut
402
[cff58b4]403sub register_builtin_commands {
[0b2afba]404    # Filter modification
[cff58b4]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
[0b2afba]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
[6700c605]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
[cff58b4]471}
472
473$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
[22b54a7]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;
[0b5168d]490    my $newfilter = "$oldfilter $sep " . quote(@append);
491    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
[22b54a7]492    if (BarnOwl::getvar('showfilterchange') eq 'on') {
493        BarnOwl::admin_message("Filter", $msgtext);
494    }
[1b9a163]495    set_filter($filter, $newfilter);
[22b54a7]496    return;
497}
498BarnOwl::new_variable_bool("showfilterchange",
499                           { default => 1,
500                             summary => 'Show modifications to filters by filterappend and friends.'});
[ee183be]501
[1b9a163]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
[0b2afba]510=head3 time_format FORMAT
511
512Set the format for displaying times (variable timeformat) and redisplay
513messages.
514
515=cut
516
[d694c55]517my $timeformat = '%H:%M';
[0b2afba]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
[6700c605]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;
[365950b]546    $delta = 10 unless defined($delta) && int($delta) > 0;
[6700c605]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;
[675a998]559    $delta = 10 unless defined($delta) && int($delta) > 0;
[6700c605]560    my $shift = BarnOwl::recv_getshift();
561    BarnOwl::recv_setshift($shift+$delta);
562}
563
[de3f641]564=head3 default_zephyr_signature
565
566Compute the default zephyr signature.
567
568=cut
569
570sub default_zephyr_signature
571{
[77c87b2]572  my $zsig = getvar('zsig');
[785ee77]573  if (!defined($zsig) || $zsig eq '') {
574      my $zsigproc = getvar('zsigproc');
575      if (defined($zsigproc) && $zsigproc ne '') {
[3c428d4]576          $zsig = `$zsigproc`;
577      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
578          $zsig = ((getpwuid($<))[6]);
579          $zsig =~ s/,.*//;
580      }
[de3f641]581  }
[77c87b2]582  chomp($zsig);
583  return $zsig;
[de3f641]584}
585
[b120bd3]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
[7589f0a]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
[ee183be]6111;
Note: See TracBrowser for help on using the repository browser.