source: perl/lib/BarnOwl/Message.pm @ 6e764aa

Last change on this file since 6e764aa was 6e764aa, checked in by Jason Gross <jgross@mit.edu>, 8 years ago
Moved the checking of whether or not to log messages to perl
  • Property mode set to 100644
File size: 8.0 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 BarnOwl::message_matches_filter(shift, "personal"); }
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_and_expunge {
84    my ($m) = @_;
85    &BarnOwl::command("delete-and-expunge --quiet --id " . $m->id);
86}
87
88sub delete {
89    my ($m) = @_;
90    &BarnOwl::command("delete --id ".$m->id);
91}
92
93sub undelete {
94    my ($m) = @_;
95    &BarnOwl::command("undelete --id ".$m->id);
96}
97
98# Serializes the message into something similar to the zwgc->vt format
99sub serialize {
100    my ($this) = @_;
101    my $s;
102    for my $f (keys %$this) {
103        my $val = $this->{$f};
104        if (ref($val) eq "ARRAY") {
105            for my $i (0..@$val-1) {
106                my $aval;
107                $aval = $val->[$i];
108                $aval =~ s/\n/\n$f.$i: /g;
109                $s .= "$f.$i: $aval\n";
110            }
111        } else {
112            $val =~ s/\n/\n$f: /g;
113            $s .= "$f: $val\n";
114        }
115    }
116    return $s;
117}
118
119=head2 log MESSAGE
120
121Returns the text that should be written to a file to log C<MESSAGE>.
122
123=cut
124
125sub log {
126    my ($m) = @_;
127    return $m->log_header . "\n\n" . $m->log_body . "\n\n";
128}
129
130=head2 log_header MESSAGE
131
132Returns the header of the message, for logging purposes.
133If you override L<BarnOwl::Message::log>, this method is not called.
134
135=cut
136
137sub log_header {
138    my ($m) = @_;
139    my $sender = $m->sender;
140    my $recipient = $m->recipient;
141    my $timestr = $m->time;
142    return "From: <$sender> To: <$recipient>\n"
143         . "Time: $timestr";
144}
145
146=head2 log_body MESSAGE
147
148Returns the body of the message, for logging purposes.
149If you override L<BarnOwl::Message::log>, this method is not called.
150
151=cut
152
153sub log_body {
154    my ($m) = @_;
155    if ($m->is_loginout) {
156        return uc($m->login)
157            . $m->login_type
158            . ($m->login_extra ? ' at ' . $m->login_extra : '');
159    } else {
160        return $m->body;
161    }
162}
163
164=head2 log_filenames MESSAGE
165
166Returns a list of filenames to which this message should be logged.
167The filenames should be relative to the path returned by
168C<log_base_path>.  See L<BarnOwl::Logging::get_filenames> for the
169specification of valid filenames, and for what happens if this
170method returns an invalid filename.
171
172=cut
173
174sub log_filenames {
175    my ($m) = @_;
176    my $filename = lc($m->type);
177    $filename = "unknown" if !defined $filename || $filename eq '';
178    if ($m->is_incoming && $m->pretty_sender) {
179        $filename .= ":" . $m->pretty_sender;
180    } elsif ($m->is_outgoing && $m->pretty_recipient) {
181        $filename .= ":" . $m->pretty_recipient;
182    }
183    return ($filename);
184}
185
186=head2 log_to_all_file MESSAGE
187
188There is an C<all> file.  This method determines if C<MESSAGE>
189should get logged to it, in addition to any files returned by
190C<log_filenames>.
191
192It defaults to returning true if and only if C<MESSAGE> is outgoing.
193
194=cut
195
196sub log_to_all_file {
197    my ($m) = @_;
198    return $m->is_outgoing;
199}
200
201=head2 log_base_path MESSAGE
202
203Returns the base path for logging, the folder in which all messages
204of this class get logged.
205
206Defaults to the BarnOwl variable C<logpath>.
207
208=cut
209
210sub log_base_path {
211    return BarnOwl::getvar('logpath');
212}
213
214=head2 log_outgoing_error MESSAGE
215
216Returns the string that should be logged if there is an error sending
217an outgoing message.
218
219=cut
220
221sub log_outgoing_error {
222    my ($m) = @_;
223    my $recipient = $m->pretty_recipient;
224    my $body = $m->body;
225    chomp $body;
226    return "ERROR (BarnOwl): $recipient\n$body\n\n";
227}
228
229=head2 should_log MESSAGE
230
231Returns true if we should log C<MESSAGE>.  This does not override
232user settings; if the BarnOwl variable C<loggingdirection> is in,
233and C<MESSAGE> is outgoing and does not match the C<logfilter>, it
234will not get logged regardless of what this method returns.
235
236Note that this method I<does> override the BarnOwl C<logging>
237variable; if a derived class overrides this method and does not
238provide an alternative BarnOwl variable (such as C<classlogging>),
239the overriding method should check the BarnOwl C<logging> variable.
240
241Defaults to returning the value of the BarnOwl variable C<logging>.
242
243=cut
244
245sub should_log {
246    return BarnOwl::getvar('logging') eq 'on';
247}
248
249# Populate the annoying legacy global variables
250sub legacy_populate_global {
251    my ($m) = @_;
252    $BarnOwl::direction  = $m->direction ;
253    $BarnOwl::type       = $m->type      ;
254    $BarnOwl::id         = $m->id        ;
255    $BarnOwl::class      = $m->class     ;
256    $BarnOwl::instance   = $m->instance  ;
257    $BarnOwl::recipient  = $m->recipient ;
258    $BarnOwl::sender     = $m->sender    ;
259    $BarnOwl::realm      = $m->realm     ;
260    $BarnOwl::opcode     = $m->opcode    ;
261    $BarnOwl::zsig       = $m->zsig      ;
262    $BarnOwl::msg        = $m->body      ;
263    $BarnOwl::time       = $m->time      ;
264    $BarnOwl::host       = $m->host      ;
265    $BarnOwl::login      = $m->login     ;
266    $BarnOwl::auth       = $m->auth      ;
267    if ($m->fields) {
268        @BarnOwl::fields = @{$m->fields};
269        @main::fields = @{$m->fields};
270    } else {
271        @BarnOwl::fields = undef;
272        @main::fields = undef;
273    }
274}
275
276sub smartfilter {
277    die("smartfilter not supported for this message\n");
278}
279
280# Display fields -- overridden by subclasses when needed
281sub login_type {""}
282sub login_extra {""}
283sub long_sender {""}
284
285# The context in which a non-personal message was sent, e.g. a chat or
286# class
287sub context {""}
288
289# Some indicator of context *within* $self->context. e.g. the zephyr
290# instance
291sub subcontext {""}
292
293
2941;
Note: See TracBrowser for help on using the repository browser.