#!/usr/bin/perl -wT
#####################################
# This script demonstrates a AJAX based popup window
use strict;
use CGI::Minimal;
use CGI::Ajax;
# main execution block
{
# $output is the output of the CGI script, ready for sending
# to the web browser
my $output = eval {
my $cgi = CGI::Minimal->new;
# A dispatch table makes it easy to add new branches
# to the program functionality without having to
# have endless 'if..ifelse..ifelse..else' clauses
my %dispatch_table = (
'show_page' => \&show_page,
'ajax' => \&ajax_request,
);
my $default_action = 'show_page';
my $action = $cgi->param('action');
$action = defined($action) ? $action : $default_action;
my $action_call = $dispatch_table{$action};
my $script_output = format_output(defined($action_call) ? &$action_call(cgi => $cgi) : bad_call(cgi => $cgi));
return $script_output;
};
# Ordinary 'the program blew up' errors
if ($@) {
$output = "Status: 500 Server Error\015\012Content-Type: text/plain\015\012\015\012Fatal Script Error: $@\n";
# Unusual 'the program just didn't output anything' errors
} elsif ((! defined $output) || ($output eq '')) {
$output = "Status: 500 Server Error\015\012Content-Type: text/plain\015\012\015\012Script Error: No output generated by script.\n";
}
print $output;
}
################################################
# ajax_request( cgi => $cgi_object );
#
# handle ajax requests
#
# We expect to find a 'content' CGI parameter that specifies
# what AJAX request has been made.
sub ajax_request {
my %args = @_;
my ($cgi) = $args{'cgi'};
my $ajax_request = $cgi->param('content');
my $default_request = 'bad_call';
$ajax_request = defined($ajax_request) ? $ajax_request : $default_request;
my %ajax_dispatch = (
'bad_call' => \&bad_ajax_call,
'example1' => \&ajax_example1,
'example2' => \&ajax_example2,
);
my $ajax_call = $ajax_dispatch{$ajax_request};
my $script_output = format_output(defined($ajax_call) ? &$ajax_call(cgi => $cgi) : bad_ajax_call(cgi => $cgi));
return $script_output;
}
#################################################
# ajax_example1( cgi => $cgi );
#
# Load up our #1 example AJAX response
sub ajax_example1 {
my %args = @_;
my ($cgi) = $args{'cgi'}; # Not actually used, but here for API consistency.
my $response =<<"EOT";
Content-Type: text/plain; charset=utf-8
Example 1 Popup data
EOT
}
#################################################
# ajax_example2( cgi => $cgi );
#
# Load up our #2 example AJAX response
sub ajax_example2 {
my %args = @_;
my ($cgi) = $args{'cgi'}; # Not actually used, but here for API consistency.
my $response =<<"EOT";
Content-Type: text/plain; charset=utf-8
Example 2 Popup data
EOT
}
#################################################
# bad_ajax_call( cgi => $cgi )
#
# Load our 'bad' ajax response
sub bad_ajax_call {
my %args = @_;
my ($cgi) = $args{'cgi'}; # Not actually used, but here for API consistency.
my $response =<<"EOT";
Content-Type: text/plain; charset=utf-8
BAD AJAX CALL. Didn't find expected CGI parameters.
EOT
}
#################################################
# format_output($output_text)
#
# Processes the text we are about to send to the browser
# to ensure it has a Status: header, a Content-Length:
# header as necessary and uses CRLF convention for
# headers EOL.
#
# Adds a 'Status: 200 OK' header (if there isn't a CGI
# Status header already), adds a Content-Length header,
# and ensures that we are compliant to the internet EOL
# convention of \015\012 for the headers
#
# This gives us both CGI and ModPerl compatibility
sub format_output {
my ($source_output) = @_;
my ($headers, $break, $body) = $source_output =~ m/^(.+?)(\015\012\015\012|\012\012|\015\015)(.*)$/s;
unless (defined $break) {
$headers = "Content-Type: text/plain; charset=utf-8";
$body = "Script Error: Unable to identify HTTP headers and body of output? Something is wrong....:\n$source_output";
}
my @header_lines = split(/[\015\012]+/,$headers);
unless (grep(/^Status: /i, @header_lines)) {
unshift(@header_lines, 'Status: 200 OK');
}
my $content_length = length($body);
push(@header_lines, "Content-Length: $content_length");
my $output = join("\015\012",@header_lines,'',$body);
return $output;
}
#################################################
# show_page( cgi=> $cgi [, results => $results] [, errors => $errors ])
#
# cgi - the CGI object (CGI, CGI::Minimal or other broker with a 'param' method)
# results - a text fragment to be inserted for the [% results %] macro (optional)
# errors - a text fragment to be inserted for the [% errors %] macro (optional)
#
# Shows the base HTML page (along with any errors or other messages)
sub show_page {
my %args = @_;
my ($cgi, $results, $errors) = @args{'cgi','results','errors'};
$results = defined($results) ? $results : '';
$errors = defined($errors) ? $errors : '';
my $pajax= CGI::Ajax->new( 'load_ajax_popup_content' => script_url());
my $ajax_js = $pajax->show_javascript();
my $substitutions = {
'errors' => $errors,
'results' => $results,
'ajax_js' => $ajax_js,
'popups_js' => popups_js(),
'ajax_popup' => ajax_popup(),
'script_name' => script_name(),
};
my $output = macro_sub( 'text' => basic_page(), 'subs' => $substitutions);
return $output;
}
#################################################
# macro_sub(text => $text, subs => { 'key' => value, ... })
#
# text - the text template
# subs - an anon hash of key/values for substitution
#
# performs macro substitution on passed text
# it looks for strings matching [% macro_name %]
# and replaces them with the corresponding hash values from
# the anon hash
sub macro_sub {
my %args = @_;
my ($text, $subs) = @args{'text','subs'};
my @sub_keys = sort keys %$subs;
my $sub_re = '\[\%\s*' . '(' . join('|', @sub_keys) . ')\s*\%\]';
$text =~ s/$sub_re/defined($subs->{$1}) ? $subs->{$1} : $1/egs;
return $text;
}
#################################################
# The code used to show and hide the hovering popup
#
# This javascript chunk performs the actual showing and
# hiding of the popup. The AJAX portion
# is handled by the Javascript generated
# by CGI::Ajax
sub popups_js {
my $script_name = script_name();
my $js_text =<<"EOT";
EOT
return $js_text;
}
#################################################
# We got a request we don't know how to handle.
sub bad_call {
my %args = @_;
my ($cgi) = $args{'cgi'};
my $errors =<<"EOT";
Something isn't right, the script was called with an 'action' it does not understand.
EOT
return show_page(cgi => $cgi, results => '', errors => $errors);
}
################################################
# The HTML fragment used for the popups
sub ajax_popup {
my $ajax_popup_text =<<"EOT";
EOT
return $ajax_popup_text;
}
################################################
# The page template
#
sub basic_page {
my $template =<<"EOT";
Content-Type: text/html; charset=utf-8
Ajaxy example
[% ajax_js %]
[% popups_js %]
Example Page
[% errors %]
[% results %]
[% ajax_popup %]
EOT
}
################################################
# the html ready script name
sub script_name { return CGI::Minimal->htmlize($ENV{'SCRIPT_NAME'}); }
##################################################
# The complete script URL
sub script_url {
my $script_name = script_name();
my $script_host = CGI::Minimal->htmlize($ENV{'HTTP_HOST'});
my $script_url = "http://$script_host$script_name";
return $script_name;
}