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

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