modules/override/CGI/Ajax.pm

   1 package CGI::Ajax;
   2 use strict;
   3 use Data::Dumper;
   4 use base qw(Class::Accessor);
   5 use overload '""' => 'show_javascript'; # for building web pages, so
   6                                         # you can just say: print $pjx
   7 BEGIN {
   8         use vars qw ($VERSION @ISA @METHODS);
   9         @METHODS = qw(url_list coderef_list DEBUG JSDEBUG html
  10                                                                 js_encode_function cgi_header_extra);
  11
  12         CGI::Ajax->mk_accessors( @METHODS );
  13
  14         $VERSION     = .697;
  15 }
  16
  17 ########################################### main pod documentation begin ##
  18
  19 =head1 NAME
  20
  21 CGI::Ajax - a perl-specific system for writing Asynchronous web
  22 applications
  23
  24 =head1 SYNOPSIS
  25
  26   use strict;
  27   use CGI;      # or any other CGI:: form handler/decoder
  28   use CGI::Ajax;
  29
  30   my $cgi = new CGI;
  31   my $pjx = new CGI::Ajax( 'exported_func' => \&perl_func );
  32
  33   print $pjx->build_html( $cgi, \&Show_HTML);
  34
  35   sub perl_func {
  36     my $input = shift;
  37     # do something with $input
  38     my $output = $input . " was the input!";
  39     return( $output );
  40   }
  41
  42   sub Show_HTML {
  43     my $html = <<EOHTML;
  44     <HTML>
  45     <BODY>
  46       Enter something:
  47         <input type="text" name="val1" id="val1"
  48          onkeyup="exported_func( ['val1'], ['resultdiv'] );">
  49       <br>
  50       <div id="resultdiv"></div>
  51     </BODY>
  52     </HTML>
  53   EOHTML
  54     return $html;
  55   }
  56
  57 I<There are several fully-functional examples in the 'scripts/'
  58 directory of the distribution.>
  59
  60 =head1 DESCRIPTION
  61
  62 CGI::Ajax is an object-oriented module that provides a unique
  63 mechanism for using perl code asynchronously from javascript-
  64 enhanced HTML pages.  CGI::Ajax unburdens the user from having to
  65 write extensive javascript, except for associating an exported
  66 method with a document-defined event (such as onClick, onKeyUp,
  67 etc).  CGI::Ajax also mixes well with HTML containing more complex
  68 javascript.
  69
  70 CGI::Ajax supports methods that return single results or multiple
  71 results to the web page, and supports returning values to multiple
  72 DIV elements on the HTML page.
  73
  74 Using CGI::Ajax, the URL for the HTTP GET/POST request is
  75 automatically generated based on HTML layout and events, and the
  76 page is then dynamically updated with the output from the perl
  77 function.  Additionally, CGI::Ajax supports mapping URL's to a
  78 CGI::Ajax function name, so you can separate your code processing
  79 over multiple scripts.
  80
  81 Other than using the Class::Accessor module to generate CGI::Ajax'
  82 accessor methods, CGI::Ajax is completely self-contained - it
  83 does not require you to install a larger package or a full Content
  84 Management System, etc.
  85
  86 We have added I<support> for other CGI handler/decoder modules,
  87 like L<CGI::Simple> or L<CGI::Minimal>, but we can't test these
  88 since we run mod_perl2 only here.  CGI::Ajax checks to see if a
  89 header() method is available to the CGI object, and then uses it.
  90 If method() isn't available, it creates it's own minimal header.
  91
  92 A primary goal of CGI::Ajax is to keep the module streamlined and
  93 maximally flexible.  We are trying to keep the generated javascript
  94 code to a minimum, but still provide users with a variety of
  95 methods for deploying CGI::Ajax. And VERY little user javascript.
  96
  97 =head1 EXAMPLES
  98
  99 The CGI::Ajax module allows a Perl subroutine to be called
 100 asynchronously, when triggered from a javascript event on the
 101 HTML page.  To do this, the subroutine must be I<registered>,
 102 usually done during:
 103
 104   my $pjx = new CGI::Ajax( 'JSFUNC' => \&PERLFUNC );
 105
 106 This maps a perl subroutine (PERLFUNC) to an automatically
 107 generated Javascript function (JSFUNC).  Next you setup a trigger this
 108 function when an event occurs (e.g. "onClick"):
 109
 110   onClick="JSFUNC(['source1','source2'], ['dest1','dest2']);"
 111
 112 where 'source1', 'dest1', 'source2', 'dest2' are the DIV ids of
 113 HTML elements in your page...
 114
 115   <input type=text id=source1>
 116   <input type=text id=source2>
 117   <div id=dest1></div>
 118   <div id=dest2></div>
 119
 120 L<CGI::Ajax> sends the values from source1 and source2 to your
 121 Perl subroutine and returns the results to dest1 and dest2.
 122
 123 =head2 4 Usage Methods
 124
 125 =over 4
 126
 127 =item 1 Standard CGI::Ajax example
 128
 129 Start by defining a perl subroutine that you want available from
 130 javascript.  In this case we'll define a subrouting that determines
 131 whether or not an input is odd, even, or not a number (NaN):
 132
 133   use strict;
 134   use CGI::Ajax;
 135   use CGI;
 136
 137
 138   sub evenodd_func {
 139     my $input = shift;
 140
 141     # see if input is defined
 142     if ( not defined $input ) {
 143       return("input not defined or NaN");
 144     }
 145
 146     # see if value is a number (*thanks Randall!*)
 147     if ( $input !~ /\A\d+\z/ ) {
 148       return("input is NaN");
 149     }
 150
 151     # got a number, so mod by 2
 152     $input % 2 == 0 ? return("EVEN") : return("ODD");
 153   }
 154
 155 Alternatively, we could have used coderefs to associate an
 156 exported name...
 157
 158   my $evenodd_func = sub {
 159     # exactly the same as in the above subroutine
 160   };
 161
 162 Next we define a function to generate the web page - this can
 163 be done many different ways, and can also be defined as an
 164 anonymous sub.  The only requirement is that the sub send back
 165 the html of the page.  You can do this via a string containing the
 166 html, or from a coderef that returns the html, or from a function
 167 (as shown here)...
 168
 169   sub Show_HTML {
 170     my $html = <<EOT;
 171   <HTML>
 172   <HEAD><title>CGI::Ajax Example</title>
 173   </HEAD>
 174   <BODY>
 175     Enter a number:&nbsp;
 176     <input type="text" name="somename" id="val1" size="6"
 177        OnKeyUp="evenodd( ['val1'], ['resultdiv'] );">
 178     <br>
 179     <hr>
 180     <div id="resultdiv">
 181     </div>
 182   </BODY>
 183   </HTML>
 184 EOT
 185     return $html;
 186   }
 187
 188 The exported Perl subrouting is triggered using the C<OnKeyUp>
 189 event handler of the input HTML element.  The subroutine takes one
 190 value from the form, the input element B<'val1'>, and returns the
 191 the result to an HTML div element with an id of B<'resultdiv'>.
 192 Sending in the input id in an array format is required to support
 193 multiple inputs, and similarly, to output multiple the results,
 194 you can use an array for the output divs, but this isn't mandatory -
 195 as will be explained in the B<Advanced> usage.
 196
 197 Now create a CGI object and a CGI::Ajax object, associating a reference
 198 to our subroutine with the name we want available to javascript.
 199
 200   my $cgi = new CGI();
 201   my $pjx = new CGI::Ajax( 'evenodd' => \&evenodd_func );
 202
 203 And if we used a coderef, it would look like this...
 204
 205   my $pjx = new CGI::Ajax( 'evenodd' => $evenodd_func );
 206
 207 Now we're ready to print the output page; we send in the cgi
 208 object and the HTML-generating function.
 209
 210   print $pjx->build_html($cgi,\&Show_HTML);
 211
 212 CGI::Ajax has support for passing in extra HTML header information
 213 to the CGI object.  This can be accomplished by adding a third
 214 argument to the build_html() call.  The argument needs to be a
 215 hashref containing Key=>value pairs that CGI objects understand:
 216
 217   print $pjx->build_html($cgi,\&Show_HTML,
 218     {-charset=>'UTF-8, -expires=>'-1d'});
 219
 220 See L<CGI> for more header() method options.
 221
 222 That's it for the CGI::Ajax standard method.  Let's look at
 223 something more advanced.
 224
 225 =item 2 Advanced CGI::Ajax example
 226
 227 Let's say we wanted to have a perl subroutine process multiple
 228 values from the HTML page, and similarly return multiple values
 229 back to distinct divs on the page.  This is easy to do, and
 230 requires no changes to the perl code - you just create it as you
 231 would any perl subroutine that works with multiple input values
 232 and returns multiple values.  The significant change happens in
 233 the event handler javascript in the HTML...
 234
 235   onClick="exported_func(['input1','input2'],['result1','result2']);"
 236
 237 Here we associate our javascript function ("exported_func") with
 238 two HTML element ids ('input1','input2'), and also send in two
 239 HTML element ids to place the results in ('result1','result2').
 240
 241 =item 3 Sending Perl Subroutine Output to a Javascript function
 242
 243 Occassionally, you might want to have a custom javascript function
 244 process the returned information from your Perl subroutine.
 245 This is possible, and the only requierment is that you change
 246 your event handler code...
 247
 248   onClick="exported_func(['input1'],[js_process_func]);"
 249
 250 In this scenario, C<js_process_func> is a javascript function you
 251 write to take the returned value from your Perl subroutine and
 252 process the results.  I<Note that a javascript function is not
 253 quoted -- if it were, then CGI::Ajax would look for a HTML element
 254 with that id.>  Beware that with this usage, B<you are responsible
 255 for distributing the results to the appropriate place on the
 256 HTML page>.  If the exported Perl subroutine returns, e.g. 2
 257 values, then C<js_process_func> would need to process the input
 258 by working through an array, or using the javascript Function
 259 C<arguments> object.
 260
 261   function js_process_func() {
 262     var input1 = arguments[0]
 263     var input2 = arguments[1];
 264     // do something and return results, or set HTML divs using
 265     // innerHTML
 266     document.getElementById('outputdiv').innerHTML = input1;
 267   }
 268
 269 =item 4 URL/Outside Script CGI::Ajax example
 270
 271 There are times when you may want a different script to
 272 return content to your page.  This could be because you have
 273 an existing script already written to perform a particular
 274 task, or you want to distribute a part of your application to another
 275 script.  This can be accomplished in L<CGI::Ajax> by using a URL in
 276 place of a locally-defined Perl subroutine.  In this usage,
 277 you alter you creation of the L<CGI::Ajax> object to link an
 278 exported javascript function name to a local URL instead of
 279 a coderef or a subroutine.
 280
 281   my $url = 'scripts/other_script.pl';
 282   my $pjx = new CGI::Ajax( 'external' => $url );
 283
 284 This will work as before in terms of how it is called from you
 285 event handler:
 286
 287   onClick="external(['input1','input2'],['resultdiv']);"
 288
 289 The other_script.pl will get the values via a CGI object and
 290 accessing the 'args' key.  The values of the B<'args'> key will
 291 be an array of everything that was sent into the script.
 292
 293   my @input = $cgi->params('args');
 294   $input[0]; # contains first argument
 295   $input[1]; # contains second argument, etc...
 296
 297 This is good, but what if you need to send in arguments to the
 298 other script which are directly from the calling Perl script,
 299 i.e. you want a calling Perl script's variable to be sent, not
 300 the value from an HTML element on the page?  This is possible
 301 using the following syntax:
 302
 303   onClick="exported_func(['args__$input1','args__$input2'],
 304                          ['resultdiv']);"
 305
 306 Similary, if the external script required a constant as input
 307 (e.g.  C<script.pl?args=42>, you would use this syntax:
 308
 309   onClick="exported_func(['args__42'],['resultdiv']);"
 310
 311 In both of the above examples, the result from the external
 312 script would get placed into the I<resultdiv> element on our
 313 (the calling script's) page.
 314
 315 If you are sending more than one argument from an external perl
 316 script back to a javascript function, you will need to split the
 317 string (AJAX applications communicate in strings only) on something.
 318 Internally, we use '__pjx__', and this string is checked for.  If
 319 found, L<CGI::Ajax> will automatically split it.  However, if you
 320 don't want to use '__pjx__', you can do it yourself:
 321
 322 For example, from your Perl script, you would...
 323
 324         return("A|B"); # join with "|"
 325
 326 and then in the javascript function you would have something like...
 327
 328         process_func() {
 329                 var arr = arguments[0].split("|");
 330                 // arr[0] eq 'A'
 331                 // arr[1] eq 'B'
 332         }
 333
 334 In order to rename parameters, in case the outside script needs
 335 specifically-named parameters and not CGI::Ajax' I<'args'> default
 336 parameter name, change your event handler associated with an HTML
 337 event like this
 338
 339   onClick="exported_func(['myname__$input1','myparam__$input2'],
 340                          ['resultdiv']);"
 341
 342 The URL generated would look like this...
 343
 344 C<script.pl?myname=input1&myparam=input2>
 345
 346 You would then retrieve the input in the outside script with this...
 347
 348   my $p1 = $cgi->params('myname');
 349   my $p1 = $cgi->params('myparam');
 350
 351 Finally, what if we need to get a value from our HTML page and we
 352 want to send that value to an outside script but the outside script
 353 requires a named parameter different from I<'args'>?  You can
 354 accomplish this with L<CGI::Ajax> using the getVal() javascript
 355 method (which returns an array, thus the C<getVal()[0]> notation):
 356
 357   onClick="exported_func(['myparam__' + getVal('div_id')[0]],
 358                          ['resultdiv']);"
 359
 360 This will get the value of our HTML element with and
 361 I<id> of I<div_id>, and submit it to the url attached to
 362 I<myparam__>.  So if our exported handler referred to a URI
 363 called I<script/scr.pl>, and the element on our HTML page called
 364 I<div_id> contained the number '42', then the URL would look
 365 like this C<script/scr.pl?myparam=42>.  The result from this
 366 outside URL would get placed back into our HTML page in the
 367 element I<resultdiv>.  See the example script that comes with
 368 the distribution called I<pjx_url.pl> and its associated outside
 369 script I<convert_degrees.pl> for a working example.
 370
 371 B<N.B.> These examples show the use of outside scripts which
 372 are other perl scripts - I<but you are not limited to Perl>!
 373 The outside script could just as easily have been PHP or any other
 374 CGI script, as long as the return from the other script is just
 375 the result, and not addition HTML code (like FORM elements, etc).
 376
 377 =back
 378
 379 =head2 GET versus POST
 380
 381 Note that all the examples so far have used the following syntax:
 382
 383   onClick="exported_func(['input1'],['result1']);"
 384
 385 There is an optional third argument to a L<CGI::Ajax> exported
 386 function that allows change the submit method.  The above event could
 387 also have been coded like this...
 388
 389   onClick="exported_func(['input1'],['result1'], 'GET');"
 390
 391 By default, L<CGI::Ajax> sends a I<'GET'> request.  If you need it,
 392 for example your URL is getting way too long, you can easily switch
 393 to a I<'POST'> request with this syntax...
 394
 395   onClick="exported_func(['input1'],['result1'], 'POST');"
 396
 397 I<('POST' and 'post' are supported)>
 398
 399 =head2 Page Caching
 400
 401 We have implemented a method to prevent page cacheing from undermining
 402 the AJAX methods in a page.  If you send in an input argument to a
 403 L<CGI::Ajax>-exported function called 'NO_CACHE', the a special
 404 parameter will get attached to the end or your url with a random
 405 number in it.  This will prevent a browser from caching your request.
 406
 407   onClick="exported_func(['input1','NO_CACHE'],['result1']);"
 408
 409 The extra param is called pjxrand, and won't interfere with the order
 410 of processing for the rest of your parameters.
 411
 412 =head1 METHODS
 413
 414 =cut
 415
 416 ################################### main pod documentation end ##
 417
 418 ######################################################
 419 ## METHODS - public                                 ##
 420 ######################################################
 421
 422 =over 4
 423
 424 =item build_html()
 425
 426     Purpose: Associates a cgi obj ($cgi) with pjx object, inserts
 427              javascript into <HEAD></HEAD> element and constructs
 428              the page, or part of the page.  AJAX applications
 429              are designed to update only the section of the
 430              page that needs it - the whole page doesn't have
 431              to be redrawn.  L<CGI::Ajax> applications use the
 432              build_html() method to take care of this: if the CGI
 433              parameter C<fname> exists, then the return from the
 434              L<CGI::Ajax>-exported function is sent to the page.
 435              Otherwise, the entire page is sent, since without
 436              an C<fname> param, this has to be the first time
 437              the page is being built.
 438
 439   Arguments: The CGI object, and either a coderef, or a string
 440              containing html.  Optionally, you can send in a third
 441              parameter containing information that will get passed
 442              directly to the CGI object header() call.
 443     Returns: html or updated html (including the header)
 444   Called By: originating cgi script
 445
 446 =cut
 447 sub build_html {
 448   my ( $self, $cgi, $html_source, $cgi_header_extra ) = @_;
 449
 450   if ( ref( $cgi ) =~ /CGI.*/ ) {
 451     if ( $self->DEBUG() ) {
 452       print STDERR "CGI::Ajax->build_html: CGI* object was received\n";
 453     }
 454     $self->cgi( $cgi ); # associate the cgi obj with the CGI::Ajax object
 455   }
 456
 457   if ( defined $cgi_header_extra ) {
 458     if ( $self->DEBUG() ) {
 459       print STDERR "CGI::Ajax->build_html: got extra cgi header info\n";
 460       if ( ref($cgi_header_extra) eq "HASH" ) {
 461         foreach my $k ( keys %$cgi_header_extra ) {
 462           print STDERR "\t$k => ", $cgi_header_extra->{$k}, "\n";
 463         }
 464       } else {
 465         print STDERR "\t$cgi_header_extra\n";
 466       }
 467     }
 468     $self->cgi_header_extra( $cgi_header_extra );
 469   }
 470
 471   #check if "fname" was defined in the CGI object
 472   if ( defined $self->cgi()->param("fname") ) {
 473     # it was, so just return the html from the handled request
 474     return ( $self->handle_request() );
 475   }
 476   else {
 477     # start with the minimum, a http header line and any extra cgi
 478     # header params sent in
 479     my $html = "";
 480     if ( $self->cgi()->can('header') ) {
 481       #$html .= $self->cgi()->header();
 482       $html .= $self->cgi()->header( $self->cgi_header_extra() );
 483     }
 484     else {
 485       # don't have an object with a "header()" method, so just create
 486       # a mimimal one
 487       $html .= "Content-Type: text/html;";
 488       $html .= $self->cgi_header_extra();
 489       $html .= "\n\n";
 490     }
 491
 492     # check if the user sent in a coderef for generating the html,
 493     # or the actual html
 494     if ( ref($html_source) eq "CODE" ) {
 495       if ( $self->DEBUG() ) {
 496         print STDERR "CGI::Ajax->build_html: html_source is a CODEREF\n";
 497       }
 498       eval { $html .= &$html_source };
 499       if ($@) {
 500         # there was a problem evaluating the html-generating function
 501         # that was sent in, so generate an error page
 502         if ( $self->cgi()->can('header') ) {
 503           $html = $self->cgi()->header( $self->cgi_header_extra() );
 504         }
 505         else {
 506           # don't have an object with a "header()" method, so just create
 507           # a mimimal one
 508           $html = "Content-Type: text/html;";
 509           $html .= $self->cgi_header_extra();
 510           $html .= "\n\n";
 511         }
 512         $html .= qq!<html><head><title></title></head><body><h2>Problems</h2> with
 513           the html-generating function sent to CGI::Ajax
 514           object</body></html>!;
 515         return $html;
 516       }
 517       $self->html($html);    # no problems, so set html
 518     }
 519     else {
 520       # user must have sent in raw html, so add it
 521       if ( $self->DEBUG() ) {
 522         print STDERR "CGI::Ajax->build_html: html_source is HTML\n";
 523       }
 524       $self->html( $html . $html_source );
 525     }
 526
 527     # now modify the html to insert the javascript
 528     $self->insert_js_in_head();
 529   }
 530   return $self->html();
 531 }
 532
 533 =item show_javascript()
 534
 535     Purpose: builds the text of all the javascript that needs to be
 536              inserted into the calling scripts html <head> section
 537   Arguments:
 538     Returns: javascript text
 539   Called By: originating web script
 540        Note: This method is also overridden so when you just print
 541              a CGI::Ajax object it will output all the javascript needed
 542              for the web page.
 543
 544 =cut
 545
 546 sub show_javascript {
 547   my ($self) = @_;
 548   my $rv = $self->show_common_js();    # show the common js
 549
 550   # build the js for each perl function you want exported to js
 551   foreach my $func ( keys %{ $self->coderef_list() }, keys %{ $self->url_list() } ) {
 552     $rv .= $self->make_function($func);
 553   }
 554   # wrap up the return in a CDATA structure for XML compatibility
 555   # (thanks Thos Davis)
 556   $rv = "\n" . '//<![CDATA[' . "\n" . $rv . "\n" . '//]]>' . "\n";
 557   $rv = '<script type="text/javascript">' . $rv . '</script>';
 558   return $rv;
 559 }
 560
 561 ## new
 562 sub new {
 563   my ($class) = shift;
 564   my $self = bless ({}, ref ($class) || $class);
 565 #  $self->SUPER::new();
 566   $self->JSDEBUG(0); # turn javascript debugging off (if on,
 567                      # extra info will be added to the web page output
 568                      # if set to 1, then the core js will get
 569                      # compressed, but the user-defined functions will
 570                      # not be compressed.  If set to 2 (or anything
 571                      # greater than 1 or 0), then none of the
 572                      # javascript will get compressed.
 573                      #
 574   $self->DEBUG(0);   # turn debugging off (if on, check web logs)
 575
 576   #accessorized attributes
 577   $self->coderef_list({});
 578   $self->url_list({});
 579   #$self->html("");
 580   #$self->cgi();
 581   #$self->cgi_header_extra(""); # set cgi_header_extra to an empty string
 582
 583   # setup a default endcoding; if you need support for international
 584         # charsets, use 'escape' instead of encodeURIComponent.  Due to the
 585         # number of browser problems users report about scripts with a default of
 586         # encodeURIComponent, we are setting the default to 'escape'
 587   $self->js_encode_function('escape');
 588
 589   if ( @_ < 2 ) {
 590     die "incorrect usage: must have fn=>code pairs in new\n";
 591   }
 592
 593   while ( @_ ) {
 594     my($function_name,$code) = splice( @_, 0, 2 );
 595     if ( ref( $code ) eq "CODE" ) {
 596       if ( $self->DEBUG() ) {
 597         print STDERR "name = $function_name, code = $code\n";
 598       }
 599       # add the name/code to hash
 600       $self->coderef_list()->{ $function_name } = $code;
 601     } elsif ( ref($code) ) {
 602       die "Unsuported code block/url\n";
 603     } else {
 604       if ( $self->DEBUG() ) {
 605         print STDERR "Setting function $function_name to url $code\n";
 606       }
 607       # if it's a url, it is added here
 608       $self->url_list()->{ $function_name } = $code;
 609     }
 610   }
 611   return ($self);
 612 }
 613
 614 ######################################################
 615 ## METHODS - private                                ##
 616 ######################################################
 617
 618 # sub cgiobj(), cgi()
 619 #
 620 #    Purpose: accessor method to associate a CGI object with our
 621 #             CGI::Ajax object
 622 #  Arguments: a CGI object
 623 #    Returns: CGI::Ajax objects cgi object
 624 #  Called By: originating cgi script, or build_html()
 625 #
 626 sub cgiobj {
 627   my $self = shift;
 628   # see if any values were sent in...
 629   if ( @_ ) {
 630     my $cgi = shift;
 631     # add support for other CGI::* modules This requires that your web server
 632     # be configured properly.  I can't test anything but a mod_perl2
 633     # setup, so this prevents me from testing CGI::Lite,CGI::Simple, etc.
 634     if ( ref($cgi) =~ /CGI.*/ ) {
 635       if ( $self->DEBUG() ) {
 636                                 print STDERR "cgiobj() received a CGI-like object ($cgi)\n";
 637       }
 638       $self->{'cgi'} = $cgi;
 639     } else {
 640       die "CGI::Ajax -- Can't set internal CGI object to a non-CGI object ($cgi)\n";
 641     }
 642   }
 643   # return the object
 644   return( $self->{'cgi'} );
 645 }
 646
 647 sub cgi {
 648   my $self = shift;
 649   if ( @_ ) {
 650     return( $self->cgiobj( @_ ) );
 651   } else {
 652     return( $self->cgiobj() );
 653   }
 654 }
 655
 656 ## # sub cgi_header_extra
 657 ## #
 658 ## #    Purpose: accessor method to associate CGI header information
 659 ## #             with the CGI::Ajax object
 660 ## #  Arguments: a hashref with key=>value pairs that get handed off to
 661 ## #             the CGI object's header() method
 662 ## #    Returns: hashref of extra cgi header params
 663 ## #  Called By: originating cgi script, or build_html()
 664 ##
 665 ## sub cgi_header_extra {
 666 ##   my $self = shift;
 667 ##   if ( @_ ) {
 668 ##     $self->{'cgi_header_extra'} = shift;
 669 ##   }
 670 ##   return( $self->{'cgi_header_extra'} );
 671 ## }
 672
 673 # sub create_js_setRequestHeader
 674 #
 675 #    Purpose: create text of the header for the javascript side,
 676 #             xmlhttprequest call
 677 #  Arguments: none
 678 #    Returns: text of header to pass to xmlhttpreq call so it will
 679 #             match whatever was setup for the main web-page
 680 #  Called By: originating cgi script, or build_html()
 681 #
 682
 683 sub create_js_setRequestHeader {
 684   my $self = shift;
 685   my $cgi_header_extra = $self->cgi_header_extra();
 686   my $js_header_string = q{r.setRequestHeader("};
 687         #$js_header_string .= $self->cgi()->header( $cgi_header_extra );
 688         $js_header_string .= $self->cgi()->header();
 689   $js_header_string .= q{");};
 690         #if ( ref $cgi_header_extra eq "HASH" ) {
 691         #       foreach my $k ( keys(%$cgi_header_extra) ) {
 692         #               $js_header_string .= $self->cgi()->header($cgi_headers)
 693         #       }
 694         #} else {
 695   #print STDERR  $self->cgi()->header($cgi_headers) ;
 696
 697         if ( $self->DEBUG() ) {
 698                 print STDERR "js_header_string is (", $js_header_string, ")\n";
 699         }
 700
 701   return($js_header_string);
 702 }
 703
 704 # sub show_common_js()
 705 #
 706 #    Purpose: create text of the javascript needed to interface with
 707 #             the perl functions
 708 #  Arguments: none
 709 #    Returns: text of common javascript subroutine, 'do_http_request'
 710 #  Called By: originating cgi script, or build_html()
 711 #
 712
 713 sub show_common_js {
 714   my $self = shift;
 715   my $encodefn = $self->js_encode_function();
 716   my $decodefn = $encodefn;
 717   $decodefn =~ s/^(en)/de/;
 718   $decodefn =~ s/^(esc)/unesc/;
 719   #my $request_header_str = $self->create_js_setRequestHeader();
 720   my $request_header_str = "";
 721   my $rv = <<EOT;
 722 var ajax = [];
 723 function pjx(args,fname,method) {
 724   this.target=args[1];
 725   this.args=args[0];
 726   method=(method)?method:'GET';
 727   if(method=='post'){method='POST';}
 728   this.method = method;
 729   this.r=ghr();
 730   this.url = this.getURL(fname);
 731 }
 732
 733 function formDump(){
 734   var all = [];
 735   var fL = document.forms.length;
 736   for(var f = 0;f<fL;f++){
 737     var els = document.forms[f].elements;
 738     for(var e in els){
 739       var tmp = (els[e].id != undefined)? els[e].id : els[e].name;
 740       if(typeof tmp != 'string'){continue;}
 741       if(tmp){ all[all.length]=tmp}
 742     }
 743   }
 744   return all;
 745 }
 746 function getVal(id) {
 747   if (id.constructor == Function ) { return id(); }
 748   if (typeof(id)!= 'string') { return id; }
 749   var element = document.getElementById(id) || document.forms[0].elements[id];
 750   if(!element){
 751      alert('ERROR: Cant find HTML element with id or name: ' +
 752      id+'. Check that an element with name or id='+id+' exists');
 753      return 0;
 754   }
 755    if(element.type == 'select-one') {
 756       if(element.selectedIndex == -1) return;
 757       var item = element[element.selectedIndex];
 758       return  item.value || item.text
 759    }
 760   if (element.type == 'select-multiple') {
 761   var ans = [];
 762   var k =0;
 763     for (var i=0;i<element.length;i++) {
 764       if (element[i].selected || element[i].checked ) {
 765         ans[k++]= element[i].value || element[i].text;
 766       }
 767     }
 768     return ans;
 769   }
 770
 771   if(element.type == 'radio' || element.type == 'checkbox'){
 772     var ans =[];
 773     var elms = document.getElementsByTagName('input');
 774     var endk = elms.length;
 775     var i =0;
 776     for(var k=0;k<endk;k++){
 777       if(elms[k].type== element.type && elms[k].checked && elms[k].id==id){
 778         ans[i++]=elms[k].value;
 779       }
 780     }
 781     return ans;
 782   }
 783   if( element.value == undefined ){
 784     return element.innerHTML;
 785   }else{
 786     return element.value;
 787   }
 788 }
 789 function fnsplit(arg) {
 790   var url="";
 791   if(arg=='NO_CACHE'){return '&pjxrand='+Math.random()}
 792   if((typeof(arg)).toLowerCase() == 'object'){
 793       for(var k in arg){
 794          url += '&' + k + '=' + arg[k];
 795       }
 796   }else if (arg.indexOf('__') != -1) {
 797     arga = arg.split(/__/);
 798     url += '&' + arga[0] +'='+ $encodefn(arga[1]);
 799   } else {
 800     var res = getVal(arg) || '';
 801     if(res.constructor != Array){ res = [res] }
 802     for(var i=0;i<res.length;i++) {
 803       url += '&args=' + $encodefn(res[i]) + '&' + arg + '=' + $encodefn(res[i]);
 804     }
 805   }
 806   return url;
 807 }
 808
 809 pjx.prototype =  {
 810   send2perl : function(){
 811     var r = this.r;
 812     var dt = this.target;
 813     this.pjxInitialized(dt);
 814     var url=this.url;
 815     var postdata;
 816     if(this.method=="POST"){
 817       var idx=url.indexOf('?');
 818       postdata = url.substr(idx+1);
 819       url = url.substr(0,idx);
 820     }
 821     r.open(this.method,url,true);
 822     $request_header_str;
 823     if(this.method=="POST"){
 824       r.setRequestHeader("Content-Type", "application/x-www-form-urlencoded");
 825       r.send(postdata);
 826     }
 827     if(this.method=="GET"){
 828       r.send(null);
 829     }
 830     r.onreadystatechange = handleReturn;
 831  },
 832  pjxInitialized : function(){},
 833  pjxCompleted : function(){},
 834  readyState4 : function(){
 835     var rsp = $decodefn(this.r.responseText);  /* the response from perl */
 836     var splitval = '__pjx__';  /* to split text */
 837     var data = rsp.split(splitval);
 838     dt = this.target;
 839     if (dt.constructor != Array) { dt=[dt]; }
 840     if (data.constructor != Array) { data=[data]; }
 841     if (typeof(dt[0])=='function') {
 842        dt[0].apply(this,data);
 843     } else {
 844       for ( var i=0; i<dt.length; i++ ) {
 845         if (typeof(dt[i])=='function') {
 846           dt[i].apply(this,[data[i]]);
 847         } else {
 848           var div = document.getElementById(dt[i]);
 849           if (div.type =='text' || div.type=='textarea' || div.type=='hidden' ) {
 850             div.value=data[i];
 851           } else{
 852             div.innerHTML = data[i];
 853           }
 854         }
 855       }
 856     }
 857     this.pjxCompleted(dt);
 858  },
 859
 860   getURL : function(fname) {
 861       var args = this.args;
 862       var url= 'fname=' + fname;
 863       for (var i=0;i<args.length;i++) {
 864         url=url + args[i];
 865       }
 866       return url;
 867   }
 868 };
 869
 870 handleReturn = function() {
 871   for( var k=0; k<ajax.length; k++ ) {
 872     if (ajax[k].r==null) { ajax.splice(k--,1); continue; }
 873     if ( ajax[k].r.readyState== 4) {
 874       ajax[k].readyState4();
 875       ajax.splice(k--,1);
 876       continue;
 877     }
 878   }
 879 };
 880
 881 var ghr=getghr();
 882 function getghr(){
 883     if(typeof XMLHttpRequest != "undefined")
 884     {
 885         return function(){return new XMLHttpRequest();}
 886     }
 887     var msv= ["Msxml2.XMLHTTP.7.0", "Msxml2.XMLHTTP.6.0",
 888     "Msxml2.XMLHTTP.5.0", "Msxml2.XMLHTTP.4.0", "MSXML2.XMLHTTP.3.0",
 889     "MSXML2.XMLHTTP", "Microsoft.XMLHTTP"];
 890     for(var j=0;j<=msv.length;j++){
 891         try
 892         {
 893             A = new ActiveXObject(msv[j]);
 894             if(A){
 895               return function(){return new ActiveXObject(msv[j]);}
 896             }
 897         }
 898         catch(e) { }
 899      }
 900      return false;
 901 }
 902
 903
 904 function jsdebug(){
 905     var tmp = document.getElementById('pjxdebugrequest').innerHTML = "<br><pre>";
 906     for( var i=0; i < ajax.length; i++ ) {
 907       tmp += '<a href= '+ ajax[i].url +' target=_blank>' +
 908       decodeURI(ajax[i].url) + ' </a><br>';
 909     }
 910     document.getElementById('pjxdebugrequest').innerHTML = tmp + "</pre>";
 911 }
 912
 913 EOT
 914
 915   if ( $self->JSDEBUG() <= 1 ) {
 916     $rv = $self->compress_js($rv);
 917   }
 918
 919   return($rv);
 920 }
 921
 922 # sub compress_js()
 923 #
 924 #    Purpose: searches the javascript for newlines and spaces and
 925 #             removes them (if a newline) or shrinks them to a single (if
 926 #             space).
 927 #  Arguments: javascript to compress
 928 #    Returns: compressed js string
 929 #  Called By: show_common_js(),
 930 #
 931
 932 sub compress_js {
 933   my($self,$js) = @_;
 934   return if not defined $js;
 935   return if $js eq "";
 936   $js =~ s/\n//g;   # drop newlines
 937   $js =~ s/\s+/ /g; # replace 1+ spaces with just one space
 938   return $js;
 939 }
 940
 941
 942 # sub insert_js_in_head()
 943 #
 944 #    Purpose: searches the html value in the CGI::Ajax object and inserts
 945 #             the ajax javascript code in the <script></script> section,
 946 #             or if no such section exists, then it creates it.  If
 947 #             JSDEBUG is set, then an extra div will be added and the
 948 #             url wil be desplayed as a link
 949 #  Arguments: none
 950 #    Returns: none
 951 #  Called By: build_html()
 952 #
 953
 954 sub insert_js_in_head{
 955   my $self = shift;
 956   my $mhtml = $self->html();
 957   my $newhtml;
 958   my @shtml;
 959   my $js = $self->show_javascript();
 960
 961   if ( $self->JSDEBUG() ) {
 962     my $showurl=qq!<br/><div id='pjxdebugrequest'></div><br/>!;
 963     # find the terminal </body> so we can insert just before it
 964     my @splith = $mhtml =~ /(.*)(<\s*\/\s*body[^>]*>?)(.*)/is;
 965     $mhtml = $splith[0].$showurl.$splith[1].$splith[2];
 966   }
 967
 968   # see if we can match on <head>
 969   @shtml= $mhtml =~ /(.*)(<\s*head[^>]*>?)(.*)/is;
 970   if ( @shtml ) {
 971     # yes, there's already a <head></head>, so let's insert inside it,
 972     # at the beginning
 973     $newhtml = $shtml[0].$shtml[1].$js.$shtml[2];
 974   } elsif( @shtml= $mhtml =~ /(.*)(<\s*html[^>]*>?)(.*)/is){
 975     # there's no <head>, so look for the <html> tag, and insert out
 976     # javascript inside that tag
 977     $newhtml = $shtml[0].$shtml[1].$js.$shtml[2];
 978   } else {
 979     $newhtml .= "<html><head>";
 980     $newhtml .= $js;
 981     $newhtml .= "</head><body>";
 982     $newhtml .= "No head/html tags, nowhere to insert.  Returning javascript anyway<br>";
 983     $newhtml .= "</body></html>";
 984   }
 985   $self->html($newhtml);
 986   return;
 987 }
 988
 989 # sub handle_request()
 990 #
 991 #    Purpose: makes sure a fname function name was set in the CGI
 992 #             object, and then tries to eval the function with
 993 #             parameters sent in on args
 994 #  Arguments: none
 995 #    Returns: the result of the perl subroutine, as text; if multiple
 996 #             arguments are sent back from the defined, exported perl
 997 #             method, then join then with a connector (__pjx__).
 998 #  Called By: build_html()
 999 #
1000
1001 sub handle_request {
1002   my ($self) = shift;
1003
1004   my $result; # $result takes the output of the function, if it's an
1005               # array split on __pjx__
1006   my @other = (); # array for catching extra parameters
1007
1008   # we need to access "fname" in the form from the web page, so make
1009   # sure there is a CGI object defined
1010   return undef unless defined $self->cgi();
1011
1012   my $rv = "";
1013   if ( $self->cgi()->can('header') ) {
1014     $rv = $self->cgi()->header( $self->cgi_header_extra() );
1015   } else {
1016     # don't have an object with a "header()" method, so just create
1017     # a mimimal one
1018     $rv = "Content-Type: text/html;";
1019     # TODO:
1020     $rv .= $self->cgi_header_extra();
1021     $rv .= "\n\n";
1022   }
1023
1024   # get the name of the function
1025   my $func_name = $self->cgi()->param("fname");
1026
1027   # check if the function name was created
1028   if ( defined $self->coderef_list()->{$func_name} ) {
1029     my $code = $self->coderef_list()->{$func_name};
1030
1031     # eval the code from the coderef, and append the output to $rv
1032     if ( ref($code) eq "CODE" ) {
1033       eval { ($result, @other) = $code->( $self->cgi()->param("args") ) };
1034
1035       if ($@) {
1036         # see if the eval caused and error and report it
1037         # Should we be more severe and die?
1038         if ( $self->DEBUG() ) {
1039           print STDERR "Problem with code: $@\n";
1040         }
1041       }
1042
1043       if( @other ) {
1044           $rv .= join( "__pjx__", ($result, @other) );
1045           if ( $self->DEBUG() ) {
1046             print STDERR "rv = $rv\n";
1047           }
1048       } else {
1049         if ( defined $result ) {
1050           $rv .= $result;
1051         }
1052       }
1053
1054     } # end if ref = CODE
1055   } else {
1056     # # problems with the URL, return a CGI rrror
1057     print STDERR "POSSIBLE SECURITY INCIDENT! Browser from ", $self->cgi()->remote_addr();
1058     print STDERR "\trequested URL: ", $self->cgi()->url();
1059     print STDERR "\tfname request: ", $self->cgi()->param('fname');
1060     print STDERR " -- returning Bad Request status 400\n";
1061     if ( $self->cgi()->can('header') ) {
1062       return($self->cgi()->header( -status=>'400' ));
1063     } else {
1064       # don't have an object with a "header()" method, so just create
1065       # a mimimal one with 400 error
1066       $rv = "Status: 400\nContent-Type: text/html;\n\n";
1067     }
1068   }
1069   return $rv;
1070 }
1071
1072
1073 # sub make_function()
1074 #
1075 #    Purpose: creates the javascript wrapper for the underlying perl
1076 #             subroutine
1077 #  Arguments: CGI object from web form, and the name of the perl
1078 #             function to export to javascript, or a url if the
1079 #             function name refers to another cgi script
1080 #    Returns: text of the javascript-wrapped perl subroutine
1081 #  Called By: show_javascript; called once for each registered perl
1082 #             subroutine
1083 #
1084
1085 sub make_function {
1086   my ($self, $func_name ) = @_;
1087   return("") if not defined $func_name;
1088   return("") if $func_name eq "";
1089   my $rv = "";
1090   my $script = $0 || $ENV{SCRIPT_FILENAME};
1091   $script =~ s/.*[\/|\\](.+)$/$1/;
1092   my $outside_url = $self->url_list()->{ $func_name };
1093   my $url = defined $outside_url ? $outside_url : $script;
1094   if ($url =~ /\?/) { $url.='&'; } else {$url.='?'}
1095   $url = "'$url'";
1096   my $jsdebug = "";
1097   if ( $self->JSDEBUG()) {
1098     $jsdebug = "jsdebug()";
1099   }
1100
1101   #create the javascript text
1102   $rv .= <<EOT;
1103 function $func_name() {
1104   var args = $func_name.arguments;
1105   for( var i=0; i<args[0].length;i++ ) {
1106     args[0][i] = fnsplit(args[0][i]);
1107   }
1108   var l = ajax.length;
1109   ajax[l]= new pjx(args,"$func_name",args[2]);
1110   ajax[l].url = $url + ajax[l].url;
1111   ajax[l].send2perl();
1112   $jsdebug;
1113 }
1114 EOT
1115
1116   if ( not $self->JSDEBUG() ) {
1117     $rv = $self->compress_js($rv);
1118   }
1119   return $rv;
1120 }
1121
1122 =item register()
1123
1124     Purpose: adds a function name and a code ref to the global coderef
1125              hash, after the original object was created
1126   Arguments: function name, code reference
1127     Returns: none
1128   Called By: originating web script
1129
1130 =cut
1131
1132 sub register {
1133   my ( $self, $fn, $coderef ) = @_;
1134   # coderef_list() is a Class::Accessor function
1135   # url_list() is a Class::Accessor function
1136   if ( ref( $coderef ) eq "CODE" ) {
1137     $self->coderef_list()->{$fn} = $coderef;
1138   } elsif ( ref($coderef) ) {
1139     die "Unsupported code/url type - error\n";
1140   } else {
1141     $self->url_list()->{$fn} = $coderef;
1142   }
1143 }
1144
1145 =item JSDEBUG()
1146
1147     Purpose: Show the AJAX URL that is being generated, and stop
1148              compression of the generated javascript, both of which can aid
1149              during debugging.  If set to 1, then the core js will get
1150              compressed, but the user-defined functions will not be
1151              compressed.  If set to 2 (or anything greater than 1 or 0),
1152              then none of the javascript will get compressed.
1153
1154   Arguments: JSDEBUG(0); # turn javascript debugging off
1155              JSDEBUG(1); # turn javascript debugging on, some javascript compression
1156              JSDEBUG(2); # turn javascript debugging on, no javascript compresstion
1157     Returns: prints a link to the url that is being generated automatically by
1158              the Ajax object. this is VERY useful for seeing what
1159              CGI::Ajax is doing. Following the link, will show a page
1160              with the output that the page is generating.
1161
1162   Called By: $pjx->JSDEBUG(1) # where $pjx is a CGI::Ajax object;
1163
1164 =item DEBUG()
1165
1166     Purpose: Show debugging information in web server logs
1167   Arguments: DEBUG(0); # turn debugging off (default)
1168              DEBUG(1); # turn debugging on
1169     Returns: prints debugging information to the web server logs using
1170              STDERR
1171   Called By: $pjx->DEBUG(1) # where $pjx is a CGI::Ajax object;
1172
1173 =back
1174
1175 =head1 BUGS
1176
1177 Follow any bugs at our homepage....
1178
1179   http://www.perljax.us
1180
1181 =head1 SUPPORT
1182
1183 Check out the news/discussion/bugs lists at our homepage:
1184
1185   http://www.perljax.us
1186
1187 =head1 AUTHORS
1188
1189   Brian C. Thomas     Brent Pedersen
1190   CPAN ID: BCT
1191   bct.x42@gmail.com   bpederse@gmail.com
1192
1193 =head1 A NOTE ABOUT THE MODULE NAME
1194
1195 This module was initiated using the name "Perljax", but then
1196 registered with CPAN under the WWW group "CGI::", and so became
1197 "CGI::Perljax".  Upon further deliberation, we decided to change it's
1198 name to L<CGI::Ajax>.
1199
1200 =head1 COPYRIGHT
1201
1202 This program is free software; you can redistribute
1203 it and/or modify it under the same terms as Perl itself.
1204
1205 The full text of the license can be found in the
1206 LICENSE file included with this module.
1207
1208 =head1 SEE ALSO
1209
1210 L<Data::Javascript>
1211 L<CGI>
1212 L<Class::Accessor>
1213
1214 =cut
1215
1216 1;
1217 __END__