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

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