source: perlwrap.pm @ 5d9c664

barnowl_perlaimdebianowlrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 5d9c664 was f1e629d, checked in by Erik Nygren <nygren@mit.edu>, 21 years ago
New API for perl message formatting functions. Legacy variables are still supported for owl::format_msg and owl::receive_msg, but these functions are now also passed an owl::Message object which contains methods for accessing the contents of the message. See perlwrap.pm (and docs TBD) for the available methods. *** WARNING: The exact API for owl::Message has *** not yet stabilized. Added "style" command for creating new styles. Usage: style <name> perl <function_name> Added support for "show styles". Changed global style table from list to dictionary. Changed AIM password prompt from "Password:" to "AIM Password:". Messages are reformatted after a window resize to allow styles to take into account the width of the window. When perl throws an error, the message is put in the msgwin if possible. Added perl functions for: owl::getcurmsg() -- returns an owl::Message object for the active message in the current view. owl::getnumcols() -- returns the column width of the window owl::zephyr_getrealm() -- returns the zephyr realm owl::zephyr_getsender() -- returns the zephyr sender Made owl::COMMAND("foo"); be syntactic sugar for owl::command("COMMAND foo"); *** Is this a good or bad idea? *** This feature may be taken out before release. Added perlwrap.pm to contain perl code to be compiled into the binary. This is transformed into perlwrap.c by encapsulate.pl. Renamed readconfig.c to perlconfig.c and changed variables accordingly. Minor bugfixes in cmd.c and commands.c
  • Property mode set to 100644
File size: 6.2 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#####################################################################
35#####################################################################
36
37package owl::Message;
38
39sub type        { return shift->{"type"}; }
40sub direction   { return shift->{"direction"}; }
41sub time        { return shift->{"time"}; }
42sub id          { return shift->{"id"}; }
43sub body        { return shift->{"body"}; }
44sub sender      { return shift->{"sender"}; }
45sub recipient   { return shift->{"recipient"}; }
46sub login       { return shift->{"login"}; }
47
48sub is_login    { return shift->login eq "login"; }
49sub is_logout   { return shift->login eq "logout"; }
50sub is_loginout { my $m=shift; return ($m->is_login or $m->is_logout); }
51sub is_incoming { return (shift->{"direction"} eq "in"); }
52sub is_outgoing { return (shift->{"direction"} eq "out"); }
53
54sub is_deleted  { return shift->{"deleted"}; }
55
56sub is_zephyr   { return (shift->{"type"} eq "zephyr"); }
57sub is_aim      { return (shift->{"type"} eq "aim"); }
58sub is_admin    { return (shift->{"type"} eq "admin"); }
59sub is_generic  { return (shift->{"type"} eq "generic"); }
60
61# These are overridden by appropriate message types
62sub is_ping     { return 0; }
63sub is_mail     { return 0; }
64sub class       { return undef; }
65sub instance    { return undef; }
66sub realm       { return undef; }
67sub opcode      { return undef; }
68sub header      { return undef; }
69sub host        { return undef; }
70sub hostname    { return undef; }
71sub auth        { return undef; }
72sub fields      { return undef; }
73sub zsig        { return undef; }
74sub zwriteline  { return undef; }
75
76sub pretty_sender { return shift->sender; }
77
78sub delete {
79    my ($m) = @_;
80    &owl::command("delete --id ".$m->id);
81}
82
83sub undelete {
84    my ($m) = @_;
85    &owl::command("undelete --id ".$m->id);
86}
87
88# Serializes the message into something similar to the zwgc->vt format
89sub serialize {
90    my ($this) = @_;
91    my $s;
92    for my $f (keys %$this) {
93        my $val = $this->{$f};
94        if (ref($val) eq "ARRAY") {
95            for my $i (0..@$val-1) {
96                my $aval;
97                $aval = $val->[$i];
98                $aval =~ s/\n/\n$f.$i: /g;
99                $s .= "$f.$i: $aval\n";   
100            }
101        } else {
102            $val =~ s/\n/\n$f: /g;
103            $s .= "$f: $val\n";
104        }
105    }
106    return $s;
107}
108
109# Populate the annoying legacy global variables
110sub legacy_populate_global {
111    my ($m) = @_;
112    $owl::direction  = $m->direction ;
113    $owl::type       = $m->type      ;
114    $owl::id         = $m->id        ;
115    $owl::class      = $m->class     ;
116    $owl::instance   = $m->instance  ;
117    $owl::recipient  = $m->recipient ;
118    $owl::sender     = $m->sender    ;
119    $owl::realm      = $m->realm     ;
120    $owl::opcode     = $m->opcode    ;
121    $owl::zsig       = $m->zsig      ;
122    $owl::msg        = $m->body      ;
123    $owl::time       = $m->time      ;
124    $owl::host       = $m->host      ;
125    if ($m->fields) {
126        @owl::fields = @{$m->fields};
127        @main::fields = @{$m->fields};
128    } else {
129        @owl::fields = undef;
130        @main::fields = undef;
131    }
132}
133
134#####################################################################
135#####################################################################
136
137package owl::Message::Admin;
138
139@ISA = qw( owl::Message );
140
141sub header       { return shift->{"header"}; }
142
143#####################################################################
144#####################################################################
145
146package owl::Message::Generic;
147
148@ISA = qw( owl::Message );
149
150#####################################################################
151#####################################################################
152
153package owl::Message::AIM;
154
155@ISA = qw( owl::Message );
156
157# all non-loginout AIM messages are personal for now...
158sub is_personal { 
159    return !(shift->is_loginout);
160}
161
162#####################################################################
163#####################################################################
164
165package owl::Message::Zephyr;
166
167@ISA = qw( owl::Message );
168
169sub login_tty { 
170    my ($m) = @_;
171    return undef if (!$m->is_loginout);
172    return $m->fields->[2];
173}
174
175sub login_host { 
176    my ($m) = @_;
177    return undef if (!$m->is_loginout);
178    return $m->fields->[0];
179}
180
181sub zwriteline  { return shift->{"zwriteline"}; }
182
183sub zsig        { return shift->{"zsig"}; }
184
185sub is_ping     { return (lc(shift->opcode) eq "ping"); }
186
187sub is_private {
188    my ($m) = @_;
189    return (lc($m->recipient) eq lc(owl::zephyr_getsender()));
190}
191
192sub is_personal { 
193    my ($m) = @_;
194    return ((lc($m->class) eq "message")
195            && (lc($m->instance) eq "personal")
196            && $m->is_private);
197}
198
199sub is_mail { 
200    my ($m) = @_;
201    return ((lc($m->class) eq "mail") && $m->is_private);
202}
203
204sub pretty_sender {
205    my ($m) = @_;
206    my $sender = $m->sender;
207    my $realm = owl::zephyr_getrealm();
208    $sender =~ s/\@$realm$//;
209    return $sender;
210}
211
212# These are arguably zephyr-specific
213sub class       { return shift->{"class"}; }
214sub instance    { return shift->{"instance"}; }
215sub realm       { return shift->{"realm"}; }
216sub opcode      { return shift->{"opcode"}; }
217sub host        { return shift->{"hostname"}; }
218sub hostname    { return shift->{"hostname"}; }
219sub header      { return shift->{"header"}; }
220sub auth        { return shift->{"auth"}; }
221sub fields      { return shift->{"fields"}; }
222sub zsig        { return shift->{"zsig"}; }
223
224#####################################################################
225#####################################################################
226
227# switch to package main when we're done
228package main;
229
2301;
Note: See TracBrowser for help on using the repository browser.