source: perl/lib/BarnOwl.pm @ eede1bf

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