source: perl/lib/BarnOwl/Style/Default.pm @ 880311d

release-1.10release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 880311d was ad0dedd, checked in by Karl Ramm <kcr@1ts.org>, 14 years ago
make control characters human-readable Random control characters that make it through the formatting code should not be passed silently to the user's terminal...
  • 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 description {"Default style";}
37
38BarnOwl::create_style("default", "BarnOwl::Style::Default");
39
40################################################################################
41
42sub format_time {
43    my $self = shift;
44    my $m = shift;
45    my $dateformat = BarnOwl::time_format('get_time_format');
46    return strftime($dateformat, localtime($m->unix_time));
47}
48
49sub format_login {
50    my $self = shift;
51    my $m = shift;
52    return sprintf(
53        '@b<%s%s> for @b(%s) (%s) %s',
54        uc( $m->login ),
55        $m->login_type,
56        $m->pretty_sender,
57        $m->login_extra,
58        $self->format_time($m)
59       );
60}
61
62sub format_ping {
63    my $self = shift;
64    my $m = shift;
65    my $personal_context = $m->personal_context;
66    $personal_context = ' [' . $personal_context . ']' if $personal_context;
67    return "\@b(PING)" . $personal_context . " from \@b(" . $m->pretty_sender . ")";
68}
69
70sub format_admin {
71    my $self = shift;
72    my $m = shift;
73    return "\@bold(OWL ADMIN)\n" . $self->indent_body($m);
74}
75
76sub format_chat {
77    my $self = shift;
78    my $m = shift;
79    my $header = $self->chat_header($m);
80    return $header . "\n". $self->indent_body($m);
81}
82
83sub chat_header {
84    my $self = shift;
85    my $m = shift;
86    my $header;
87    if ( $m->is_personal ) {
88        my $personal_context = $m->personal_context;
89        $personal_context = ' [' . $self->humanize($personal_context, 1) . ']' if $personal_context;
90
91        if ( $m->direction eq "out" ) {
92            $header = ucfirst $m->type . $personal_context . " sent to " . $m->pretty_recipient;
93        } else {
94            $header = ucfirst $m->type . $personal_context . " from " . $m->pretty_sender;
95        }
96    } else {
97        $header = $self->humanize($m->context, 1);
98        if(defined $m->subcontext) {
99            $header .= ' / ' . $self->humanize($m->subcontext, 1);
100        }
101        $header .= ' / @b{' . $m->pretty_sender . '}';
102    }
103
104    if($m->opcode) {
105        $header .= " [" . $self->humanize($m->opcode, 1) . "]";
106    }
107    $header .= "  " . $self->format_time($m);
108    $header .= $self->format_sender($m);
109    return $header;
110}
111
112sub format_sender {
113    my $self = shift;
114    my $m = shift;
115    my $sender = $m->long_sender;
116    $sender =~ s/\n.*$//s;
117    if (BarnOwl::getvar('colorztext') eq 'on') {
118      return "  (" . $sender . '@color[default]' . ")";
119    } else {
120      return "  ($sender)";
121    }
122}
123
124sub indent_body
125{
126    my $self = shift;
127    my $m = shift;
128
129    my $body = $m->body;
130    if ($m->{should_wordwrap}) {
131      $body = BarnOwl::wordwrap($body, BarnOwl::getnumcols()-9);
132    }
133    # replace newline followed by anything with
134    # newline plus four spaces and that thing.
135    $body =~ s/\n(.)/\n    $1/g;
136    # Trim trailing newlines.
137    $body =~ s/\n*$//;
138    return "    ".$body;
139}
140
141=head3 humanize STRING [one_line]
142
143Method that takes a STRING with control characters and makes it human
144readable in such a way as to not do anything funky with the terminal.
145If one_line is true, be more conservative about what we treat as
146control character.
147
148=cut
149
150sub humanize
151{
152  my $self = shift;
153  my $s = shift;
154  my $oneline = shift;
155  sub _humanize_char
156  {
157    my $c = ord(shift);
158
159    if ($c < ord(' ')) {
160      return ('^' . chr($c + ord('@')));
161    } elsif ($c == 255) {
162      return ('^?');
163    } else {
164      return (sprintf('\\x{%x}', $c));
165    }
166  }
167  my $colorize = (BarnOwl::getvar('colorztext') eq 'on')
168    ? '@color(cyan)' : '';
169
170  my $chars = $oneline ? qr/[[:cntrl:]]/ : qr/[^[:print:]]|[\r\cK\f]/;
171
172  $s =~ s/($chars)/
173    "\@b($colorize" . _humanize_char($1) . ')'/eg;
174
175  return $s;
176}
177
178=head3 humanize_short STRING
179
180As above, but always be conservative, and replace with a '?' instead
181of something mmore elaborate.
182
183=cut
184
185sub humanize_short
186{
187  my $self = shift;
188  my $s = shift;
189
190  $s =~ s/[[:cntrl:]]/?/g;
191
192  return $s;
193}
194
1951;
Note: See TracBrowser for help on using the repository browser.