source: perlwrap.pm @ 467aa16

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