#! @PERL@ -w

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

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

my $schema = eval { Lire::DlfSchema::load_schema( "dialup" ); };
lr_err( "error loading dialup schema: $@" ) if $@;
my $dlf_maker =
  $schema->make_hashref2asciidlf_func( qw/time connection_time
                    telephone_number cost cost_currency
                    direction connection_type local_number
                    connect_status hangup_status/ );

my $qid = '';
my %conns;

sub print_dlf {
    my ($c, $print_only_x ) = @_;

    my $subroutine = 'print_dlf';

    my %dlf = map { $_ => $c->{$_} }
            qw/time connection_time telephone_number cost 
               cost_currency direction connection_type
               local_number connect_status hangup_status/;
    my $dlf = $dlf_maker->( \%dlf );
    print join( " ", @$dlf ), "\n";
    $dlflines++;
}

sub parse_isdnlog_line {
    my ( $line ) = @_;

    my $direction = "";

    if ($line =~ /^isdnlog.*starting/) {
        # detect new isdnlog run. This should delete all
        # %conns information
        %conns = ();
    } elsif (($line =~ /->/) || ($line =~ /<-/)) {
        if ($line =~ /->/) {
            $direction = "outbound";
        } elsif ($line =~ /<-/) {
            $direction = "inbound";
        }

        if ($line =~ /^\(HiSax driver detected\)/) {
            # remove this part (bug in Debian's isdnlog 3.1pre4?)
            $line =~ s/^\(HiSax driver detected\)//;
        }

        # get the time stamp
        my ( $day2, $time ) =
        $line =~ /^(\w\w\w)\ (\w\w\w\ \d\d\ \d\d:\d\d:\d\d)/
            or die "Line contains an invalid time stamp!\n";
        my $local_tm_ref = [localtime()];
        $time = syslog2cal( $time, $local_tm_ref );

        # get telephone number information.
        my $local = "";
        my $remote = "";
        if ($line =~ /(\+\d.*\ .*),.*\ [<|>|-]*\ (\+\d.*\ .*),/ ||
            $line =~ /(\+\d.*\ .*),.*\ [<|>|-]*\ (\?)/ ||
            $line =~ /(\?)\ [<|>|-]*\ (\+\d.*\ .*),/ ||
            $line =~ /(\?)\ [<|>|-]*\ (\?)/) {
            $local = $1;
            $remote = $2;
        } else {
            lr_debug("Was not able to extract telephone numbers from: ");
            lr_debug($line);
        }

        # isdnlog does not do IDs... use telephone numbers.
        # NOTE: this will break when two identical connections
        # are made: X - Y and X - Y
        $qid = $local . "-" . $remote;

        #lr_debug($line);
        if ($line =~ /HANGUP/) {
            # this denotes the END of a dial up connection

            # make sure a connection exists
            if (!$conns{$qid}{time}) {
                initCall();
                $conns{$qid}{time} = $time;
                $conns{$qid}{local_number} = "$local";
                $conns{$qid}{telephone_number} = "$remote";
                $conns{$qid}{direction} = "$direction";
            }

            # determine the connection time
            if ($conns{$qid}{time}) {
                $conns{$qid}{connection_time} = $time - $conns{$qid}{time};
            }

            # determine status
            if ($line =~ /Timeout/ ||
                $line =~ /No\ answer/) {
                $conns{$qid}{hangup_status} = "ring";
                $conns{$qid}{hangup_status} = "no_answer";
            } elsif ($line =~ /Unallocated/) {
                $conns{$qid}{hangup_status} = "failed";
                $conns{$qid}{hangup_status} = "unallocated_number";
            } else {
                $conns{$qid}{hangup_status} = "normal";
            }

            # determine the total cost for this connection
            if ($line =~ /HANGUP.*\ (\d*\.\d\d)\ (\w*)/) {
                # hopefully, this is not too general ;)
                $conns{$qid}{cost} = $1;
                $conns{$qid}{cost_currency} = $2;
            }

            print_dlf( $conns{$qid} );
            
            # delete all information for this connection
            $conns{$qid} = {};
        } elsif ($line =~ /RING/) {
            # this denotes the START of a new dial up connection

            initCall();
            $conns{$qid}{time} = $time;
            $conns{$qid}{connect_status} = "ring";
            $conns{$qid}{local_number} = "$local";
            $conns{$qid}{telephone_number} = "$remote";
            $conns{$qid}{direction} = "$direction";

        } elsif ($line =~ /User\ busy/) {
            # this denotes a FAILED dial up connection
            # NOTE: HANGUP User Busy is parsed above

            if (!$conns{$qid}{time}) {
                initCall();
                $conns{$qid}{time} = $time;
                $conns{$qid}{connect_status} = "busy";
                $conns{$qid}{local_number} = "$local";
                $conns{$qid}{telephone_number} = "$remote";
                $conns{$qid}{direction} = "$direction";
            } else {
                # this call was already busy
            }

        } elsif ($line =~ /CONNECT/) {
            # it happens that no RING was found
            if (!$conns{$qid}{time}) {
                initCall();
                $conns{$qid}{time} = $time;
                $conns{$qid}{local_number} = "$local";
                $conns{$qid}{telephone_number} = "$remote";
                $conns{$qid}{direction} = "$direction";
            }

            # get the connection type (data or speech)
            $conns{$qid}{connect_status} = "connected";

            if ($line =~ /CONNECT\ \(Data\)/) {
                $conns{$qid}{connection_type} = "data";
            } elsif ($line =~ /CONNECT\ \(Speech\)/) {
                $conns{$qid}{connection_type} = "speech";
            }
        }
    } else {
        # skip this line
    }

}

sub initCall {
    $conns{$qid} = {
        local_number     => "+00 00/00000000",
        telephone_number => "+00 00/00000000",
        direction        => "inbound",
        connection_time  => "0",
        cost             => "0.00",
        cost_currency    => "EUR",
        connection_type  => "speech",
        connect_status   => "none",
        hangup_status    => "none",
    };
}

init_dlf_converter( "dialup" );
while ( <> ) {
    chomp;
    $lines++;

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

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

__END__

=pod

=head1 NAME

isdnlog2dlf - convert ISDN logs to DLF format

=head1 SYNOPSIS

B<isdnlog2dlf>

=head1 DESCRIPTION

This script reads a Linux kernel ISDN log file, as produced by the isdn4linux
Linux kernel modules, and written by isdn4k-utils's isdnlog(8).  The script is
tested with the isdnlog Debian package, version 4.57, as shipped with Debian
GNU/Linux 3.0.

=head1 EXAMPLES

To process a log as produced by isdnlog:

 $ isdnlog2dlf < isdn-log

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

 $ lr_log2report isdnlog < /var/log/isdn-log

=head1 SEE ALSO

isdnlog(5), isdnlog(8), http://www.isdn4linux.de/

=head1 AUTHOR

Egon Willighagen <egonw@logreport.org>

=head1 VERSION

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

=head1 COPYRIGHT

Copyright (C) 2000-2001 Stichting LogReport Foundation LogReport@LogReport.org

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

=cut