test/perl/TestClient.pl

#!/usr/bin/env perl

#
# Licensed to the Apache Software Foundation (ASF) under one
# or more contributor license agreements. See the NOTICE file
# distributed with this work for additional information
# regarding copyright ownership. The ASF licenses this file
# to you under the Apache License, Version 2.0 (the
# "License"); you may not use this file except in compliance
# with the License. You may obtain a copy of the License at
#
#   http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing,
# software distributed under the License is distributed on an
# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
# KIND, either express or implied. See the License for the
# specific language governing permissions and limitations
# under the License.
#

use 5.10.0;
use strict;
use warnings;
use Data::Dumper;
use Getopt::Long qw(GetOptions);
use Time::HiRes qw(gettimeofday);

use lib '../../lib/perl/lib';
use lib 'gen-perl';

use Thrift;
use Thrift::BinaryProtocol;
use Thrift::BufferedTransport;
use Thrift::FramedTransport;
use Thrift::MultiplexedProtocol;
use Thrift::SSLSocket;
use Thrift::Socket;
use Thrift::UnixSocket;

use ThriftTest::SecondService;
use ThriftTest::ThriftTest;
use ThriftTest::Types;

$|++;

sub usage {
    print <<"EOF";
Usage: $0 [OPTIONS]

Options:                          (default)
  --ca                                         CA to validate server with.
  --cert                                       Certificate to use.
                                               Required if using --ssl.
  --ciphers                                    Acceptable cipher list.
  --domain-socket <file>                       Use a unix domain socket.
  --help                                       Show usage.
  --key                                        Certificate key.
                                               Required if using --ssl.
  --port <portnum>                9090         Port to use.
  --protocol {binary}             binary       Protocol to use.
  --ssl                                        If present, use SSL.
  --transport {buffered|framed}   buffered     Transport to use.

EOF
}

my %opts = (
    'port' => 9090,
    'protocol' => 'binary',
    'transport' => 'buffered'
);

GetOptions(\%opts, qw (
    ca=s
    cert=s
    ciphers=s
    key=s
    domain-socket=s
    help
    host=s
    port=i
    protocol=s
    ssl
    transport=s
)) || exit 1;

if ($opts{help}) {
    usage();
    exit 0;
}

my $socket = undef;
if ($opts{'domain-socket'}) {
    $socket = Thrift::UnixSocket->new($opts{'domain-socket'});
}
elsif ($opts{ssl}) {
  $socket = Thrift::SSLSocket->new(\%opts);
}
else {
  $socket = Thrift::Socket->new($opts{host}, $opts{port});
}

my $transport;
if ($opts{transport} eq 'buffered') {
    $transport = Thrift::BufferedTransport->new($socket, 1024, 1024);
}
elsif ($opts{transport} eq 'framed') {
    $transport = Thrift::FramedTransport->new($socket);
}
else {
    usage();
    exit 1;
}

my $protocol;
my $protocol2;
if ($opts{protocol} eq 'binary' || $opts{protocol} eq 'multi') {
    $protocol = Thrift::BinaryProtocol->new($transport);
}
else {
    usage();
    exit 1;
}

my $secondService = undef;
if (index($opts{protocol}, 'multi') == 0) {
  $protocol2     = Thrift::MultiplexedProtocol->new($protocol, 'SecondService');
  $protocol      = Thrift::MultiplexedProtocol->new($protocol, 'ThriftTest');
  $secondService = ThriftTest::SecondServiceClient->new($protocol2);
}

my $testClient = ThriftTest::ThriftTestClient->new($protocol);

eval {
  $transport->open();
};
if($@){
    die(Dumper($@));
}

use constant ERR_BASETYPES => 1;
use constant ERR_STRUCTS => 2;
use constant ERR_CONTAINERS => 4;
use constant ERR_EXCEPTIONS => 8;
use constant ERR_PROTOCOL => 16;
use constant ERR_UNKNOWN => 64;

my $start = gettimeofday();

#
# VOID TEST
#
print('testVoid()');
$testClient->testVoid();
print(" = void\n");

#
# STRING TEST
#
print('testString("Test")');
my $s = $testClient->testString('Test');
print(qq| = "$s"\n|);
exit(ERR_BASETYPES) if ($s ne 'Test');

#
# MULTIPLEXED TEST
#
if (index($opts{protocol}, 'multi') == 0) {
    print('secondtestString("Test2")');
    $s = $secondService->secondtestString('Test2');
    print(qq| = "$s"\n|);
    exit(ERR_PROTOCOL) if ($s ne 'testString("Test2")');
}

#
# BOOL TEST
#
print('testBool(1)');
my $t = $testClient->testBool(1);
print(" = $t\n");
exit(ERR_BASETYPES) if ($t ne 1);
print('testBool(0)');
my $f = $testClient->testBool(0);
print(" = $f\n");
exit(ERR_BASETYPES) if ($f ne q||);


#
# BYTE TEST
#
print('testByte(1)');
my $u8 = $testClient->testByte(1);
print(" = $u8\n");

#
# I32 TEST
#
print('testI32(-1)');
my $i32 = $testClient->testI32(-1);
print(" = $i32\n");
exit(ERR_BASETYPES) if ($i32 ne -1);

#
# I64 TEST
#
print('testI64(-34359738368)');
my $i64 = $testClient->testI64(-34359738368);
print(" = $i64\n");
exit(ERR_BASETYPES) if ($i64 ne -34359738368);

#
# DOUBLE TEST
#
print('testDouble(-852.234234234)');
my $dub = $testClient->testDouble(-852.234234234);
print(" = $dub\n");
exit(ERR_BASETYPES) if ($dub ne -852.234234234);

#
# BINARY TEST
#
print("testBinary(pack('C*', 0..255))");
my $bin = $testClient->testBinary(pack('C*', 0..255));
printf(" = %s\n", join ' ', map { sprintf '%02x', $_ } unpack('C*', $bin));
exit(ERR_BASETYPES) if ($bin ne pack('C*', 0..255));

#
# STRUCT TEST
#
print('testStruct({"Zero", 1, -3, -5})');
my $out = ThriftTest::Xtruct->new();
$out->string_thing('Zero');
$out->byte_thing(1);
$out->i32_thing(-3);
$out->i64_thing(-5);
my $in = $testClient->testStruct($out);
print(' = {"'.$in->string_thing.'", '.
        $in->byte_thing.', '.
        $in->i32_thing.', '.
        $in->i64_thing."}\n");

#
# NESTED STRUCT TEST
#
print('testNest({1, {"Zero", 1, -3, -5}, 5}');
my $out2 = ThriftTest::Xtruct2->new();
$out2->byte_thing(1);
$out2->struct_thing($out);
$out2->i32_thing(5);
my $in2 = $testClient->testNest($out2);
$in = $in2->struct_thing;
print(' = {'.$in2->byte_thing.', {"'.
      $in->string_thing.'", '.
      $in->byte_thing.', '.
      $in->i32_thing.', '.
      $in->i64_thing.'}, '.
      $in2->i32_thing."}\n");

#
# MAP TEST
#
my $mapout = {};
for (my $i = 0; $i < 5; ++$i) {
  $mapout->{$i} = $i-10;
}
print('testMap({');
my $first = 1;
while( my($key,$val) = each %$mapout) {
    if ($first) {
        $first = 0;
    }
    else {
        print(', ');
    }
    print("$key => $val");
}
print('})');


my $mapin = $testClient->testMap($mapout);
print(' = {');

$first = 1;
while( my($key,$val) = each %$mapin){
    if ($first) {
        $first = 0;
    }
    else {
        print(', ');
    }
    print("$key => $val");
}
print("}\n");

#
# SET TEST
#
my $setout = [];
for (my $i = -2; $i < 3; ++$i) {
    push(@$setout, $i);
}

print('testSet({'.join(',',@$setout).'})');

my $setin = $testClient->testSet($setout);

print(' = {'.join(',',@$setout)."}\n");

#
# LIST TEST
#
my $listout = [];
for (my $i = -2; $i < 3; ++$i) {
    push(@$listout, $i);
}

print('testList({'.join(',',@$listout).'})');

my $listin = $testClient->testList($listout);

print(' = {'.join(',',@$listin)."}\n");

#
# ENUM TEST
#
print('testEnum(ONE)');
my $ret = $testClient->testEnum(ThriftTest::Numberz::ONE);
print(" = $ret\n");

print('testEnum(TWO)');
$ret = $testClient->testEnum(ThriftTest::Numberz::TWO);
print(" = $ret\n");

print('testEnum(THREE)');
$ret = $testClient->testEnum(ThriftTest::Numberz::THREE);
print(" = $ret\n");

print('testEnum(FIVE)');
$ret = $testClient->testEnum(ThriftTest::Numberz::FIVE);
print(" = $ret\n");

print('testEnum(EIGHT)');
$ret = $testClient->testEnum(ThriftTest::Numberz::EIGHT);
print(" = $ret\n");

#
# TYPEDEF TEST
#
print('testTypedef(309858235082523)');
my $uid = $testClient->testTypedef(309858235082523);
print(" = $uid\n");

#
# NESTED MAP TEST
#
print('testMapMap(1)');
my $mm = $testClient->testMapMap(1);
print(' = {');
while( my ($key,$val) = each %$mm) {
    print("$key => {");
    while( my($k2,$v2) = each %$val) {
        print("$k2 => $v2, ");
    }
    print('}, ');
}
print("}\n");

#
# INSANITY TEST
#
my $insane = ThriftTest::Insanity->new();
$insane->{userMap}->{ThriftTest::Numberz::FIVE} = 5000;
my $truck = ThriftTest::Xtruct->new();
$truck->string_thing('Hello2');
$truck->byte_thing(2);
$truck->i32_thing(2);
$truck->i64_thing(2);
my $truck2 = ThriftTest::Xtruct->new();
$truck2->string_thing('Goodbye4');
$truck2->byte_thing(4);
$truck2->i32_thing(4);
$truck2->i64_thing(4);
push(@{$insane->{xtructs}}, $truck);
push(@{$insane->{xtructs}}, $truck2);

print('testInsanity()');
my $whoa = $testClient->testInsanity($insane);
print(' = {');
while( my ($key,$val) = each %$whoa) {
    print("$key => {");
    while( my($k2,$v2) = each %$val) {
        print("$k2 => {");
        my $userMap = $v2->{userMap};
        print('{');
        if (ref($userMap) eq 'HASH') {
            while( my($k3,$v3) = each %$userMap) {
                print("$k3 => $v3, ");
            }
        }
        print('}, ');

        my $xtructs = $v2->{xtructs};
        print('{');
        if (ref($xtructs) eq 'ARRAY') {
            foreach my $x (@$xtructs) {
                print('{"'.$x->{string_thing}.'", '.
                      $x->{byte_thing}.', '.$x->{i32_thing}.', '.$x->{i64_thing}.'}, ');
            }
        }
        print('}');

        print('}, ');
    }
    print('}, ');
}
print("}\n");

#
# EXCEPTION TEST
#
print(q|testException('Xception')|);
eval {
    $testClient->testException('Xception');
    print("  void\nFAILURE\n");
}; if($@ && $@->UNIVERSAL::isa('ThriftTest::Xception')) {
    print(' caught xception '.$@->{errorCode}.': '.$@->{message}."\n");
}


#
# Normal tests done.
#
my $stop = gettimeofday();
my $elp  = sprintf('%d',1000*($stop - $start), 0);
print("Total time: $elp ms\n");

#
# Extraneous "I don't trust PHP to pack/unpack integer" tests
#

# Max I32
my $num = 2**30 + 2**30 - 1;
my $num2 = $testClient->testI32($num);
if ($num != $num2) {
    print "Missed max32 $num = $num2\n";
}

# Min I32
$num = 0 - 2**31;
$num2 = $testClient->testI32($num);
if ($num != $num2) {
    print "Missed min32 $num = $num2\n";
}

# Max Number I can get out of my perl
$num = 2**40;
$num2 = $testClient->testI64($num);
if ($num != $num2) {
    print "Missed max64 $num = $num2\n";
}

# Max Number I can get out of my perl
$num = 0 - 2**40;
$num2 = $testClient->testI64($num);
if ($num != $num2) {
    print "Missed min64 $num = $num2\n";
}

$transport->close();