[cgiapp] Stuck with Dispatch

[Jason A. Crome]

Hi all,

I'm working on my IIS subclass for CA::Dispatch, and am stuck for
reasons I am unsure of.

My subclass looks like this:

sub _parse_path {
   my ($self, $path, $table) = @_;

   # get the module name from the table
   return unless defined($path);

   unless(ref($table) eq 'ARRAY') {
       warn "[Dispatch] Invalid or no dispatch table!\n";
       return;
   }

   # Strip the script name from the start of the URL
   $path =~ s|(/[^/]+)||;

   # look at each rule and stop when we get a match
   for(my $i = 0 ; $i < scalar(@$table) ; $i += 2) {

       my $rule = $table->[$i];

       # are we trying to dispatch based on HTTP_METHOD?
       my $http_method_regex = qr/\[([^\]]+)\]$/;
       if($rule =~ /$http_method_regex/) {
           my $http_method = $1;

           # go ahead to the next rule
           next unless lc($1) eq lc($self->_http_method);

           # remove the method portion from the rule
           $rule =~ s/$http_method_regex//;
       }

       # make sure they start and end with a '/' to match how
PATH_INFO is formatted
       $rule = "/$rule" unless(index($rule, '/') == 0);
       $rule = "$rule/" if(substr($rule, -1) ne '/');

       my @names = ();

       # translate the rule into a regular expression, but remember
where the named args are
       # '/:foo' will become '/([^\/]*)'
       # and
       # '/:bar?' will become '/?([^\/]*)?'
       # and then remember which position it matches

       $rule =~ s{
           (^|/)                 # beginning or a /
           (:([^/\?]+)(\?)?)     # stuff in between
       }{
           push(@names, $3);
           $1 . ($4 ? '?([^/]*)?' : '([^/]*)')
       }gxe;

       # '/*/' will become '/(.*)/$' the end / is added to the end of
       # both $rule and $path elsewhere
       if($rule =~ m{/\*/$}) {
           $rule =~ s{/\*/$}{/(.*)/\$};
           push(@names, 'dispatch_url_remainder');
       }

       warn
         "[Dispatch] Trying to match '${path}' against rule
'$table->[$i]' using regex '${rule}'\n"
         if $CGI::Application::Dispatch::DEBUG;

       # if we found a match, then run with it
       if(my @values = ($path =~ m#^$rule$#)) {

           warn "[Dispatch] Matched!\n" if $CGI::Application::Dispatch::DEBUG;

           my %named_args = %{$table->[++$i]};
           @named_args{@names} = @values if @names;

           return \%named_args;
       }
   }

   return;
}

The ONLY thing I do different is strip the script name off the
beginning of the path.  I keep getting 404's though.

My instance script looks like this:

use strict;
use warnings;
use lib qw( /www/DEVNET/lib );
use CGI::Application::Dispatch::IIS;

$CGI::Application::Dispatch::DEBUG = 1;
CGI::Application::Dispatch::IIS->dispatch(
   prefix => 'DEVNET::App',
   default => 'TaxBill',
);

DEVNET::App::TaxBill does exist in /www/DEVNET/lib.

My subclass gives me the following debugging info:

[Dispatch] Trying to match '/' against rule ':app' using regex '/([^/]*)/'
[Dispatch] Trying to match '/' against rule ':app/:rm' using regex
'/([^/]*)/([^/]*)/'

Any ideas?  What am I missing?

What ideas might you all have for testing this?  Just run the existing CGI
test suite against it?

Thanks,
Jason