Debugging mod_perl with ptkdb

[John Williams]

I followed the advice on the mod_perl guide to try setting up remote
debugging of mod_perl with ptkdb, and I've been trying to solve the
remaining problems.

http://perl.apache.org/docs/1.0/guide/debug.html#ptkdb_and_Interactive_mod_perl_Debugging

I now have ptkdb working in Apache multi-server mode without -X (-X works
too), popping up a new ptkdb window on the remote host for each request.

This required patches to both Apache::DB and Devel::ptkdb.

Devel::ptkdb-1.1086 had a line which prevented the window from appearing
unless the filename matched $0. Since $0 is "httpd" under Apache, it never
matched.  I also added some code to emit a warning and continue running
without the window if the connection to the X server is refused.

For Apache::DB I added a new method handler for ptkdb, since the handler
turned out almost completely different from the one for the default
debugger.

Patches attached for Devel::ptkdb-1.1086 and Apache::DB-0.06.

~ John Williams

--- ptkdb.pm    2003/07/23 17:05:20     1.1
+++ ptkdb.pm    2003/07/23 17:51:09
@@ -1105,8 +1105,21 @@
 
   # Main Window
   
-
+eval {
   $self->{main_window} = MainWindow->new() ;
+};
+if ($@) {
+  my $err = $@;
+  my $r = eval { Apache->request };  # check if running under mod_perl
+  undef $@;
+  if ($r && $err =~ m/Xlib: connection .*? refused|Xlib: Client is not 
authorized|couldn't connect to display/) {
+       $DB::connection_refused = 1;
+       $self->{main_window} = undef;
+       warn($err);  # log the problem
+        return;
+  } 
+  die $err;
+}
   $self->{main_window}->geometry($ENV{'PTKDB_GEOMETRY'} || "800x600") ;
 
   $self->setup_options() ; # must be done after MainWindow and before other frames 
are setup
@@ -1237,8 +1250,9 @@
 
   $DB::window->{'event'} = 'run' ;
   $self->{current_file} = "" ; # force a file reset
-  $self->{'main_window'}->destroy ;
+  $self->{'main_window'}->destroy if $self->{'main_window'};
   $self->{'main_window'} = undef ;
+  $DB::connection_refused = undef;  # allow another try
 }
 
 sub setup_menu_bar {
@@ -4048,7 +4062,12 @@
 
     $^W = $saveW ;
    unless( $DB::ptkdb::isInitialized ) {
-     return if( $filename ne $0 ) ; # not in our target file
+     if ( $filename ne $0 ) { # not in our target file
+        # check if running under mod_perl
+       my $r = eval { Apache->request };
+       undef $@;
+       return unless $r;
+     }
      &DB::Initialize($filename) ;
    }
 
@@ -4063,6 +4082,11 @@
      return ;
    }
 
+   if ( $DB::connection_refused ) {  # X to remote host failed
+     $@ = $DB::save_err ;
+     return ;
+   }
+
  $DB::window->setup_main_window() unless $DB::window->{'main_window'} ;
 
  $DB::window->EnterActions() ; 

--- DB.pm       2003/07/23 16:59:07     1.1
+++ DB.pm       2003/07/23 17:03:29
@@ -39,6 +39,34 @@
     return 0;
 }
 
+
+sub ptkdb ($$) {
+    my ($class,$r) = @_;
+
+    init();
+
+    # need to have a list of authorized remote hosts
+    $ENV{DISPLAY} = $r->get_remote_host.':0.0';
+    $DB::connection_refused = 0;  # try try again
+    require 'Devel/ptkdb.pm';
+    $DB::single = 1;
+# bug workaround?  Pressing "Return" button at toplevel makes ptkdb hang.
+    $DB::subroutine_depth = 0 ;
+    $DB::step_over_depth = -1 ;
+
+    if (ref $r) {
+        $SIG{INT} = \&DB::dbint_handler;
+        $r->register_cleanup(sub {
+            $SIG{INT} = \&DB::ApacheSIGINT();
+            $DB::single = 0; # do not debug during withdraw
+            $DB::window->close_ptkdb_window;
+        });
+    }
+
+    return 0;
+}
+
+
 1;
 __END__
 
@@ -93,6 +121,18 @@
   SetHandler perl-script
   PerlHandler My::handler
  </Location>
+
+=item ptkdb
+
+This is an Apache Method Handler which will start the ptkdb graphical debugger.
+Devel::ptkdb and Tk modules are expected to be installed.
+Example configuration:
+
+ <Location /my-handler>
+  PerlFixupHandler Apache::DB->ptkdb
+  SetHandler perl-script
+  PerlHandler My::handler
+ </Location>
 
 =back