somestub

#!/usr/bin/perl -l
use strict;
use utf8;
use 5.16.1;
use constant {
    EAGAIN => 11,
    TCP_KEEPIDLE => 4,
    TCP_KEEPINTVL => 5,
    TCP_KEEPCNT => 6,
    TEMP_BUF_SIZE => 4096,
    CRLF => "\r\n",
    GZIP_MAGIC => "\x1f\x8b",
    GZIP_MAGIC_LENGTH => 2,
    NO_FLAGS => 0,
    LISTEN_QUEUE_SIZE => 3,
    LISTEN_ON_PORT => 1212,
    YES => 1,
    NO => undef
};
my $LOG_FILE = '/tmp/stubCry.log';

use IO::Socket::INET;
use Socket qw(IPPROTO_TCP);
use IO::Uncompress::Gunzip qw(gunzip);
use IO::Compress::Gzip;
use EPW;
use JSON::XS qw(encode_json decode_json);

my ($S, $fhLog);
my %clientBuf;

my %sn2Rate=(
    1   =>  10,
    2   =>  25,
    3   =>  50
);

sub logg
{
        printf $fhLog '%s '.$_[0].(substr($_[0],-1) eq "\n"?'':"\n"), scalar(localtime()), @_[1..$#_];
}

sub newClient
{
    my $c = $S->accept();
    $c->blocking(0);
    return unless $c;
    logg '+client #%s %s', fileno($c), inet_ntoa((sockaddr_in $c->peername())[1]);
#    send $c, CRLF, NO_FLAGS;   #only small message
    $c->setsockopt(IPPROTO_TCP, TCP_KEEPIDLE, 100);
    $c->setsockopt(IPPROTO_TCP, TCP_KEEPINTVL, 30);
    $c->setsockopt(IPPROTO_TCP, TCP_KEEPCNT,    5);
    $c->setsockopt(SOL_SOCKET,  SO_KEEPALIVE,   1);
    $clientBuf{$c} = {
        'jsonHndl' => JSON::XS->new(),
        'replyBuf' => '',
        'flGzip'   => undef,
        'reader'   => \&readPlainData,
        'writer'   => \&writePlainData,
        'nDataPortion' => 0,
    };
    EPW::setFDH($c, \&processClientReq, undef, \&dropClient, undef);
}

=doc
    Syntax:
        processObjs(client_connection_handle, [object1, object2..objectN])
=cut
sub processObjs {
        my $c=shift;
        return unless $_=$_[0] and ref eq 'ARRAY' and @{$_};
        for my $obj (@{$_}) {
            eval { process($c, $obj) || 1 } or do {
                chomp(my $msg=sprintf('fail to process object <<%s>>. reason: %s', encode_json($obj), $@));
                logg($msg=~s/\n/\\n/gr);
                dropClient($c);
                return
            }
        }
        return 1
}

sub processClientReq
{
    my ($c)=@_;
    return unless defined(my $client=$clientBuf{$c});
    my $flFirstBytes = $client->{'nDataPortion'}++ == 0;
    # If client buffer is empty, then we need to get only first GZIP_MAGIC_LENGTH (i.e. 2) bytes of stream to determine, whether data was compressed
    my ($foodSize, $err)=$client->{'reader'}->($c, \my $foodCont, $flFirstBytes?GZIP_MAGIC_LENGTH:TEMP_BUF_SIZE);
    if (defined $foodSize) {
        unless ($foodSize) {
            if (length $client->{'replyBuf'}) {
            # We have anything to send back to the client
                EPW::setFDH($c, undef, \&sendReply, \&dropClient, undef)
            } else {
            # Get rid of this client: we tell her all she want to know
                dropClient($c)
            }
            return
        } elsif ($flFirstBytes and $foodSize==GZIP_MAGIC_LENGTH and $foodCont eq GZIP_MAGIC) {
            logg '<c#%s[*] compressed stream detected, we will use uncompressing on the fly', fileno($c);
            my $zI=IO::Uncompress::Gunzip->new($c, 'Prime' => $foodCont);
            $client->{'flGzip'}=1;
            ($foodSize, $err)=(
                $client->{'reader'} = sub { $_ = $zI->read(${$_[1]}, $_[2]); return ($_, $!) }
            )->(undef, \$foodCont, TEMP_BUF_SIZE);
            my $zO=IO::Compress::Gzip->new($c, 'TextFlag'=>1) or die "IO::Compress::Gzip failed: ".$IO::Compress::Gzip::GzipError." \n";
            $zO->autoflush(1);
            $client->{'writer'} = sub { print STDERR $_[1]; $zO->print($_[1]); length($_[1]) };
        }
    }

    unless (defined $foodSize) {
        dropClient($c) unless $err == EAGAIN;
        return
    }

    if (my @objs=eval { $client->{'jsonHndl'}->incr_parse($foodCont) }) {
        processObjs($c, \@objs)
    } elsif ($@) {
        chomp(my $msg="breaking-all data portion from client received: << $foodCont >>. JSON parser say: $@");
        logg($msg=~s%\n%\\n%gr);
        dropClient($c);
        return
    }
}

sub sendReply
{
    my ($c)=@_;
    logg('[err] cant sendReply to unknown client'), return unless my $client=$clientBuf{$c};
    my $nBytesSended = $client->{'writer'}->($c, $client->{'replyBuf'}, NO_FLAGS);
    if (length($client->{'replyBuf'}) == $nBytesSended) {
        undef $client->{'replyBuf'};
        EPW::setFDH($c, \&processClientReq, undef, \&dropClient, undef)
    } else {
        substr($client->{'replyBuf'}, 0, $nBytesSended-1) = ''
    }
}

sub reply
{
   my ($c,$obj)=@_;
   logg('[err] cant reply to unknown client'), return unless my $client=$clientBuf{$c};
   my $dt = encode_json($obj);
   logg '>c#%s[%s]: %s', fileno($c), $obj->{'ans'}, $dt;
   $dt .= CRLF;
   if (length $client->{'replyBuf'}) {
        $clientBuf{$c}{'replyBuf'} .= $dt
   } else {
        my $nBytesSended = $client->{'writer'}->($c, $dt, NO_FLAGS);
        return 1 if $nBytesSended==length($dt);
        # ?? WDIM ->
#            $clientBuf{$c}{'replyBuf'} = $dt;
        # remaining part we need to send:
        $clientBuf{$c}{'replyBuf'} = substr($dt, $nBytesSended);
        # <-
        EPW::setFDH($c, \&processClientReq, \&sendReply, \&dropClient, undef)
   }
   return 1
}

my %hndlByReqType=(
    'verify'    => sub {
         verify($_[0] => $_[1]{'code'})
    },
    'prepare'   => \&calc,
    'close' => \&fin,
    'closed'    => sub {
        dummyClosed($_[0] => $_[1]{'id'})
    },
    'default'   => sub {
        die "wrong type $_[1]{'req'}"
    },
);

sub process
{
    my ($c, $obj)=@_;
    my $req = $obj->{'req'};
    logg "<c#".fileno($c)."[$req]: ".encode_json($obj);
    ($hndlByReqType{$req || 'default'} || $hndlByReqType{'default'})->($c, $obj);
}

sub verify
{
    my ($c, $ccode)=@_;
    reply( $c =>
            $ccode=~/^cl(?:b|\d\d)\d{7,}/
            ? do {
                my %opt = verify_onFile($ccode);
                +{
                    'ans'=>'coupon',
                    'state'=>((!%opt || $opt{'closed'})?'in':'').'valid',
                    'code'=>$ccode
                }
              }
            : {'ans'=>'unknown', 'code'=>$ccode}
    );
}

sub fin
{
    my ($c, $obj)=@_;

    for my $cp (@{$obj->{'coupons'}})
    {
        my %opt=verify_onFile($cp);
        close_onFile($cp) if $sn2Rate{$opt{'id'}}
    }

    reply($c => {
                    'ans'=>'close',
                    'id'=>$obj->{'id'}
                }
    )
}

sub dummyClosed
{
    my($c, $id)=@_;
    reply($c => {
                    'ans'=>'closed',
                    'id'=>$id
                }
    )
}

sub calc
{
    my ($c, $obj)=@_;
    my @items = grep {!$_->{'exclude'}} @{$obj->{'items'}};
    my @discs =
        @items
            ? map {
                my $coupon = $_;
                my %opt = verify_onFile($coupon);
                unless (my $rate = $sn2Rate{$opt{'id'}}) {
                    ()
                } else {
                    map {
                        'num'       => $_->{'num'},
                        'discount'  => $_->{'discount'} + $_->{'cost'} * $_->{'amount'} * $rate * 0.01,
                        'code'      => $opt{'aId'},
                    }, @items
                }
              } @{$obj->{'coupons'}}
            : ();
    reply($c => {
                    'ans'=>'discount',
                    'id'=>$obj->{'id'},
                    'discount'=>\@discs
                }
    )
}

sub dropClient
{
    my $c=shift;
    delete $clientBuf{$c};
    logg "-client #". fileno($c);
    EPW::clearFDH($c);
    shutdown($c,2);
    close $c
}

sub verify_onFile
{
    my ($code)=@_;
    $code=~/^cl(b|\d\d)(\d\d\d)(\d\d\d)(\d+)/ or return ();

    my $iCode="$1-$2-$3-$4";
    open my $F, '<', "cps/$iCode.data" or return ();
    my %opt;
    while(<$F>)
    {
        $opt{$1}=$2     if /^\s*(id|weight|closed|aId)=(.*)/;
        last        if /\@Coupon\[registered\]:.End$/i;
    }
    return %opt;
}

sub close_onFile
{
    my ($code)=@_;
    $code =~ /^cl(b|\d\d)(\d\d\d)(\d\d\d)(\d+)/ or logg ("close <$code> failed"), return;
    my $iCode="$1-$2-$3-$4";
    logg "coupon $iCode closed";
    my $F;
    open $F,'>>',"cps/$iCode.data" or logg("close-open <$iCode> failed: $!"), return;
    print $F "closed=1";
    close $F;
}

sub readPlainData {
    $_ = sysread($_[0], ${$_[1]}, $_[2]);
    return ($_, $!)
}

sub writePlainData {
    logg('[err] client writer wont to write nothing'), return
        unless defined $_[1];
    send($_[0], $_[1], $_[2] // NO_FLAGS)
}

sub main {
    $fhLog=do { open $_, '>>', $LOG_FILE or die 'Cant open log file. No log == No work!'; $_ };
    # ?? WDIM. Why this strange hack stays undocumented?
    select+((select $fhLog),$|=1)[0];

    $S=IO::Socket::INET->new(
        'Listen'    =>  LISTEN_QUEUE_SIZE,
        'ReuseAddr' =>  YES,
        'LocalPort' =>  LISTEN_ON_PORT
    ) or die "bindErr: $!";

    EPW::setFDH($S, \&newClient, undef, undef);
    EPW::loo();
}

main();