1#!perl
2
3# Copied from WWW::Mechanize::Plugin::JavaScript and modified.
4
5# I have not got round to writing a complete set of tests yet. For now I’m
6# just testing for fixed bugs and other changes.
7
8use strict; use warnings;
9use lib 't';
10use Test::More;
11
12use HTML'DOM 0.027;
13use HTML::DOM::Interface ':all';
14use URI::file;
15use WWW::Scripter 0.016; # event2sub and $@
16
17sub data_url {
18	my $u = new URI 'data:';
19	$u->media_type('text/html');
20	$u->data(shift);
21	$u
22}
23
24# blank page for playing with JS; some tests need their own, though
25my $js = (my $m = new WWW::Scripter)->use_plugin('JavaScript',
26	engine => 'JE'
27);
28$m->get(URI::file->new_abs( 't/blank.html' ));
29$js->new_function($_ => \&$_) for qw 'is ok';
30
31use tests 2; # fourth arg to new_function
32{
33	$js->new_function(foo => sub { return 72 }, 'String');
34	$js->new_function(bar => sub { return 72 }, 'Number');
35	is ($m->eval('typeof foo()'), 'string', 'third arg passed ...');
36	is ($m->eval('typeof bar()'), 'number', '... to new_function');
37}
38
39use tests 1; # types of bound read-only properties
40{
41	is $m->eval(
42		'typeof document.nodeType'
43	), 'number', 'types of bound read-only properties';
44}
45
46use tests 2; # unwrap
47{
48	sub Foo::Bar::baz{
49		return join ',', map ref||(defined()?$_:'^^'),@_
50	};
51	$js->bind_classes({
52		'Foo::Bar' => 'Bar',
53		Bar => {
54			baz => METHOD | STR
55		}
56	});
57	$js->set($m, 'baz', bless[], 'Foo::Bar');
58	is($m->eval('baz.baz(null, undefined, 3, "4", baz)'),
59	   'Foo::Bar,^^,^^,JE::Number,JE::String,Foo::Bar', 'unwrap');
60
61	is $m->eval("getComputedStyle(document.documentElement,null)"),
62	  '[object CSSStyleDeclaration]',
63	  'objects are unwrapped when passed to window methods';
64}
65
66use tests 4; # null DOMString
67{
68	sub Phoo::Bar::bar {
69		return (undef,765)[!!pop];
70	}
71	sub Phoo::Bar::baz { "heelo" }
72	sub Phoo::Bar::nullbaz {}
73	$js->bind_classes({
74		'Phoo::Bar' => 'Phoo',
75		Phoo => {
76			bar => METHOD | STR,
77			baz => STR,
78			nullbaz => STR,
79		}
80	});
81	$js->set($m, 'baz', bless[], 'Phoo::Bar');
82	ok($m->eval('baz.bar(0) === null'),
83		'undef --> null conversion for a DOMString retval');
84	ok($m->eval('baz.bar(1) === "765"'),
85		'any --> string conversion for a DOMString retval');
86	ok($m->eval('baz.nullbaz === null'),
87		'undef --> null conversion when getting a DOMString prop');
88	ok($m->eval('baz.baz === "heelo"'),
89		'any --> string conversion when getting a DOMString prop');
90}
91
92use tests 2; # window wrappers
93{
94	ok $m->eval('window === top'),
95		'windows are wrapped up in global objects';
96	ok $m->eval('window === document.defaultView'),
97		'window === document.defaultView';
98}
99
100use tests 3; # frames
101{
102	$m->eval(q|
103		document.write("<iframe id=i src='data:text/html,'>")
104		document.close()
105	|);
106	ok $m->eval('frames[0] && "document" in frames[0] &&
107			frames[0].document.defaultView == frames[0]'),
108		'frame access by array index', or diag $@;
109	ok $m->eval('frames.i && "document" in frames.i'),
110		'frame access by name';
111	ok $m->eval('frames.i === frames[0]'),
112		'the two methods return the same object';
113}
114
115use tests 1; # var statements should create vars (broken in 0.006
116{            # [Mech plugin])
117	ok $m->eval(q|
118		var zarbardar;
119		"zarbardar" in this
120	|), 'var statements without "=" do create the vars';
121}
122
123use tests 1; # form event attributes with unusable scope chains
124{            # (broken in 0.002; fixed in 0.007 [Mech plugin])
125 $m->get(URI::file->new_abs( 't/je-form-event.html' ));
126 $m->submit_form(
127       form_name => 'y',
128       button    => 'Search Now'
129  );
130 like $m->uri->query, qr/x=lofasz/, 'form event attributes';
131}
132
133use tests 2; # inline HTML comments (support added in 0.002)
134my $warnings;
135local $SIG{__WARN__} = sub { ++$warnings; diag shift };
136
137$m->get(data_url <<'</html>');
138<script type="text/javascript" language="JavaScript">
139    function isginnf(omr)
140      {
141      avrn <!--o=wnwe aDt(e);
142      ofmr.itmzeoenOffste.avleu=onwg.teTmieoznOefsfe(t);
143<!-- UU_OMDP L480003D PTA- >-
144      ofr.muluoignwp.avleu=ofr.mpdw.avleu;
145<!-- nEdU UM_O D->-
146      ertrun;
147      }
148</script>
149</html>
150
151ok(!$warnings,
152   'no warnings (syntax errors) when HTML comments are embedded in JS');
153ok $m->eval('isginnf'), 'The code around the HTML comments actually runs';
154
155use tests 17; # Those weird and utterly useless HTML-generating string
156              # methods that have been part of JavaScript since day 1.
157is $m->eval('"pext".anchor("med")'), '<a name="med">pext</a>', '.anchor';
158is $m->eval('"clit".big   (     )'), '<big>clit</big>'       , '.big'   ;
159is $m->eval('"clile".blink(     )'), '<blink>clile</blink>'  , '.blink' ;
160is $m->eval('"dwew" .bold (     )'), '<b>dwew</b>'           , '.bold'  ;
161is $m->eval('"dro"  .fixed(     )'), '<tt>dro</tt>'          , '.fixed' ;
162is $m->eval('"crin".fontcolor("drow")'), '<font color="drow">crin</font>',
163 '.fontcolor';
164is $m->eval('"brelp".fontsize("blat")'), '<font size="blat">brelp</font>',
165 '.fontsize';
166is $m->eval('"bleen".italics (      )'), '<i>bleen</i>'       , '.italics';
167is $m->eval('"crare".link  ("blon")'), '<a href="blon">crare</a>', '.link';
168is $m->eval('"bleck".small (      )'), '<small>bleck</small>'   , '.small';
169is $m->eval('"blee" .strike(      )'), '<strike>blee</strike>' , '.strike';
170is $m->eval('"bleard".sub  (      )'), '<sub>bleard</sub>'     , '.sub'   ;
171is $m->eval('"clor"  .sup  (      )'), '<sup>clor</sup>'       , '.sup'   ;
172is $m->eval('"byph".anchor()'), '<a name="undefined">byph</a>',
173 '.anchor with no args';
174is $m->eval('"bames".fontcolor()'), '<font color="undefined">bames</font>',
175 '.fontcolor with no args';
176is $m->eval('"blash".fontsize()'), '<font size="undefined">blash</font>',
177 '.fontsize with no args';
178is $m->eval('"brode".link()'), '<a href="undefined">brode</a>',
179 '.link with no args';
180
181use tests 4; # Existence of non-core global JS properties.
182# It’s possible to make properties only half-exist, in that window.foo
183# returns something, but it’s not a scope variable and the hasOwnProperty
184# method can’t see it.  This was the case with collection properties  prior
185# to version 0.004.
186$m->document->innerHTML("<iframe name=ba>");
187ok $m->eval('hasOwnProperty("document")'),
188 'hasOwnProperty can see window properties listed by WWW::Scripter';
189ok $m->eval('hasOwnProperty("ba")'),
190 'hasOwnProperty can see collection properties of the window';
191ok $m->eval('document'),
192 'window properties listed by WWW::Scripter are in scope';
193ok $m->eval('ba'),
194 'collection properties of the window are in scope';
195
196use tests 4; # HTML event handler scope
197$m->back until $m->uri =~ /blank/;
198$m->eval(q{
199 document.innerHTML = "<form name=f><input id=it onclick='which=thing'>"
200 var it = document.getElementById('it');
201 window.thing="παράθι"
202 it.click(); is(which, "παράθι", 'window is in event scope')
203 document.thing='ἔγγραφον'
204 it.click(); is(which,'ἔγγραφον','document shadows window in event scope')
205 document.f.thing='μορφὴ'
206 it.click(); is(which,'μορφὴ', 'form shadows document in event scope')
207 it.thing='πράγμα'
208 it.click(); is(which,'πράγμα', 'target shadows form in event scope')
209});
210
211use tests 2; # UTF-16
212$m->eval("
213 is((node=document.createTextNode('\x{10000}aa')).length,4,'UTF-16 prop');
214 node.insertData(2,'b')
215 is(node.data, '\x{10000}baa', 'UTF-16 method')
216");
217
218use tests 1; # frames retaining the same global object from one page to the
219             # next (problem in 0.003 and earlier)
220$m->document->innerHTML(q|<iframe name=f></iframe>|);
221$m->eval(q|f.smow="bar"|);
222$m->frames->{f}->get("data:text/html,");
223is $m->eval("''+f.smow"), 'undefined',
224 "JS-less frames get a new global object when a page is fetched";
225
226use tests 1; # Calling JS methods on other windows (bug introduced in 0.004
227             # along with proxies for global objects that fixed the previ-
228             # ous test; fixed in 0.006)
229{
230 my $buffalo;
231 $m->set_alert_function(sub{ $buffalo = shift });
232 $m->frames->[0]->eval("top.alert(\"ooo\")");
233 is $buffalo, 'ooo', 'calling methods with JS on other windows';
234}
235
236use tests 1; # syntax errors in HTML event attributes
237{
238 my $w;
239 local $SIG{__WARN__} = sub { $w = shift };
240 $m->get('data:text/html,<body onload="a b">');
241 ok $w, "syntax errors in HTML event attributes are turned into warninsg";
242}
243