source: perl/lib/BarnOwl.pm @ b303ba2

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