source: perlwrap.pm @ 87c6ef1

barnowl_perlaimdebianowlrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 87c6ef1 was 87c6ef1, checked in by Erik Nygren <nygren@mit.edu>, 17 years ago
Added some base methods (eg, for login_host) that return undef.
  • Property mode set to 100644
File size: 6.4 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# bootstrap in C bindings and glue
11bootstrap owl 1.2;
12
13# populate global variable space for legacy owlconf files
14sub _format_msg_legacy_wrap {
15    my ($m) = @_;
16    $m->legacy_populate_global();
17    return &owl::format_msg($m);
18}
19
20# populate global variable space for legacy owlconf files
21sub _receive_msg_legacy_wrap {
22    my ($m) = @_;
23    $m->legacy_populate_global();
24    return &owl::receive_msg($m);
25}
26
27# make owl::<command>("foo") be aliases to owl::command("<command> foo");
28sub AUTOLOAD {
29    my $called = $AUTOLOAD;
30    $called =~ s/.*:://;
31    return &owl::command("$called ".join(" ",@_));
32}
33
34#####################################################################
35#####################################################################
36
37package owl::Message;
38
39sub type        { return shift->{"type"}; }
40sub direction   { return shift->{"direction"}; }
41sub time        { return shift->{"time"}; }
42sub id          { return shift->{"id"}; }
43sub body        { return shift->{"body"}; }
44sub sender      { return shift->{"sender"}; }
45sub recipient   { return shift->{"recipient"}; }
46sub login       { return shift->{"login"}; }
47
48sub is_login    { return shift->login eq "login"; }
49sub is_logout   { return shift->login eq "logout"; }
50sub is_loginout { my $m=shift; return ($m->is_login or $m->is_logout); }
51sub is_incoming { return (shift->{"direction"} eq "in"); }
52sub is_outgoing { return (shift->{"direction"} eq "out"); }
53
54sub is_deleted  { return shift->{"deleted"}; }
55
56sub is_zephyr   { return (shift->{"type"} eq "zephyr"); }
57sub is_aim      { return (shift->{"type"} eq "aim"); }
58sub is_admin    { return (shift->{"type"} eq "admin"); }
59sub is_generic  { return (shift->{"type"} eq "generic"); }
60
61# These are overridden by appropriate message types
62sub is_ping     { return 0; }
63sub is_mail     { return 0; }
64sub is_personal { return undef; }
65sub is_private  { return undef; }
66sub class       { return undef; }
67sub instance    { return undef; }
68sub realm       { return undef; }
69sub opcode      { return undef; }
70sub header      { return undef; }
71sub host        { return undef; }
72sub hostname    { return undef; }
73sub auth        { return undef; }
74sub fields      { return undef; }
75sub zsig        { return undef; }
76sub zwriteline  { return undef; }
77sub login_host  { return undef; }
78sub login_tty   { return undef; }
79
80sub pretty_sender { return shift->sender; }
81
82sub delete {
83    my ($m) = @_;
84    &owl::command("delete --id ".$m->id);
85}
86
87sub undelete {
88    my ($m) = @_;
89    &owl::command("undelete --id ".$m->id);
90}
91
92# Serializes the message into something similar to the zwgc->vt format
93sub serialize {
94    my ($this) = @_;
95    my $s;
96    for my $f (keys %$this) {
97        my $val = $this->{$f};
98        if (ref($val) eq "ARRAY") {
99            for my $i (0..@$val-1) {
100                my $aval;
101                $aval = $val->[$i];
102                $aval =~ s/\n/\n$f.$i: /g;
103                $s .= "$f.$i: $aval\n";   
104            }
105        } else {
106            $val =~ s/\n/\n$f: /g;
107            $s .= "$f: $val\n";
108        }
109    }
110    return $s;
111}
112
113# Populate the annoying legacy global variables
114sub legacy_populate_global {
115    my ($m) = @_;
116    $owl::direction  = $m->direction ;
117    $owl::type       = $m->type      ;
118    $owl::id         = $m->id        ;
119    $owl::class      = $m->class     ;
120    $owl::instance   = $m->instance  ;
121    $owl::recipient  = $m->recipient ;
122    $owl::sender     = $m->sender    ;
123    $owl::realm      = $m->realm     ;
124    $owl::opcode     = $m->opcode    ;
125    $owl::zsig       = $m->zsig      ;
126    $owl::msg        = $m->body      ;
127    $owl::time       = $m->time      ;
128    $owl::host       = $m->host      ;
129    $owl::login      = $m->login     ;
130    $owl::auth       = $m->auth      ;
131    if ($m->fields) {
132        @owl::fields = @{$m->fields};
133        @main::fields = @{$m->fields};
134    } else {
135        @owl::fields = undef;
136        @main::fields = undef;
137    }
138}
139
140#####################################################################
141#####################################################################
142
143package owl::Message::Admin;
144
145@ISA = qw( owl::Message );
146
147sub header       { return shift->{"header"}; }
148
149#####################################################################
150#####################################################################
151
152package owl::Message::Generic;
153
154@ISA = qw( owl::Message );
155
156#####################################################################
157#####################################################################
158
159package owl::Message::AIM;
160
161@ISA = qw( owl::Message );
162
163# all non-loginout AIM messages are personal for now...
164sub is_personal { 
165    return !(shift->is_loginout);
166}
167
168#####################################################################
169#####################################################################
170
171package owl::Message::Zephyr;
172
173@ISA = qw( owl::Message );
174
175sub login_tty { 
176    my ($m) = @_;
177    return undef if (!$m->is_loginout);
178    return $m->fields->[2];
179}
180
181sub login_host { 
182    my ($m) = @_;
183    return undef if (!$m->is_loginout);
184    return $m->fields->[0];
185}
186
187sub zwriteline  { return shift->{"zwriteline"}; }
188
189sub zsig        { return shift->{"zsig"}; }
190
191sub is_ping     { return (lc(shift->opcode) eq "ping"); }
192
193sub is_private {
194    my ($m) = @_;
195    return (lc($m->recipient) eq lc(owl::zephyr_getsender()));
196}
197
198sub is_personal { 
199    my ($m) = @_;
200    return ((lc($m->class) eq "message")
201            && (lc($m->instance) eq "personal")
202            && $m->is_private);
203}
204
205sub is_mail { 
206    my ($m) = @_;
207    return ((lc($m->class) eq "mail") && $m->is_private);
208}
209
210sub pretty_sender {
211    my ($m) = @_;
212    my $sender = $m->sender;
213    my $realm = owl::zephyr_getrealm();
214    $sender =~ s/\@$realm$//;
215    return $sender;
216}
217
218# These are arguably zephyr-specific
219sub class       { return shift->{"class"}; }
220sub instance    { return shift->{"instance"}; }
221sub realm       { return shift->{"realm"}; }
222sub opcode      { return shift->{"opcode"}; }
223sub host        { return shift->{"hostname"}; }
224sub hostname    { return shift->{"hostname"}; }
225sub header      { return shift->{"header"}; }
226sub auth        { return shift->{"auth"}; }
227sub fields      { return shift->{"fields"}; }
228sub zsig        { return shift->{"zsig"}; }
229
230#####################################################################
231#####################################################################
232
233# switch to package main when we're done
234package main;
235
2361;
Note: See TracBrowser for help on using the repository browser.