#!/usr/bin/perl -w

use strict;
$|=1;

use Dumpvalue; my $dumper= new Dumpvalue;
use IO::Select;
use TVData;
use tvclient;
use Fcntl;      # fcntl
use IO::Socket; # IO::Socket::INET


# uncompressed : about 140K/s
# compressed: about 30K/s
#
# limited to 5 frames per second:
# uncompressed: about 30K/s
# compressed: about 5.5K/s

# Compress::Zlib::compress has header of : 0x78, 0x9c
# Compress::Zlib::memGzip has header of  : 0x1f, 0x8b, 0x08
# '/usr/bin/compress' has header of      : 0x1f, 0x9d, 0x90

# keep list of client connections,with socket, zlib object ...

# todo:
#    implement protocol as follows:
#    - if no data from client within <clientProtoV0Timeout> then
#      start sending a compressed datastream
#    - client can specify type of compression(compress,zlib,none,...),
#      framerate, 

#    - try to send data 1 frame at a time.
#      possibly frame start can be recognized by '\033[1;1H'
#      and skip frame of client is still busy receiving previous frame.
# add java client.
#  - try to be compatible with starwars player.
#
#bugs:
#  - disconnects from clients are not handled correctly:
#     the wrong client object gets destroyed.
my %clients;
$SIG{PIPE}= 'IGNORE';
$SIG{QUIT}= \&terminate;
$SIG{INT}= \&terminate;

my $server= allocateServerSocket() or die "can't allocate server socket : $!\n";

my $select= IO::Select->new($server);

my $tv= TVData->new();

# constants
my $readtimeout= 0;
my $writetimeout= 0;
my $excepttimeout= 0;

my $clientbufsize= 256;

my $totaltvdata= 0;
my $tstart= time();
my $tnow;     # used by 'speed()'
my $senddata;
while (1) {
    $tnow= time();

    $senddata= $tv->read();

    my $bytesread= length($senddata);
    $totaltvdata += $bytesread;

    &printStats();  # '&' to aviod 'called too early to check prototype' warning

    foreach my $client ($select->can_read($readtimeout)) {
        if ($client==$server) {
            # handle new connects
            my ($client, $packedaddress)= $server->accept();
            if (defined $client) {
                $clients{$client}=tvclient->new($client, $packedaddress);
                #setxmitlowat($client);
                $select->add($client);
                nonblock($client);
            }
        }
        else {
            # handle data from client
            my $data;
            #todo: move this to tvclient class.
            my $rv= $client->recv($data, $clientbufsize, 0);

            if (!defined($rv) || length($data)==0) {
                print "disconnected\n";
                delete $clients{$client};
                $select->remove($client);
                close $client;
            }
            else {
                print "received clientdata:|n";
                $dumper->dumpValue(\$data);
            }
        }
    }

    # register data that could have been transmitted to client
    # [ as opposed to data that fit on the wire. ]
    foreach my $client (keys %clients) {
        $clients{$client}->{stats_alltvdata} += $bytesread;
    }

    # send data to clients.
    if ($bytesread) {
        foreach my $client ($select->can_write($writetimeout)) {
            next unless exists $clients{$client};

            #todo: only -really- write data when there is 'room on the wire'
            $clients{$client}->write($senddata);
        }
    }

    foreach my $client ($select->has_exception($excepttimeout)) {
    # handle out of band data.
        print "ob: -$!-$@-\n";
    }
}

sub nonblock {
    my $socket= shift;
    my $flags= fcntl($socket, F_GETFL, 0) or die "can't get flags for socket: $!\n";
    fcntl($socket, F_SETFL, $flags | O_NONBLOCK) or die "can't make socket nonblocking: $!\n";
}

# see for explanation: http://www.unixadm.net/networking/tune.html
# doesn't work for two reasons:
#   - linux kernel does not implement setting sndlowat
#   - sndbuf size is not a static entity, it varies during the connection.
sub setxmitlowat {
    my $socket= shift;
    my $maxbufsize= $socket->getsockopt(SOL_SOCKET, SO_SNDBUF);
    print "maxbufsize= $maxbufsize\n";
    $socket->setsockopt(SOL_SOCKET, SO_SNDLOWAT, $maxbufsize);
    print "setsockopt: -$!-$@\n";
}

sub speed {
    my $bytecount= shift;

    if ($tnow>$tstart) {
        return $bytecount/($tnow-$tstart);
    }
    else {
        return 0;
    }
}

my $recent;
sub printStats()
{
    return if (defined $recent && $tnow-$recent<2);
    $recent=$tnow;

    printf "           server      %12d %9.2f\n", $totaltvdata, speed($totaltvdata);
    foreach my $clientinfo (values %clients) {
        printf("%12d %9.2f %12d %9.2f %12d %s\n", $clientinfo->{stats_compressed},speed($clientinfo->{stats_compressed}),
                $clientinfo->{stats_uncompressed}, speed($clientinfo->{stats_uncompressed}),
                $clientinfo->{stats_alltvdata},
                $clientinfo->{description});
    }
}

sub allocateServerSocket {

    for (my $portnr= 2000 ; $portnr<2100 ; $portnr++) {
        my $server= IO::Socket::INET->new(LocalPort=>$portnr, Listen=>10);
        if (defined $server) {
            print "listening on port $portnr\n";
            nonblock($server);
            return $server;
        }
    }
    return undef;
}

sub terminate {
    %clients=();
    $server->close();
    print "terminating main\n";
    exit(0);
}

