Patch for gnatsweb.pl

[Robert Lupton the Good]

Here's a patch to help debug things (my patch.7).

It allows the user to define a callback to print debugging
information, specifically to add a "Debug" button to the gnats
menubar.  It's up to gnatsweb-site.pl what to do with this,
but I use it to print the state of the server with a callback like:

    elsif ($reason eq 'cmd')
    {
        # Handle site-specific values for 'cmd' param.
        my $cmd = shift(@args);
        if ($cmd eq 'debug') {
            if(address@hidden) {
                print_header();
                initialize();

                print "global_prefs:\n<DL>";
                foreach (sort keys %global_prefs) {
                    print "<DT>$_\n<DD>\"$global_prefs{$_}\"\n";
                }
                print "</DL>\n";

                print "db_prefs:\n<DL>";
                foreach (sort keys %db_prefs) {
                    print "<DT>$_\n<DD>\"$db_prefs{$_}\"\n";
                }
                print "</DL>\n";

                print "<PRE>";
                debug_print_all_cookies(\*STDOUT);
                print "</PRE>";
            }
            return 1;
...
        

I also changed debug_print_all_cookies() to optinally take a file
handle (the default's still STDERR so it goes to the httpd log).


                                        R



*** /u/gnats/src/Patches/gnatsweb.pl    Mon Sep 16 09:28:38 2002
--- /u/dss/cgi-bin/gnatsweb-v4.pl       Wed Sep 18 15:44:57 2002
***************
*** 3285,3290 ****
--- 3285,3292 ----
    $row2 .= qq(<td><a href="$url&cmd=logout" style="$buttonstyle">LOG 
OUT</a></td>)
          unless ($site_gnatsweb_server_auth);
    $row2 .= qq(<td><a href="$url&cmd=help" style="$buttonstyle">HELP</a></td>);
+   $row2 .= qq(<td><a href="$url&cmd=debug" 
style="$buttonstyle">DEBUG</a></td>)
+       if(cb('cmd', 'debug', 'inquire'));
    $row2 .= qq(</tr>\n);
    $row2 .= qq(</table>\n</td>\n</tr>);
  
***************
*** 4122,4140 ****
  
  sub debug_print_all_cookies
  {
    # Debug: print all our cookies into server log.
!   warn "================= all cookies ===================================\n";
    my @c;
    my $i = 0;
    foreach my $y ($q->cookie())
    {
      @c = $q->cookie($y);
!     warn "got cookie: length=", scalar(@c), ": $y =>@c<=\n";
      $i += length($y);
    }
  #  @c = $q->raw_cookie();
! #  warn "debug 0.5: @c:\n";
! #  warn "debug 0.5: total size of raw cookies: ", length("@c"), "\n";
  }
  
  # set_pref -
--- 4124,4149 ----
  
  sub debug_print_all_cookies
  {
+   my($fd) = @_;
+ 
+   if (!defined($fd))
+   {
+     $fd = \*STDERR;
+   }
+ 
    # Debug: print all our cookies into server log.
!   print $fd "================= all cookies 
===================================\n";
    my @c;
    my $i = 0;
    foreach my $y ($q->cookie())
    {
      @c = $q->cookie($y);
!     print $fd "got cookie: length=", scalar(@c), ": $y =>@c<=\n";
      $i += length($y);
    }
  #  @c = $q->raw_cookie();
! #  print $fd "debug 0.5: @c:\n";
! #  print $fd "debug 0.5: total size of raw cookies: ", length("@c"), "\n";
  }
  
  # set_pref -