source: perl/lib/BarnOwl/Hooks.pm @ e2f7963

release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since e2f7963 was e2f7963, checked in by Nelson Elhage <nelhage@mit.edu>, 12 years ago
Fix missing commands from command completion. If even a command is shadowed from the BarnOwl:: namespace by an existing sub, we should include it in the list of all commands that is used by the completion code.
  • Property mode set to 100644
File size: 6.5 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Hooks;
5
6use Carp;
7use List::Util qw(first);
8
9=head1 BarnOwl::Hooks
10
11=head1 DESCRIPTION
12
13C<BarnOwl::Hooks> exports a set of C<BarnOwl::Hook> objects made
14available by BarnOwl internally.
15
16=head2 USAGE
17
18Modules wishing to respond to events in BarnOwl should register
19functions with these hooks.
20
21=head2 EXPORTS
22
23None by default. Either import the hooks you need explicitly, or refer
24to them with fully-qualified names. Available hooks are:
25
26=over 4
27
28=item $startup
29
30Called on BarnOwl startup, and whenever modules are
31reloaded. Functions registered with the C<$startup> hook get a true
32argument if this is a reload, and false if this is a true startup
33
34=item $shutdown
35
36Called before BarnOwl shutdown
37
38=item $receiveMessage
39
40Called with a C<BarnOwl::Message> object every time BarnOwl receives a
41new incoming message.
42
43=item $newMessage
44
45Called with a C<BarnOwl::Message> object every time BarnOwl appends
46I<any> new message to the message list.
47
48=item $mainLoop
49
50Called on every pass through the C<BarnOwl> main loop. This is
51guaranteed to be called at least once/sec and may be called more
52frequently.
53
54=item $getBuddyList
55
56Called to display buddy lists for all protocol handlers. The result
57from every function registered with this hook will be appended and
58displayed in a popup window, with zephyr formatting parsed.
59
60=item $getQuickstart
61
62Called by :show quickstart to display 2-5 lines of help on how to
63start using the protocol. The result from every function registered
64with this hook will be appended and displayed in an admin message,
65with zephyr formatting parsed. The format should be
66"@b(Protocol:)\nSome text.\nMore text.\n"
67
68=back
69
70=cut
71
72use Exporter;
73
74our @EXPORT_OK = qw($startup $shutdown
75                    $receiveMessage $newMessage
76                    $mainLoop $getBuddyList
77                    $getQuickstart);
78
79our %EXPORT_TAGS = (all => [@EXPORT_OK]);
80
81our $startup = BarnOwl::Hook->new;
82our $shutdown = BarnOwl::Hook->new;
83our $receiveMessage = BarnOwl::Hook->new;
84our $newMessage = BarnOwl::Hook->new;
85our $mainLoop = BarnOwl::Hook->new;
86our $getBuddyList = BarnOwl::Hook->new;
87our $getQuickstart = BarnOwl::Hook->new;
88
89# Internal startup/shutdown routines called by the C code
90
91sub _load_perl_commands {
92    # Load builtin perl commands
93    BarnOwl::new_command(style => \&BarnOwl::Style::style_command,
94                       {
95                           summary => "creates a new style",
96                           usage   => "style <name> perl <function_name>",
97                           description =>
98                           "A style named <name> will be created that will\n" .
99                           "format messages using the perl function <function_name>.\n\n" .
100                           "SEE ALSO: show styles, view -s, filter -s\n\n" .
101                           "DEPRECATED in favor of BarnOwl::create_style(NAME, OBJECT)",
102                          });
103    BarnOwl::new_command('edit:complete' => \&BarnOwl::Completion::do_complete,
104                       {
105                           summary     => "Complete the word at point",
106                           usage       => "complete",
107                           description =>
108                           "This is the function responsible for tab-completion."
109                       });
110    BarnOwl::bindkey(editline => TAB => command => 'edit:complete');
111}
112
113sub _load_owlconf {
114    # load the config  file
115    if ( -r $BarnOwl::configfile ) {
116        undef $@;
117        package main;
118        do $BarnOwl::configfile;
119        if($@) {
120            BarnOwl::error("In startup: $@\n");
121            return;
122        }
123        package BarnOwl;
124        if(*BarnOwl::format_msg{CODE}) {
125            # if the config defines a legacy formatting function, add 'perl' as a style
126            BarnOwl::create_style("perl", BarnOwl::Style::Legacy->new(
127                "BarnOwl::format_msg",
128                "User-defined perl style that calls BarnOwl::format_msg"
129                . " with legacy global variable support",
130                1));
131             BarnOwl::set("-q default_style perl");
132        }
133    }
134}
135
136# These are the internal hooks called by the barnowl C code, which
137# take care of dispatching to the appropriate perl hooks, and deal
138# with compatibility by calling the old, fixed-name hooks.
139
140sub _startup {
141    _load_perl_commands();
142    _load_owlconf();
143
144    if(eval {require BarnOwl::ModuleLoader}) {
145        eval {
146            BarnOwl::ModuleLoader->load_all;
147        };
148        BarnOwl::error("$@") if $@;
149
150    } else {
151        BarnOwl::error("Can't load BarnOwl::ModuleLoader, loadable module support disabled:\n$@");
152    }
153   
154    $startup->run(0);
155    BarnOwl::startup() if *BarnOwl::startup{CODE};
156}
157
158sub _shutdown {
159    $shutdown->run;
160   
161    BarnOwl::shutdown() if *BarnOwl::shutdown{CODE};
162}
163
164sub _receive_msg {
165    my $m = shift;
166
167    $receiveMessage->run($m);
168   
169    BarnOwl::receive_msg($m) if *BarnOwl::receive_msg{CODE};
170}
171
172sub _new_msg {
173    my $m = shift;
174
175    $newMessage->run($m);
176   
177    BarnOwl::new_msg($m) if *BarnOwl::new_msg{CODE};
178}
179
180sub _mainloop_hook {
181    $mainLoop->run;
182    BarnOwl::mainloop_hook() if *BarnOwl::mainloop_hook{CODE};
183}
184
185sub _get_blist {
186    return join("\n", $getBuddyList->run);
187}
188
189sub _get_quickstart {
190    return join("\n", $getQuickstart->run);
191}
192
193sub _new_command {
194    my $command = shift;
195    (my $symbol = $command) =~ s/-/_/g;
196    my $package = "BarnOwl";
197
198
199    if(!contains(\@BarnOwl::all_commands, $command)) {
200        push @BarnOwl::all_commands, $command;
201    }
202
203    if($symbol =~ m{^edit:(.+)$}) {
204        $symbol = $1;
205        $package = "BarnOwl::Editwin";
206    } else {
207        $symbol =~ s/:/_/;
208    }
209    {
210        no strict 'refs';
211        if(defined(*{"${package}::${symbol}"}{CODE})) {
212            return;
213        }
214        *{"${package}::${symbol}"} = sub {
215            if(@_ == 1 && $_[0] =~ m{\s}) {
216                carp "DEPRECATED: ${package}::${symbol}: Tokenizing argument on ' '.\n"
217                . "In future versions, the argument list will be passed to\n"
218                . "'$command' directly. Tokenize yourself, or use BarnOwl::command()\n";
219                BarnOwl::command("$command $_[0]");
220            } else {
221                BarnOwl::command($command, @_);
222            }
223          };
224        if(defined(*{"${package}::EXPORT_OK"}{ARRAY})
225          && !contains(*{"${package}::EXPORT_OK"}{ARRAY}, $symbol)) {
226            push @{*{"${package}::EXPORT_OK"}{ARRAY}}, $symbol;
227        }
228    }
229}
230
231sub contains {
232    my $list = shift;
233    my $what = shift;
234    return defined(first {$_ eq $what} @$list);
235}
236
2371;
Note: See TracBrowser for help on using the repository browser.