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

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