source: perl/lib/BarnOwl/Message.pm @ fc92548d

release-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since fc92548d was fd8dfe7, checked in by Nelson Elhage <nelhage@mit.edu>, 15 years ago
Load perl code from the filesystem at runtime. Remove perlwrap.pm and associated code, and instead do 'use BarnOwl' at boot time to load cdoe from the file system at runtime. In addition, add appropriate 'use' statements to the .pm files to cause everything to get loaded.
  • Property mode set to 100644
File size: 4.6 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Message;
5
6use BarnOwl::Message::Admin;
7use BarnOwl::Message::AIM;
8use BarnOwl::Message::Generic;
9use BarnOwl::Message::Loopback;
10use BarnOwl::Message::Zephyr;
11
12sub new {
13    my $class = shift;
14    my %args = (@_);
15    if($class eq __PACKAGE__ && $args{type}) {
16        $class = "BarnOwl::Message::" . ucfirst $args{type};
17    }
18    return bless {%args}, $class;
19}
20
21sub type        { return shift->{"type"}; }
22sub direction   { return shift->{"direction"}; }
23sub time        { return shift->{"time"}; }
24sub id          { return shift->{"id"}; }
25sub body        { return shift->{"body"}; }
26sub sender      { return shift->{"sender"}; }
27sub recipient   { return shift->{"recipient"}; }
28sub login       { return shift->{"login"}; }
29sub is_private  { return shift->{"private"}; }
30
31sub is_login    { return shift->login eq "login"; }
32sub is_logout   { return shift->login eq "logout"; }
33sub is_loginout { my $m=shift; return ($m->is_login or $m->is_logout); }
34sub is_incoming { return (shift->{"direction"} eq "in"); }
35sub is_outgoing { return (shift->{"direction"} eq "out"); }
36
37sub is_deleted  { return shift->{"deleted"}; }
38
39sub is_admin    { return (shift->{"type"} eq "admin"); }
40sub is_generic  { return (shift->{"type"} eq "generic"); }
41sub is_zephyr   { return (shift->{"type"} eq "zephyr"); }
42sub is_aim      { return (shift->{"type"} eq "AIM"); }
43sub is_jabber   { return (shift->{"type"} eq "jabber"); }
44sub is_icq      { return (shift->{"type"} eq "icq"); }
45sub is_yahoo    { return (shift->{"type"} eq "yahoo"); }
46sub is_msn      { return (shift->{"type"} eq "msn"); }
47sub is_loopback { return (shift->{"type"} eq "loopback"); }
48
49# These are overridden by appropriate message types
50sub is_ping     { return 0; }
51sub is_mail     { return 0; }
52sub is_personal { return shift->is_private; }
53sub class       { return undef; }
54sub instance    { return undef; }
55sub realm       { return undef; }
56sub opcode      { return undef; }
57sub header      { return undef; }
58sub host        { return undef; }
59sub hostname    { return undef; }
60sub auth        { return undef; }
61sub fields      { return undef; }
62sub zsig        { return undef; }
63sub zwriteline  { return undef; }
64sub login_host  { return undef; }
65sub login_tty   { return undef; }
66
67# This is for back-compat with old messages that set these properties
68# New protocol implementations are encourages to user override these
69# methods.
70sub replycmd         { return shift->{replycmd}};
71sub replysendercmd   { return shift->{replysendercmd}};
72
73sub pretty_sender    { return shift->sender; }
74sub pretty_recipient { return shift->recipient; }
75
76# Override if you want a context (instance, network, etc.) on personals
77sub personal_context { return ""; }
78# extra short version, for use where space is especially tight
79# (eg, the oneline style)
80sub short_personal_context { return ""; }
81
82sub delete {
83    my ($m) = @_;
84    &BarnOwl::command("delete --id ".$m->id);
85}
86
87sub undelete {
88    my ($m) = @_;
89    &BarnOwl::command("undelete --id ".$m->id);
90}
91
92# Serializes the message into something similar to the zwgc->vt format
93sub serialize {
94    my ($this) = @_;
95    my $s;
96    for my $f (keys %$this) {
97        my $val = $this->{$f};
98        if (ref($val) eq "ARRAY") {
99            for my $i (0..@$val-1) {
100                my $aval;
101                $aval = $val->[$i];
102                $aval =~ s/\n/\n$f.$i: /g;
103                $s .= "$f.$i: $aval\n";
104            }
105        } else {
106            $val =~ s/\n/\n$f: /g;
107            $s .= "$f: $val\n";
108        }
109    }
110    return $s;
111}
112
113# Populate the annoying legacy global variables
114sub legacy_populate_global {
115    my ($m) = @_;
116    $BarnOwl::direction  = $m->direction ;
117    $BarnOwl::type       = $m->type      ;
118    $BarnOwl::id         = $m->id        ;
119    $BarnOwl::class      = $m->class     ;
120    $BarnOwl::instance   = $m->instance  ;
121    $BarnOwl::recipient  = $m->recipient ;
122    $BarnOwl::sender     = $m->sender    ;
123    $BarnOwl::realm      = $m->realm     ;
124    $BarnOwl::opcode     = $m->opcode    ;
125    $BarnOwl::zsig       = $m->zsig      ;
126    $BarnOwl::msg        = $m->body      ;
127    $BarnOwl::time       = $m->time      ;
128    $BarnOwl::host       = $m->host      ;
129    $BarnOwl::login      = $m->login     ;
130    $BarnOwl::auth       = $m->auth      ;
131    if ($m->fields) {
132        @BarnOwl::fields = @{$m->fields};
133        @main::fields = @{$m->fields};
134    } else {
135        @BarnOwl::fields = undef;
136        @main::fields = undef;
137    }
138}
139
140sub smartfilter {
141    die("smartfilter not supported for this message\n");
142}
143
144# Display fields -- overridden by subclasses when needed
145sub login_type {""}
146sub login_extra {""}
147sub long_sender {""}
148
149# The context in which a non-personal message was sent, e.g. a chat or
150# class
151sub context {""}
152
153# Some indicator of context *within* $self->context. e.g. the zephyr
154# instance
155sub subcontext {""}
156
157
1581;
Note: See TracBrowser for help on using the repository browser.