source: perlwrap.pm @ e7ac2b6

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