source: perl/lib/BarnOwl.pm @ 048b1ff

release-1.9
Last change on this file since 048b1ff was b303ba2, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 10 years ago
Add getnumlines() to perl interface
  • Property mode set to 100644
File size: 17.3 KB
RevLine 
[ee183be]1use strict;
2use warnings;
3
4package BarnOwl;
5
[2be605a]6use base qw(Exporter);
[b303ba2]7our @EXPORT_OK = qw(command getcurmsg getnumcols getnumlines getidletime
[2be605a]8                    zephyr_getsender zephyr_getrealm zephyr_zwrite
9                    zephyr_stylestrip zephyr_smartstrip_user zephyr_getsubs
10                    queue_message admin_message
[e89ec48]11                    start_edit
[2be605a]12                    start_question start_password start_edit_win
13                    get_data_dir get_config_dir popless_text popless_ztext
[eede1bf]14                    error debug
[2be605a]15                    create_style getnumcolors wordwrap
[ffc4df6]16                    add_dispatch remove_dispatch
17                    add_io_dispatch remove_io_dispatch
[2be605a]18                    new_command
19                    new_variable_int new_variable_bool new_variable_string
[4df918b]20                    quote redisplay);
[2be605a]21our %EXPORT_TAGS = (all => \@EXPORT_OK);
22
[fd8dfe7]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
[9179fd7]32use Glib;
33use AnyEvent;
34
[fd8dfe7]35use BarnOwl::Hook;
36use BarnOwl::Hooks;
37use BarnOwl::Message;
38use BarnOwl::Style;
[df569c5]39use BarnOwl::Zephyr;
[fd8dfe7]40use BarnOwl::Timer;
[cf26b72]41use BarnOwl::Editwin;
[8eac1a5]42use BarnOwl::Completion;
[b30c256]43use BarnOwl::Help;
[fd8dfe7]44
[6700c605]45use List::Util qw(max);
46
[ee183be]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
[b8a3e00]55BarnOwl by defining things like the default style.
[ee183be]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
[b8a3e00]83Returns the zephyr realm BarnOwl is running in
[ee183be]84
85=head2 zephyr_getsender
86
[b8a3e00]87Returns the fully-qualified name of the zephyr sender BarnOwl is
[ee183be]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
[e89ec48]108BarnOwl::Message or a subclass.
[ee183be]109
110=head2 admin_message HEADER BODY
111
112Display a BarnOwl B<Admin> message, with the given header and body.
113
[e89ec48]114=head2 start_edit %ARGS
[ee183be]115
[e89ec48]116Displays a prompt on the screen and lets the user enter text,
117and calls a callback when the editwin is closed.
[ee183be]118
[e89ec48]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
[ee183be]143
[e89ec48]144Like question, but echoes the user's input as C<*>s when they
[ee183be]145input.
146
[e89ec48]147=back
148
149=item callback
150
151A Perl subroutine that is called when the user closes the edit_win.
[7803326]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.
[e89ec48]155
156=back
157
158=head2 start_question PROMPT CALLBACK
159
160=head2 start_password PROMPT CALLBACK
161
[ee183be]162=head2 start_edit_win PROMPT CALLBACK
163
[7803326]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.
[e89ec48]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) = @_;
[7803326]179    BarnOwl::start_edit(type => 'question', prompt => $prompt, callback => sub {
180            my ($text, $success) = @_;
181            $callback->($text) if $success;
182        });
[e89ec48]183}
184
185sub start_password {
186    my ($prompt, $callback) = @_;
[7803326]187    BarnOwl::start_edit(type => 'password', prompt => $prompt, callback => sub {
188            my ($text, $success) = @_;
189            $callback->($text) if $success;
190        });
[e89ec48]191}
192
193sub start_edit_win {
194    my ($prompt, $callback) = @_;
[7803326]195    BarnOwl::start_edit(type => 'edit_win', prompt => $prompt, callback => sub {
196            my ($text, $success) = @_;
197            $callback->($text) if $success;
198        });
[e89ec48]199}
[ee183be]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
[eede1bf]225=head2 debug STRING
226
227Logs a debugging message to BarnOwl's debug log
228
[ee183be]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
[bcde7926]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'>.
[ffc4df6]242
243=cut
244
245sub add_dispatch {
246    my $fd = shift;
247    my $cb = shift;
248    add_io_dispatch($fd, 'r', $cb);
249}
250
[ee183be]251=head2 remove_dispatch FD
252
253Remove a file descriptor previously registered via C<add_dispatch>
254
[bcde7926]255C<remove_dispatch> has been deprecated in favor of C<AnyEvent>.
[ffc4df6]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
[bcde7926]270C<add_io_dispatch> has been deprecated in favor of C<AnyEvent>.
271
[ffc4df6]272=cut
273
[bcde7926]274our %_io_dispatches;
275
[ffc4df6]276sub add_io_dispatch {
277    my $fd = shift;
278    my $modeStr = shift;
279    my $cb = shift;
[bcde7926]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        }
[ffc4df6]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
[bcde7926]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
[ee183be]310=head2 create_style NAME OBJECT
311
[b8a3e00]312Creates a new BarnOwl style with the given NAME defined by the given
[ee183be]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
[4df918b]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
[ee183be]323=cut
324
325# perlconfig.c will set this to the value of the -c command-line
326# switch, if present.
327our $configfile;
328
[d7bcff8]329our @all_commands;
330
[8135737]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    }
[ee183be]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
[fc92e6e2]447=head2 quote LIST
[ee183be]448
[fc92e6e2]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!'"
[ee183be]454
455=cut
456
457sub quote {
[fc92e6e2]458    my @quoted;
459    for my $str (@_) {
460        if ($str eq '') {
461            push @quoted, "''";
[ef4700c]462        } elsif ($str !~ /['" \n\t]/) {
[fc92e6e2]463            push @quoted, "$str";
464        } elsif ($str !~ /'/) {
465            push @quoted, "'$str'";
466        } else {
467            (my $qstr = $str) =~ s/"/"'"'"/g;
468            push @quoted, '"' . $qstr . '"';
469        }
[ee183be]470    }
[fc92e6e2]471    return join(' ', @quoted);
[ee183be]472}
473
[22b54a7]474=head2 Modify filters by appending text
475
476=cut
477
[cff58b4]478sub register_builtin_commands {
[0b2afba]479    # Filter modification
[cff58b4]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
[0b2afba]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
[6700c605]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
[cff58b4]546}
547
548$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
[22b54a7]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;
[0b5168d]565    my $newfilter = "$oldfilter $sep " . quote(@append);
566    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
[22b54a7]567    if (BarnOwl::getvar('showfilterchange') eq 'on') {
568        BarnOwl::admin_message("Filter", $msgtext);
569    }
[1b9a163]570    set_filter($filter, $newfilter);
[22b54a7]571    return;
572}
573BarnOwl::new_variable_bool("showfilterchange",
574                           { default => 1,
575                             summary => 'Show modifications to filters by filterappend and friends.'});
[ee183be]576
[1b9a163]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
[0b2afba]585=head3 time_format FORMAT
586
587Set the format for displaying times (variable timeformat) and redisplay
588messages.
589
590=cut
591
[d694c55]592my $timeformat = '%H:%M';
[0b2afba]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
[6700c605]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;
[365950b]621    $delta = 10 unless defined($delta) && int($delta) > 0;
[6700c605]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;
[675a998]634    $delta = 10 unless defined($delta) && int($delta) > 0;
[6700c605]635    my $shift = BarnOwl::recv_getshift();
636    BarnOwl::recv_setshift($shift+$delta);
637}
638
[de3f641]639=head3 default_zephyr_signature
640
641Compute the default zephyr signature.
642
643=cut
644
645sub default_zephyr_signature
646{
[77c87b2]647  my $zsig = getvar('zsig');
[785ee77]648  if (!defined($zsig) || $zsig eq '') {
649      my $zsigproc = getvar('zsigproc');
650      if (defined($zsigproc) && $zsigproc ne '') {
[3c428d4]651          $zsig = `$zsigproc`;
652      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
653          $zsig = ((getpwuid($<))[6]);
654          $zsig =~ s/,.*//;
655      }
[de3f641]656  }
[77c87b2]657  chomp($zsig);
658  return $zsig;
[de3f641]659}
660
[b120bd3]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
[7589f0a]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
[ee183be]6861;
Note: See TracBrowser for help on using the repository browser.