source: perl/lib/BarnOwl.pm @ 3e8625f

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