source: perl/lib/BarnOwl.pm @ b54b06a

Last change on this file since b54b06a was b54b06a, checked in by Jason Gross <jgross@mit.edu>, 13 years ago
Added functionality for creating enum variables from perl
  • Property mode set to 100644
File size: 18.0 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_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 new_variable_enum
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 && -f $ENV{HOME} . "/.barnowlconf") {
332    $configfile = $ENV{HOME} . "/.barnowlconf";
333}
334$configfile ||= $ENV{HOME}."/.owlconf";
335
336# populate global variable space for legacy owlconf files
337sub _receive_msg_legacy_wrap {
338    my ($m) = @_;
339    $m->legacy_populate_global();
340    return &BarnOwl::Hooks::_receive_msg($m);
341}
342
343=head2 new_command NAME FUNC [{ARGS}]
344
345Add a new owl command. When owl executes the command NAME, FUNC will
346be called with the arguments passed to the command, with NAME as the
347first argument.
348
349ARGS should be a hashref containing any or all of C<summary>,
350C<usage>, or C<description> keys:
351
352=over 4
353
354=item summary
355
356A one-line summary of the purpose of the command
357
358=item usage
359
360A one-line usage synopsis, showing available options and syntax
361
362=item description
363
364A longer description of the syntax and semantics of the command,
365explaining usage and options
366
367=back
368
369=cut
370
371sub new_command {
372    my $name = shift;
373    my $func = shift;
374    my $args = shift || {};
375    my %args = (
376        summary     => "",
377        usage       => "",
378        description => "",
379        %{$args}
380    );
381
382    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
383}
384
385=head2 new_variable_int NAME [{ARGS}]
386
387=head2 new_variable_bool NAME [{ARGS}]
388
389=head2 new_variable_string NAME [{ARGS}]
390
391=head2 new_variable_enum NAME [{ARGS}]
392
393Add a new owl variable, either an int, a bool, a string, or an enum,
394with the specified name.
395
396ARGS can optionally contain the following keys:
397
398=over 4
399
400=item default
401
402The default and initial value for the variable.
403Note that this should be a string value for an enum.
404
405=item summary
406
407A one-line summary of the variable's purpose
408
409=item description
410
411A longer description of the function of the variable
412
413=item valid_settings
414
415A listref of valid setttings for the enum variable.
416The settings must not contain any commas.
417
418=back
419
420=cut
421
422sub new_variable_int {
423    unshift @_, \&BarnOwl::Internal::new_variable_int, 0;
424    goto \&_new_variable;
425}
426
427sub new_variable_bool {
428    unshift @_, \&BarnOwl::Internal::new_variable_bool, 0;
429    goto \&_new_variable;
430}
431
432sub new_variable_string {
433    unshift @_, \&BarnOwl::Internal::new_variable_string, "";
434    goto \&_new_variable;
435}
436
437sub new_variable_enum {
438    my $name = shift;
439    my $args = shift || {};
440    my %args = (
441        summary     => "",
442        description => "",
443        %{$args});
444
445    my @valid_settings =  @{$args{valid_settings}};
446    if (defined $args{default}) {
447        ($args{default}) = grep { $args{default} eq $valid_settings[$_] } 0..$#valid_settings; # turn the string default into a numerical default
448    } else {
449        $args{default} = 0;
450    }
451    $args{valid_settings} = join ",", @valid_settings;
452
453    BarnOwl::Internal::new_variable_enum($name, $args{default}, $args{summary}, $args{description}, $args{valid_settings});
454}
455
456sub _new_variable {
457    my $func = shift;
458    my $default_default = shift;
459    my $name = shift;
460    my $args = shift || {};
461    my %args = (
462        summary     => "",
463        description => "",
464        default     => $default_default,
465        %{$args});
466    $func->($name, $args{default}, $args{summary}, $args{description});
467}
468
469=head2 quote LIST
470
471Quotes each of the strings in LIST and returns a string that will be
472correctly decoded to LIST by the BarnOwl command parser.  For example:
473
474    quote('zwrite', 'andersk', '-m', 'Hello, world!')
475    # returns "zwrite andersk -m 'Hello, world!'"
476
477=cut
478
479sub quote {
480    my @quoted;
481    for my $str (@_) {
482        if ($str eq '') {
483            push @quoted, "''";
484        } elsif ($str !~ /['" \n\t]/) {
485            push @quoted, "$str";
486        } elsif ($str !~ /'/) {
487            push @quoted, "'$str'";
488        } else {
489            (my $qstr = $str) =~ s/"/"'"'"/g;
490            push @quoted, '"' . $qstr . '"';
491        }
492    }
493    return join(' ', @quoted);
494}
495
496=head2 Modify filters by appending text
497
498=cut
499
500sub register_builtin_commands {
501    # Filter modification
502    BarnOwl::new_command("filterappend",
503                         sub { filter_append_helper('appending', '', @_); },
504                       {
505                           summary => "append '<text>' to filter",
506                           usage => "filterappend <filter> <text>",
507                       });
508
509    BarnOwl::new_command("filterand",
510                         sub { filter_append_helper('and-ing', 'and', @_); },
511                       {
512                           summary => "append 'and <text>' to filter",
513                           usage => "filterand <filter> <text>",
514                       });
515
516    BarnOwl::new_command("filteror",
517                         sub { filter_append_helper('or-ing', 'or', @_); },
518                       {
519                           summary => "append 'or <text>' to filter",
520                           usage => "filteror <filter> <text>",
521                       });
522
523    # Date formatting
524    BarnOwl::new_command("showdate",
525                         sub { BarnOwl::time_format('showdate', '%Y-%m-%d %H:%M'); },
526                       {
527                           summary => "Show date in timestamps for supporting styles.",
528                           usage => "showdate",
529                       });
530
531    BarnOwl::new_command("hidedate",
532                         sub { BarnOwl::time_format('hidedate', '%H:%M'); },
533                       {
534                           summary => "Don't show date in timestamps for supporting styles.",
535                           usage => "hidedate",
536                       });
537
538    BarnOwl::new_command("timeformat",
539                         \&BarnOwl::time_format,
540                       {
541                           summary => "Set the format for timestamps and re-display messages",
542                           usage => "timeformat <format>",
543                       });
544
545    # Receive window scrolling
546    BarnOwl::new_command("recv:shiftleft",
547                        \&BarnOwl::recv_shift_left,
548                        {
549                            summary => "scrolls receive window to the left",
550                            usage => "recv:shiftleft [<amount>]",
551                            description => <<END_DESCR
552By default, scroll left by 10 columns. Passing no arguments or 0 activates this default behavior.
553Otherwise, scroll by the number of columns specified as the argument.
554END_DESCR
555                        });
556
557    BarnOwl::new_command("recv:shiftright",
558                        \&BarnOwl::recv_shift_right,
559                        {
560                            summary => "scrolls receive window to the right",
561                            usage => "recv:shiftright [<amount>]",
562                            description => <<END_DESCR
563By default, scroll right by 10 columns. Passing no arguments or 0 activates this default behavior.
564Otherwise, scroll by the number of columns specified as the argument.
565END_DESCR
566                        });
567
568}
569
570$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
571
572=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
573
574Helper to append to filters.
575
576=cut
577
578sub filter_append_helper
579{
580    my $action = shift;
581    my $sep = shift;
582    my $func = shift;
583    my $filter = shift;
584    my @append = @_;
585    my $oldfilter = BarnOwl::getfilter($filter);
586    chomp $oldfilter;
587    my $newfilter = "$oldfilter $sep " . quote(@append);
588    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
589    if (BarnOwl::getvar('showfilterchange') eq 'on') {
590        BarnOwl::admin_message("Filter", $msgtext);
591    }
592    set_filter($filter, $newfilter);
593    return;
594}
595BarnOwl::new_variable_bool("showfilterchange",
596                           { default => 1,
597                             summary => 'Show modifications to filters by filterappend and friends.'});
598
599sub set_filter
600{
601    my $filtername = shift;
602    my $filtertext = shift;
603    my $cmd = 'filter ' . BarnOwl::quote($filtername) . ' ' . $filtertext;
604    BarnOwl::command($cmd);
605}
606
607=head3 time_format FORMAT
608
609Set the format for displaying times (variable timeformat) and redisplay
610messages.
611
612=cut
613
614my $timeformat = '%H:%M';
615
616sub time_format
617{
618    my $function = shift;
619    my $format = shift;
620    if(!$format)
621    {
622        return $timeformat;
623    }
624    if(shift)
625    {
626        return "Wrong number of arguments for command";
627    }
628    $timeformat = $format;
629    redisplay();
630}
631
632=head3 Receive window scrolling
633
634Permit scrolling the receive window left or right by arbitrary
635amounts (with a default of 10 characters).
636
637=cut
638
639sub recv_shift_left
640{
641    my $func = shift;
642    my $delta = shift;
643    $delta = 10 unless defined($delta) && int($delta) > 0;
644    my $shift = BarnOwl::recv_getshift();
645    if($shift > 0) {
646        BarnOwl::recv_setshift(max(0, $shift-$delta));
647    } else {
648        return "Already full left";
649    }
650}
651
652sub recv_shift_right
653{
654    my $func = shift;
655    my $delta = shift;
656    $delta = 10 unless defined($delta) && int($delta) > 0;
657    my $shift = BarnOwl::recv_getshift();
658    BarnOwl::recv_setshift($shift+$delta);
659}
660
661=head3 default_zephyr_signature
662
663Compute the default zephyr signature.
664
665=cut
666
667sub default_zephyr_signature
668{
669  my $zsig = getvar('zsig');
670  if (!defined($zsig) || $zsig eq '') {
671      my $zsigproc = getvar('zsigproc');
672      if (defined($zsigproc) && $zsigproc ne '') {
673          $zsig = `$zsigproc`;
674      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
675          $zsig = ((getpwuid($<))[6]);
676          $zsig =~ s/,.*//;
677      }
678  }
679  chomp($zsig);
680  return $zsig;
681}
682
683=head3 random_zephyr_signature
684
685Retrieve a random line from ~/.zsigs (except those beginning with '#')
686and use it as the zephyr signature.
687
688=cut
689
690sub random_zephyr_signature
691{
692    my $zsigfile = "$ENV{'HOME'}/.zsigs";
693    open my $file, '<', $zsigfile or die "Error opening file $zsigfile: $!";
694    my @lines = grep !(/^#/ || /^\s*$/), <$file>;
695    close $file;
696    return '' if !@lines;
697    my $zsig = "$lines[int(rand(scalar @lines))]";
698    chomp $zsig;
699    return $zsig;
700}
701
702# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
703# startup command. This may be redefined in a user's configfile.
704sub startup
705{
706}
707
7081;
Note: See TracBrowser for help on using the repository browser.