source: perl/lib/BarnOwl/Message.pm @ 50a3240

Last change on this file since 50a3240 was 50a3240, checked in by Jason Gross <jgross@mit.edu>, 9 years ago
Log to subfolders of a base path A different subfolder for each protocol.
  • Property mode set to 100644
File size: 8.3 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Message;
5
6use File::Spec;
7
8use BarnOwl::Message::Admin;
9use BarnOwl::Message::AIM;
10use BarnOwl::Message::Generic;
11use BarnOwl::Message::Loopback;
12use BarnOwl::Message::Zephyr;
13
14sub new {
15    my $class = shift;
16    my %args = (@_);
17    if($class eq __PACKAGE__ && $args{type}) {
18        $class = "BarnOwl::Message::" . ucfirst $args{type};
19    }
20    return bless {%args}, $class;
21}
22
23sub type        { return shift->{"type"}; }
24sub direction   { return shift->{"direction"}; }
25sub time        { return shift->{"time"}; }
26sub unix_time   { return shift->{"unix_time"}; }
27sub id          { return shift->{"id"}; }
28sub body        { return shift->{"body"}; }
29sub sender      { return shift->{"sender"}; }
30sub recipient   { return shift->{"recipient"}; }
31sub login       { return shift->{"login"}; }
32sub is_private  { return shift->{"private"}; }
33
34sub is_login    { return shift->login eq "login"; }
35sub is_logout   { return shift->login eq "logout"; }
36sub is_loginout { my $m=shift; return ($m->is_login or $m->is_logout); }
37sub is_incoming { return (shift->{"direction"} eq "in"); }
38sub is_outgoing { return (shift->{"direction"} eq "out"); }
39
40sub is_deleted  { return shift->{"deleted"}; }
41
42sub is_admin    { return (shift->{"type"} eq "admin"); }
43sub is_generic  { return (shift->{"type"} eq "generic"); }
44sub is_zephyr   { return (shift->{"type"} eq "zephyr"); }
45sub is_aim      { return (shift->{"type"} eq "AIM"); }
46sub is_jabber   { return (shift->{"type"} eq "jabber"); }
47sub is_icq      { return (shift->{"type"} eq "icq"); }
48sub is_yahoo    { return (shift->{"type"} eq "yahoo"); }
49sub is_msn      { return (shift->{"type"} eq "msn"); }
50sub is_loopback { return (shift->{"type"} eq "loopback"); }
51
52# These are overridden by appropriate message types
53sub is_ping     { return 0; }
54sub is_mail     { return 0; }
55sub is_personal { return BarnOwl::message_matches_filter(shift, "personal"); }
56sub class       { return undef; }
57sub instance    { return undef; }
58sub realm       { return undef; }
59sub opcode      { return undef; }
60sub header      { return undef; }
61sub host        { return undef; }
62sub hostname    { return undef; }
63sub auth        { return undef; }
64sub fields      { return undef; }
65sub zsig        { return undef; }
66sub zwriteline  { return undef; }
67sub login_host  { return undef; }
68sub login_tty   { return undef; }
69
70# This is for back-compat with old messages that set these properties
71# New protocol implementations are encourages to user override these
72# methods.
73sub replycmd         { return shift->{replycmd}};
74sub replysendercmd   { return shift->{replysendercmd}};
75
76sub pretty_sender    { return shift->sender; }
77sub pretty_recipient { return shift->recipient; }
78
79# Override if you want a context (instance, network, etc.) on personals
80sub personal_context { return ""; }
81# extra short version, for use where space is especially tight
82# (eg, the oneline style)
83sub short_personal_context { return ""; }
84
85sub delete_and_expunge {
86    my ($m) = @_;
87    &BarnOwl::command("delete-and-expunge --quiet --id " . $m->id);
88}
89
90sub delete {
91    my ($m) = @_;
92    &BarnOwl::command("delete --id ".$m->id);
93}
94
95sub undelete {
96    my ($m) = @_;
97    &BarnOwl::command("undelete --id ".$m->id);
98}
99
100# Serializes the message into something similar to the zwgc->vt format
101sub serialize {
102    my ($this) = @_;
103    my $s;
104    for my $f (keys %$this) {
105        my $val = $this->{$f};
106        if (ref($val) eq "ARRAY") {
107            for my $i (0..@$val-1) {
108                my $aval;
109                $aval = $val->[$i];
110                $aval =~ s/\n/\n$f.$i: /g;
111                $s .= "$f.$i: $aval\n";
112            }
113        } else {
114            $val =~ s/\n/\n$f: /g;
115            $s .= "$f: $val\n";
116        }
117    }
118    return $s;
119}
120
121=head2 log MESSAGE
122
123Returns the text that should be written to a file to log C<MESSAGE>.
124
125=cut
126
127sub log {
128    my ($m) = @_;
129    return $m->log_header . "\n\n" . $m->log_body . "\n\n";
130}
131
132=head2 log_header MESSAGE
133
134Returns the header of the message, for logging purposes.
135If you override L<BarnOwl::Message::log>, this method is not called.
136
137=cut
138
139sub log_header {
140    my ($m) = @_;
141    my $sender = $m->sender;
142    my $recipient = $m->recipient;
143    my $timestr = $m->time;
144    return "From: <$sender> To: <$recipient>\n"
145         . "Time: $timestr";
146}
147
148=head2 log_body MESSAGE
149
150Returns the body of the message, for logging purposes.
151If you override L<BarnOwl::Message::log>, this method is not called.
152
153=cut
154
155sub log_body {
156    my ($m) = @_;
157    if ($m->is_loginout) {
158        return uc($m->login)
159            . $m->login_type
160            . ($m->login_extra ? ' at ' . $m->login_extra : '');
161    } else {
162        return $m->body;
163    }
164}
165
166=head2 log_filenames MESSAGE
167
168Returns a list of filenames to which this message should be logged.
169The filenames should be relative to the path returned by C<log_path>.
170See L<BarnOwl::Logging::get_filenames> for the specification of valid
171filenames, and for what happens if this method returns an invalid
172filename.
173
174=cut
175
176sub log_filenames {
177    my ($m) = @_;
178    my $filename;
179    if ($m->is_incoming) {
180        $filename = $m->pretty_sender;
181    } elsif ($m->is_outgoing) {
182        $filename = $m->pretty_recipient;
183    }
184    $filename = "unknown" if !defined($filename) || $filename eq '';
185    return ($filename);
186}
187
188=head2 log_to_all_file MESSAGE
189
190There is an C<all> file.  This method determines if C<MESSAGE>
191should get logged to it, in addition to any files returned by
192C<log_filenames>.
193
194It defaults to returning true if and only if C<MESSAGE> is outgoing.
195
196=cut
197
198sub log_to_all_file {
199    my ($m) = @_;
200    return $m->is_outgoing;
201}
202
203=head2 log_path MESSAGE
204
205Returns the folder in which all messages of this class get logged.
206
207Defaults to C<log_base_path>/C<log_subfolder>.
208
209=cut
210
211sub log_path {
212    my ($m) = @_;
213    return File::Spec->catfile($m->log_base_path, $m->log_subfolder);
214}
215
216=head2 log_base_path MESSAGE
217
218Returns the base path for logging.  See C<log_path> for more information.
219
220Defaults to the BarnOwl variable C<logbasepath>.
221
222=cut
223
224sub log_base_path {
225    return BarnOwl::getvar('logbasepath');
226}
227
228=head2 log_subfolder MESSAGE
229
230Returns the subfolder of C<log_base_path> to log messages in.
231
232Defaults to C<lc($m->type)>.
233
234=cut
235
236sub log_subfolder {
237    return lc(shift->type);
238}
239
240=head2 log_outgoing_error MESSAGE
241
242Returns the string that should be logged if there is an error sending
243an outgoing message.
244
245=cut
246
247sub log_outgoing_error {
248    my ($m) = @_;
249    my $recipient = $m->pretty_recipient;
250    my $body = $m->body;
251    chomp $body;
252    return "ERROR (BarnOwl): $recipient\n$body\n\n";
253}
254
255=head2 should_log MESSAGE
256
257Returns true if we should log C<MESSAGE>.  This does not override
258user settings; if the BarnOwl variable C<loggingdirection> is in,
259and C<MESSAGE> is outgoing and does not match the C<logfilter>, it
260will not get logged regardless of what this method returns.
261
262Note that this method I<does> override the BarnOwl C<logging>
263variable; if a derived class overrides this method and does not
264provide an alternative BarnOwl variable (such as C<classlogging>),
265the overriding method should check the BarnOwl C<logging> variable.
266
267Defaults to returning the value of the BarnOwl variable C<logging>.
268
269=cut
270
271sub should_log {
272    return BarnOwl::getvar('logging') eq 'on';
273}
274
275# Populate the annoying legacy global variables
276sub legacy_populate_global {
277    my ($m) = @_;
278    $BarnOwl::direction  = $m->direction ;
279    $BarnOwl::type       = $m->type      ;
280    $BarnOwl::id         = $m->id        ;
281    $BarnOwl::class      = $m->class     ;
282    $BarnOwl::instance   = $m->instance  ;
283    $BarnOwl::recipient  = $m->recipient ;
284    $BarnOwl::sender     = $m->sender    ;
285    $BarnOwl::realm      = $m->realm     ;
286    $BarnOwl::opcode     = $m->opcode    ;
287    $BarnOwl::zsig       = $m->zsig      ;
288    $BarnOwl::msg        = $m->body      ;
289    $BarnOwl::time       = $m->time      ;
290    $BarnOwl::host       = $m->host      ;
291    $BarnOwl::login      = $m->login     ;
292    $BarnOwl::auth       = $m->auth      ;
293    if ($m->fields) {
294        @BarnOwl::fields = @{$m->fields};
295        @main::fields = @{$m->fields};
296    } else {
297        @BarnOwl::fields = undef;
298        @main::fields = undef;
299    }
300}
301
302sub smartfilter {
303    die("smartfilter not supported for this message\n");
304}
305
306# Display fields -- overridden by subclasses when needed
307sub login_type {""}
308sub login_extra {""}
309sub long_sender {""}
310
311# The context in which a non-personal message was sent, e.g. a chat or
312# class
313sub context {""}
314
315# Some indicator of context *within* $self->context. e.g. the zephyr
316# instance
317sub subcontext {""}
318
319
3201;
Note: See TracBrowser for help on using the repository browser.