source: perl/lib/BarnOwl/Style/Default.pm @ 6edc38b

release-1.10release-1.8release-1.9
Last change on this file since 6edc38b was 5738650, checked in by Nelson Elhage <nelhage@nelhage.com>, 14 years ago
Prepend "UNAUTH: " to displayed sender for unauthenticated zephyrs This patch extends the default style to indicate if a zephyr message is unauthenticated. [nelhage@nelhage.com: Tweak the styling, and also catch personals.]
  • Property mode set to 100644
File size: 5.0 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 ";
100            if(defined($m->auth) && ($m->auth ne "YES")) {
101                $header .= "UNAUTH: ";
102            }
103            $header .= maybe($m->pretty_sender);
104        }
105    } else {
106        $header = $self->humanize($m->context, 1);
107        if(defined $m->subcontext) {
108            $header .= ' / ' . $self->humanize($m->subcontext, 1);
109        }
110        $header .= ' / ';
111        if(defined($m->auth) && ($m->auth ne "YES")) {
112            $header .= "UNAUTH: ";
113        }
114        $header .= '@b{' . maybe($m->pretty_sender) . '}';
115    }
116
117    if($m->opcode) {
118        $header .= " [" . $self->humanize($m->opcode, 1) . "]";
119    }
120    $header .= "  " . $self->format_time($m);
121    $header .= $self->format_sender($m);
122    return $header;
123}
124
125sub format_sender {
126    my $self = shift;
127    my $m = shift;
128    my $sender = $m->long_sender;
129    $sender =~ s/\n.*$//s;
130    if (BarnOwl::getvar('colorztext') eq 'on') {
131      return "  (" . $sender . '@color[default]' . ")";
132    } else {
133      return "  ($sender)";
134    }
135}
136
137sub indent_body
138{
139    my $self = shift;
140    my $m = shift;
141
142    my $body = $m->body;
143    if ($m->{should_wordwrap}) {
144      $body = BarnOwl::wordwrap($body, BarnOwl::getnumcols()-9);
145    }
146    # replace newline followed by anything with
147    # newline plus four spaces and that thing.
148    $body =~ s/\n(.)/\n    $1/g;
149    # Trim trailing newlines.
150    $body =~ s/\n*$//;
151    return "    ".$body;
152}
153
154=head3 humanize STRING [one_line]
155
156Method that takes a STRING with control characters and makes it human
157readable in such a way as to not do anything funky with the terminal.
158If one_line is true, be more conservative about what we treat as
159control character.
160
161=cut
162
163sub humanize
164{
165  my $self = shift;
166  my $s = shift;
167  my $oneline = shift;
168  sub _humanize_char
169  {
170    my $c = ord(shift);
171
172    if ($c < ord(' ')) {
173      return ('^' . chr($c + ord('@')));
174    } elsif ($c == 255) {
175      return ('^?');
176    } else {
177      return (sprintf('\\x{%x}', $c));
178    }
179  }
180  my $colorize = (BarnOwl::getvar('colorztext') eq 'on')
181    ? '@color(cyan)' : '';
182
183  my $chars = $oneline ? qr/[[:cntrl:]]/ : qr/[^[:print:]\n]|[\r\cK\f]/;
184
185  $s =~ s/($chars)/
186    "\@b($colorize" . _humanize_char($1) . ')'/eg;
187
188  return $s;
189}
190
191=head3 humanize_short STRING
192
193As above, but always be conservative, and replace with a '?' instead
194of something more elaborate.
195
196=cut
197
198sub humanize_short
199{
200  my $self = shift;
201  my $s = shift;
202
203  $s =~ s/[[:cntrl:]]/?/g;
204
205  return $s;
206}
207
2081;
Note: See TracBrowser for help on using the repository browser.