source: perlwrap.pm @ 8862725

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