#!perl
use
warnings;
no
warnings<utf8 parenthesis regexp once
qw bareword
syntax>;
our
(
@method
,
@args
,
$obj
);
{
++
$INC
{
'WWW/Scripter/Plugin/JavaScript/BE.pm'
};
sub
new {
push
@method
,
'new'
;
push
@args
, \
@_
;
$obj
=
bless
[];
}
for
(<
eval
bind_classes new_function set>) {
eval
"
sub
$_
{
push
\
@method
,
'$_'
;
push
\
@args
, \\\
@_
;
_:
} ";
}
}
$w
= new WWW::Scripter;
$w
->use_plugin(
'JavaScript'
,
engine
=>
'BE'
);
$js
=
$w
->plugin(
"JavaScript"
);
sub
reset
{
@args
=
@method
=(); }
$js
->
eval
(
$w
,
'code'
,
'url'
,
'78'
);
is
shift
@method
,
'new'
,
'eval calls "new"'
;
is @{
$args
[0]}, 2,
'new is passed one arg'
;
is
shift
@{
$args
[0]}, WWW
'Scripter'
Plugin
'JavaScript'
BE,
'new is passed the pkg'
;
is
shift
@{
shift
@args
},
$w
,
'new is passed the window'
;
while
(
@method
and
$method
[0] ne
'eval'
) {
shift
@method
,
shift
@args
}
is
shift
@method
,
'eval'
;
is_deeply
shift
@args
, [
$obj
,
'code'
,
'url'
,
'78'
],
'eval args'
;
$js
->new_function(
'a'
,\
&reset
);
is
shift
@method
,
'new_function'
,
'new_function'
;
is_deeply
shift
@args
, [
$obj
,
'a'
,\
&reset
],
'new_function arguments'
;
$js
->set(
$w
,
'a'
,
'b'
,
'c'
,\
&reset
);
is
shift
@method
,
'set'
,
'set'
;
is_deeply
shift
@args
, [
$obj
,
'a'
,
'b'
,
'c'
,\
&reset
],
'set arguments'
;
$js
->bind_classes(\%::);
&is
(
shift
@method
, (
'bind_classes'
)x2);
is @{
$args
[0]}, 2,
'right number of args to bind_classes'
;
is
pop
@{
shift
@args
}, \%::,
'arggh to bind_classes'
;