Add support for GFS start handler

The start handler allows Perl to interpret the GFS opaque config
file - given by option -c.

diff --git a/SimpleServer.pm b/SimpleServer.pm
index e0cfda4..6e8841a 100644 (file)
--- a/SimpleServer.pm
+++ b/SimpleServer.pm
@@ -96,7 +96,9 @@ sub launch_server {
        if (defined($self->{DELETE})) {
                set_delete_handler($self->{DELETE});
        }
-
+       if (defined($self->{START})) {
+               set_start_handler($self->{START});
+       }
        start_server(@args);
 }
 
@@ -242,6 +244,7 @@ environments) whenever a new connection is received.
 The programmer can specify subroutines to take care of the following type
 of events:
 
+  - Start service (called once).
   - Initialize request
   - Search request
   - Present request
@@ -264,6 +267,7 @@ The Perl programmer specifies the event handlers for the server by
 means of the SimpleServer object constructor
 
   my $z = new Net::Z3950::SimpleServer(
+                        START   =>      \&my_start_handler,
                        INIT    =>      \&my_init_handler,
                        CLOSE   =>      \&my_close_handler,
                        SEARCH  =>      \&my_search_handler,
@@ -307,6 +311,23 @@ application invocation: <http://indexdata.com/yaz/doc/server.invocation.tkl>
 In particular, you need to use the -T switch to start your SimpleServer
 in threaded mode.
 
+=head2 Start handler
+
+The start handler is called when service is started. The argument hash
+passed to the start handler has the form
+
+  $args = {
+            CONFIG =>  "default-config" ## GFS config (as given by -c)
+         };
+
+
+The purpose of the start handler is to read the configuration file
+for the Generic Frontend Server . This is specified by option -c.
+If -c is omitted, the configuration file is set to "default-config".
+
+The start handler is optional. It is supported in Simpleserver 1.16 and
+later.
+
 =head2 Init handler
 
 The init handler is called whenever a Z39.50 client is attempting

diff --git a/SimpleServer.xs b/SimpleServer.xs
index 93546f2..004a8a0 100644 (file)
--- a/SimpleServer.xs
+++ b/SimpleServer.xs
@@ -89,6 +89,7 @@ SV *esrequest_ref = NULL;
 SV *delete_ref = NULL;
 SV *scan_ref = NULL;
 SV *explain_ref = NULL;
+SV *start_ref = NULL;
 PerlInterpreter *root_perl_context;
 
 #define GRS_BUF_SIZE 8192
@@ -1799,6 +1800,41 @@ void bend_close(void *handle)
        return;
 }
 
+static void start_stop(struct statserv_options_block *sob, SV *handler_ref)
+{
+       HV *href;
+       dSP;
+       ENTER;
+       SAVETMPS;
+
+       href = newHV();
+       hv_store(href, "CONFIG", 6, newSVpv(sob->configname, 0), 0);
+
+       PUSHMARK(sp);
+
+       XPUSHs(sv_2mortal(newRV((SV*) href)));
+
+       PUTBACK;
+
+       if (handler_ref != NULL)
+       {
+               CV* handler_cv = simpleserver_sv2cv( handler_ref );
+               perl_call_sv( (SV *) handler_cv, G_SCALAR | G_DISCARD);
+       }
+
+       SPAGAIN;
+
+       PUTBACK;
+       FREETMPS;
+       LEAVE;
+
+
+}
+
+void bend_start(struct statserv_options_block *sob)
+{
+       start_stop(sob, start_ref);
+}
 
 MODULE = Net::Z3950::SimpleServer      PACKAGE = Net::Z3950::SimpleServer
 
@@ -1879,6 +1915,12 @@ set_explain_handler(arg)
        CODE:
                explain_ref = newSVsv(arg);
 
+void
+set_start_handler(arg)
+               SV *arg
+       CODE:
+               start_ref = newSVsv(arg);
+
 int
 start_server(...)
        PREINIT:
@@ -1887,6 +1929,7 @@ start_server(...)
                char *ptr;
                int i;
                STRLEN len;
+               struct statserv_options_block *sob;
        CODE:
                argv_buf = (char **)xmalloc((items + 1) * sizeof(char *));
                argv = argv_buf;
@@ -1897,13 +1940,18 @@ start_server(...)
                        strcpy(*argv_buf++, ptr); 
                }
                *argv_buf = NULL;
+
+               sob = statserv_getcontrol();
+               sob->bend_start = bend_start;
+               statserv_setcontrol(sob);
+
                root_perl_context = PERL_GET_CONTEXT;
                yaz_mutex_create(&simpleserver_mutex);
 #if 0
                /* only for debugging perl_clone .. */
                tst_clones();
 #endif
-               
+
                RETVAL = statserv_main(items, argv, bend_init, bend_close);
        OUTPUT:
                RETVAL

diff --git a/ztest.pl b/ztest.pl
index 9ecb4d9..473e380 100755 (executable)
--- a/ztest.pl
+++ b/ztest.pl
@@ -169,9 +169,15 @@ sub my_fetch_handler {
        }
 }
 
+sub my_start_handler {
+    my $args = shift;
+    my $config = $args->{CONFIG};
+}
+
 Net::Z3950::SimpleServer::yazlog("hello");
 
 my $handler = new Net::Z3950::SimpleServer( 
+                START   =>      "main::my_start_handler",
                INIT    =>      "main::my_init_handler",
                SEARCH  =>      "main::my_search_handler",
                SCAN    =>      "main::my_scan_handler",