package Onis::Parser;

use strict;
use warnings;

use Exporter;
use Onis::Config qw#get_config#;
use Onis::Data::Core qw#nick_rename store#;
use Onis::Parser::Persistent qw/set_absolute_time get_absolute_time add_relative_time get_state %MONTHNAMES @MONTHNUMS/;

@Onis::Parser::EXPORT_OK = qw/parse last_date/;
@Onis::Parser::ISA = ('Exporter');

our $WORD_LENGTH = 5;

if (get_config ('min_word_length'))
{
	my $tmp = get_config ('min_word_length');
	$tmp =~ s/\D//g;
	$WORD_LENGTH = $tmp if ($tmp);
}

my $VERSION = '$Id: Mirc.pm,v 1.5 2003/12/16 09:22:28 octo Exp $';
print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);

return (1);

sub parse
{
	my $line = shift;
	my $state;

	# Fix weird mIRC 6.1 behaviour..
	$line =~ s/\x0f//g;
	
	if ($line =~ m/^Session (?:Start|Close|Time): \w\w\w (\w\w\w)  ?(\d\d?) (\d\d):(\d\d):(\d\d) (\d{4})/)
	{
		if (!defined ($MONTHNAMES{$1})) { return (4); }
		set_absolute_time ($6, $MONTHNAMES{$1}, $2, $3, $4, $5);
	}
	if ($line =~ m/^\[(\d\d):(\d\d)\] /)
	{
		add_relative_time ($1, $2);
	}
	
	$state = get_state ();
	if ($state != 1)
	{
		return ($state);
	}

	# [12:12] <kiga> OpiSan: och, eigentlich wäre ich da ganz gerne mal ;-)
	# [12:11] <Greyson> OpiSan: der rest is dann eh egal *g*
	if ($line =~ m/^\[(\d\d):(\d\d)\] <([^>]+)> (.+)/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			text	=> $4,
			type	=> 'TEXT'
		};
		
		my @words = grep { length ($_) >= $WORD_LENGTH } (split (m/\W+/, $4));
		$data->{'words'} = \@words;
		
		store ($data);
	}

	# [23:12] * DenizBey has joined #flirt.de
	# [16:21] * fluxXL (^fluxXL@pD9E669DA.dip.t-dialin.net) has joined #flirt.de
	# [12:19] *** Tronic (~apache@pC19F5EDB.dip.t-dialin.net) has joined #flirt.de
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*(?:\*\*)? (\S+) (?:\(([^\)]+)\) )?has joined ([#!+&]\S+)/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			channel	=> $5,
			type	=> 'JOIN'
		};
		$data->{'host'} = $4 if ($4);
		store ($data);
	}

	# [21:26] *** ted3 has quit IRC (Get NEW °ShowDowN v9.5 PrO° At http://koti.icenet.fi/~julsei/)
	# [21:25] *** Dom has quit IRC (Leaving)
	# [17:22] * Sahne76 has quit IRC
	# [17:28] * BiG_TiGeR has quit IRC (reboot^O)
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*(?:\*\*)? (\S+) has quit IRC(?: \((.*)\))?/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			type	=> 'QUIT'
		};
		$data->{'text'} = $4 if ($4);
		store ($data);
	}

	# [16:18] * LieberAnd (~LieberAnd@L0862P13.dipool.highway.telekom.at) Quit
	# [16:19] * bochum24m (~sascha@80.245.134.41) Quit (EOF From client)
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*(?:\*\*)? (\S+) \(([^\)]+)\) Quit(?: \(([^\)]+)\))?/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			host	=> $4,
			type	=> 'QUIT'
		};
		$data->{'text'} = $5 if ($5);
		store ($data);
	}

	# [12:13] *** Herzchen (surfinn@195.145.114.134) has left #flirt.de (Herzchen)
	# [12:18] *** coolu (~spiess@lizzard.sbs.de) has left #flirt.de (coolu)
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*(?:\*\*)? (\S+)(?: \(([^\)]+)\))? has left ([#!+&]\S+) \(([^\)]*)\)/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			channel	=> $5,
			text	=> $6,
			type	=> 'LEAVE'
		};
		$data->{'host'} = $4 if ($4);
		store ($data);
	}
	
	# [12:16] *** Lizbeth sets mode: -b *!*@*.pl
	# [12:21] *** Lizbeth sets mode: -bbb *!*@*kaapeli.net *!*@62.96.159.* *!*@209*
	# [22:34] * Weibaheld sets mode: -bb *!*@p508E8A23.dip0.t-ipconnect.de *!*@213.233.*
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*(?:\*\*)? (\S+) sets mode: ([-+].+)/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			mode	=> $4,
			type	=> 'MODE'
		};
		store ($data);
	}
	
	# [12:21] *** konichiki is now known as StraferXX
	# [12:27] *** kiga is now known as kiga_tel
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*(?:\*\*)? (\S+) is now known as (\S+)/)
	{
		nick_rename ($1, $2);
	}

	# [21:23] *** NemdaRuLe changes topic to 'bitte keine dcc-sends annehmen..user bei ops melden..danke'
	# [21:25] *** NemdaRuLe changes topic to 'bitte keine dcc-sends annehmen..user mit unaufgeforderten dcc-sends an sie bei o'
	# [19:11] * _sph|nx_- changes topic to 'Sitzt ein Östrreicher mit einer Angel in der Sahara....<<schwarzenegger'
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*(?:\*\*)? (\S+) changes topic to '(.+)'/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			text	=> $4,
			type	=> 'TOPIC'
		};
		store ($data);
	}

	# [12:17] *** __Storm__ was kicked by St3rNchEn (banned: SPAM)
	# [12:32] *** SiLvABiRd was kicked by Vario500 (Striking :->> Lass doch endlich deine Onjoin messages !!! ...)
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*(?:\*\*)? (\S+) was kicked by (\S+) \(([^\)]+)\)/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick_received	=> $3,
			nick	=> $4,
			text	=> $5,
			type	=> 'KICK'
		};
		store ($data);
	}

	# [12:16] * OpiSan macht sich nun mal wieder an die Arbeit
	# [12:19] * |SoNnE| versucht sich wieder zu den lebenden zu zählen..........
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] (\* (\S+) .+)$/)
	{
		if (($4 ne 'Looking') and ($4 ne 'Now')
				and ($4 ne 'Topic')
				and ($4 ne 'Set'))
		{
			my $data =
			{
				hour	=> $1,
				minute	=> $2,
				nick	=> $4,
				text	=> $3,
				type	=> 'ACTION'
			};
		
			my @words = grep { length ($_) >= $WORD_LENGTH } (split (m/\W+/, $3));
			$data->{'words'} = \@words;
		
			store ($data);
		}
	}

	else
	{
		print STDERR $/, __FILE__, ": Not parsed: ``$line''" if ($::DEBUG & 0x20);
		return (2);
	}

	return (1);
}

sub last_date
{
	# $line =~ m/(\w\w\w) (\d\d) (\d\d):(\d\d):(\d\d) (\d{4})/
	my $time = get_absolute_time ();
	my ($sec, $min, $hour, $day, $month_num, $year) = (localtime ($time))[0 .. 5];
	my $month_name = $MONTHNUMS[$month_num];

	$year += 1900;

	my $retval = sprintf ("Session Time: xxx %s %02u %02u:%02u:%02u %04u\n",
		$month_name, $day, $hour, $min, $sec, $year);

	return ($retval);
}