source: perlwrap.pm @ 8203afd

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 8203afd was 8203afd, checked in by Nelson Elhage <nelhage@mit.edu>, 14 years ago
* Renaming package owl to BarnOwl:: * Moving hooks into the BarnOwl::Hooks package, and restoring support for .owlconf files that use sub startup {} and so on.
  • Property mode set to 100644
File size: 12.4 KB
Line 
1# $Id$
2#
3# This is all linked into the binary and evaluated when perl starts up...
4#
5#####################################################################
6#####################################################################
7
8use strict;
9use warnings;
10
11package BarnOwl;
12
13
14BEGIN {
15# bootstrap in C bindings and glue
16    *owl:: = \*BarnOwl::;
17    bootstrap BarnOwl 1.2;
18};
19
20use lib(get_data_dir()."/lib");
21use lib($::ENV{'HOME'}."/.owl/lib");
22
23our $configfile;
24
25$configfile ||= $::ENV{'HOME'}."/.owlconf";
26
27# populate global variable space for legacy owlconf files
28sub _format_msg_legacy_wrap {
29    my ($m) = @_;
30    $m->legacy_populate_global();
31    return &BarnOwl::format_msg($m);
32}
33
34# populate global variable space for legacy owlconf files
35sub _receive_msg_legacy_wrap {
36    my ($m) = @_;
37    $m->legacy_populate_global();
38    return &BarnOwl::Hooks::receive_msg($m);
39}
40
41# make BarnOwl::<command>("foo") be aliases to BarnOwl::command("<command> foo");
42sub AUTOLOAD {
43    our $AUTOLOAD;
44    my $called = $AUTOLOAD;
45    $called =~ s/.*:://;
46    $called =~ s/_/-/g;
47    return &BarnOwl::command("$called ".join(" ",@_));
48}
49
50=head2 new_command NAME FUNC [{ARGS}]
51
52Add a new owl command. When owl executes the command NAME, FUNC will
53be called with the arguments passed to the command, with NAME as the
54first argument.
55
56ARGS should be a hashref containing any or all of C<summary>,
57C<usage>, or C<description> keys.
58
59=cut
60
61sub new_command {
62    my $name = shift;
63    my $func = shift;
64    my $args = shift || {};
65    my %args = (
66        summary     => undef,
67        usage       => undef,
68        description => undef,
69        %{$args}
70    );
71
72    no warnings 'uninitialized';
73    BarnOwl::new_command_internal($name, $func, $args{summary}, $args{usage}, $args{description});
74}
75
76#####################################################################
77#####################################################################
78
79package BarnOwl::Message;
80
81sub new {
82    my $class = shift;
83    my %args = (@_);
84    if($class eq __PACKAGE__ && $args{type}) {
85        $class = "BarnOwl::Message::" . ucfirst $args{type};
86    }
87    return bless {%args}, $class;
88}
89
90sub type        { return shift->{"type"}; }
91sub direction   { return shift->{"direction"}; }
92sub time        { return shift->{"time"}; }
93sub id          { return shift->{"id"}; }
94sub body        { return shift->{"body"}; }
95sub sender      { return shift->{"sender"}; }
96sub recipient   { return shift->{"recipient"}; }
97sub login       { return shift->{"login"}; }
98sub is_private  { return shift->{"private"}; }
99
100sub is_login    { return shift->login eq "login"; }
101sub is_logout   { return shift->login eq "logout"; }
102sub is_loginout { my $m=shift; return ($m->is_login or $m->is_logout); }
103sub is_incoming { return (shift->{"direction"} eq "in"); }
104sub is_outgoing { return (shift->{"direction"} eq "out"); }
105
106sub is_deleted  { return shift->{"deleted"}; }
107
108sub is_admin    { return (shift->{"type"} eq "admin"); }
109sub is_generic  { return (shift->{"type"} eq "generic"); }
110sub is_zephyr   { return (shift->{"type"} eq "zephyr"); }
111sub is_aim      { return (shift->{"type"} eq "aim"); }
112sub is_jabber   { return (shift->{"type"} eq "jabber"); }
113sub is_icq      { return (shift->{"type"} eq "icq"); }
114sub is_yahoo    { return (shift->{"type"} eq "yahoo"); }
115sub is_msn      { return (shift->{"type"} eq "msn"); }
116sub is_loopback { return (shift->{"type"} eq "loopback"); }
117
118# These are overridden by appropriate message types
119sub is_ping     { return 0; }
120sub is_mail     { return 0; }
121sub is_personal { return shift->is_private; }
122sub class       { return undef; }
123sub instance    { return undef; }
124sub realm       { return undef; }
125sub opcode      { return undef; }
126sub header      { return undef; }
127sub host        { return undef; }
128sub hostname    { return undef; }
129sub auth        { return undef; }
130sub fields      { return undef; }
131sub zsig        { return undef; }
132sub zwriteline  { return undef; }
133sub login_host  { return undef; }
134sub login_tty   { return undef; }
135
136sub pretty_sender { return shift->sender; }
137
138sub delete {
139    my ($m) = @_;
140    &BarnOwl::command("delete --id ".$m->id);
141}
142
143sub undelete {
144    my ($m) = @_;
145    &BarnOwl::command("undelete --id ".$m->id);
146}
147
148# Serializes the message into something similar to the zwgc->vt format
149sub serialize {
150    my ($this) = @_;
151    my $s;
152    for my $f (keys %$this) {
153        my $val = $this->{$f};
154        if (ref($val) eq "ARRAY") {
155            for my $i (0..@$val-1) {
156                my $aval;
157                $aval = $val->[$i];
158                $aval =~ s/\n/\n$f.$i: /g;
159                $s .= "$f.$i: $aval\n";   
160            }
161        } else {
162            $val =~ s/\n/\n$f: /g;
163            $s .= "$f: $val\n";
164        }
165    }
166    return $s;
167}
168
169# Populate the annoying legacy global variables
170sub legacy_populate_global {
171    my ($m) = @_;
172    $BarnOwl::direction  = $m->direction ;
173    $BarnOwl::type       = $m->type      ;
174    $BarnOwl::id         = $m->id        ;
175    $BarnOwl::class      = $m->class     ;
176    $BarnOwl::instance   = $m->instance  ;
177    $BarnOwl::recipient  = $m->recipient ;
178    $BarnOwl::sender     = $m->sender    ;
179    $BarnOwl::realm      = $m->realm     ;
180    $BarnOwl::opcode     = $m->opcode    ;
181    $BarnOwl::zsig       = $m->zsig      ;
182    $BarnOwl::msg        = $m->body      ;
183    $BarnOwl::time       = $m->time      ;
184    $BarnOwl::host       = $m->host      ;
185    $BarnOwl::login      = $m->login     ;
186    $BarnOwl::auth       = $m->auth      ;
187    if ($m->fields) {
188        @BarnOwl::fields = @{$m->fields};
189        @main::fields = @{$m->fields};
190    } else {
191        @BarnOwl::fields = undef;
192        @main::fields = undef;
193    }
194}
195
196sub smartfilter {
197    die("smartfilter not supported for this message");
198}
199
200#####################################################################
201#####################################################################
202
203package BarnOwl::Message::Admin;
204
205use base qw( BarnOwl::Message );
206
207sub header       { return shift->{"header"}; }
208
209#####################################################################
210#####################################################################
211
212package BarnOwl::Message::Generic;
213
214use base qw( BarnOwl::Message );
215
216#####################################################################
217#####################################################################
218
219package BarnOwl::Message::AIM;
220
221use base qw( BarnOwl::Message );
222
223# all non-loginout AIM messages are personal for now...
224sub is_personal { 
225    return !(shift->is_loginout);
226}
227
228#####################################################################
229#####################################################################
230
231package BarnOwl::Message::Zephyr;
232
233use base qw( BarnOwl::Message );
234
235sub login_tty { 
236    my ($m) = @_;
237    return undef if (!$m->is_loginout);
238    return $m->fields->[2];
239}
240
241sub login_host { 
242    my ($m) = @_;
243    return undef if (!$m->is_loginout);
244    return $m->fields->[0];
245}
246
247sub zwriteline  { return shift->{"zwriteline"}; }
248
249sub is_ping     { return (lc(shift->opcode) eq "ping"); }
250
251sub is_personal { 
252    my ($m) = @_;
253    return ((lc($m->class) eq "message")
254            && (lc($m->instance) eq "personal")
255            && $m->is_private);
256}
257
258sub is_mail { 
259    my ($m) = @_;
260    return ((lc($m->class) eq "mail") && $m->is_private);
261}
262
263sub pretty_sender {
264    my ($m) = @_;
265    my $sender = $m->sender;
266    my $realm = BarnOwl::zephyr_getrealm();
267    $sender =~ s/\@$realm$//;
268    return $sender;
269}
270
271# These are arguably zephyr-specific
272sub class       { return shift->{"class"}; }
273sub instance    { return shift->{"instance"}; }
274sub realm       { return shift->{"realm"}; }
275sub opcode      { return shift->{"opcode"}; }
276sub host        { return shift->{"hostname"}; }
277sub hostname    { return shift->{"hostname"}; }
278sub header      { return shift->{"header"}; }
279sub auth        { return shift->{"auth"}; }
280sub fields      { return shift->{"fields"}; }
281sub zsig        { return shift->{"zsig"}; }
282
283#####################################################################
284#####################################################################
285################################################################################
286package owl;
287
288################################################################################
289# Mainloop hook
290################################################################################
291
292our $shutdown;
293$shutdown = 0;
294our $reload;
295$reload = 0;
296
297#Run this on start and reload. Adds modules
298sub onStart
299{
300    reload_init();
301    loadModules();
302}
303################################################################################
304# Reload Code, taken from /afs/sipb/user/jdaniel/project/owl/perl
305################################################################################
306sub reload_hook (@)
307{
308    BarnOwl::Hooks::startup();
309    return 1;
310}
311
312sub reload
313{
314    # Use $reload to tell modules that we're performing a reload.
315  {
316      local $reload = 1;
317      BarnOwl::mainloop_hook();
318  }
319   
320  @BarnOwl::Hooks::onMainLoop = ();
321  @BarnOwl::Hooks::onStartSubs = ();
322
323  # Do reload
324  package main;
325  if (do "$ENV{HOME}/.owlconf" && BarnOwl::reload_hook(@_))
326  {
327      return "owlconf reloaded";
328  } 
329  else
330  {
331      return "$ENV{HOME}/.owlconf load attempted, but error encountered:\n$@";
332  }
333  package owl;
334}
335
336sub reload_init () 
337{
338    BarnOwl::command('alias reload perl BarnOwl::reload()');
339    BarnOwl::command('bindkey global "C-x C-r" command reload');
340}
341
342################################################################################
343# Loads modules from ~/.owl/modules and owl's data directory
344################################################################################
345
346sub loadModules () {
347    my @modules;
348    my $rv;
349    foreach my $dir ( BarnOwl::get_data_dir() . "/modules",
350                      $ENV{HOME} . "/.owl/modules" )
351    {
352        opendir( MODULES, $dir );
353
354        # source ./modules/*.pl
355        @modules = grep( /\.pl$/, readdir(MODULES) );
356
357        foreach my $mod (@modules) {
358            owl::error("Loading $dir/$mod...");
359            unless ($rv = do "$dir/$mod") {
360                BarnOwl::error("Couldn't load $dir/$mod:\n $@") if $@;
361                BarnOwl::error("Couldn't run $dir/$mod:\n $!") unless defined $rv;
362            }
363        }
364        closedir(MODULES);
365    }
366}
367
368package BarnOwl::Hooks;
369
370# Arrays of subrefs to be called at specific times.
371our @onStartSubs = ();
372our @onReceiveMsg = ();
373our @onMainLoop = ();
374our @onGetBuddyList = ();
375
376# Functions to call hook lists
377sub runHook($@)
378{
379    my $hook = shift;
380    my @args = @_;
381    $_->(@args) for (@$hook);
382}
383
384sub runHook_accumulate($@)
385{
386    my $hook = shift;
387    my @args = @_;
388    return join("\n", map {$_->(@args)} @$hook);
389}
390
391################################################################################
392# Startup and Shutdown code
393################################################################################
394sub startup
395{
396    # Modern versions of owl provides a great place to have startup stuff.
397    # Put things in ~/.owl/startup
398
399    #So that the user's .owlconf can have startsubs, we don't clear
400    #onStartSubs; reload does however
401    @onReceiveMsg = ();
402    @onMainLoop = ();
403    @onGetBuddyList = ();
404
405    BarnOwl::onStart();
406
407    runHook(\@onStartSubs);
408
409    BarnOwl::startup() if *BarnOwl::startup{CODE};
410}
411
412sub shutdown
413{
414# Modern versions of owl provides a great place to have shutdown stuff.
415# Put things in ~/.owl/shutdown
416
417    # use $shutdown to tell modules that that's what we're doing.
418    $BarnOwl::shutdown = 1;
419    BarnOwl::mainloop_hook();
420
421    BarnOwl::shutdown() if *BarnOwl::shutdown{CODE};
422}
423
424sub mainloop_hook
425{
426    runHook(\@onMainLoop);
427    BarnOwl::mainlook_hook() if *BarnOwl::mainloop_hook{CODE};
428}
429
430################################################################################
431# Hooks into receive_msg()
432################################################################################
433
434sub receive_msg
435{
436    my $m = shift;
437    runHook(\@onReceiveMsg, $m);
438    BarnOwl::receive_msg($m) if *BarnOwl::receive_msg{CODE};
439}
440
441################################################################################
442# Hooks into get_blist()
443################################################################################
444
445sub get_blist
446{
447    return runHook_accumulate(\@onGetBuddyList);
448}
449
450# switch to package main when we're done
451package main;
452# alias the hooks
453{
454    no strict 'refs';
455    foreach my $hook  qw (onStartSubs
456                          onReceiveMsg
457                          onMainLoop
458                          onGetBuddyList ) {
459        *{"main::".$hook} = \*{"BarnOwl::Hooks::".$hook};
460        *{"owl::".$hook} = \*{"BarnOwl::Hooks::".$hook};
461    }
462}
463
464# load the config  file
465if (-r $BarnOwl::configfile) {
466    undef $@;
467    do $BarnOwl::configfile;
468    die $@ if $@;
469}
470
4711;
Note: See TracBrowser for help on using the repository browser.