source: perl/lib/BarnOwl/Style/Default.pm @ 08544e0

release-1.7release-1.8release-1.9
Last change on this file since 08544e0 was 08544e0, checked in by Nelson Elhage <nelhage@mit.edu>, 11 years ago
Default style: Be more robust against undefs
  • Property mode set to 100644
File size: 4.7 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Style::Default;
5use POSIX qw(strftime);
6
7################################################################################
8# Branching point for various formatting functions in this style.
9################################################################################
10sub format_message
11{
12    my $self = shift;
13    my $m    = shift;
14    my $fmt;
15
16    if ( $m->is_loginout) {
17        $fmt = $self->format_login($m);
18    } elsif($m->is_ping && $m->is_personal) {
19        $fmt = $self->format_ping($m);
20    } elsif($m->is_admin) {
21        $fmt = $self->format_admin($m);
22    } else {
23        $fmt = $self->format_chat($m);
24    }
25    $fmt = BarnOwl::Style::boldify($fmt) if $self->should_bold($m);
26    $fmt = $self->humanize($fmt);
27    return $fmt;
28}
29
30sub should_bold {
31    my $self = shift;
32    my $m = shift;
33    return $m->is_personal && $m->direction eq "in";
34}
35
36sub maybe {
37    my $x = shift;
38    return defined($x) ? $x : "";
39}
40
41sub description {"Default style";}
42
43BarnOwl::create_style("default", "BarnOwl::Style::Default");
44
45################################################################################
46
47sub format_time {
48    my $self = shift;
49    my $m = shift;
50    my $dateformat = BarnOwl::time_format('get_time_format');
51    return strftime($dateformat, localtime($m->unix_time));
52}
53
54sub format_login {
55    my $self = shift;
56    my $m = shift;
57    return sprintf(
58        '@b<%s%s> for @b(%s) (%s) %s',
59        uc( $m->login ),
60        $m->login_type,
61        $m->pretty_sender,
62        $m->login_extra,
63        $self->format_time($m)
64       );
65}
66
67sub format_ping {
68    my $self = shift;
69    my $m = shift;
70    my $personal_context = $m->personal_context;
71    $personal_context = ' [' . $personal_context . ']' if $personal_context;
72    return "\@b(PING)" . $personal_context . " from \@b(" . $m->pretty_sender . ")";
73}
74
75sub format_admin {
76    my $self = shift;
77    my $m = shift;
78    return "\@bold(OWL ADMIN)\n" . $self->indent_body($m);
79}
80
81sub format_chat {
82    my $self = shift;
83    my $m = shift;
84    my $header = $self->chat_header($m);
85    return $header . "\n". $self->indent_body($m);
86}
87
88sub chat_header {
89    my $self = shift;
90    my $m = shift;
91    my $header;
92    if ( $m->is_personal ) {
93        my $personal_context = $m->personal_context;
94        $personal_context = ' [' . $self->humanize($personal_context, 1) . ']' if $personal_context;
95
96        if ( $m->direction eq "out" ) {
97            $header = ucfirst $m->type . $personal_context . " sent to " . $m->pretty_recipient;
98        } else {
99            $header = ucfirst $m->type . $personal_context . " from " . $m->pretty_sender;
100        }
101    } else {
102        $header = $self->humanize($m->context, 1);
103        if(defined $m->subcontext) {
104            $header .= ' / ' . $self->humanize($m->subcontext, 1);
105        }
106        $header .= ' / @b{' . maybe($m->pretty_sender) . '}';
107    }
108
109    if($m->opcode) {
110        $header .= " [" . $self->humanize($m->opcode, 1) . "]";
111    }
112    $header .= "  " . $self->format_time($m);
113    $header .= $self->format_sender($m);
114    return $header;
115}
116
117sub format_sender {
118    my $self = shift;
119    my $m = shift;
120    my $sender = $m->long_sender;
121    $sender =~ s/\n.*$//s;
122    if (BarnOwl::getvar('colorztext') eq 'on') {
123      return "  (" . $sender . '@color[default]' . ")";
124    } else {
125      return "  ($sender)";
126    }
127}
128
129sub indent_body
130{
131    my $self = shift;
132    my $m = shift;
133
134    my $body = $m->body;
135    if ($m->{should_wordwrap}) {
136      $body = BarnOwl::wordwrap($body, BarnOwl::getnumcols()-9);
137    }
138    # replace newline followed by anything with
139    # newline plus four spaces and that thing.
140    $body =~ s/\n(.)/\n    $1/g;
141    # Trim trailing newlines.
142    $body =~ s/\n*$//;
143    return "    ".$body;
144}
145
146=head3 humanize STRING [one_line]
147
148Method that takes a STRING with control characters and makes it human
149readable in such a way as to not do anything funky with the terminal.
150If one_line is true, be more conservative about what we treat as
151control character.
152
153=cut
154
155sub humanize
156{
157  my $self = shift;
158  my $s = shift;
159  my $oneline = shift;
160  sub _humanize_char
161  {
162    my $c = ord(shift);
163
164    if ($c < ord(' ')) {
165      return ('^' . chr($c + ord('@')));
166    } elsif ($c == 255) {
167      return ('^?');
168    } else {
169      return (sprintf('\\x{%x}', $c));
170    }
171  }
172  my $colorize = (BarnOwl::getvar('colorztext') eq 'on')
173    ? '@color(cyan)' : '';
174
175  my $chars = $oneline ? qr/[[:cntrl:]]/ : qr/[^[:print:]\n]|[\r\cK\f]/;
176
177  $s =~ s/($chars)/
178    "\@b($colorize" . _humanize_char($1) . ')'/eg;
179
180  return $s;
181}
182
183=head3 humanize_short STRING
184
185As above, but always be conservative, and replace with a '?' instead
186of something more elaborate.
187
188=cut
189
190sub humanize_short
191{
192  my $self = shift;
193  my $s = shift;
194
195  $s =~ s/[[:cntrl:]]/?/g;
196
197  return $s;
198}
199
2001;
Note: See TracBrowser for help on using the repository browser.