Have added a file you can now run
authorChris Cormack <chrisc@catalyst.net.nz>
Wed, 28 Aug 2013 02:46:11 +0000 (14:46 +1200)
committerJason Stephenson <jstephenson@mvlc.org>
Thu, 29 Aug 2013 20:17:26 +0000 (16:17 -0400)
./test_server.pl
And if you haven't edited the test config

telnet 127.0.0.1 6001

then type, it will just echo at this point

Signed-off-by: Jason Stephenson <jstephenson@mvlc.org>
lib/NCIP/Configuration.pm
lib/NCIPServer.pm
t/NCIPServer.t
t/NCIP_Configuration.t
test_server.pl [new file with mode: 0755]

index 070a2fd..4db0e5f 100644 (file)
@@ -58,10 +58,8 @@ sub find_service {
     my $portstr;
     foreach my $addr ( '', '*:', "$sockaddr:" ) {
         $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
-
-        #        Sys::Syslog::syslog( "LOG_DEBUG",
-        #            "Configuration::find_service: Trying $portstr" );
-        #        print "Configuration::find_service: Trying $portstr";
+        Sys::Syslog::syslog( "LOG_DEBUG",
+            "Configuration::find_service: Trying $portstr" );
         last if ( exists( ( $self->{listeners} )->{$portstr} ) );
     }
     return $self->{listeners}->{$portstr};
index d8928ed..de274f4 100644 (file)
@@ -1,12 +1,18 @@
 package NCIPServer;
 
+use Sys::Syslog qw(syslog);
 use Modern::Perl;
 use NCIP::Configuration;
-
+use IO::Socket::INET;
+use Socket qw(:DEFAULT :crlf);
 use base qw(Net::Server::PreFork);
 
 our $VERSION = '0.01';
 
+# This sets up the configuration
+
+my %transports = ( RAW => \&raw_transport, );
+
 sub configure_hook {
     my ($self)        = @_;
     my $server        = $self->{'server'};
@@ -19,13 +25,61 @@ sub configure_hook {
     foreach my $svc ( keys %$listeners ) {
         $server->{'port'} = $listeners->{$svc}->{'port'};
     }
+    $self->{'local_config'} = $config;
 }
 
+# Debug, remove before release
+
 sub post_configure_hook {
     my $self = shift;
     use Data::Dumper;
     print Dumper $self;
 }
 
+# this handles the actual requests
+sub process_request {
+    my $self     = shift;
+    my $sockname = getsockname(STDIN);
+    my ( $port, $sockaddr ) = sockaddr_in($sockname);
+    $sockaddr = inet_ntoa($sockaddr);
+    my $proto = $self->{server}->{client}->NS_proto();
+    $self->{'service'} =
+      $self->{'local_config'}->find_service( $sockaddr, $port, $proto );
+    if ( !defined( $self->{service} ) ) {
+        syslog( "LOG_ERR",
+            "process_request: Unknown recognized server connection: %s:%s/%s",
+            $sockaddr, $port, $proto );
+        die "process_request: Bad server connection";
+    }
+    my $transport = $transports{ $self->{service}->{transport} };
+    if ( !defined($transport) ) {
+        syslog(
+            "LOG_WARNING",
+            "Unknown transport '%s', dropping",
+            $self->{'service'}->{transport}
+        );
+        return;
+    }
+    else {
+        &$transport($self);
+    }
+}
+
+sub raw_transport {
+    my $self = shift;
+    my ($input);
+    my $service = $self->{service};
+
+    # place holder code, just echo at the moment
+    while (1) {
+        local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
+        $input = <STDIN>;
+        if ($input) {
+            print "You said $input";
+        }
+    }
+
+}
+
 1;
 __END__
index 22ca4e0..1928ff1 100644 (file)
@@ -7,9 +7,9 @@ use Test::More tests => 2;
 BEGIN { use_ok('NCIPServer') };
 
 ok(my $server = NCIPServer->new({config_dir => '../t/config_sample'}));
-use Data::Dumper;
 
-print Dumper $server;
-$server->run();
+# use Data::Dumper;
+# print Dumper $server;
 
-print Dumper $server;
+# uncomment this if you want to run the server in test mode
+# $server->run();
index e01cf56..a9ca54f 100644 (file)
@@ -17,6 +17,7 @@
 
 use strict;
 use warnings;
+use Sys::Syslog;
 
 use Test::More tests => 5;    # last test to print
 
diff --git a/test_server.pl b/test_server.pl
new file mode 100755 (executable)
index 0000000..1d30a6e
--- /dev/null
@@ -0,0 +1,29 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: test_server.pl
+#
+#        USAGE: ./test_server.pl
+#
+#  DESCRIPTION:
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Chris Cormack (rangi), chrisc@catalyst.net.nz
+# ORGANIZATION: Koha Development Team
+#      VERSION: 1.0
+#      CREATED: 28/08/13 14:12:51
+#     REVISION: ---
+#===============================================================================
+
+use strict;
+use warnings;
+
+use lib "lib";
+
+use NCIPServer;
+
+my $server = NCIPServer->new( { config_dir => 't/config_sample' } );
+$server->run();