view release on metacpan or  search on metacpan

lib/WWW/Scripter/Plugin/JavaScript.pm  view on Meta::CPAN

package WWW::Scripter::Plugin::JavaScript;

use strict;   # :-(
use warnings; # :-(

use Encode 'decode_utf8';
use LWP'UserAgent 5.815;
use Scalar::Util qw'weaken';
use URI::Escape 'uri_unescape';
use Hash::Util::FieldHash::Compat 'fieldhash';
use WWW::Scripter 0.022; # screen

our $VERSION = '0.009';

# Attribute constants (array indices)
sub mech() { 0 }
sub jsbe() { 1 } # JavaScript back-end (field hash of objects, keyed
sub benm() { 2 } # Back-end name  # by document)
sub init_cb() { 3 } # callback routine that's called whenever a new js
                    # environment is created
sub alert()   { 4 }
sub confirm() { 5 }
sub prompt()  { 6 }
sub cb() { 7 } # class bindings
sub tmout() { 8 } # timeouts
sub f()       { 9 } # functions
sub g()        { 10 } # guard objects for back ends, to destroy
                      # them forcibly

{no warnings; no strict;
undef *$_ for qw/mech jsbe benm init_cb g cb
              f alert confirm prompt tmout/} # These are PRIVATE constants!

sub init {

	my ($package, $mech) = @_;

	my $self = bless [$mech], $package;
	weaken $self->[mech];

	$mech->script_handler( default => $self );
	$mech->script_handler(
	 qr/(?:^|\/)(?:x-)?(?:ecma|j(?:ava)?)script[\d.]*\z/i => $self
	);

	$mech->set_my_handler(request_preprepare => sub {
		my($request,$mech) = @_;
		$self->eval(
		 $mech, decode_utf8 uri_unescape opaque {uri $request}
		);
		$@ and $mech->warn($@);
		WWW'Scripter'abort;
	}, m_scheme => 'javascript');

	# stop closures from preventing destruction
	weaken $mech;
	my $life_raft = $self;
	weaken $self;

	$self;
}

sub options {
	my $self = shift;
	my %opts = @_;

	my $w;
	for(keys %opts) {
		if($_ eq 'engine') {
			if($self->[jsbe] &&
			   $self->[benm] ne $opts{$_}
			) {
			    $self->[mech]->die(
			        "Can't set JavaScript engine to " .
			        "'$opts{$_}' since $self->[benm] is " .
			        "already loaded.");;
			}
			$self->[benm] = $opts{$_};;
		}
		elsif($_ eq 'init') {
			$self->[init_cb] = $opts{$_};
		}
		else {
			$self->[mech]->die(