source: perl/lib/BarnOwl/Style/Default.pm @ e5b119a

use strict;
use warnings;

package BarnOwl::Style::Default;
use POSIX qw(strftime);

################################################################################
# Branching point for various formatting functions in this style.
################################################################################
sub format_message
{
    my $self = shift;
    my $m    = shift;
    my $fmt;

    if ( $m->is_loginout) {
        $fmt = $self->format_login($m);
    } elsif($m->is_ping && $m->is_personal) {
        $fmt = $self->format_ping($m);
    } elsif($m->is_admin) {
        $fmt = $self->format_admin($m);
    } else {
        $fmt = $self->format_chat($m);
    }
    $fmt = BarnOwl::Style::boldify($fmt) if $self->should_bold($m);
    $fmt = $self->humanize($fmt);
    return $fmt;
}

sub should_bold {
    my $self = shift;
    my $m = shift;
    return $m->is_personal && $m->direction eq "in";
}

sub maybe {
    my $x = shift;
    return defined($x) ? $x : "";
}

sub description {"Default style";}

BarnOwl::create_style("default", "BarnOwl::Style::Default");

################################################################################

sub format_time {
    my $self = shift;
    my $m = shift;
    my $dateformat = BarnOwl::time_format('get_time_format');
    return strftime($dateformat, localtime($m->unix_time));
}

sub format_login {
    my $self = shift;
    my $m = shift;
    return sprintf(
        '@b<%s%s> for @b(%s) (%s) %s',
        uc( $m->login ),
        $m->login_type,
        $m->pretty_sender,
        $m->login_extra,
        $self->format_time($m)
       );
}

sub format_ping {
    my $self = shift;
    my $m = shift;
    my $personal_context = $m->personal_context;
    $personal_context = ' [' . $personal_context . ']' if $personal_context;
    return "\@b(PING)" . $personal_context . " from \@b(" . $m->pretty_sender . ")";
}

sub format_admin {
    my $self = shift;
    my $m = shift;
    return "\@bold(OWL ADMIN)\n" . $self->indent_body($m);
}

sub format_chat {
    my $self = shift;
    my $m = shift;
    my $header = $self->chat_header($m);
    return $header . "\n". $self->indent_body($m);
}

sub chat_header {
    my $self = shift;
    my $m = shift;
    my $header;
    if ( $m->is_personal ) {
        my $personal_context = $m->personal_context;
        $personal_context = ' [' . $self->humanize($personal_context, 1) . ']' if $personal_context;

        if ( $m->direction eq "out" ) {
            $header = ucfirst $m->type . $personal_context . " sent to " . $m->pretty_recipient;
        } else {
            $header = ucfirst $m->type . $personal_context . " from ";
            if(defined($m->auth) && ($m->auth ne "YES")) {
                $header .= "UNAUTH: ";
            }
            $header .= maybe($m->pretty_sender);
        }
    } else {
        $header = $self->humanize($m->context, 1);
        if(defined $m->subcontext) {
            $header .= ' / ' . $self->humanize($m->subcontext, 1);
        }
        $header .= ' / ';
        if(defined($m->auth) && ($m->auth ne "YES")) {
            $header .= "UNAUTH: ";
        }
        $header .= '@b{' . maybe($m->pretty_sender) . '}';
        if (defined($m->realm) && $m->realm ne BarnOwl::zephyr_getrealm()) {
            $header .= ' {' . $self->humanize($m->realm, 1) . '}';
        }
    }

    if($m->opcode) {
        $header .= " [" . $self->humanize($m->opcode, 1) . "]";
    }
    $header .= "  " . $self->format_time($m);
    $header .= $self->format_sender($m);
    return $header;
}

sub format_sender {
    my $self = shift;
    my $m = shift;
    my $sender = $m->long_sender;
    $sender =~ s/\n.*$//s;
    if (BarnOwl::getvar('colorztext') eq 'on') {
      return "  (" . $sender . '@color[default]' . ")";
    } else {
      return "  ($sender)";
    }
}

sub indent_body
{
    my $self = shift;
    my $m = shift;

    my $body = $m->body;
    if ($m->{should_wordwrap}) {
      $body = BarnOwl::wordwrap($body, BarnOwl::getnumcols()-9);
    }
    # replace newline followed by anything with
    # newline plus four spaces and that thing.
    $body =~ s/\n(.)/\n    $1/g;
    # Trim trailing newlines.
    $body =~ s/\n*$//;
    return "    ".$body;
}

=head3 humanize STRING [one_line]

Method that takes a STRING with control characters and makes it human
readable in such a way as to not do anything funky with the terminal.
If one_line is true, be more conservative about what we treat as
control character.

=cut

sub humanize
{
  my $self = shift;
  my $s = shift;
  my $oneline = shift;
  sub _humanize_char
  {
    my $c = ord(shift);

    if ($c < ord(' ')) {
      return ('^' . chr($c + ord('@')));
    } elsif ($c == 255) {
      return ('^?');
    } else {
      return (sprintf('\\x{%x}', $c));
    }
  }
  my $colorize = (BarnOwl::getvar('colorztext') eq 'on')
    ? '@color(cyan)' : '';

  my $chars = $oneline ? qr/[[:cntrl:]]/ : qr/[^[:print:]\n]|[\r\cK\f]/;

  $s =~ s/($chars)/
    "\@b($colorize" . _humanize_char($1) . ')'/eg;

  return $s;
}

=head3 humanize_short STRING

As above, but always be conservative, and replace with a '?' instead
of something more elaborate.

=cut

sub humanize_short
{
  my $self = shift;
  my $s = shift;

  $s =~ s/[[:cntrl:]]/?/g;

  return $s;
}

1;