[cgiapp] CAD::Server strangeness

[George Hartzell]

Richard Jones writes:
 > Using CGI::Application::Dispatch::Server, I'm getting a weird phenomenon 
 > occurring:
 > 
 > my $server = CGI::Application::Dispatch::Server->new(
 >      class    => 'MyWebApp::Dispatch',
 >      root_dir => '/path/to/htdocs',
 > );
 > 
 > $server->run;
 > 
 > Server starts OK. But with debug set I get the following console output 
 > with every request:
 > 
 > [Dispatch] Final args to pass to new(): $VAR1 = {
 >      'TMPL_PATH' => [
 >          '/path/to/templates',
 >          '/path/to/templates',
 >          '/path/to/templates',
 >          '/path/to/templates',
 >          '/path/to/templates',
 >          '/path/to/templates',
 >      ],
 >      'PARAMS' => {
 >          foo => 'bar, etc,
 >      },
 > },
 > 
 > This '/path/to/templates' output can be repeated over a few lines only, 
 > or indefinitely until I kill & re-start the server. It also hammers 
 > system resources. No web content appears until the repeating output 
 > stops and '[Dispatch] creating instance of MyWebApp::Foo' appears.
 > 
 > My dispatch_args are pretty standard:
 > {
 >      prefix  => 'MyWebApp',
 >      default => 'foo',
 >      debug => 1,
 >      args_to_new => {
 >         PARAMS => {
 >              cfg_file => 'path/to/config.pl',
 >         },
 >         TMPL_PATH => [ 'path/to/templates' ], # tried as scalar as well
 >      },
 >      table   => [
 >          :app/:rm' => {  }, etc,
 >      ],
 > }
 > 
 > It's only ever the TMPL_PATH content that gets repeated, never PARAMS. 
 > And it's not a potential error in the table arrayref as I can configure 
 > dispatch_args with no table entry, and the problem's still there.
 > 
 > Has anyone seen this before, or any idea what's causing it?

Can you provide a simplified test case that shows this behaviour, or
share a copy of the app with me to walk into?

That output's being generated by CGI::Application::Dispatch, which is
calling Data::Dumper:Dumper on the $args that are about to be passed
to new().

It'd be interested to fire the server up under the perl debugger,
break at that line, and see what's up with $args.

The stock stand alone server that CAP::D::Server uses doesn't do IO
redirection right, in that you can't fire it up under the debugger and
have things work (either you get the web page sent to your screen or
your debugging output goes to the remote browser, depending on a
variety of stuff).  I've sent patches to the author but haven't had
any luck getting them included.  If you're up for patching
HTTP::Server::Simple.pm yourself, find the section of _default_run
where there are two lines that redirect stdin and stdout, and replace
them with something like this, which stashes the old values, sets up
to send the reply to the client, the reinstalls the old values
(apologies for what email will probably do to this hunk of diff
output):

   --- 262,305 ----
                     $self->accept_hook if $self->can("accept_hook");
     
     
   !                 # be more rigorous about how we hook the socket up to stdio,
   !                 # so that things work in the perl debugger.  
   !               # 
   !                 # *STDIN  = $self->stdin_handle();
   !                 # *STDOUT = $self->stdout_handle();
   ! 
   !               my $saved_stdin;
   !               my $saved_stdout;
   !               open( $saved_stdin, '<&', STDIN->fileno() ) or
   !                 die "Can't save original stdin: $!";
   !               close STDIN;
   !               open( STDIN, '<&', $self->stdin_handle() ) or
   !                 die "Can't dup stdin: $!";
   ! 
   !               open( $saved_stdout, '>&', STDOUT->fileno() ) or
   !                   die "Can't save original stdout: $!";
   !                 close STDOUT;
   !                 open( STDOUT, '>&', $self->stdout_handle() ) or
   !                   die "Can't dup stdout: $!";
   ! 
                     select STDOUT;   # required for HTTP::Server::Simple::Recorder
                                      # XXX TODO glasser: why?
   + 
                     $pkg->process_request;
   + 
   +                 close STDIN;
   +                 open( STDIN, "<&", $saved_stdin) or
   +                   die "Can't restore stdin:$!";
   +                 close STDOUT;
   +                 open( STDOUT, ">&", $saved_stdout) or
   +                   die "Can't restore stdout:$!";
   + 
                     close $remote;
                 }
             }
         };
     }
     
     sub _process_request {
         my $self = shift;
   

Thanks,

g.