source: perlwrap.pm @ 4692b70

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 4692b70 was dd16bdd, checked in by Nelson Elhage <nelhage@mit.edu>, 18 years ago
Initial support for creating and injecting messages into the display. Note that at the moment, you can easily segfault owl from perl by injecting messages that don't contain fields owl assumes they will.
  • Property mode set to 100644
File size: 7.4 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_zephyr   { return (shift->{"type"} eq "zephyr"); }
92sub is_aim      { return (shift->{"type"} eq "aim"); }
93sub is_admin    { return (shift->{"type"} eq "admin"); }
94sub is_generic  { return (shift->{"type"} eq "generic"); }
[dd16bdd]95sub is_jabber   { return (shift->{"type"} eq "jabber"); }
[f1e629d]96
97# These are overridden by appropriate message types
98sub is_ping     { return 0; }
99sub is_mail     { return 0; }
[87c6ef1]100sub is_personal { return undef; }
[f1e629d]101sub class       { return undef; }
102sub instance    { return undef; }
103sub realm       { return undef; }
104sub opcode      { return undef; }
105sub header      { return undef; }
106sub host        { return undef; }
107sub hostname    { return undef; }
108sub auth        { return undef; }
109sub fields      { return undef; }
110sub zsig        { return undef; }
111sub zwriteline  { return undef; }
[87c6ef1]112sub login_host  { return undef; }
113sub login_tty   { return undef; }
[f1e629d]114
115sub pretty_sender { return shift->sender; }
116
117sub delete {
118    my ($m) = @_;
119    &owl::command("delete --id ".$m->id);
120}
121
122sub undelete {
123    my ($m) = @_;
124    &owl::command("undelete --id ".$m->id);
125}
126
127# Serializes the message into something similar to the zwgc->vt format
128sub serialize {
129    my ($this) = @_;
130    my $s;
131    for my $f (keys %$this) {
132        my $val = $this->{$f};
133        if (ref($val) eq "ARRAY") {
134            for my $i (0..@$val-1) {
135                my $aval;
136                $aval = $val->[$i];
137                $aval =~ s/\n/\n$f.$i: /g;
138                $s .= "$f.$i: $aval\n";   
139            }
140        } else {
141            $val =~ s/\n/\n$f: /g;
142            $s .= "$f: $val\n";
143        }
144    }
145    return $s;
146}
147
148# Populate the annoying legacy global variables
149sub legacy_populate_global {
150    my ($m) = @_;
151    $owl::direction  = $m->direction ;
152    $owl::type       = $m->type      ;
153    $owl::id         = $m->id        ;
154    $owl::class      = $m->class     ;
155    $owl::instance   = $m->instance  ;
156    $owl::recipient  = $m->recipient ;
157    $owl::sender     = $m->sender    ;
158    $owl::realm      = $m->realm     ;
159    $owl::opcode     = $m->opcode    ;
160    $owl::zsig       = $m->zsig      ;
161    $owl::msg        = $m->body      ;
162    $owl::time       = $m->time      ;
163    $owl::host       = $m->host      ;
[282ec9b]164    $owl::login      = $m->login     ;
[87c6ef1]165    $owl::auth       = $m->auth      ;
[f1e629d]166    if ($m->fields) {
167        @owl::fields = @{$m->fields};
168        @main::fields = @{$m->fields};
169    } else {
170        @owl::fields = undef;
171        @main::fields = undef;
172    }
173}
174
175#####################################################################
176#####################################################################
177
178package owl::Message::Admin;
179
180@ISA = qw( owl::Message );
181
182sub header       { return shift->{"header"}; }
183
184#####################################################################
185#####################################################################
186
187package owl::Message::Generic;
188
189@ISA = qw( owl::Message );
190
191#####################################################################
192#####################################################################
193
194package owl::Message::AIM;
195
196@ISA = qw( owl::Message );
197
198# all non-loginout AIM messages are personal for now...
199sub is_personal { 
200    return !(shift->is_loginout);
201}
202
203#####################################################################
204#####################################################################
205
206package owl::Message::Zephyr;
207
208@ISA = qw( owl::Message );
209
210sub login_tty { 
211    my ($m) = @_;
212    return undef if (!$m->is_loginout);
213    return $m->fields->[2];
214}
215
216sub login_host { 
217    my ($m) = @_;
218    return undef if (!$m->is_loginout);
219    return $m->fields->[0];
220}
221
222sub zwriteline  { return shift->{"zwriteline"}; }
223
224sub zsig        { return shift->{"zsig"}; }
225
226sub is_ping     { return (lc(shift->opcode) eq "ping"); }
227
228sub is_personal { 
229    my ($m) = @_;
230    return ((lc($m->class) eq "message")
231            && (lc($m->instance) eq "personal")
232            && $m->is_private);
233}
234
235sub is_mail { 
236    my ($m) = @_;
237    return ((lc($m->class) eq "mail") && $m->is_private);
238}
239
240sub pretty_sender {
241    my ($m) = @_;
242    my $sender = $m->sender;
243    my $realm = owl::zephyr_getrealm();
244    $sender =~ s/\@$realm$//;
245    return $sender;
246}
247
248# These are arguably zephyr-specific
249sub class       { return shift->{"class"}; }
250sub instance    { return shift->{"instance"}; }
251sub realm       { return shift->{"realm"}; }
252sub opcode      { return shift->{"opcode"}; }
253sub host        { return shift->{"hostname"}; }
254sub hostname    { return shift->{"hostname"}; }
255sub header      { return shift->{"header"}; }
256sub auth        { return shift->{"auth"}; }
257sub fields      { return shift->{"fields"}; }
258sub zsig        { return shift->{"zsig"}; }
259
260#####################################################################
261#####################################################################
262
[dd16bdd]263package owl::Message::Jabber;
264
265@ISA = qw( owl::Message );
266
267#####################################################################
268#####################################################################
269
[f1e629d]270# switch to package main when we're done
271package main;
272
2731;
Note: See TracBrowser for help on using the repository browser.