source: perlwrap.pm @ c0987a8

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