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

In reply to CGI::Ajax Template::Toolkit mod_perl question. by Ransom

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.