[ee183be] | 1 | use strict; |
---|
| 2 | use warnings; |
---|
| 3 | |
---|
| 4 | package BarnOwl::Hooks; |
---|
| 5 | |
---|
[eb6cedc] | 6 | use Carp; |
---|
| 7 | |
---|
[ee183be] | 8 | =head1 BarnOwl::Hooks |
---|
| 9 | |
---|
| 10 | =head1 DESCRIPTION |
---|
| 11 | |
---|
| 12 | C<BarnOwl::Hooks> exports a set of C<BarnOwl::Hook> objects made |
---|
| 13 | available by BarnOwl internally. |
---|
| 14 | |
---|
| 15 | =head2 USAGE |
---|
| 16 | |
---|
| 17 | Modules wishing to respond to events in BarnOwl should register |
---|
| 18 | functions with these hooks. |
---|
| 19 | |
---|
| 20 | =head2 EXPORTS |
---|
| 21 | |
---|
| 22 | None by default. Either import the hooks you need explicitly, or refer |
---|
| 23 | to them with fully-qualified names. Available hooks are: |
---|
| 24 | |
---|
| 25 | =over 4 |
---|
| 26 | |
---|
| 27 | =item $startup |
---|
| 28 | |
---|
| 29 | Called on BarnOwl startup, and whenever modules are |
---|
| 30 | reloaded. Functions registered with the C<$startup> hook get a true |
---|
| 31 | argument if this is a reload, and false if this is a true startup |
---|
| 32 | |
---|
| 33 | =item $shutdown |
---|
| 34 | |
---|
| 35 | Called before BarnOwl shutdown |
---|
| 36 | |
---|
| 37 | =item $receiveMessage |
---|
| 38 | |
---|
| 39 | Called with a C<BarnOwl::Message> object every time BarnOwl receives a |
---|
| 40 | new incoming message. |
---|
| 41 | |
---|
| 42 | =item $newMessage |
---|
| 43 | |
---|
| 44 | Called with a C<BarnOwl::Message> object every time BarnOwl appends |
---|
| 45 | I<any> new message to the message list. |
---|
| 46 | |
---|
| 47 | =item $mainLoop |
---|
| 48 | |
---|
| 49 | Called on every pass through the C<BarnOwl> main loop. This is |
---|
| 50 | guaranteed to be called at least once/sec and may be called more |
---|
| 51 | frequently. |
---|
| 52 | |
---|
| 53 | =item $getBuddyList |
---|
| 54 | |
---|
| 55 | Called to display buddy lists for all protocol handlers. The result |
---|
| 56 | from every function registered with this hook will be appended and |
---|
| 57 | displayed in a popup window, with zephyr formatting parsed. |
---|
| 58 | |
---|
| 59 | =item $getQuickstart |
---|
| 60 | |
---|
| 61 | Called by :show quickstart to display 2-5 lines of help on how to |
---|
| 62 | start using the protocol. The result from every function registered |
---|
| 63 | with this hook will be appended and displayed in an admin message, |
---|
| 64 | with zephyr formatting parsed. The format should be |
---|
| 65 | "@b(Protocol:)\nSome text.\nMore text.\n" |
---|
| 66 | |
---|
| 67 | =back |
---|
| 68 | |
---|
| 69 | =cut |
---|
| 70 | |
---|
| 71 | use Exporter; |
---|
| 72 | |
---|
| 73 | our @EXPORT_OK = qw($startup $shutdown |
---|
| 74 | $receiveMessage $newMessage |
---|
| 75 | $mainLoop $getBuddyList |
---|
| 76 | $getQuickstart); |
---|
| 77 | |
---|
| 78 | our %EXPORT_TAGS = (all => [@EXPORT_OK]); |
---|
| 79 | |
---|
| 80 | our $startup = BarnOwl::Hook->new; |
---|
| 81 | our $shutdown = BarnOwl::Hook->new; |
---|
| 82 | our $receiveMessage = BarnOwl::Hook->new; |
---|
| 83 | our $newMessage = BarnOwl::Hook->new; |
---|
| 84 | our $mainLoop = BarnOwl::Hook->new; |
---|
| 85 | our $getBuddyList = BarnOwl::Hook->new; |
---|
| 86 | our $getQuickstart = BarnOwl::Hook->new; |
---|
| 87 | |
---|
| 88 | # Internal startup/shutdown routines called by the C code |
---|
| 89 | |
---|
| 90 | sub _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 | |
---|
| 104 | sub _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 | |
---|
| 131 | sub _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 | |
---|
| 149 | sub _shutdown { |
---|
| 150 | $shutdown->run; |
---|
| 151 | |
---|
| 152 | BarnOwl::shutdown() if *BarnOwl::shutdown{CODE}; |
---|
| 153 | } |
---|
| 154 | |
---|
| 155 | sub _receive_msg { |
---|
| 156 | my $m = shift; |
---|
| 157 | |
---|
| 158 | $receiveMessage->run($m); |
---|
| 159 | |
---|
| 160 | BarnOwl::receive_msg($m) if *BarnOwl::receive_msg{CODE}; |
---|
| 161 | } |
---|
| 162 | |
---|
| 163 | sub _new_msg { |
---|
| 164 | my $m = shift; |
---|
| 165 | |
---|
| 166 | $newMessage->run($m); |
---|
| 167 | |
---|
| 168 | BarnOwl::new_msg($m) if *BarnOwl::new_msg{CODE}; |
---|
| 169 | } |
---|
| 170 | |
---|
| 171 | sub _mainloop_hook { |
---|
| 172 | $mainLoop->run; |
---|
| 173 | BarnOwl::mainloop_hook() if *BarnOwl::mainloop_hook{CODE}; |
---|
| 174 | } |
---|
| 175 | |
---|
| 176 | sub _get_blist { |
---|
| 177 | return join("\n", $getBuddyList->run); |
---|
| 178 | } |
---|
| 179 | |
---|
| 180 | sub _get_quickstart { |
---|
| 181 | return join("\n", $getQuickstart->run); |
---|
| 182 | } |
---|
| 183 | |
---|
[eb6cedc] | 184 | sub _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 | } |
---|
[ee183be] | 210 | |
---|
| 211 | 1; |
---|