#!/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

<div style="border-style: solid; background: #ccffcc; margin: 2px 2px; padding: 5px 5px;">Example 1 Popup data</div>

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

<div style="border-style: solid; background: #cccccff; margin: 2px 2px; padding: 5px 5px;">Example 2 Popup data</div>

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";
<script type="text/javascript" language="Javascript">
//<![CDATA[
/**
  Functions for supporting a popup text box
*/


// Tracks whether the popup is live
var textPopupInUse = 0;

// This is the ID of the block we are going to use for the popup
var ajaxTargetId   = 'ajax_popup_placeholder_field';

/**
  showTextPopup( text_id, event, color, element_width )

      text_id       - the ID of the block we are going to put in the popup
      event         - the Javascript event (onmousein in this case)
      color         - the color to be assigned to the enclosing div
      element_width - the width for the enclosing div
 */
function showTextPopup( text_id, event, color, element_width ){
    var x, y;
    if( event.x ){ // IE
            x = event.x + document.body.scrollLeft;
            y = event.y + document.body.scrollTop;
    } else { // Mozilla
            x = event.pageX;
            y = event.pageY;
    }

    var textPopup      = document.getElementById( text_id );
    var d_style        = textPopup.style;
    d_style.left       = x + 5;
    d_style.top        = y + 10;
    d_style.width      = element_width;
    d_style.wordWrap   = "normal";
    if (color != '') {
        d_style.background = color;
    }
    d_style.visibility  = "visible";
    textPopupInUse      = 1;
}


/**
  closeTextPopup( delay )
  
      delay       - number of milliseconds to wait before closing the
                    popup after the close event is requested
*/
function closeTextPopup(ajaxTargetId, delay ){
    textPopupInUse = 0;
    setTimeout( 'realCloseTextPopup(ajaxTargetId)', delay );
}

/**
  realCloseTextPopup(textPopupId)
  
  textPopupId       - The ID of the popup block
  
  Really closes the popup
*/
function realCloseTextPopup(textPopupId){
    if( textPopupInUse == 1 ) return;
    document.getElementById( textPopupId ).style.visibility = "hidden";
}

/**
  show_ajax_popup( event, ajaxParms, backgroundColor, boxWidth)

       event           - the event object
       ajaxParms       - CGI parameters for the AJAX call (['key1__value1','key2__value2', etc])
       backgroundColor - A background color for the popup block
       boxWidth        - the width of the popup block
*/
function show_ajax_popup (event,  ajaxParms, backgroundColor, boxWidth) {
    load_ajax_popup_content(ajaxParms, ajaxTargetId, 'GET');
    showTextPopup(ajaxTargetId, event, backgroundColor, boxWidth);
}

/**
   hide_ajax_popup(delay)
   
        delay - number of milliseconds to wait before actually closing the popup block
*/
function hide_ajax_popup (delay) {
    closeTextPopup(ajaxTargetId, delay);
}
//]]>
</script>
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";
 <p>Something isn't right, the script was called with an 'action' it does not understand.</p>
EOT
    return show_page(cgi => $cgi, results => '', errors => $errors);
}

################################################
# The HTML fragment used for the popups
sub ajax_popup {
    my $ajax_popup_text =<<"EOT";
<div id="ajax_popup_placeholder_field"
  style='cursor: hand; visibility: hidden; position: absolute; z-index: 100; text-align: left;'></div>
EOT
  return $ajax_popup_text;
}

################################################
# The page template
#
sub basic_page {
    my $template =<<"EOT";
Content-Type: text/html; charset=utf-8

<html>
    <head>
        <title>Ajaxy example</title>
        [% ajax_js %]
        [% popups_js %]
    </head>
    <body>
       
        <h1>Example Page</h1>
        [% errors %]
        [% results %]
        <ul>
          <li>
            <a href="http://nihongo.org/" target="_top" 
               onMouseOver="javascript:show_ajax_popup(event, ['action__ajax','content__example1'],'#ffcccc','40%');"
               onMouseOut="javascript:hide_ajax_popup(3000);">Example 1</a>
          </li>
          <li>
            <a href="http://devilbunnies.org/" target="_top" 
               onMouseOver="javascript:show_ajax_popup(event, ['action__ajax','content__example2'],'#ffcccc','40%');"
               onMouseOut="javascript:hide_ajax_popup(3000);">Example 2</a>
          </li>
        </ul>
        [% ajax_popup %]
    </body>
</html>
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;
}