source: perlwrap.pm @ 3c9012b

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 3c9012b was 3c9012b, checked in by Nelson Elhage <nelhage@mit.edu>, 18 years ago
Adding some support for distinguishing personals/private with messages generated from perl
  • Property mode set to 100644
File size: 7.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
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
[6922edd]34=head2 new_command NAME FUNC [{ARGS}]
35
36Add a new owl command. When owl executes the command NAME, FUNC will
37be called with the arguments passed to the command, with NAME as the
38first argument.
39
40ARGS should be a hashref containing any or all of C<summary>,
41C<usage>, or C<description> keys.
42
43=cut
44
45sub new_command {
46    my $name = shift;
47    my $func = shift;
48    my $args = shift || {};
49    my %args = (
50        summary     => undef,
51        usage       => undef,
52        description => undef,
53        %{$args}
54    );
55
56    owl::new_command_internal($name, $func, $args{summary}, $args{usage}, $args{description});
57}
58
[f1e629d]59#####################################################################
60#####################################################################
61
62package owl::Message;
63
[dd16bdd]64sub new {
65    my $class = shift;
66    my %args = (@_);
67    if($class eq __PACKAGE__ && $args{type}) {
68        $class = "owl::Message::" . ucfirst $args{type};
69    }
70    return bless {%args}, $class;
71}
72
[f1e629d]73sub type        { return shift->{"type"}; }
74sub direction   { return shift->{"direction"}; }
75sub time        { return shift->{"time"}; }
76sub id          { return shift->{"id"}; }
77sub body        { return shift->{"body"}; }
78sub sender      { return shift->{"sender"}; }
79sub recipient   { return shift->{"recipient"}; }
80sub login       { return shift->{"login"}; }
[216c734]81sub is_private  { return shift->{"private"}; }
[f1e629d]82
83sub is_login    { return shift->login eq "login"; }
84sub is_logout   { return shift->login eq "logout"; }
85sub is_loginout { my $m=shift; return ($m->is_login or $m->is_logout); }
86sub is_incoming { return (shift->{"direction"} eq "in"); }
87sub is_outgoing { return (shift->{"direction"} eq "out"); }
88
89sub is_deleted  { return shift->{"deleted"}; }
90
91sub is_admin    { return (shift->{"type"} eq "admin"); }
92sub is_generic  { return (shift->{"type"} eq "generic"); }
[421c8ef7]93sub is_zephyr   { return (shift->{"type"} eq "zephyr"); }
94sub is_aim      { return (shift->{"type"} eq "aim"); }
[dd16bdd]95sub is_jabber   { return (shift->{"type"} eq "jabber"); }
[421c8ef7]96sub is_icq      { return (shift->{"type"} eq "icq"); }
97sub is_yahoo    { return (shift->{"type"} eq "yahoo"); }
98sub is_msn      { return (shift->{"type"} eq "msn"); }
99sub is_loopback { return (shift->{"type"} eq "loopback"); }
[f1e629d]100
101# These are overridden by appropriate message types
102sub is_ping     { return 0; }
103sub is_mail     { return 0; }
[3c9012b]104sub is_personal { return shift->is_private; }
[f1e629d]105sub class       { return undef; }
106sub instance    { return undef; }
107sub realm       { return undef; }
108sub opcode      { return undef; }
109sub header      { return undef; }
110sub host        { return undef; }
111sub hostname    { return undef; }
112sub auth        { return undef; }
113sub fields      { return undef; }
114sub zsig        { return undef; }
115sub zwriteline  { return undef; }
[87c6ef1]116sub login_host  { return undef; }
117sub login_tty   { return undef; }
[f1e629d]118
119sub pretty_sender { return shift->sender; }
120
121sub delete {
122    my ($m) = @_;
123    &owl::command("delete --id ".$m->id);
124}
125
126sub undelete {
127    my ($m) = @_;
128    &owl::command("undelete --id ".$m->id);
129}
130
131# Serializes the message into something similar to the zwgc->vt format
132sub serialize {
133    my ($this) = @_;
134    my $s;
135    for my $f (keys %$this) {
136        my $val = $this->{$f};
137        if (ref($val) eq "ARRAY") {
138            for my $i (0..@$val-1) {
139                my $aval;
140                $aval = $val->[$i];
141                $aval =~ s/\n/\n$f.$i: /g;
142                $s .= "$f.$i: $aval\n";   
143            }
144        } else {
145            $val =~ s/\n/\n$f: /g;
146            $s .= "$f: $val\n";
147        }
148    }
149    return $s;
150}
151
152# Populate the annoying legacy global variables
153sub legacy_populate_global {
154    my ($m) = @_;
155    $owl::direction  = $m->direction ;
156    $owl::type       = $m->type      ;
157    $owl::id         = $m->id        ;
158    $owl::class      = $m->class     ;
159    $owl::instance   = $m->instance  ;
160    $owl::recipient  = $m->recipient ;
161    $owl::sender     = $m->sender    ;
162    $owl::realm      = $m->realm     ;
163    $owl::opcode     = $m->opcode    ;
164    $owl::zsig       = $m->zsig      ;
165    $owl::msg        = $m->body      ;
166    $owl::time       = $m->time      ;
167    $owl::host       = $m->host      ;
[282ec9b]168    $owl::login      = $m->login     ;
[87c6ef1]169    $owl::auth       = $m->auth      ;
[f1e629d]170    if ($m->fields) {
171        @owl::fields = @{$m->fields};
172        @main::fields = @{$m->fields};
173    } else {
174        @owl::fields = undef;
175        @main::fields = undef;
176    }
177}
178
179#####################################################################
180#####################################################################
181
182package owl::Message::Admin;
183
184@ISA = qw( owl::Message );
185
186sub header       { return shift->{"header"}; }
187
188#####################################################################
189#####################################################################
190
191package owl::Message::Generic;
192
193@ISA = qw( owl::Message );
194
195#####################################################################
196#####################################################################
197
198package owl::Message::AIM;
199
200@ISA = qw( owl::Message );
201
202# all non-loginout AIM messages are personal for now...
203sub is_personal { 
204    return !(shift->is_loginout);
205}
206
207#####################################################################
208#####################################################################
209
210package owl::Message::Zephyr;
211
212@ISA = qw( owl::Message );
213
214sub login_tty { 
215    my ($m) = @_;
216    return undef if (!$m->is_loginout);
217    return $m->fields->[2];
218}
219
220sub login_host { 
221    my ($m) = @_;
222    return undef if (!$m->is_loginout);
223    return $m->fields->[0];
224}
225
226sub zwriteline  { return shift->{"zwriteline"}; }
227
228sub zsig        { return shift->{"zsig"}; }
229
230sub is_ping     { return (lc(shift->opcode) eq "ping"); }
231
232sub is_personal { 
233    my ($m) = @_;
234    return ((lc($m->class) eq "message")
235            && (lc($m->instance) eq "personal")
236            && $m->is_private);
237}
238
239sub is_mail { 
240    my ($m) = @_;
241    return ((lc($m->class) eq "mail") && $m->is_private);
242}
243
244sub pretty_sender {
245    my ($m) = @_;
246    my $sender = $m->sender;
247    my $realm = owl::zephyr_getrealm();
248    $sender =~ s/\@$realm$//;
249    return $sender;
250}
251
252# These are arguably zephyr-specific
253sub class       { return shift->{"class"}; }
254sub instance    { return shift->{"instance"}; }
255sub realm       { return shift->{"realm"}; }
256sub opcode      { return shift->{"opcode"}; }
257sub host        { return shift->{"hostname"}; }
258sub hostname    { return shift->{"hostname"}; }
259sub header      { return shift->{"header"}; }
260sub auth        { return shift->{"auth"}; }
261sub fields      { return shift->{"fields"}; }
262sub zsig        { return shift->{"zsig"}; }
263
264#####################################################################
265#####################################################################
266
[dd16bdd]267package owl::Message::Jabber;
268
269@ISA = qw( owl::Message );
270
271#####################################################################
272#####################################################################
273
[f1e629d]274# switch to package main when we're done
275package main;
276
2771;
Note: See TracBrowser for help on using the repository browser.