package JavaScript::DebugConsole;
use 5.005;
use strict;
use vars qw($VERSION);
$VERSION = '0.01';
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = ($#_ == 0) ? shift : { @_ };
$self->{debug} = 1 if ( ! defined $self->{debug} || $self->{debug} !~ /^(0|1)$/ );
return bless $self,$class;
}
sub debugConsole {
my $self = shift;
my %args = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_;
$args{'title'} ||= 'POPUPConsole';
$args{'auto_open'} = 1 if ! defined $args{'auto_open'};
$args{'id'} = defined $args{'id'} || ( $$ . '_' . ++$self->{'popup_count'} );
$args{'content'} ||= $self->{'content'};
$args{'env'} ||= \%ENV;
$args{debug} = $self->{debug} if ( ! defined $args{debug} || $args{debug} !~ /^(0|1)$/ );
$args{'popup_options'} ||= 'height=250,width=500,scrollbars=1,resizable=1,dependent,screenX=250,screenY=200,top=200,left=250';
# create javascript code
my $str = <<EOM;
<SCRIPT LANGUAGE="JavaScript1.2">
<!--
function OpenDebugConsole_$args{'id'}(title, caption, options) {
def_options = '$args{'popup_options'}';
if ( !options )
options = def_options;
// if our debug window is already open, just switch to it and navigate
var win = top.debugWin ;
if ( win && win.body && (! win.closed) ) {
win.focus();
}
// open debug win and write
else {
var win = window.open("",caption,options);
win.focus();
}
EOM
$str .= "win.document.writeln(\"<PRE>\")\n" if $args{'pre'};
# print debug info
if ( $args{'debug'} ) {
$args{'content'} .= <<EOM;
<TABLE BGCOLOR="#8888FF" BORDER="0" CELLPADDING="1" CELLSPACING="1">
<TR ALIGN="LEFT">
<TH COLSPAN="2"><FONT FACE="VERDANA,ARIAL" SIZE="4" COLOR="#FFFFFF">CGI/form environment</FONT></TH>
</TR>
<TR BGCOLOR="#CCCCCC">
<TH COLSPAN="2" ALIGN="LEFT"><FONT FACE="VERDANA,ARIAL" SIZE="3">FORM PARAMS</FONT></TH>
</TR>
<TR BGCOLOR="#EEEEEE">
<TD><FONT FACE="VERDANA,ARIAL" SIZE="-1">
EOM
$args{'content'} .= _HashVariables($args{'form'},"</FONT></TD>\n </TR>\n <TR BGCOLOR=\"#EEEEEE\">\n <TD><FONT FACE=\"VERDANA,ARIAL\" SIZE=\"-1\">","</FONT></TD>\n <TD><FONT FACE=\"VERDANA,ARIAL\" SIZE=\"-1\">");
$args{'content'} .= <<EOM;
</FONT></TD>
<TD></TD>
</TR>
<TR BGCOLOR="#CCCCCC">
<TH COLSPAN="2" ALIGN="LEFT"><FONT FACE="VERDANA,ARIAL" SIZE="3">ENVIRONMENT VARIABLES</FONT></TH>
</TR>
<TR BGCOLOR="#EEEEEE">
<TD><FONT FACE="VERDANA,ARIAL" SIZE="-1">
EOM
$args{'content'} .= _HashVariables($args{'env'},"</FONT></TD>\n\t</TR>\n <TR BGCOLOR=\"#EEEEEE\">\n <TD><FONT FACE=\"VERDANA,ARIAL\" SIZE=\"-1\">","</FONT></TD>\n <TD><FONT FACE=\"VERDANA,ARIAL\" SIZE=\"-1\">");
$args{'content'} .= <<EOM;
</FONT></TD>
<TD></TD>
</TR>
</TABLE>
<BR>
EOM
}
foreach my $debug_line( split(/\n/,$args{'content'}) ) {
$debug_line =~ s/cM//g;
$debug_line =~ s/\r//g;
$debug_line =~ s/'/\\'/g;
$debug_line =~ s/"/\\"/g;
$str .= "\twin.document.writeln(\"$debug_line\");\n";
}
$str .= "win.document.writeln(\"</PRE>\")\n" if $args{'pre'};
$str .= <<EOM;
win.document.close();
}
EOM
# Store JS function call into object property
$self->{'link'} = "OpenDebugConsole_$args{'id'}('$args{'title'}', '$args{'title'}','$args{'popup_options'}')";
if ( $args{'auto_open'} ) {
$str .= <<EOM;
// open js console
$self->{'link'}
EOM
}
$str .= <<EOM;
//-->
</SCRIPT>
EOM
$self->{'console'} = $str;
}
sub add {
my ($self) = shift;
$self->{content} .= join "\n", @_;
}
sub link {
my $self = shift;
return 'javascript:' . $self->{'link'};
}
sub console {
my $self = shift;
$self->{'console'};
}
sub _HashVariables {
my($hash,$separator,$equal) = @_;
my $str = '';
$equal = ' = ' unless $equal;
eval { $hash->can('param') };
if ( $@ ) {
foreach(sort keys %$hash) {
$str .= $_ . $equal . $hash->{$_} . $separator;
}
}
else {
foreach(sort $hash->param) {
$str .= $_ . $equal . $hash->param($_) . $separator;
}
}
return $str;
}
1;
__END__
=pod
=head1 NAME
JavaScript::DebugConsole - Perl extension to generate JavaScript popups with
custom text and typical web development useful informations
=head1 SYNOPSIS
use JavaScript::DebugConsole;
my $jdc = new JavaScript::DebugConsole;
$jdc->add('Some', 'text');
print $jdc->debugConsole();
=head1 DESCRIPTION
I packaged some my old and simple functions inside a Perl module (I was tired to
do cut&paste each time :-) ) to generate the necessary JavaScript code in order
to open a popup window with custom text and typical web development useful infos
(like form params, environment variables, HTTP headers and so on).
=head1 INSTALLATION
In order to install and use this package you will need Perl version 5.005 or
higher.
Installation as usual:
% perl Makefile.PL
% make
% make test
% su
Password: *******
% make install
=head1 DEPENDENCIES
No thirdy-part modules are required.
=head1 CONSTRUCTOR
=over 4
=item * new( %args )
It's possible to create a new C<JavaScript::DebugConsole> by invoking the
C<new> method. Parameters are passed as hash array:
=over 4
=item C<debug> boolean
Enable CGI form parameters and environment prints. Default value is 1.
=back
=head1 METHODS
=over 4
=item * add( 'Some', 'Text', [...] )
Add text to be rendered with JavaScript C<writeln> calls.
=item * debugConsole(%args)
Returns JavaScript code in order to open popup with custom text.
Parameters are passed as hash array:
=over 4
=item C<content> string
Allows to set the content which will be render by Javascript
C<document.writeln> statement. The parameter isn't mandatory. It overrides text
previously added with calls to C<add> method.
=item C<title> string
Popup title. Default vaule is I<POPUPConsole>.
=item C<auto_open> boolean
Appends to JavaScript generated code, the necessary call in order to open
popup automatically when page is loaded. Default value is C<1>.
=item C<form> object or hashref
Reference to the form data. This can either be a hash reference, or a
CGI.pm-like object. In particular, the object must have a param() method that
works like the one in CGI.pm does. CGI::Simple and Apache::Request objects are
known to work.
=item C<env> hashref
Hash reference to environment variables. Default is C<%ENV>.
=item C<id> string
Unique identifier in order to use it to name JavaScript function that creates
popup. This allow more that one popup calls in same page without conflicts.
Default is C<$$> (process PID).
=item C<popup_options> string
Popup options. Default value is:
C<height=250,width=450,scrollbars=1,resizable=1,dependent,screenX=250,screenY=200,top=200,left=250>.
See the JavaScript reference manual for more info about C<window.open> method.
=item C<pre> boolean
Print popup content inside I<E<lt>PREE<gt> E<lt>/PREE<gt>> HTML tag.
Default values is 0.
=item C<debug> boolean
Enable CGI form parameters and environment prints. Ovverride C<debug> object property
value only for method invocation.
=back
The method returns the generated JavaScript code.
=back
=head1 INTEGRATING IN Template Toolkit
During initial development, Sam Vilain asked me to include also a
Template::Plugin::JS::DebugConsole plugin in order to use this class in Template
Toolkit environment.
Since the wrapper wouldn't have added nothing of special, I used successfully
C<Template::Plugin::Class> plugin, by avoiding to write e new one at the cost
of one line only of additional code:
[% USE c = Class('JavaScript::DebugConsole') %]
[% jdc = c.new %]
[% jdc.debugConsole( content => "Popup text",
title => "Debug title", auto_open => 0 ) %]
<p>Click <a href="[% jdc.link %]">here</a> to open the console!</p>
Following code use CGI plugin in order to print also CGI form params:
[% USE q = CGI %]
[% USE c = Class('JavaScript::DebugConsole') %]
[% jdc = c.new %]
[% jdc.debugConsole( content => "Popup text", title => "Debug title",
auto_open => 1, form => q ) %]
=head1 EXAMPLES
#!/usr/local/bin/perl
use JavaScript::DebugConsole;
use CGI qw/:standard/;
my $q = new CGI;
print header;
# create new object
my $jdc = new JavaScript::DebugConsole;
print $jdc->debugConsole( content => 'My debug infos', title => 'Debug Test',
auto_open => 0, form => $q );
print '<a href="' . $jdc->link . '">Open the console!</A>';
=head1 BUGS
Please submit bugs to CPAN RT system at
http://rt.cpan.org/NoAuth/ReportBug.html?Queue=JavaScript-DebugConsole or by
email at bug-javascript-debugconsole@rt.cpan.org
Patches are welcome and I'll update the module if any problems will be found.
=head1 VERSION
Version 0.01
=head1 SEE ALSO
perl
=head1 AUTHOR
Enrico Sorcinelli, E<lt>enrico at sorcinelli.itE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2004 by Enrico Sorcinelli
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.1 or,
at your option, any later version of Perl 5 you may have available.
=cut