source: perl/lib/BarnOwl.pm @ a4dd3a5

release-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since a4dd3a5 was 0b5168d, checked in by Anders Kaseorg <andersk@mit.edu>, 15 years ago
Fix quoting for filterappend, filterand, filteror. Signed-off-by: Anders Kaseorg <andersk@mit.edu>
  • Property mode set to 100644
File size: 9.6 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_dispath remove_dispatch
16                    new_command
17                    new_variable_int new_variable_bool new_variable_string
18                    quote);
19our %EXPORT_TAGS = (all => \@EXPORT_OK);
20
21BEGIN {
22# bootstrap in C bindings and glue
23    *owl:: = \*BarnOwl::;
24    bootstrap BarnOwl 1.2;
25};
26
27use lib(get_data_dir() . "/lib");
28use lib(get_config_dir() . "/lib");
29
30use BarnOwl::Hook;
31use BarnOwl::Hooks;
32use BarnOwl::Message;
33use BarnOwl::Style;
34use BarnOwl::Timer;
35use BarnOwl::Editwin;
36use BarnOwl::Completion;
37
38=head1 NAME
39
40BarnOwl
41
42=head1 DESCRIPTION
43
44The BarnOwl module contains the core of BarnOwl's perl
45bindings. Source in this module is also run at startup to bootstrap
46barnowl by defining things like the default style.
47
48=for NOTE
49These following functions are defined in perlglue.xs. Keep the
50documentation here in sync with the user-visible commands defined
51there!
52
53=head2 command STRING
54
55Executes a BarnOwl command in the same manner as if the user had
56executed it at the BarnOwl command prompt. If the command returns a
57value, return it as a string, otherwise return undef.
58
59=head2 getcurmsg
60
61Returns the current message as a C<BarnOwl::Message> subclass, or
62undef if there is no message selected
63
64=head2 getnumcols
65
66Returns the width of the display window BarnOwl is currently using
67
68=head2 getidletime
69
70Returns the length of time since the user has pressed a key, in
71seconds.
72
73=head2 zephyr_getrealm
74
75Returns the zephyr realm barnowl is running in
76
77=head2 zephyr_getsender
78
79Returns the fully-qualified name of the zephyr sender barnowl is
80running as, e.g. C<nelhage@ATHENA.MIT.EDU>
81
82=head2 zephyr_zwrite COMMAND MESSAGE
83
84Sends a zephyr programmatically. C<COMMAND> should be a C<zwrite>
85command line, and C<MESSAGE> is the zephyr body to send.
86
87=head2 ztext_stylestrip STRING
88
89Strips zephyr formatting from a string and returns the result
90
91=head2 zephyr_getsubs
92
93Returns the list of subscription triples <class,instance,recipient>,
94separated by newlines.
95
96=head2 queue_message MESSAGE
97
98Enqueue a message in the BarnOwl message list, logging it and
99processing it appropriately. C<MESSAGE> should be an instance of
100BarnOwl::Message or a subclass.
101
102=head2 admin_message HEADER BODY
103
104Display a BarnOwl B<Admin> message, with the given header and body.
105
106=head2 start_question PROMPT CALLBACK
107
108Displays C<PROMPT> on the screen and lets the user enter a line of
109text, and calls C<CALLBACK>, which must be a perl subroutine
110reference, with the text the user entered
111
112=head2 start_password PROMPT CALLBACK
113
114Like C<start_question>, but echoes the user's input as C<*>s when they
115input.
116
117=head2 start_edit_win PROMPT CALLBACK
118
119Like C<start_question>, but displays C<PROMPT> on a line of its own
120and opens the editwin. If the user cancels the edit win, C<CALLBACK>
121is not invoked.
122
123=head2 get_data_dir
124
125Returns the BarnOwl system data directory, where system libraries and
126modules are stored
127
128=head2 get_config_dir
129
130Returns the BarnOwl user configuration directory, where user modules
131and configuration are stored (by default, C<$HOME/.owl>)
132
133=head2 popless_text TEXT
134
135Show a popup window containing the given C<TEXT>
136
137=head2 popless_ztext TEXT
138
139Show a popup window containing the provided zephyr-formatted C<TEXT>
140
141=head2 error STRING
142
143Reports an error and log it in `show errors'. Note that in any
144callback or hook called in perl code from BarnOwl, a C<die> will be
145caught and passed to C<error>.
146
147=head2 debug STRING
148
149Logs a debugging message to BarnOwl's debug log
150
151=head2 getnumcolors
152
153Returns the number of colors this BarnOwl is capable of displaying
154
155=head2 add_dispatch FD CALLBACK
156
157Adds a file descriptor to C<BarnOwl>'s internal C<select()>
158loop. C<CALLBACK> will be invoked whenever data is available to be
159read from C<FD>.
160
161=head2 remove_dispatch FD
162
163Remove a file descriptor previously registered via C<add_dispatch>
164
165=head2 create_style NAME OBJECT
166
167Creates a new barnowl style with the given NAME defined by the given
168object. The object must have a C<description> method which returns a
169string description of the style, and a and C<format_message> method
170which accepts a C<BarnOwl::Message> object and returns a string that
171is the result of formatting the message for display.
172
173=cut
174
175# perlconfig.c will set this to the value of the -c command-line
176# switch, if present.
177our $configfile;
178
179our @all_commands;
180
181if(!$configfile && -f $ENV{HOME} . "/.barnowlconf") {
182    $configfile = $ENV{HOME} . "/.barnowlconf";
183}
184$configfile ||= $ENV{HOME}."/.owlconf";
185
186# populate global variable space for legacy owlconf files
187sub _receive_msg_legacy_wrap {
188    my ($m) = @_;
189    $m->legacy_populate_global();
190    return &BarnOwl::Hooks::_receive_msg($m);
191}
192
193=head2 new_command NAME FUNC [{ARGS}]
194
195Add a new owl command. When owl executes the command NAME, FUNC will
196be called with the arguments passed to the command, with NAME as the
197first argument.
198
199ARGS should be a hashref containing any or all of C<summary>,
200C<usage>, or C<description> keys:
201
202=over 4
203
204=item summary
205
206A one-line summary of the purpose of the command
207
208=item usage
209
210A one-line usage synopsis, showing available options and syntax
211
212=item description
213
214A longer description of the syntax and semantics of the command,
215explaining usage and options
216
217=back
218
219=cut
220
221sub new_command {
222    my $name = shift;
223    my $func = shift;
224    my $args = shift || {};
225    my %args = (
226        summary     => "",
227        usage       => "",
228        description => "",
229        %{$args}
230    );
231
232    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
233}
234
235=head2 new_variable_int NAME [{ARGS}]
236
237=head2 new_variable_bool NAME [{ARGS}]
238
239=head2 new_variable_string NAME [{ARGS}]
240
241Add a new owl variable, either an int, a bool, or a string, with the
242specified name.
243
244ARGS can optionally contain the following keys:
245
246=over 4
247
248=item default
249
250The default and initial value for the variable
251
252=item summary
253
254A one-line summary of the variable's purpose
255
256=item description
257
258A longer description of the function of the variable
259
260=back
261
262=cut
263
264sub new_variable_int {
265    unshift @_, \&BarnOwl::Internal::new_variable_int, 0;
266    goto \&_new_variable;
267}
268
269sub new_variable_bool {
270    unshift @_, \&BarnOwl::Internal::new_variable_bool, 0;
271    goto \&_new_variable;
272}
273
274sub new_variable_string {
275    unshift @_, \&BarnOwl::Internal::new_variable_string, "";
276    goto \&_new_variable;
277}
278
279sub _new_variable {
280    my $func = shift;
281    my $default_default = shift;
282    my $name = shift;
283    my $args = shift || {};
284    my %args = (
285        summary     => "",
286        description => "",
287        default     => $default_default,
288        %{$args});
289    $func->($name, $args{default}, $args{summary}, $args{description});
290}
291
292=head2 quote LIST
293
294Quotes each of the strings in LIST and returns a string that will be
295correctly decoded to LIST by the BarnOwl command parser.  For example:
296
297    quote('zwrite', 'andersk', '-m', 'Hello, world!')
298    # returns "zwrite andersk -m 'Hello, world!'"
299
300=cut
301
302sub quote {
303    my @quoted;
304    for my $str (@_) {
305        if ($str eq '') {
306            push @quoted, "''";
307        } elsif ($str !~ /['" ]/) {
308            push @quoted, "$str";
309        } elsif ($str !~ /'/) {
310            push @quoted, "'$str'";
311        } else {
312            (my $qstr = $str) =~ s/"/"'"'"/g;
313            push @quoted, '"' . $qstr . '"';
314        }
315    }
316    return join(' ', @quoted);
317}
318
319=head2 Modify filters by appending text
320
321=cut
322
323sub register_builtin_commands {
324    BarnOwl::new_command("filterappend",
325                         sub { filter_append_helper('appending', '', @_); },
326                       {
327                           summary => "append '<text>' to filter",
328                           usage => "filterappend <filter> <text>",
329                       });
330
331    BarnOwl::new_command("filterand",
332                         sub { filter_append_helper('and-ing', 'and', @_); },
333                       {
334                           summary => "append 'and <text>' to filter",
335                           usage => "filterand <filter> <text>",
336                       });
337
338    BarnOwl::new_command("filteror",
339                         sub { filter_append_helper('or-ing', 'or', @_); },
340                       {
341                           summary => "append 'or <text>' to filter",
342                           usage => "filteror <filter> <text>",
343                       });
344
345}
346
347$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
348
349=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
350
351Helper to append to filters.
352
353=cut
354
355sub filter_append_helper
356{
357    my $action = shift;
358    my $sep = shift;
359    my $func = shift;
360    my $filter = shift;
361    my @append = @_;
362    my $oldfilter = BarnOwl::getfilter($filter);
363    chomp $oldfilter;
364    my $newfilter = "$oldfilter $sep " . quote(@append);
365    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
366    if (BarnOwl::getvar('showfilterchange') eq 'on') {
367        BarnOwl::admin_message("Filter", $msgtext);
368    }
369    BarnOwl::filter($filter, $newfilter);
370    return;
371}
372BarnOwl::new_variable_bool("showfilterchange",
373                           { default => 1,
374                             summary => 'Show modifications to filters by filterappend and friends.'});
375
3761;
Note: See TracBrowser for help on using the repository browser.