##############################################################################
#
# Jarl - Parser Code
#   Perl code to perform parsing of messages and nicks for nick completion.
#
##############################################################################

##############################################################################
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
#  Jabber
#  Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
#
##############################################################################

##############################################################################
#
# jarlParser_ParseText - takes a section of text and an array of words to
#                        highlight, and returns an array of values which can 
#                        be passed to another interface function for display.
#                        The array looks like this:
#                        (
#                          "normal" , "This is a cool site: ",
#                          "link" , "http://www.jabber.org",
#                          "normal" , " It shows ",
#                          "highlight", "Linux",
#                          "normal", " information."
#                        )
#
##############################################################################
sub jarlParser_ParseText {
  my ($body,@highlights) = @_;

  $Debug->Log10("jarlParser_ParseText: in($body)");

  my %highlight;
  foreach my $word (@highlights) {
    $highlight{lc($word)} = 1;
  }

  my $highlights = join("|",keys(%highlight));

  my @tempBody;

  foreach my $word (split(/(\s+)/,$body)) {
    $Debug->Log10("jarlParser_ParseText: word($word)");

#    $xhtml{b}->{on} = 1 if ($word =~ s/\<b\>//);
#    $xhtml{b}->{off} = 1 if ($word =~ s/\<\/b\>//);
#    $xhtml{i}->{on} = 1 if ($word =~ s/\<i\>//);
#    $xhtml{i}->{off} = 1 if ($word =~ s/\<\/i\>//);

    foreach my $urlTest1 (split(/((?:http|ftp):\/\/\S+)/,$word)) {
      $Debug->Log10("jarlParser_ParseText: urlTest1($urlTest1)");
      if ($urlTest1 =~ /^(?:http|ftp):\/\//) {
	$Debug->Log10("jarlParser_ParseText: urlTest1 is a link");
	&jarlParser_AddSegment(\@tempBody,"link",$urlTest1);
      } else {
	$Debug->Log10("jarlParser_ParseText: urlTest1 is NOT a link");
	my @subPieces2 = split(/([^\ ]+\.(?:com|org|net|edu|gov|mil)(?:\/[^\ ]*)*)/,$urlTest1);
	my @subPieces2 = split(/([^\ ]+\.(?:com|org|net|edu|gov|mil)(?:\/[^\ ]*)*)/,$urlTest1);
	foreach my $index2 (0..$#subPieces2) {
	  my $urlTest2 = $subPieces2[$index2];
	  $Debug->Log10("jarlParser_ParseText: urlTest2($urlTest2)");
	  if (($urlTest2 =~ /\.(com|org|net|edu|gov|mil)(?:\/[^\ ]*)*$/) &&
	      !($urlTest2 =~ /\@/) &&
	      (($index2 == $#subPieces2) ||
	       ($subPieces2[$index2+1] =~ /^[\n\ ]/) ||
	       ($subPieces2[$index2+1] =~ /^[\!\?\.\,][\n\ ]/) ||
	       ($subPieces2[$index2+1] =~ /^[\!\?\.\,]$/))
	     ) {
	    $Debug->Log10("jarlParser_ParseText: urlTest2 is a link");
	    &jarlParser_AddSegment(\@tempBody,"link",$urlTest2);
	  } else {
	    $Debug->Log10("jarlParser_ParseText: urlTest2 is NOT a link");
	    foreach my $piece (split(/(\s+)/i,$urlTest2)) {
	      $Debug->Log10("jarlParser_ParseText: piece($piece)");

	      $Debug->Log10("jarlParser_ParseText: let's treat piece as a normal word for now");
	      my $type = "normal";
	      #		$type .= "-b" if ($xhtml{b}->{on} == 1);
	      #		$type .= "-i" if ($xhtml{i}->{on} == 1);
	      &jarlParser_AddSegment(\@tempBody,$type,$piece);
	    }
	  }
	}
      }
    }
#    $xhtml{b}->{off} = $xhtml{b}->{on} = 0 if ($xhtml{b}->{off} == 1);
#    $xhtml{i}->{off} = $xhtml{i}->{on} = 0 if ($xhtml{i}->{off} == 1);
  }

  my @newBody;
  while ($#tempBody != -1) {
    my $type = shift(@tempBody);
    my $piece = shift(@tempBody);

    if ($type =~ /^normal/) {
      foreach my $subPiece (split(/($highlights)/,$piece)) {
	$Debug->Log10("jarlParser_ParseText: subPiece($subPiece)");
	
	if (exists($highlight{lc($subPiece)})) {
	  $Debug->Log10("jarlParser_ParseText: subPiece is a highlight word");
	  &jarlParser_AddSegment(\@newBody,"highlight",$subPiece);
	} else {
	  $Debug->Log10("jarlParser_ParseText: subPiece is a normal word");
	  &jarlParser_AddSegment(\@newBody,$type,$subPiece);
	}
      }
    } else {
      &jarlParser_AddSegment(\@newBody,$type,$piece);
    }
  }

  $Debug->Log10("jarlParser_ParseText: out(\"",join("\",\"",@newBody),"\")");

  return @newBody;
}


##############################################################################
#
# jarlParser_AddSegment - rather that just add every little string we get
#                         and possibly really screw ourselves over in terms
#                         a large array of repeated tag types, let's add them
#                         intelligently.  For example:
#
#                           ["normal","f","normal","o","normal","o"]
#
#                         is the same as:
#
#                           ["normal","foo"]
#
#                         You be the judge. =)
#
##############################################################################
sub jarlParser_AddSegment {
  my ($body,$type,$string) = @_;

  return if ($string eq "");

  if (($#{@{$body}} > -1) && ($$body[$#{@{$body}}-1] eq $type)) {
    $$body[$#{@{$body}}] .= $string;
  } else {
    push(@{$body},$type,$string);
  }
}


##############################################################################
#
# jarlParser_NickComplete - this function takes a string, grabs the last part,
#                           compares it to every nick in the channel, or in 
#                           the chat if you are chatting, and returns the 
#                           first nick that matches the rules... if any.
#
##############################################################################
sub jarlParser_NickComplete {
  my(%args) = @_;

  $args{type} = "chat" unless exists($args{type});
  $args{channel} = "" unless exists($args{channel});
  $args{chatid} = "" unless exists($args{chatid});
  $args{string} = "" unless exists($args{string});
  $args{previous} = "" unless exists($args{previous});

  $Debug->Log1("jarlParser_NickComplete: type($args{type}) channel($args{channel}) chatid($args{chatid}) string($args{string}) previous($args{previous})");

  my ($partial) = ($args{string} =~ /\s?(\S+)$/);
  my $prevMatch = $args{previous};
#  ($prevMatch) = ($args{previous} =~ /\s?(\S+)$/)
#    if ($args{previous} =~ /\S+$/);
#  ($prevMatch) = ($args{previous} =~ /\s?(\S+)\s$/)
#    if ($args{previous} =~ /\s$/);
#  ($prevMatch) = ($args{previous} =~ /\s?(\S+)\:\s$/)
#    if ($args{previous} =~ /\:\s$/);

  return $args{chatid} if (($args{type} eq "chat") && (!defined($partial) || ($partial eq "")));
  return "" unless defined($partial);

  $Debug->Log1("jarlParser_NickComplete: partial($partial)");

  my @nicks = ();
  @nicks = $groupchatRosters{&jarlGroupChat_Tag($args{channel})}->Names() if ($args{type} eq "groupchat");
  @nicks = ($args{chatid}) if ($args{type} eq "chat");
  @nicks = $Roster->Names() if ($args{type} eq "roster");

  $Debug->Log1("jarlParser_NickComplete: nicks(",join(",",@nicks),")");

  @nicks = &jarlParser_NickMatches($partial,@nicks);
  return "" if ($#nicks == -1);
  return $nicks[0] if ($#nicks == 0);

  $Debug->Log1("jarlParser_NickComplete: prevMatch($prevMatch)");

  my $match = "";
  foreach my $nick (@nicks) {
    $Debug->Log1("jarlParser_NickComplete: nick($nick) prevMatch($prevMatch)");
    if ($prevMatch eq "") {
      $match = $nick;
      last;
    }
    if ($prevMatch eq $nick) {
      $prevMatch = "";
    }
  }
  $match = $nicks[0] if ($match eq "");

  $Debug->Log1("jarlParser_NickComplete: match($match)");
  return $match;
}


sub jarlParser_NickMatches {
  my ($partial,@nicks) = @_;

  my %matches;
  my $level;
  foreach my $nick (sort {$a cmp $b} @nicks) {
    my $realNick = $nick;
    $realNick =~ s/^[\@\+]//;
    next if (lc(substr($realNick,0,1)) ne lc(substr($partial,0,1)));
    my $subNick = substr($realNick,0,length($partial));

    $level = 5;

    $Debug->Log1("jarlParser_NickMatches: nick($realNick) subNick($subNick) partial($partial)");

    if (($subNick eq $partial) && ($level > 1)) {
      $match = $realNick;
      $Debug->Log2("jarlParser_NickMatches: match equals");
      $level = 1;
    }
    if ((lc($subNick) eq $partial) && ($level > 2)) {
      $match = $realNick;
      $Debug->Log2("jarlParser_NickMatches: match all lower");
      $level = 2;
    }
    if ((uc($subNick) eq $partial) && ($level > 3)) {
      $match = $realNick;
      $Debug->Log2("jarlParser_NickMatches: match all caps");
      $level = 3;
    }
    if (($subNick =~ /^$partial$/i) && ($level > 4)) {
      $match = $realNick;
      $Debug->Log2("jarlParser_NickMatches: match mixed");
      $level = 4;
    }
    push(@{$matches{$level}},$nick);
  }

  $Debug->Log1(&Net::Jabber::sprintData("\$matches",\%matches));

  return @{$matches{1}} if exists($matches{1});
  return @{$matches{2}} if exists($matches{2});
  return @{$matches{3}} if exists($matches{3});
  return @{$matches{4}} if exists($matches{4});
  return ();
}

1;