source: perlwrap.pm @ 4c46dfd

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 4c46dfd was 6922edd, checked in by Nelson Elhage <nelhage@mit.edu>, 18 years ago
Adding the ability to install real commands from perl.
  • Property mode set to 100644
File size: 6.9 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=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
59#####################################################################
60#####################################################################
61
62package owl::Message;
63
64sub type        { return shift->{"type"}; }
65sub direction   { return shift->{"direction"}; }
66sub time        { return shift->{"time"}; }
67sub id          { return shift->{"id"}; }
68sub body        { return shift->{"body"}; }
69sub sender      { return shift->{"sender"}; }
70sub recipient   { return shift->{"recipient"}; }
71sub login       { return shift->{"login"}; }
72sub is_private  { return shift->{"private"}; }
73
74sub is_login    { return shift->login eq "login"; }
75sub is_logout   { return shift->login eq "logout"; }
76sub is_loginout { my $m=shift; return ($m->is_login or $m->is_logout); }
77sub is_incoming { return (shift->{"direction"} eq "in"); }
78sub is_outgoing { return (shift->{"direction"} eq "out"); }
79
80sub is_deleted  { return shift->{"deleted"}; }
81
82sub is_zephyr   { return (shift->{"type"} eq "zephyr"); }
83sub is_aim      { return (shift->{"type"} eq "aim"); }
84sub is_admin    { return (shift->{"type"} eq "admin"); }
85sub is_generic  { return (shift->{"type"} eq "generic"); }
86
87# These are overridden by appropriate message types
88sub is_ping     { return 0; }
89sub is_mail     { return 0; }
90sub is_personal { return undef; }
91sub class       { return undef; }
92sub instance    { return undef; }
93sub realm       { return undef; }
94sub opcode      { return undef; }
95sub header      { return undef; }
96sub host        { return undef; }
97sub hostname    { return undef; }
98sub auth        { return undef; }
99sub fields      { return undef; }
100sub zsig        { return undef; }
101sub zwriteline  { return undef; }
102sub login_host  { return undef; }
103sub login_tty   { return undef; }
104
105sub pretty_sender { return shift->sender; }
106
107sub delete {
108    my ($m) = @_;
109    &owl::command("delete --id ".$m->id);
110}
111
112sub undelete {
113    my ($m) = @_;
114    &owl::command("undelete --id ".$m->id);
115}
116
117# Serializes the message into something similar to the zwgc->vt format
118sub serialize {
119    my ($this) = @_;
120    my $s;
121    for my $f (keys %$this) {
122        my $val = $this->{$f};
123        if (ref($val) eq "ARRAY") {
124            for my $i (0..@$val-1) {
125                my $aval;
126                $aval = $val->[$i];
127                $aval =~ s/\n/\n$f.$i: /g;
128                $s .= "$f.$i: $aval\n";   
129            }
130        } else {
131            $val =~ s/\n/\n$f: /g;
132            $s .= "$f: $val\n";
133        }
134    }
135    return $s;
136}
137
138# Populate the annoying legacy global variables
139sub legacy_populate_global {
140    my ($m) = @_;
141    $owl::direction  = $m->direction ;
142    $owl::type       = $m->type      ;
143    $owl::id         = $m->id        ;
144    $owl::class      = $m->class     ;
145    $owl::instance   = $m->instance  ;
146    $owl::recipient  = $m->recipient ;
147    $owl::sender     = $m->sender    ;
148    $owl::realm      = $m->realm     ;
149    $owl::opcode     = $m->opcode    ;
150    $owl::zsig       = $m->zsig      ;
151    $owl::msg        = $m->body      ;
152    $owl::time       = $m->time      ;
153    $owl::host       = $m->host      ;
154    $owl::login      = $m->login     ;
155    $owl::auth       = $m->auth      ;
156    if ($m->fields) {
157        @owl::fields = @{$m->fields};
158        @main::fields = @{$m->fields};
159    } else {
160        @owl::fields = undef;
161        @main::fields = undef;
162    }
163}
164
165#####################################################################
166#####################################################################
167
168package owl::Message::Admin;
169
170@ISA = qw( owl::Message );
171
172sub header       { return shift->{"header"}; }
173
174#####################################################################
175#####################################################################
176
177package owl::Message::Generic;
178
179@ISA = qw( owl::Message );
180
181#####################################################################
182#####################################################################
183
184package owl::Message::AIM;
185
186@ISA = qw( owl::Message );
187
188# all non-loginout AIM messages are personal for now...
189sub is_personal { 
190    return !(shift->is_loginout);
191}
192
193#####################################################################
194#####################################################################
195
196package owl::Message::Zephyr;
197
198@ISA = qw( owl::Message );
199
200sub login_tty { 
201    my ($m) = @_;
202    return undef if (!$m->is_loginout);
203    return $m->fields->[2];
204}
205
206sub login_host { 
207    my ($m) = @_;
208    return undef if (!$m->is_loginout);
209    return $m->fields->[0];
210}
211
212sub zwriteline  { return shift->{"zwriteline"}; }
213
214sub zsig        { return shift->{"zsig"}; }
215
216sub is_ping     { return (lc(shift->opcode) eq "ping"); }
217
218sub is_personal { 
219    my ($m) = @_;
220    return ((lc($m->class) eq "message")
221            && (lc($m->instance) eq "personal")
222            && $m->is_private);
223}
224
225sub is_mail { 
226    my ($m) = @_;
227    return ((lc($m->class) eq "mail") && $m->is_private);
228}
229
230sub pretty_sender {
231    my ($m) = @_;
232    my $sender = $m->sender;
233    my $realm = owl::zephyr_getrealm();
234    $sender =~ s/\@$realm$//;
235    return $sender;
236}
237
238# These are arguably zephyr-specific
239sub class       { return shift->{"class"}; }
240sub instance    { return shift->{"instance"}; }
241sub realm       { return shift->{"realm"}; }
242sub opcode      { return shift->{"opcode"}; }
243sub host        { return shift->{"hostname"}; }
244sub hostname    { return shift->{"hostname"}; }
245sub header      { return shift->{"header"}; }
246sub auth        { return shift->{"auth"}; }
247sub fields      { return shift->{"fields"}; }
248sub zsig        { return shift->{"zsig"}; }
249
250#####################################################################
251#####################################################################
252
253# switch to package main when we're done
254package main;
255
2561;
Note: See TracBrowser for help on using the repository browser.