Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

first commit

  • Loading branch information...
commit 2069e79e0162f492f671abb9350d5d132ac36f36 0 parents
naoya authored
22 Hello.pm.patch
@@ -0,0 +1,22 @@
+--- gen-perl/Hello.pm.orig 2008-07-29 10:42:41.000000000 +0900
++++ gen-perl/Hello.pm 2008-07-29 10:43:36.000000000 +0900
+@@ -261,7 +261,7 @@
+
+ sub process_hello{
+ my $self = shift;
+- my ($seqid, $input, $output);
++ my ($seqid, $input, $output) = @_;
+ my $args = new Hello_hello_args();
+ $args->read($input);
+ $input->readMessageEnd();
+@@ -271,4 +271,10 @@
+ $result->write($output);
+ $output->getTransport()->flush();
+ }
++
++sub method_exists {
++ my ($self, $methodname) = @_;
++ $self->can($methodname) ? 1 : 0;
++}
++
+ 1;
7 README
@@ -0,0 +1,7 @@
+Thrift の Perl サーバー実装。Thfit の perl バインディングは名前空間が
+Thrift:: だったり TProtocolFactory だったり統一性がないのが気になる。と
+りあえず自分の実装は Thrift:: を使っている。
+
+Thrift が生成する gen-perl の Processor のコードが Release 20080411p1
+では一部まだ未完の模様。Hello.pm.patch にあるように変更を加える必要があ
+る。
13 gen-perl/Constants.pm
@@ -0,0 +1,13 @@
+#
+# Autogenerated by Thrift
+#
+# DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING
+#
+package Constants;
+require 5.6.0;
+use strict;
+use warnings;
+use Thrift;
+
+
+1;
280 gen-perl/Hello.pm
@@ -0,0 +1,280 @@
+#
+# Autogenerated by Thrift
+#
+# DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING
+#
+require 5.6.0;
+use strict;
+use warnings;
+use Thrift;
+
+use Types;
+
+# HELPER FUNCTIONS AND STRUCTURES
+
+package Hello_hello_args;
+use base('Class::Accessor');
+Hello_hello_args->mk_accessors( qw( name ) );
+sub new {
+my $classname = shift;
+my $self = {};
+my $vals = shift || {};
+$self->{name} = undef;
+ if (UNIVERSAL::isa($vals,'HASH')) {
+ if (defined $vals->{name}) {
+ $self->{name} = $vals->{name};
+ }
+ }
+return bless($self,$classname);
+}
+
+sub getName {
+ return 'Hello_hello_args';
+}
+
+sub read {
+ my $self = shift;
+ my $input = shift;
+ my $xfer = 0;
+ my $fname;
+ my $ftype = 0;
+ my $fid = 0;
+ $xfer += $input->readStructBegin(\$fname);
+ while (1)
+ {
+ $xfer += $input->readFieldBegin(\$fname, \$ftype, \$fid);
+ if ($ftype == TType::STOP) {
+ last;
+ }
+ SWITCH: for($fid)
+ {
+ /^1$/ && do{ if ($ftype == TType::STRING) {
+ $xfer += $input->readString(\$self->{name});
+ } else {
+ $xfer += $input->skip($ftype);
+ }
+ last; };
+ $xfer += $input->skip($ftype);
+ }
+ $xfer += $input->readFieldEnd();
+ }
+ $xfer += $input->readStructEnd();
+ return $xfer;
+}
+
+sub write {
+ my $self = shift;
+ my $output = shift;
+ my $xfer = 0;
+ $xfer += $output->writeStructBegin('Hello_hello_args');
+ if (defined $self->{name}) {
+ $xfer += $output->writeFieldBegin('name', TType::STRING, 1);
+ $xfer += $output->writeString($self->{name});
+ $xfer += $output->writeFieldEnd();
+ }
+ $xfer += $output->writeFieldStop();
+ $xfer += $output->writeStructEnd();
+ return $xfer;
+}
+
+package Hello_hello_result;
+use base('Class::Accessor');
+Hello_hello_result->mk_accessors( qw( success ) );
+sub new {
+my $classname = shift;
+my $self = {};
+my $vals = shift || {};
+$self->{success} = undef;
+ if (UNIVERSAL::isa($vals,'HASH')) {
+ if (defined $vals->{success}) {
+ $self->{success} = $vals->{success};
+ }
+ }
+return bless($self,$classname);
+}
+
+sub getName {
+ return 'Hello_hello_result';
+}
+
+sub read {
+ my $self = shift;
+ my $input = shift;
+ my $xfer = 0;
+ my $fname;
+ my $ftype = 0;
+ my $fid = 0;
+ $xfer += $input->readStructBegin(\$fname);
+ while (1)
+ {
+ $xfer += $input->readFieldBegin(\$fname, \$ftype, \$fid);
+ if ($ftype == TType::STOP) {
+ last;
+ }
+ SWITCH: for($fid)
+ {
+ /^0$/ && do{ if ($ftype == TType::STRING) {
+ $xfer += $input->readString(\$self->{success});
+ } else {
+ $xfer += $input->skip($ftype);
+ }
+ last; };
+ $xfer += $input->skip($ftype);
+ }
+ $xfer += $input->readFieldEnd();
+ }
+ $xfer += $input->readStructEnd();
+ return $xfer;
+}
+
+sub write {
+ my $self = shift;
+ my $output = shift;
+ my $xfer = 0;
+ $xfer += $output->writeStructBegin('Hello_hello_result');
+ if (defined $self->{success}) {
+ $xfer += $output->writeFieldBegin('success', TType::STRING, 0);
+ $xfer += $output->writeString($self->{success});
+ $xfer += $output->writeFieldEnd();
+ }
+ $xfer += $output->writeFieldStop();
+ $xfer += $output->writeStructEnd();
+ return $xfer;
+}
+
+package HelloIf;
+
+sub hello{
+ my $self = shift;
+ my $name = shift;
+
+ die 'implement interface';
+}
+package HelloRest;
+
+sub new {
+ my $classname=shift;
+ my $impl =shift;
+ my $self ={ impl => $impl };
+
+ return bless($self,$classname);
+}
+
+sub hello{
+ my $self = shift;
+ my $request = shift;
+
+ my $name = ($request->{'name'}) ? $request->{'name'} : undef;
+ return $self->{impl}->hello($name);
+}
+
+package HelloClient;
+
+use base('HelloIf');
+sub new {
+ my $classname = shift;
+ my $input = shift;
+ my $output = shift;
+ my $self = {};
+ $self->{input} = $input;
+ $self->{output} = defined $output ? $output : $input;
+ $self->{seqid} = 0;
+ return bless($self,$classname);
+}
+
+sub hello{
+ my $self = shift;
+ my $name = shift;
+
+ $self->send_hello($name);
+ return $self->recv_hello();
+}
+
+sub send_hello{
+ my $self = shift;
+ my $name = shift;
+
+ $self->{output}->writeMessageBegin('hello', TMessageType::CALL, $self->{seqid});
+ my $args = new Hello_hello_args();
+ $args->{name} = $name;
+ $args->write($self->{output});
+ $self->{output}->writeMessageEnd();
+ $self->{output}->getTransport()->flush();
+}
+
+sub recv_hello{
+ my $self = shift;
+
+ my $rseqid = 0;
+ my $fname;
+ my $mtype = 0;
+
+ $self->{input}->readMessageBegin(\$fname, \$mtype, \$rseqid);
+ if ($mtype == TMessageType::EXCEPTION) {
+ my $x = new TApplicationException();
+ $x->read($self->{input});
+ $self->{input}->readMessageEnd();
+ die $x;
+ }
+ my $result = new Hello_hello_result();
+ $result->read($self->{input});
+ $self->{input}->readMessageEnd();
+
+ if (defined $result->{success} ) {
+ return $result->{success};
+ }
+ die "hello failed: unknown result";
+}
+package HelloProcessor;
+
+sub new {
+ my $classname = shift;
+ my $handler = shift;
+ my $self = {};
+ $self->{handler} = $handler;
+ return bless($self,$classname);
+}
+
+sub process {
+ my $self = shift;
+ my $input = shift;
+ my $output = shift;
+ my $rseqid = 0;
+ my $fname = undef;
+ my $mtype = 0;
+
+ $input->readMessageBegin(\$fname, \$mtype, \$rseqid);
+ my $methodname = 'process_'.$fname;
+ if (!method_exists($self, $methodname)) {
+ $input->skip(TType::STRUCT);
+ $input->readMessageEnd();
+ my $x = new TApplicationException('Function '.$fname.' not implemented.', TApplicationException::UNKNOWN_METHOD);
+ $output->writeMessageBegin($fname, TMessageType::EXCEPTION, $rseqid);
+ $x->write($output);
+ $output->writeMessageEnd();
+ $output->getTransport()->flush();
+ return;
+ }
+ $self->$methodname($rseqid, $input, $output);
+ return 1;
+ }
+
+sub process_hello{
+ my $self = shift;
+ my ($seqid, $input, $output) = @_;
+ my $args = new Hello_hello_args();
+ $args->read($input);
+ $input->readMessageEnd();
+ my $result = new Hello_hello_result();
+ $result->{success} = $self->{handler}->hello($args->name);
+ $output->writeMessageBegin('hello', TMessageType::REPLY, $seqid);
+ $result->write($output);
+ $output->getTransport()->flush();
+ }
+
+sub method_exists {
+ my ($self, $methodname) = @_;
+ $self->can($methodname) ? 1 : 0;
+}
+
+1;
274 gen-perl/Hello.pm.orig
@@ -0,0 +1,274 @@
+#
+# Autogenerated by Thrift
+#
+# DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING
+#
+require 5.6.0;
+use strict;
+use warnings;
+use Thrift;
+
+use Types;
+
+# HELPER FUNCTIONS AND STRUCTURES
+
+package Hello_hello_args;
+use base('Class::Accessor');
+Hello_hello_args->mk_accessors( qw( name ) );
+sub new {
+my $classname = shift;
+my $self = {};
+my $vals = shift || {};
+$self->{name} = undef;
+ if (UNIVERSAL::isa($vals,'HASH')) {
+ if (defined $vals->{name}) {
+ $self->{name} = $vals->{name};
+ }
+ }
+return bless($self,$classname);
+}
+
+sub getName {
+ return 'Hello_hello_args';
+}
+
+sub read {
+ my $self = shift;
+ my $input = shift;
+ my $xfer = 0;
+ my $fname;
+ my $ftype = 0;
+ my $fid = 0;
+ $xfer += $input->readStructBegin(\$fname);
+ while (1)
+ {
+ $xfer += $input->readFieldBegin(\$fname, \$ftype, \$fid);
+ if ($ftype == TType::STOP) {
+ last;
+ }
+ SWITCH: for($fid)
+ {
+ /^1$/ && do{ if ($ftype == TType::STRING) {
+ $xfer += $input->readString(\$self->{name});
+ } else {
+ $xfer += $input->skip($ftype);
+ }
+ last; };
+ $xfer += $input->skip($ftype);
+ }
+ $xfer += $input->readFieldEnd();
+ }
+ $xfer += $input->readStructEnd();
+ return $xfer;
+}
+
+sub write {
+ my $self = shift;
+ my $output = shift;
+ my $xfer = 0;
+ $xfer += $output->writeStructBegin('Hello_hello_args');
+ if (defined $self->{name}) {
+ $xfer += $output->writeFieldBegin('name', TType::STRING, 1);
+ $xfer += $output->writeString($self->{name});
+ $xfer += $output->writeFieldEnd();
+ }
+ $xfer += $output->writeFieldStop();
+ $xfer += $output->writeStructEnd();
+ return $xfer;
+}
+
+package Hello_hello_result;
+use base('Class::Accessor');
+Hello_hello_result->mk_accessors( qw( success ) );
+sub new {
+my $classname = shift;
+my $self = {};
+my $vals = shift || {};
+$self->{success} = undef;
+ if (UNIVERSAL::isa($vals,'HASH')) {
+ if (defined $vals->{success}) {
+ $self->{success} = $vals->{success};
+ }
+ }
+return bless($self,$classname);
+}
+
+sub getName {
+ return 'Hello_hello_result';
+}
+
+sub read {
+ my $self = shift;
+ my $input = shift;
+ my $xfer = 0;
+ my $fname;
+ my $ftype = 0;
+ my $fid = 0;
+ $xfer += $input->readStructBegin(\$fname);
+ while (1)
+ {
+ $xfer += $input->readFieldBegin(\$fname, \$ftype, \$fid);
+ if ($ftype == TType::STOP) {
+ last;
+ }
+ SWITCH: for($fid)
+ {
+ /^0$/ && do{ if ($ftype == TType::STRING) {
+ $xfer += $input->readString(\$self->{success});
+ } else {
+ $xfer += $input->skip($ftype);
+ }
+ last; };
+ $xfer += $input->skip($ftype);
+ }
+ $xfer += $input->readFieldEnd();
+ }
+ $xfer += $input->readStructEnd();
+ return $xfer;
+}
+
+sub write {
+ my $self = shift;
+ my $output = shift;
+ my $xfer = 0;
+ $xfer += $output->writeStructBegin('Hello_hello_result');
+ if (defined $self->{success}) {
+ $xfer += $output->writeFieldBegin('success', TType::STRING, 0);
+ $xfer += $output->writeString($self->{success});
+ $xfer += $output->writeFieldEnd();
+ }
+ $xfer += $output->writeFieldStop();
+ $xfer += $output->writeStructEnd();
+ return $xfer;
+}
+
+package HelloIf;
+
+sub hello{
+ my $self = shift;
+ my $name = shift;
+
+ die 'implement interface';
+}
+package HelloRest;
+
+sub new {
+ my $classname=shift;
+ my $impl =shift;
+ my $self ={ impl => $impl };
+
+ return bless($self,$classname);
+}
+
+sub hello{
+ my $self = shift;
+ my $request = shift;
+
+ my $name = ($request->{'name'}) ? $request->{'name'} : undef;
+ return $self->{impl}->hello($name);
+}
+
+package HelloClient;
+
+use base('HelloIf');
+sub new {
+ my $classname = shift;
+ my $input = shift;
+ my $output = shift;
+ my $self = {};
+ $self->{input} = $input;
+ $self->{output} = defined $output ? $output : $input;
+ $self->{seqid} = 0;
+ return bless($self,$classname);
+}
+
+sub hello{
+ my $self = shift;
+ my $name = shift;
+
+ $self->send_hello($name);
+ return $self->recv_hello();
+}
+
+sub send_hello{
+ my $self = shift;
+ my $name = shift;
+
+ $self->{output}->writeMessageBegin('hello', TMessageType::CALL, $self->{seqid});
+ my $args = new Hello_hello_args();
+ $args->{name} = $name;
+ $args->write($self->{output});
+ $self->{output}->writeMessageEnd();
+ $self->{output}->getTransport()->flush();
+}
+
+sub recv_hello{
+ my $self = shift;
+
+ my $rseqid = 0;
+ my $fname;
+ my $mtype = 0;
+
+ $self->{input}->readMessageBegin(\$fname, \$mtype, \$rseqid);
+ if ($mtype == TMessageType::EXCEPTION) {
+ my $x = new TApplicationException();
+ $x->read($self->{input});
+ $self->{input}->readMessageEnd();
+ die $x;
+ }
+ my $result = new Hello_hello_result();
+ $result->read($self->{input});
+ $self->{input}->readMessageEnd();
+
+ if (defined $result->{success} ) {
+ return $result->{success};
+ }
+ die "hello failed: unknown result";
+}
+package HelloProcessor;
+
+sub new {
+ my $classname = shift;
+ my $handler = shift;
+ my $self = {};
+ $self->{handler} = $handler;
+ return bless($self,$classname);
+}
+
+sub process {
+ my $self = shift;
+ my $input = shift;
+ my $output = shift;
+ my $rseqid = 0;
+ my $fname = undef;
+ my $mtype = 0;
+
+ $input->readMessageBegin(\$fname, \$mtype, \$rseqid);
+ my $methodname = 'process_'.$fname;
+ if (!method_exists($self, $methodname)) {
+ $input->skip(TType::STRUCT);
+ $input->readMessageEnd();
+ my $x = new TApplicationException('Function '.$fname.' not implemented.', TApplicationException::UNKNOWN_METHOD);
+ $output->writeMessageBegin($fname, TMessageType::EXCEPTION, $rseqid);
+ $x->write($output);
+ $output->writeMessageEnd();
+ $output->getTransport()->flush();
+ return;
+ }
+ $self->$methodname($rseqid, $input, $output);
+ return 1;
+ }
+
+sub process_hello{
+ my $self = shift;
+ my ($seqid, $input, $output);
+ my $args = new Hello_hello_args();
+ $args->read($input);
+ $input->readMessageEnd();
+ my $result = new Hello_hello_result();
+ $result->{success} = $self->{handler}->hello($args->name);
+ $output->writeMessageBegin('hello', TMessageType::REPLY, $seqid);
+ $result->write($output);
+ $output->getTransport()->flush();
+ }
+1;
11 gen-perl/Types.pm
@@ -0,0 +1,11 @@
+#
+# Autogenerated by Thrift
+#
+# DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING
+#
+require 5.6.0;
+use strict;
+use warnings;
+use Thrift;
+
+1;
23 hello.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use lib 'gen-perl';
+
+use Thrift;
+use Thrift::BinaryProtocol;
+use Thrift::Socket;
+
+use Hello;
+
+my $transport = Thrift::Socket->new('localhost', 9090);
+my $client = HelloClient->new( Thrift::BinaryProtocol->new($transport) );
+
+eval {
+ $transport->open();
+ printf "%s\n", $client->hello("naoya");
+ $transport->close();
+};
+
+if (my $e = $@) {
+ warn $e->{message};
+}
8 hello.thrift
@@ -0,0 +1,8 @@
+#!/usr/bin/thrift
+# namespace cpp Hello
+# namespace perl Hello
+
+service Hello
+{
+ string hello(1: string name)
+}
15 lib/Thrift/BinaryProtocolFactory.pm
@@ -0,0 +1,15 @@
+## TProtoclFactory seems buggy
+package Thrift::BinaryProtocolFactory;
+use strict;
+use warnings;
+use Thrift::Protocol;
+use base qw/TProtocolFactory/;
+
+use Thrift::BinaryProtocol;
+
+sub getProtocol {
+ my ($self, $trans) = @_;
+ return Thrift::BinaryProtocol->new( $trans );
+}
+
+1;
13 lib/Thrift/BufferedTransportFactory.pm
@@ -0,0 +1,13 @@
+package Thrift::BufferedTransportFactory;
+use strict;
+use warnings;
+use base qw/Thrift::TransportFactory/;
+
+use Thrift::BufferedTransport;
+
+sub getTransport {
+ my ($self, $trans) = @_;
+ return Thrift::BufferedTransport->new($trans);
+}
+
+1;
51 lib/Thrift/ServerSocket.pm
@@ -0,0 +1,51 @@
+package Thrift::ServerSocket;
+use strict;
+use warnings;
+use base qw/Thrift::ServerTransport Class::Accessor::Fast/;
+
+__PACKAGE__->mk_accessors(qw/port handle/);
+
+use IO::Socket;
+use Thrift::Socket;
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new;
+ $self->port( shift || 9090 );
+ bless $self, $class;
+}
+
+sub listen {
+ my $self = shift;
+ $self->handle(
+ IO::Socket::INET->new(
+ LocalPort => $self->port,
+ Listen => SOMAXCONN,
+ Proto => 'tcp',
+ Reuse => 1,
+ )
+ );
+}
+
+sub accept {
+ my $self = shift;
+ if (defined $self->handle) {
+ my $sock = $self->handle->accept;
+
+ my $trans = Thrift::Socket->new;
+ $trans->setHandle( $sock );
+
+ return $trans;
+ }
+ return;
+}
+
+package Thrift::Socket;
+use IO::Select;
+
+sub setHandle {
+ my ($self, $sock) = @_;
+ $self->{handle} = IO::Select->new( $sock );
+}
+
+1;
9 lib/Thrift/ServerTransport.pm
@@ -0,0 +1,9 @@
+package Thrift::ServerTransport;
+use strict;
+use warnings;
+
+sub listen { die "interface" }
+sub accept { die "interface" }
+sub close { die "interface" }
+
+1;
47 lib/Thrift/SimpleServer.pm
@@ -0,0 +1,47 @@
+package Thrift::SimpleServer;
+use strict;
+use warnings;
+use base qw/Class::Accessor::Fast/;
+
+use Thrift;
+use Thrift::BinaryProtocolFactory;
+use Thrift::TransportFactory;
+
+__PACKAGE__->mk_accessors(qw/processor serverTransport transportFactory protocolFactory/);
+
+sub new {
+ my ($class, @args) = @_;
+ my $self = $class->SUPER::new;
+
+ $self->processor ( $args[0] );
+ $self->serverTransport ( $args[1] );
+ $self->transportFactory( $args[2] || Thrift::TransportFactory->new );
+ $self->protocolFactory ( $args[3] || Thrift::BinaryProtocolFactory->new );
+
+ bless $self, $class;
+}
+
+sub serve {
+ my $self = shift;
+ $self->serverTransport->listen;
+ while (1) {
+ my $client = $self->serverTransport->accept or die Thrift::TException->new($!);
+ my $trans = $self->transportFactory->getTransport($client);
+ my $prot = $self->protocolFactory->getProtocol($trans);
+
+ eval {
+ while (1) { $self->processor->process( $prot, $prot ) }
+ };
+ if (my $e = $@) {
+ ## NOTE: These exceptions are not implemented yet.
+ if ($e->isa('Thrift::TTransportException') or $e->isa('Thrift::TProtocolException')) {
+ warn $e->{message};
+ } else {
+ $trans->close;
+ }
+ }
+ }
+ $self->serverTransport->close;
+}
+
+1;
12 lib/Thrift/TransportFactory.pm
@@ -0,0 +1,12 @@
+package Thrift::TransportFactory;
+use strict;
+use warnings;
+
+sub new { bless {}, shift }
+
+sub getTransport {
+ my ($self, $trans) = @_;
+ return $trans;
+}
+
+1;
27 server.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use lib 'gen-perl';
+use lib 'lib';
+
+package HelloHandler;
+use Hello;
+use base qw/HelloIf/;
+
+sub new { bless {}, shift }
+
+sub hello {
+ my ($self, $name) = @_;
+ return sprintf "Hello, %s", $name;
+}
+
+package main;
+
+use Thrift::ServerSocket;
+use Thrift::SimpleServer;
+
+my $processor = HelloProcessor->new( HelloHandler->new );
+my $transport = Thrift::ServerSocket->new(9090);
+
+my $server = Thrift::SimpleServer->new( $processor, $transport );
+$server->serve;
Please sign in to comment.
Something went wrong with that request. Please try again.