source: perl/lib/BarnOwl.pm @ 0b20de4

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