use strict;
use warnings;

package BarnOwl::Module::VT_ASedeno;

use BarnOwl::Hooks;

use Text::Autoformat;
use Text::CharWidth qw(mbswidth);
use HTML::WikiConverter;
use Encode qw(encode decode);
use Encode::MIME::Header;
use WWW::Mechanize;

*boldify = \&BarnOwl::Style::boldify;

################################################################################
# BarnOwl variables
################################################################################
BarnOwl::new_variable_bool('vta:escape_formatting', {
    default => 'on',
    summary => "Escape z-formatting in VT_ASedeno style."
                           });

BarnOwl::new_variable_bool('vta:show_zsigs', {
    default => 'off',
    summary => "Hides z-sigs in VT_ASedeno style."
                           });

BarnOwl::new_variable_int('vta:narrow_mode', {
    default => 100,
    summary => "VT_ASedeno narrow screen style below this many columns."
                           });


################################################################################
# Run this on start and reload. Adds styles, sets style to start.
################################################################################
sub onStart
{
    my $reload = shift;
    bindings_VT() unless $reload;
}

$BarnOwl::Hooks::startup->add(\&onStart);

################################################################################
# Help information
################################################################################
sub moduleHelp()
{
    my @helpmsgArray = <<END_OF_HELP ;
Module: VT-asedeno (package: VT_asedeno)

  Module commands:
    VT		  Switch to VT style
    VT-zsigs	  Toggle for displaying zsigs
    VT-hosts	  Toggle for displaying .MIT.EDU in zephyr hostnames
    VT-ctrl	  Toggle for dealing with control characters.

  Module keys:
    C-s C-v	  VT
    C-s C-z	  VT-zsigs
    C-s C-h	  VT-hosts

END_OF_HELP

    return @helpmsgArray;
}
push @::onModuleHelp, \&moduleHelp;


################################################################################
# Dispatch to various formatting functions in this style.
################################################################################
sub style_VT($)
{
    my $m = shift;

    return format_VT($m) if ($m->is_zephyr);
    return format_VT_AIM($m) if ($m->is_aim);
    return format_VT_jabber($m) if ($m->is_jabber);
    return format_VT_irc($m) if ($m->type eq 'IRC');
    return "\@bold(OWL ADMIN):\t".$m->header.': '.$m->body if ($m->is_admin);
    return "\@bold(loopback):  ".$m->body if ($m->is_loopback);
    return $m->type.":\t".$m->body;
}

################################################################################
# A place to keep my options all together, with default values.
################################################################################
our %VT_Options =
    ("zsigs" => 0,
     "showControl" => 0,
     "stripMitEdu" => 1,
     "rot13" => 0,
     "narrowMode" => 100);

sub bindings_VT
{
    # Style definition
    owl::command("style VT perl BarnOwl::Module::VT_ASedeno::format_msg");

    # Command aliases
    owl::command("alias VT view -s VT");

    # Keybinding
    owl::command('bindkey recv "C-s C-v" command VT');

    # Legacy stuff:
    # Command aliases
    owl::command("alias VT-zsigs perl VT_asedeno::VT_toggle_sigs()");
    owl::command("alias VT-hosts perl VT_asedeno::VT_toggle_host_strip()");
    owl::command("alias VT-ctrl  perl VT_asedeno::VT_toggle_control()");
    owl::command("alias VT-rot13 perl VT_asedeno::VT_toggle_rot13()");

    # Keybinding
    owl::command('bindkey recv "C-s C-z" command VT-zsigs');
    owl::command('bindkey recv "C-s C-h" command VT-hosts');
}

#Turn zsigs on or off
sub VT_toggle_sigs
{
    $VT_Options{"zsigs"} = !($VT_Options{"zsigs"});
    refreshView();
}

#Toggle stripping of MIT.EDU from hosts
sub VT_toggle_host_strip
{
    $VT_Options{"stripMitEdu"} = !($VT_Options{"stripMitEdu"});
    refreshView();
}

#Toggle literal backspace display method
sub VT_toggle_control
{
    $VT_Options{"showControl"} = !($VT_Options{"showControl"});
    refreshView();
}

#Toggle rot13 body
sub VT_toggle_rot13
{
    $VT_Options{"rot13"} = !($VT_Options{"rot13"});
    refreshView();
}

sub refreshView()
{
    my $filter = owl::command("getview");
    my $style = owl::command("getstyle");
    owl::command("view -f $filter ".($style?"-s $style":""));
}

sub zescape {
    my $text = shift;
    if(BarnOwl::getvar('vta:escape_formatting') eq 'on') {
        $text =~ s/@/@@/g;
    }
    return $text;
}

################################################################################
# Functions to format zephyrs.
# header for large screens (>narrowMode cols):
#  username___.HH:MM.class[instance]___.A. (width: 38)
################################################################################
sub format_VT($)
{
    my $m = shift;

    # Extract time from message
    my ($time) = $m->time =~ /(\d\d:\d\d)/;

    # Deal with PING messages, assuming owl's rxping variable is true.
    if ($m->is_ping)
    {
	return("\@bold(PING) from \@bold(".$m->pretty_sender.")\n");
    }

    # Deal with login/logout messages
    elsif ($m->is_loginout)
    {
	return sprintf('@b(%-10.10s) %s @b(%s) at %s %s',
		       $m->pretty_sender,
		       $time,
		       uc($m->login),
		       uc($m->host),
		       $m->login_tty);
    }

    # Extract destination from message
    my $dest;

    if ($m->is_personal)
    {
	# Special casing personal zephyrs. Yes, we could use personals as a
	# case of -c message, but I want the consistency of case on display.
	$dest = '[personal]';
    }
    elsif (lc($m->instance) eq 'personal')
    {
	# Since personal is the default instance, strip it and just use the
	# class name.
	$dest = $m->context;
    }
    elsif (lc($m->class) eq 'message')
    {
	# Since message is the default class, strip it and just use the
	# instance name, in square brackets.
	$dest = '['.$m->instance.']';
    }
    else
    {
	# If the defaults aren't being used, show both class and instance.
	$dest = $m->context.'['.$m->instance.']';
    }
    $dest =~ s/[[:cntrl:]]//g;

    # Extract user/authentication information from the message.
    my $user = $m->pretty_sender;
    if ($user eq 'daemon.webzephyr' && lc($m->class) eq 'webzephyr')
    {
        $user = lc($m->instance);
    }

    my $auth = (($m->auth =~ /YES/)
		? '+'
		: '-');

    # I'm assuming I'll never see echoes of outbound non-personal zephyrs,
    # so these must be personals. For outbound personals, set username as
    # the recipient with '->' prepended, set auth to '>' to indicate
    # outbound.
    if (lc($m->direction) eq 'out')
    {
        $auth = '>';
        if (lc($m->class eq 'webzephyr'))
        {
            $user = "->".$m->instance;
        }
        elsif (lc($m->class) eq 'message' && lc($m->instance) eq 'personal')
        {
            $user = "->".$m->recipient;
            $user =~ s/\@ATHENA\.MIT\.EDU$//;
            $dest = '[personal]';
        }
    }

    my ($body, $hostSep) = format_body($m);

    my $zVT = "";
    my $cols = owl::getnumcols();
    my $wDestAdjustment = (length($dest) - mbswidth($dest));
    $wDestAdjustment++ while($dest =~ /@@/g);
    if ($cols < $VT_Options{"narrowMode"})
    {
	#This formats the zephyr for smaller screens.

	$cols -= 3;
	if ($cols < 50)
	{
	    #	      1
	    #1234567890123456789
	    #_username_ HH:MM A
	    my $wDest = ($cols - 19) + $wDestAdjustment;
	    my $fmt = "%-10.10s %5s $auth %-".$wDest.".".$wDest."s\n %s";
	    $zVT = sprintf($fmt,
			   $user,
			   $time,
			   $dest,
			   $body);
	}
	else
	{
	    # Prepare the hostname.
	    my $hostStr = uc($m->host);
	    $hostStr =~ s/\.MIT\.EDU$// if $VT_Options{"stripMitEdu"};

	    my $rest  = $cols - 50;

	    my $wDest = 16 + (($rest <= 14) ? $rest : 14 );
	    $rest -= $wDest - 16;

	    my $wUser = 10 + (($rest <= 2) ? $rest : 2);
	    $rest -= $wUser - 10;

	    my $wHost = 14 + (($rest <= 10) ? $rest : 10);
	    $rest -= $wHost - 14;

	    $wDest += $rest  + $wDestAdjustment;

	    my $fmt =  "%-".$wUser.".".$wUser."s %5s $auth %-".$wDest.".".$wDest."s %".$wHost."s\n %s";

	    $zVT = sprintf($fmt,
			   $user,
			   $time,
			   $dest,
			   $hostSep.' '.$hostStr,
			   $body);
	}
    }
    else
    {
	# This formats the zephyr for larger screens.
        $dest_width = 18 + $wDestAdjustment;
	$zVT = sprintf("%-10.10s %5s %-".$dest_width.".".$dest_width."s $auth%s",
		       $user,
		       $time,
		       $dest,
		       $body);
    }

    if (($m->is_personal || lc($m->direction) eq 'out'))
    {
	return boldify($zVT);
    }
    return $zVT;
}

################################################################################
# Functions to format AIM messages.
################################################################################
sub format_VT_AIM($)
{
    my $m = shift;

    # Extract time from message
    my ($time) = $m->time =~ /(\d\d:\d\d)/;

    # Deal with login/logout messages
    if ($m->is_login())
    {
	return sprintf("\@b(%-10.10s) %s \@b(%s)",
		       "AIM LOGIN",
		       $time,
		       $m->sender);
    }

    if ($m->is_logout())
    {
	return sprintf("\@b(%-10.10s) %s \@b(%s)",
		       "AIM LOGOUT",
		       $time,
		       $m->sender);
    }

    # Extract destination from message
    my $dest = $m->recipient;

    # Extract user/authentication information from the message.
    my $user = $m->sender;

    my $dir = (lc($m->direction) eq 'out') ? '>' : '<';

    my ($body, $hostSep) = format_body($m);

    # Now build the message.
    my $zVT = "";
    if (owl::getnumcols() < $VT_Options{"narrowMode"})
    {
	$zVT = sprintf("From: %-16.16s To: %-16.16s %5s\n %s",
		       $user,
		       $dest,
		       $time,
		       $body);
    }
    else
    {
	$zVT = sprintf("%-10.10s %5s %-18.18s $dir%s",
		       $user,
		       $time,
		       $dest,
		       $body);
    }
    if (($m->is_personal || lc($m->direction) eq 'out'))
    {
        return boldify($zVT);
    }
    return $zVT;
}

################################################################################
# Functions to format jabber messages.
################################################################################
sub format_VT_jabber($)
{
    my $m = shift;

    # Extract time from message
    my ($time) = $m->time =~ /(\d\d:\d\d)/;

    # Deal with login/logout messages
    if ($m->is_login())
    {
        my $show = $m->{show};
        my $status = $m->{status};
        my $appendStr = "";
        $appendStr .= "$show" if ($show);
        $appendStr .= ", $status" if ($status);
        $appendStr = " ($appendStr)" if $appendStr;
        return sprintf("\@b(%-10.10s) %s %s",
                       "LOGIN",
                       $time,
                       boldify($m->sender.$appendStr));
    }

    if ($m->is_logout())
    {
        return sprintf("\@b(%-10.10s) %s %s",
                       "LOGOUT",
                       $time,
                       boldify($m->sender));
    }

    my $dir = (lc($m->direction) eq 'out') ? '>' : '<';

    # Extract destination from message
    my $dest = $m->recipient;
    my $hostStr = '';
    if ($m->jtype eq "groupchat") {
        #MUC
        $dest =~ s/\@(.*)//;
        $hostStr = uc($1);
        $dest .= "[".$m->{subject}."]"if ($m->{subject});
        $dir = '*'
    }

    # Extract user information from the message.
    my $user = $m->sender;

    if ($m->sender =~ /s.ly$/) {
        $m->sender =~ /^(.*)\@s\.ly$/;
        $dest = $m->sender;
        if ($m->direction eq 'in') {
            $m->body =~ /^(.*): (.*)$/;
            $user = $1;
            $m->{body} = $2;
        }
    }

    
    my ($body, $hostSep) = format_body($m);

    # Now build the message.
    my $zVT = "";
    my $cols = owl::getnumcols();
    if ($cols < $VT_Options{"narrowMode"})
    {
        my $wHost = $cols - (3+6+16+5+16+1+5+1);
	$zVT = sprintf("From: %-16.16s To: %-16.16s %5s %".$wHost."s\n %s",
		       $user,
		       $dest,
		       $time,
		       ($hostStr ? $hostSep.' '.$hostStr : ''),
		       $body);
    }
    else
    {
	$zVT = sprintf("%-10.10s %5s %-18.18s $dir%s",
		       $user,
		       $time,
		       $dest,
		       $body);
    }
    if (($m->is_personal || lc($m->direction) eq 'out'))
    {
 	return boldify($zVT);
    }
    return $zVT;
}

################################################################################
# Functions to format irc messages.
################################################################################
sub format_VT_irc($)
{
    my $m = shift;

    # Extract time from message
    my ($time) = $m->time =~ /(\d\d:\d\d)/;

    # Deal with login/logout messages
    if ($m->is_login())
    {
        my $show = $m->{show};
        my $status = $m->{status};
        my $appendStr = "";
        $appendStr .= "$show" if ($show);
        $appendStr .= ", $status" if ($status);
        $appendStr = " ($appendStr)" if $appendStr;
        return sprintf("\@b(%-10.10s) %s %s (%s/%s)",
                       "JOIN",
                       $time,
                       boldify($m->sender.$appendStr),
                       $m->network, $m->channel);
    }

    if ($m->is_logout())
    {
        return sprintf("\@b(%-10.10s) %s %s (%s/%s)",
                       "PART",
                       $time,
                       boldify($m->sender),
                       $m->network, $m->channel);
    }

    my $dir = (lc($m->direction) eq 'out') ? '>' : '<';

    # Extract destination from message
    my $dest = $m->recipient;
    my $hostStr = uc($m->server);

    # Extract user information from the message.
    my $user = $m->sender;

    my ($body, $hostSep) = format_body($m);

    # Now build the message.
    my $zVT = "";
    my $cols = owl::getnumcols();
    if ($cols < $VT_Options{"narrowMode"})
    {
        my $wHost = $cols - (3+6+16+5+16+1+5+1);
	$zVT = sprintf("From: %-16.16s To: %-16.16s %5s %".$wHost."s\n %s",
		       $user,
		       $dest,
		       $time,
		       ($hostStr ? $hostSep.' '.$hostStr : ''),
		       $body);
    }
    else
    {
	$zVT = sprintf("%-10.10s %5s %-18.18s $dir%s",
		       $user,
		       $time,
		       $dest,
		       $body);
    }
    if (($m->is_personal || lc($m->direction) eq 'out'))
    {
 	return boldify($zVT);
    }
    return $zVT;
}

################################################################################
# Universal body formatter.
################################################################################
sub format_body
{
    my $m = shift;
    my $cols = owl::getnumcols();	# actual number of columns 
    my $width = $cols - 3;	# max usable width
    my $hwidth = ($cols < $VT_Options{"narrowMode"}) ? 2 : 38; # body header width / body indent
    my $bwidth = $width - $hwidth; # body width
    my $zsindent = ($cols < $VT_Options{"narrowMode"}) ? 1 : 18; # zsig indent width (zephyrs only)
    my $zsbwidth = $width - $zsindent; # zsig body width (zephyrs only)
    
    my $strlen = 0;
    my $body = "";
    my $hostAlone = 0;

    # Zephyrs only: This shows me if there are literal backspaces in the
    # zephyr body or zsig.
    my $hostSep = ($m->body =~ /\cH/ || $m->zsig =~ /\cH/) ? "!#" : "##";

    my $rawBody = $m->body;
    
    if ($m->type eq "zephyr" && lc($m->opcode) ne "crypt")
    {
        # Show the other fields in zephyrs.
        my $count = @{$m->fields};
        (my $body = $m->body) =~ s/^\n*|\n*$//g;
        (my $zsig = $m->zsig) =~ s/^\n*|\n*$//g;
        
        for(my $index = 0; $index < $count; $index++)
        {
            my $field = @{($m->fields)}[$index];
            $field =~ s/^\n*|\n*$//g;
            next if ($field eq $body
                     || $field eq $zsig
                     || $field eq "");
            $rawBody .= sprintf(" [field %i: %s]", $index + 1, $field);
        }
    }
    # Show the XML for body-less messages.
    elsif ($m->type eq "jabber") {
        if ($m->body eq "") {
            $rawBody = "XMPP{".$m->{xml}."}";
        }
    }

    if($m->type eq "zephyr" && lc($m->class) eq 'mail') {
        $rawBody =decode('MIME-Header', $rawBody);
    }



    # Deal with literal backspaces by interpreting them or revealing them.
    if ($VT_Options{"showControl"}) {
        $rawBody =~ s/[\cH]/^H/g;
    } else {
        1 while $rawBody =~ s/[^\cH]\cH//g;
        $rawBody =~ s/[\cH]//g;
    }
    # Deal with literal escapes by hiding or revealing them.
    if ($VT_Options{"showControl"}) {
        $hostSep = '!#' if $rawBody =~ s/\x1B/^[/g;
    } else {
        $hostSep = '!#' if $rawBody =~ s/\x1B//g;
    }

    # Kill leading <BODY> tags. AIM troubles.
    $rawBody =~ s/^<BODY>//;

    # Tab to eight spaces. Why are people sending tabs anyhow?
    $rawBody =~ s/\t/        /g;

    # This cleans up other peoples formatting. I can see what they meant, but it
    # doesn't muck with my display.
    # Basically, double up the '@'s in these formatting messages such that they
    # no longer work. Also, fix backspace issues.
    $rawBody =~ s/\@font\(fixed\)$//; # GAIM is broken.
    $rawBody = zescape($rawbody);

    $rawBody = tag_youtube($rawBody);

    # This is a really dumb formatting test. If the message has any newlines 
    # followed by whitespace followed by non whitespace, I'll assume the sender
    # knows what they're doing and format the message as they desire.
    if ($rawBody =~ /\n[ \t]+\S.*\n/) {
        # Strip multiple and trailing newlines, then get an array of lines.
        $rawBody =~ s/\n+/\n/g;
        $rawBody =~ s/\n*$//g;
        my @lines = split (/\n/, $rawBody);

        # build the body, taking into account the desired indenting.
        my $line = shift @lines;
        $body .= " $line";
        $strlen = mbswidth($line);

        foreach my $l (@lines) {
            $body .= "\n";
            $body .= " " x ($hwidth - 1);
            $body .= " $l";
            $strlen = mbswidth($l);
            $line = $l;
        }

        my @count = split(/\@\@/, $line);
        if ($#count == -1) {
            $strlen -= mbswidth($line) / 2;
        } elsif ($#count) {
            $strlen -= $#count;
        }


    }
    # If the formatting does not pass the above test, I'm rewrapping the entire
    # message to my liking.
    else {
        # Strip leading whitespace and then get an array of 'words'
        $rawBody =~ s/^\s*//; 
        my @words = split (/\s+/,$rawBody);

        # -1 to take into account the leading space. It makes the loop nicer,
        # and is a useful space anyways.
        $strlen = -1;
        foreach my $word (@words) {
            #Strip extra control characters, and take note.
            $hostSep = '!#' if ($word =~ /[[:cntrl:]]/);
            if (!$VT_Options{'showControl'}) {
                $word =~ s/[[:cntrl:]]//g;
            }
            if (($strlen + mbswidth($word) + 1) < $bwidth) {
                $body .= " $word";
                $strlen += 1 + mbswidth($word);
            } else {
                # There is a small bug here, but it doesn't bother
                # me. If someone types in a 'word' that is larger than
                # the 'max width' it will be on a line by itself.
                # Since owl can scroll sideways, I can look at what
                # was said, and it won't affect the rest of the
                # display... I hope.  I could instead break the 'word'
                # if this becomes a problem one day.

                $body .= " " x ($bwidth - $strlen);
                $body .= "\n";
                $body .= " " x $hwidth;
                $body .= "$word";
                $strlen = mbswidth($word);
            }

            # Since '@@' is displayed as '@', we should take that into
            # account when figuring out how long this word is.
            my @count = split(/\@\@/, $word);
            if ($#count == -1) {
                $strlen -= mbswidth($word) / 2;
            } elsif ($#count) {
                $strlen -= $#count;
            }
        }
    }

    $body =~ tr/A-Za-z/N-ZA-Mn-za-m/ if ($VT_Options{"rot13"});
    if ($m->is_zephyr) {
        # Now that the body is done, we deal with formatting the zsig, if desired.
        if ($VT_Options{"zsigs"} && $m->zsig ne "") {
            $hostAlone = 0;
            $body .= "\n";
            $body .= " " x $zsindent;
            $body .= "--";

            my $sig = $m->zsig;

            $sig =~ s/.\cH//g;
            # Kill leading whitespace
            $sig =~ s/^\s*//;

            
            $sig = zescape($sig);

            # Unlike zephyr bodies, I'm unwrapping zsigs no matter what.
            my @words = split (/\s+/, $sig);

            $strlen = 2;	    #takes into account the '--' we've put in.

            foreach my $word (@words) {
                $hostSep = '!#' if ($word =~ /[[:cntrl:]]/);
                if (!$VT_Options{'showControl'}) {
                    $word =~ s/[[:cntrl:]]//go;
                }
                if (($strlen + mbswidth($word) + 1) < $zsbwidth) {
                    $body .= " $word";
                    $strlen += 1 + mbswidth($word);
                } else {
                    $body .= "\n";
                    $body .= " " x $zsindent;
                    # The three extra spaces keep the zsig body lined up.
                    # Remember the '-- '?
                    $body .= "   $word";
                    $strlen = 3 + mbswidth($word);
                }
                # And again with the '@@' => '@' processing.
                my @count = split(/\@\@/, $word);
                if ($#count == -1) {
                    $strlen -= mbswidth($word) / 2;
                } elsif ($#count) {
                    $strlen -= $#count;
                }
            }
        }
    }
    if ($m->is_zephyr || ($m->type eq 'jabber' && $m->jtype eq 'groupchat') || ($m->type eq 'IRC')) {
        # Finally append the hostname. If it will fit on the last line of the
        # zephyr, that's great, if not it gets a line of its own. The hostname is
        # right justified. This only happens in the large screen formatting style.
        if ($cols >= $VT_Options{"narrowMode"}) {
            my $hostwidth = (!($VT_Options{"zsigs"} && $m->zsig ne "")
                             ? $bwidth 
                             : $zsbwidth);

            my $hostStr;
            if ($m->is_zephyr) {
                $hostStr = uc($m->host);
                $hostStr =~ s/\.MIT\.EDU$// if $VT_Options{"stripMitEdu"};
            } elsif ($m->type eq 'IRC') {
                $hostStr = uc($m->server);
            } else {
                $hostStr = uc($m->room);
                $hostStr =~ s/.*\@//;
            }

            if ($hostAlone || (($strlen + 4 + mbswidth($hostStr)) >= $hostwidth)) {
                $body .= "\n";
                $body .= sprintf("%".($width)."s",
                                 " $hostSep $hostStr");
            } else {
                $body .= " " x ($hostwidth - $strlen - 4 - mbswidth($hostStr));
                $body .= " $hostSep $hostStr";
            }
        } else {
            $body .= " " x ($bwidth - $strlen);
        }
    } else {
        $body .= " " x ($bwidth - $strlen);
    }
    return ($body, $hostSep);
}
