source: perlwrap.pm @ c681337

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