Ransom has asked for the wisdom of the Perl Monks concerning the following question:

Hey monks,

I've got a real world problem this time. I'm attempting to implement some dynamic content things for a particular page on our internal site. We're already using CGI, Template::Toolkit, and mod_perl. I've added some CGI::Ajax to the script and have gotten some results but a very confusing problem.

I expect the function call from the first listbox to return and change a value in the 2nd listbox. Instead I get a 404 with the following URL https://netdev.andrews.edu/netman/cable/apache2?fname=get_types&args=Access&lb1=Access. The page I'm on is netman/cable/add. There's absolutely no apache2 directives handled by any of these pages. I'm not even sure why this URL is called, but the value I'm trying to return never makes it in. Can someone explain what's going on here or how to debug this? My apache logs don't help, firefox debug just says "yep, not found". I can't find anywhere in the code where this URL is generated. I'm a bit over my head in all this web technology (I didn't build this system). Where can I look next?

I've got an ungodly amount of code, most of which isn't particularly pertinent to the situation. My TT code has the onclick event and function call. The main code is where I set up Ajax and the callbacks. The specific module code sets up the initial listbox and populates the data.

My T::T code is as follows: 
[% WRAPPER wrapper.tt %]
    [% q.start_table() %]
        [% q.start_Tr() %]
            [% q.start_td() %]
                [% q.start_form(method => 'GET') %]
                
                    <select id="lb1" name="endpoint1" size="10" onclic
+k="get_types(['lb1'], 'lb2op1'); return true;">
                    <optgroup label="Endpoints">
                    [% FOREACH et IN endpoint_types %]
                        <option value = [% et.endpoint_type_name %]>[%
+ et.endpoint_type_name %]</option>
                    [% END %]
                    </optgroup>                
                    </select> 
                    
                    <select id="lb2" name="endpoint2" size="10">
                        <option id="lb2op1" value="before">before</opt
+ion>
                    </select>
                    
                    [% q.h6('Label') %]
                    [% q.textfield('label') %]
                    [% q.hidden('endpointid') %]
                    [% q.submit('Create') %]
                [% q.end_form() %]
            [% q.end_td() %]
        [% q.end_Tr() %]
    [% q.end_table() %] 
[% END %]

[download]

My main perl handler code follows: 
package Netman;

use strict;
use warnings;
use Apache2::RequestRec;
use Apache2::Const;
use CGI ':cgi-lib';
use CGI::Ajax;
use Template;

use Data::Dumper;

use Netman::Const;
use Netman::Search;
use Netman::DBI;
use Netman::Permissions;
use Netman::User;
use Netman::MAC;
use Netman::Switch;
use Netman::Room;
use Netman::IP;
use Netman::Connection;
use Netman::AccessPoint;
use Netman::Rack;
use Netman::Computer;
use Netman::PatchPanel;
use Netman::Quarantine;
use Netman::LDAP;
use Netman::NAC;
use Netman::SNMP;
use Netman::Network;
use Netman::Lease;
use Netman::VLAN;
use Netman::Bootservice;
use Netman::DNS;
use Netman::EventCode;
use Netman::Trace;

# Create a hashref to pass important stuff around in
my $base_vars = {webroot            =>    Netman::Const::WEBROOT,
                fswd                =>     Netman::Const::FSWD,       
+     
                search_groups        =>    $Netman::Const::search_grou
+ps,
                title                =>    'Network Management: '};

# Create a template object
my $tt = Template->new({INCLUDE_PATH => $base_vars->{fswd} . 'template
+s/'});

#=====================================================================
+=============================
# The function that mod_perl calls when a page is requested
sub handler    
{
    my ($r) = @_;
    
    # Set the content type
    $r->content_type('text/html');
    
    my $vars = {};
    %$vars = %$base_vars;
    
    # Get permissions
    $vars->{dns_edit} = Netman::Permissions::check_named('dns_edit');
    $vars->{eventcode_edit} = Netman::Permissions::check_named('eventc
+ode_edit');
    
    # Parse the uri
    my $uri_raw = $r->uri();
    $uri_raw =~ s/$vars->{webroot}\/*//;
    $uri_raw =~ s/\/$//;
    my @uri = split(/\//, $uri_raw);
    
    # Check to see if any params were provided
    if (scalar(@uri) > 0)
    {
        # Check to see if the module in question exists
        if (exists($Netman::Const::modules->{$uri[0]}))
        {
            # Populate the vars hash            
            $vars->{q} = CGI->new();
            $vars->{ajax} = new CGI::Ajax('get_types' => \&perl_func,
                                          'skip_header' => 1,);
            $vars->{ajax}->skip_header(1);
            $vars->{uri} = \@uri;
            $vars->{params} = Vars();
    
            # Call the module handler function
            my @return = &{$Netman::Const::modules->{$uri[0]}}($vars);
+        
            
            # If the return code was for a template
            if ($return[0] == Netman::Const::RETURN_TEMPLATE)
            {
                # If this is the cable creation page, process the temp
+late using Ajax
                if ($return[1] =~ m/cable\/create.tt/)
                {
                    print "Hello Ajax";
                    print $vars->{ajax}->build_html($vars->{q}, sub { 
+&process_ajax(@return) });
                }
                else
                {
                     # Process the template
                     print "Hello NOT Ajax";
                     $tt->process($return[1], $return[2]) || print $tt
+->error();
                }
              
                # Send back OK to apache    
                return Apache2::Const::OK;
            }
            
            # If the return code was for a redirect
            elsif ($return[0] == Netman::Const::RETURN_REDIRECT)
            {
                print $vars->{q}->redirect($vars->{webroot} . $return[
+1]);
                
                # Send back OK to apache
                return Apache2::Const::OK;
            }
            
            # If the return code was for not found 
            elsif ($return[0] == Netman::Const::RETURN_NOT_FOUND)
            {
                return Apache2::Const::NOT_FOUND;
            }
            
            # If the return code was for a forbiddon
            elsif ($return[0] == Netman::Const::RETURN_FORBIDDEN)
            {
                return Apache2::Const::FORBIDDEN;
            }
            
            # Otherwise something went wrong
            else
            {
                return Apache2::Const::SERVER_ERROR;
            }            
        }        
        
        # Otherwise return not found
        else
        {
            return Apache2::Const::NOT_FOUND;
        }
    }    
    
    # Otherwise return the homepage
    else
    {        
        # Populate the vars hash            
        $vars->{q} = CGI->new();
        
        # See if we should show the extra homepage links
        $vars->{show_links} = Netman::Permissions::permissions() & 1;
            
        # Process the template
        $tt->process('index.tt', $vars) || print $tt->error();
        
        # Send back OK to apache    
        return Apache2::Const::OK;
    }        
}

# A special subroutine to process the template and return the html to 
+CGI::Ajax
sub process_ajax
{
    my (@return) = @_; 
    my $output = '';
    $tt->process($return[1], $return[2], \$output) || print $tt->error
+();
    return $output;
}

sub perl_func
{
     my $input = shift;
     print Dumper($input);
     return $input;
}
1;

[download]

My specific module code follows: 
package Netman::Connection::Cable;

use strict;
use warnings;

use Netman::Const;
use CGI;
use CGI::Ajax;
use Data::Dumper;
use Netman::DBI::EndpointType;

# The handler func
sub handler
{
    my ($vars) = @_;
    
    # Check to see if something other than the module was in the uri
    if (exists($vars->{uri}->[1]))
    {    
        if ($vars->{uri}->[1] eq 'add')
        {            
            if (exists($vars->{params}->{endpointid}))
            {
                if (exists($vars->{params}->{label}))
                {
                    # Check to see if the provided cable label already
+ exists                
                    my $ids = Netman::DBI::Connection::Cable::ids($var
+s->{params}->{label});
                    
                    # If it doesn't create it
                    if (!$ids)
                    {                
                        $ids->{cable_id} = Netman::DBI::Connection::Ca
+ble::create($vars->{params}->{label});                    
                        $ids->{connection_id} = Netman::DBI::Connectio
+n::create('Cable', $ids->{cable_id});
                    }                
                    
                    # Add the endpoint to connection mapping
                    Netman::DBI::Connection::endpoint_to_connection_ad
+d($vars->{params}->{endpointid}, $ids->{connection_id});
                    
                    # Redirect to the cable page
                    return(Netman::Const::RETURN_REDIRECT, "/cable?cab
+leid=$ids->{cable_id}");        
                }
                else
                {
                    # Find all the cables that don't have both ends co
+nnected
                    $vars->{half_connected_cables} = Netman::Connectio
+n::connection_endpoint_count_lt('Cable', 2);                    
                
                    # Return the template
                    return(Netman::Const::RETURN_TEMPLATE, 'connection
+/cable/new.tt', $vars);
                }
            }
            else
            {
                $vars->{endpoint_types} = Netman::DBI::EndpointType::a
+ll();
                
                return(Netman::Const::RETURN_TEMPLATE, 'connection/cab
+le/create.tt', $vars);
            }        
        }
        elsif ($vars->{uri}->[1] eq 'delete')
        {
            if (exists($vars->{params}->{connectionid}) && exists($var
+s->{params}->{cableid}))
            {
                if (exists($vars->{params}->{endpointid}))
                {
                    Netman::DBI::Connection::endpoint_to_connection_de
+lete($vars->{params}->{endpointid}, $vars->{params}->{connectionid});
                    
                    # Redirect to the cable page
                    return(Netman::Const::RETURN_REDIRECT, "/cable?cab
+leid=$vars->{params}->{cableid}");    
                }
                else
                {
                    Netman::DBI::Connection::endpoint_to_connection_de
+lete('%', $vars->{params}->{connectionid});
                    
                    Netman::DBI::Connection::delete($vars->{params}->{
+connectionid});
                    
                    Netman::DBI::Connection::Cable::delete($vars->{par
+ams}->{cableid});
                    
                    $vars->{msg} = 'Cable Deleted';
                    
                    # Return the template
                    return(Netman::Const::RETURN_TEMPLATE, 'msg.tt', $
+vars);
                }    
            }
        }
        else
        {    
            return(Netman::Const::RETURN_NOT_FOUND);
        }                
    }
    else
    {    
        # If a search was requested
        if (exists($vars->{params}->{type}) && exists($vars->{params}-
+>{searchstr}))
        {
            # If no offset was provided set the offset to 0
            if (!exists($vars->{params}->{offset}) || $vars->{params}-
+>{offset} < 0)
            {
                $vars->{params}->{offset} = 0;
            }
        
            # Replace all *s with the mysql wildcard    
            $vars->{searchstr} = $vars->{params}->{searchstr};    
            $vars->{searchstr} =~ s/\*/\%/g;
            
            # Search the database
            $vars->{results} = Netman::DBI::Connection::Cable::search(
+$vars->{searchstr}, $vars->{params}->{offset});
            
            # If only one result was returned direct to that users pag
+e
            if (scalar(@{$vars->{results}}) == 1)
            {
                return(Netman::Const::RETURN_REDIRECT, "/cable?cableid
+=$vars->{results}->[0]->{cable_id}");
            }
            else
            {        
                # Do some processing on a few of the columns
                map
                {                
                    my $row = $_;
                    
                    $row->{endpoints} = Netman::Connection::connection
+_endpoints($row->{connection_id}); 
                                            
                } @{$vars->{results}};
                 
                # Return the template
                return(Netman::Const::RETURN_TEMPLATE, 'connection/cab
+le/search.tt', $vars);    
            }            
        }
        elsif (exists($vars->{params}->{cableid}))
        {    
            # Get the gen info
            $vars->{gen_info} = Netman::DBI::Connection::Cable::gen_in
+fo($vars->{params}->{cableid});
            
            # Get the endpoints
            $vars->{endpoints} = Netman::Connection::connection_endpoi
+nts($vars->{gen_info}->{connection_id});
            
            # Return the template
            return(Netman::Const::RETURN_TEMPLATE, 'connection/cable/c
+able.tt', $vars);        
        }        
        else
        {
            return(Netman::Const::RETURN_NOT_FOUND);
        }    
    }
}

# Create the connection description
sub description
{
    my ($connection_id, $connection_type_specific_id, $endpoint_id) = 
+@_;
    
    my $gen_info = Netman::DBI::Connection::Cable::gen_info($connectio
+n_type_specific_id);
    
    return($gen_info->{cable_label}, "/cable?cableid=$connection_type_
+specific_id");
}

# Return the redirect for the page to add a new connection 
sub new_redirect
{
    my ($endpoint_id) = @_;
    
    return "/cable/add?endpointid=$endpoint_id";    
}


1;

[download]
Ransom

Replies are listed 'Best First'.
Re: CGI::Ajax Template::Toolkit mod_perl question.
by dsheroh (Monsignor) on Jun 14, 2012 at 15:30 UTC
    CGI::Ajax does a lot of magic behind the scenes when you call build_html in order to make the AJAX bits work. The .../apache2 URL is likely to be coming from there - take a look at the page returned by your code and you should be able to find it in the HTML <head> in a chunk of javascript inserted by CGI::Ajax.

    As far as how to prevent it... You pretty much can't, as far as I was ever able to figure out. You'll probably need to restructure your URI space so that the URLs generated by CGI::Ajax will work and be equivalent to the "normal" URLs that you use elsewhere. (This sort of thing is one of the main reasons I don't use CGI::Ajax any more... It's wonderfully easy to use for things that fit how it wants to do things, but you're pretty much screwed when you hit a case that it doesn't Just WorkTM for.)

[reply]
[d/l]
[select]

      ajax[l].url = 'apache2?' + ajax[l].url; is in the header. I'm thinking this must be where it comes from.

      Seeing that I've only spent roughly half a day on this, I'm perfectly fine switching technologies. Do you have any recommendations in order to get some dynamic content? All I need is a selection from 1 listbox to affect the contents of a 2nd listbox... rinse repeat. Ideally I would like to do this without page refreshes since it would add up to about 6 refreshes per session.

      Thanks for your input and quick response

      Ransom
[reply]
[d/l]

      .../apache2 URL is likely to be coming from ther

      No way :) Thought it won't hurt to check, say after turning on DEBUG/JSDEBUG

[reply]

Back to Seekers of Perl Wisdom