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: Energymech.pm,v 1.2 2004/08/07 10:34:03 octo Exp $';
print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);

return (1);

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

	# Well, this is not actually a part of emech logfiles, but i have a script 
	# which is adding mIRC headers/footers to the files
	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);
	}

	# [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+) .+)$/)
	{
		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);
	}

	# [00:07] *** Joins: tomcat (TCat@TCat.users.undernet.org)
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*\*\* Joins: (\S+) \(([^\)]+)\)/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			host	=> $4,
			type	=> 'JOIN'
		};
		store ($data);
	}

	# [00:13] *** Quits: Oggy (Quit: Verlassend)
	# [17:15] *** Quits: Renard^ (Quit)
	# (The following are ignored:)
	# [17:48] *** Quits: helen78 (Read error: Connection reset by peer)
	# [18:46] *** Quits: peti- (Ping timeout)
	
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*\*\* Quits: (\S+) \((?:Quit(?:: (.*))?|.*)\)/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			type	=> 'QUIT'
		};
		$data->{'text'} = $4 if ($4);

		store ($data);
	}

	# emech:
	# [00:19] *** Parts: formund (~pirch@142.173.147.146)
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*\*\* Parts: (\S+) \(([^\)]+)\)/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			host	=> $4,
			type	=> 'LEAVE'
		};
		$data->{'host'} = $4 if ($4);
		store ($data);
	}
	
	# [00:30] *** eGirl sets mode: +l 21
	# [01:10] *** X sets mode: +v filosof
	# [08:55] *** X sets mode: +vv JuergenHH tomcat
	# [10:59] *** X sets mode: +o Dusslchen
	# [11:00] *** Geneva.CH.EU.Undernet.org sets mode: +o peti-
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*\*\* (\S+) sets mode: ([-+].+)/)
	{
		my $data =
		{
			hour	=> $1,
			minute	=> $2,
			nick	=> $3,
			mode	=> $4,
			type	=> 'MODE'
		};
		store ($data);
	}
	
	# [11:47] *** [char]OFF is now known as [charly]
	elsif ($line =~ m/^\[(\d\d):(\d\d)\] \*\*\* (\S+) is now known as (\S+)/)
	{
		nick_rename ($1, $2);
	}

	# [21:34] *** LuckyOne^ changes topic to "gratuliert filosof nachträglich zum Burzeltach :)) http:luckyones.de.vu"
	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);
	}

	# [00:20] *** mario{} was kicked by X ((LuckyOne) This is not a home for idler :))
	# [14:26] *** Zuccherro was kicked by SchokoMan (you want it... and stop with your bad language!)
	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);
	}

	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);
}