#! @PERL@ -w
# vim:syntax=perl

use strict;
use lib '@LR_PERL5LIBDIR@';
use Lire::Time;
use Lire::DlfSchema;
use Lire::Program qw(:msg :dlf);
use Time::Local;

my $lines	= 0;
my $dlflines	= 0;
my $errorlines  = 0;

my $schema = eval { Lire::DlfSchema::load_schema('database'); };
lr_err("error loading database schema: $@") if $@;

my $dlf_maker = $schema->make_hashref2asciidlf_func(qw/
	time user remote_host action database query
	success connection_id run_id
/);

init_dlf_converter('database');
my $timestart = time() or lr_crit("can't get time");
my @ltime = localtime($timestart) or lr_crit("can't get time");

my (@w, $runid, $pid, $dlf, %seq, $ctx);

$runid = 0;

sub flush_query {
	my $ctx = $_[0];
        # FIXME: this is a workaround against a real bug
        # in the code which calls flush_query with a string.
        return unless ref $ctx eq 'HASH';
	return if !exists $ctx->{'query'};
	my $dlf = $ctx->{'query'};
 	print_dlf($ctx, $dlf);
        $dlflines++;
	delete $ctx->{'query'};
}

sub print_dlf {
	my ($ctx, $dlf) = @_;

	$dlf->{'user'} = $ctx->{'user'};
	$dlf->{'remote_host'} = $ctx->{'host'};
	$dlf->{'database'} = $ctx->{'database'};
	$dlf->{'connection_id'} = $ctx->{'id'};

	my $d = $dlf_maker->($dlf);
	print join(' ', @$d), "\n";
}

while(<>) {
	chomp;
	$lines++;

	@w = split ' ', $_, 7;

	$dlf = {};
	$ctx = {};

	$dlf->{'time'} = syslog2cal($w[0], $w[1], $w[2], \@ltime);

	$pid = $w[4];
	$pid =~ tr/0-9//cd;
	$pid = int($pid);

	$_ = $w[6];

	if(/^DEBUG:\s+database\ssystem\sis\sready/) {
		$runid = $pid;
		next;
	} elsif(/^ERROR:/) {
		$ctx = $seq{$pid} or next;
		$ctx->{'query'}->{'success'} = 'no' if exists $ctx->{'sq'};
		next;
	} elsif(/^DEBUG:\s+connection:\s+host=(\S+)\s+user=(\S+)\s+database=(\S+)$/) {
		$ctx = {};
		$ctx->{'host'} = $1;
		$ctx->{'user'} = $2;
		$ctx->{'database'} = $3;
		$ctx->{'id'} = $dlf->{'time'}.".$pid";
		$seq{$pid} = $ctx;
		$dlf->{'action'} = 'connect';
		$dlf->{'success'} = 'yes';
	} elsif(/^DEBUG:\s+child process \(pid (\d+)\) exited/) {
		$ctx = $seq{$1} or next;
		flush_query($ctx);
		$dlf->{'action'} = 'disconnect';
		$dlf->{'success'} = 'yes';
		delete $seq{$1};
	} elsif(/^DEBUG:\s+query:\s+([A-Za-z]+)([^A-Za-z]|$)/) {
		$ctx = $seq{$pid} or next;
		flush_query($ctx);
		$dlf->{'action'} = 'query';
		$dlf->{'query'} = uc($1);
		$dlf->{'success'} = 'yes';
		$ctx->{'query'} = $dlf;
		next;
	} else {
		next;
	}

	print_dlf($ctx, $dlf);

#	if($@) {
#		lr_warn($@);
#		lr_warn("failed to parse '$_'. Skipping.");
#		$errorlines++;
#	}
}

foreach $ctx (%seq) {
	flush_query($ctx);
}

# while(<>) {
#
#	alternative main-loop might reassemble split lines. Not needed for now.
#
# }

end_dlf_converter($lines, $dlflines, $errorlines);

__END__

=pod

=head1 NAME

pgsql2dlf - convert pgsql logfiles to dlf format

=head1 SYNOPSIS

B<pgsql2dlf>

=head1 DESCRIPTION

B<pgsql2dlf> converts a PostgreSQL query log file to DLF format.  Information on
PostgreSQL can be found on http://www.postgresql.org/.
Logging can be enabled in the postgresql.conf file.

The following options should be present at least for this converter to
work well:

debug_level = 1

debug_print_parse = on

debug_print_query = on

The generic database dlf format is described in database.xml.

=head1 EXAMPLES

To process a log as produced by PostgreSQL:

 $ pgsql2dlf < /var/log/postgresql.log

pgsql2dlf will be rarely used on its own, but is more likely called
by lr_log2report:

 $ lr_log2report pgsql < /var/log/postgresql.log

=head1 NOTES

The parser has been tested for log files from PostgreSQL 7.2.1.

=head1 SEE ALSO

psql(1), postmaster(1), postgresql.conf(5)

=head1 VERSION

$Id: pgsql2dlf.in,v 1.12 2006/07/23 13:16:33 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2002 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire 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 (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html.

=head1 AUTHOR

Wessel Dankers <wsl@logreport.org>

=cut

# Local Variables:
# mode: cperl
# End: