source: perl/lib/BarnOwl/Style/Default.pm @ 8505b8f

release-1.10release-1.9
Last change on this file since 8505b8f was 732d5c0, checked in by Anders Kaseorg <andersk@mit.edu>, 13 years ago
Show foreign realms on non-personal zephyrs like Owl did Signed-off-by: Anders Kaseorg <andersk@mit.edu> Reviewed-by: David Benjamin <davidben@mit.edu>
  • Property mode set to 100644
File size: 5.1 KB
RevLine 
[ee183be]1use strict;
2use warnings;
3
4package BarnOwl::Style::Default;
[5550eb0]5use POSIX qw(strftime);
6
[ee183be]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);
[ad0dedd]26    $fmt = $self->humanize($fmt);
[ee183be]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
[08544e0]36sub maybe {
37    my $x = shift;
38    return defined($x) ? $x : "";
39}
40
[ee183be]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;
[0b2afba]50    my $dateformat = BarnOwl::time_format('get_time_format');
51    return strftime($dateformat, localtime($m->unix_time));
[ee183be]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;
[ad0dedd]94        $personal_context = ' [' . $self->humanize($personal_context, 1) . ']' if $personal_context;
[ee183be]95
96        if ( $m->direction eq "out" ) {
97            $header = ucfirst $m->type . $personal_context . " sent to " . $m->pretty_recipient;
98        } else {
[5738650]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);
[ee183be]104        }
105    } else {
[ad0dedd]106        $header = $self->humanize($m->context, 1);
[ee183be]107        if(defined $m->subcontext) {
[ad0dedd]108            $header .= ' / ' . $self->humanize($m->subcontext, 1);
[ee183be]109        }
[5738650]110        $header .= ' / ';
111        if(defined($m->auth) && ($m->auth ne "YES")) {
112            $header .= "UNAUTH: ";
113        }
114        $header .= '@b{' . maybe($m->pretty_sender) . '}';
[732d5c0]115        if (defined($m->realm) && $m->realm ne BarnOwl::zephyr_getrealm()) {
116            $header .= ' {' . $self->humanize($m->realm, 1) . '}';
117        }
[ee183be]118    }
119
120    if($m->opcode) {
[ad0dedd]121        $header .= " [" . $self->humanize($m->opcode, 1) . "]";
[ee183be]122    }
123    $header .= "  " . $self->format_time($m);
124    $header .= $self->format_sender($m);
125    return $header;
126}
127
128sub format_sender {
129    my $self = shift;
130    my $m = shift;
131    my $sender = $m->long_sender;
132    $sender =~ s/\n.*$//s;
133    if (BarnOwl::getvar('colorztext') eq 'on') {
134      return "  (" . $sender . '@color[default]' . ")";
135    } else {
136      return "  ($sender)";
137    }
138}
139
140sub indent_body
141{
142    my $self = shift;
143    my $m = shift;
144
145    my $body = $m->body;
146    if ($m->{should_wordwrap}) {
147      $body = BarnOwl::wordwrap($body, BarnOwl::getnumcols()-9);
148    }
149    # replace newline followed by anything with
150    # newline plus four spaces and that thing.
151    $body =~ s/\n(.)/\n    $1/g;
152    # Trim trailing newlines.
153    $body =~ s/\n*$//;
154    return "    ".$body;
155}
156
[ad0dedd]157=head3 humanize STRING [one_line]
158
159Method that takes a STRING with control characters and makes it human
160readable in such a way as to not do anything funky with the terminal.
161If one_line is true, be more conservative about what we treat as
162control character.
163
164=cut
165
166sub humanize
167{
168  my $self = shift;
169  my $s = shift;
170  my $oneline = shift;
171  sub _humanize_char
172  {
173    my $c = ord(shift);
174
175    if ($c < ord(' ')) {
176      return ('^' . chr($c + ord('@')));
177    } elsif ($c == 255) {
178      return ('^?');
179    } else {
180      return (sprintf('\\x{%x}', $c));
181    }
182  }
183  my $colorize = (BarnOwl::getvar('colorztext') eq 'on')
184    ? '@color(cyan)' : '';
185
[0fe69d2]186  my $chars = $oneline ? qr/[[:cntrl:]]/ : qr/[^[:print:]\n]|[\r\cK\f]/;
[ad0dedd]187
188  $s =~ s/($chars)/
189    "\@b($colorize" . _humanize_char($1) . ')'/eg;
190
191  return $s;
192}
193
194=head3 humanize_short STRING
195
196As above, but always be conservative, and replace with a '?' instead
[25bfc10]197of something more elaborate.
[ad0dedd]198
199=cut
200
201sub humanize_short
202{
203  my $self = shift;
204  my $s = shift;
205
206  $s =~ s/[[:cntrl:]]/?/g;
207
208  return $s;
209}
[ee183be]210
2111;
Note: See TracBrowser for help on using the repository browser.