source: perl/lib/BarnOwl/Message.pm @ 76e0e4a

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