File Coverage

blib/lib/WWW/Mechanize/PhantomJS.pm
Criterion Covered Total %
statement 107 804 13.3
branch 12 318 3.7
condition 8 255 3.1
subroutine 25 116 21.5
pod 69 87 79.3
total 221 1580 13.9


line stmt bran cond sub pod time code
1             package WWW::Mechanize::PhantomJS;
2 34     34   3826620 use strict;
  34         76  
  34         1349  
3 34     34   675 use 5.010;
  34         127  
4 34     34   206 use warnings;
  34         85  
  34         1942  
5              
6 34     34   18809 use Filter::signatures;
  34         865342  
  34         277  
7 34     34   1733 no warnings 'experimental::signatures';
  34         77  
  34         1580  
8 34     34   182 use feature 'signatures';
  34         62  
  34         1299  
9              
10 34     34   31297 use Selenium::Remote::Driver;
  34         12027938  
  34         1846  
11 34     34   21047 use WWW::Mechanize::Plugin::Selector;
  34         125  
  34         1763  
12 34     34   283 use HTTP::Response;
  34         70  
  34         1251  
13 34     34   190 use HTTP::Headers;
  34         93  
  34         1055  
14 34     34   182 use Scalar::Util qw( blessed );
  34         147  
  34         2109  
15 34     34   272 use File::Basename;
  34         117  
  34         2689  
16 34     34   241 use Carp qw(croak carp);
  34         75  
  34         1809  
17 34     34   17477 use WWW::Mechanize::Link;
  34         16816  
  34         1429  
18 34     34   19900 use IO::Socket::INET;
  34         562607  
  34         280  
19 34     34   19905 use Time::HiRes qw(time sleep);
  34         91  
  34         398  
20              
21 34     34   3311 use Carp 'croak';
  34         101  
  34         91026  
22              
23             our $VERSION= '0.25';
24             our @CARP_NOT=qw(Selenium::Remote::Driver);
25              
26             =head1 NAME
27              
28             WWW::Mechanize::PhantomJS - automate the PhantomJS browser
29              
30             =head1 SYNOPSIS
31              
32             use WWW::Mechanize::PhantomJS;
33             my $mech = WWW::Mechanize::PhantomJS->new();
34             $mech->get('http://google.com');
35              
36             $mech->eval_in_page('alert("Hello PhantomJS")');
37             my $png= $mech->content_as_png();
38              
39             =head2 C<< WWW::Mechanize::PhantomJS->new %options >>
40              
41             my $mech = WWW::Mechanize::PhantomJS->new();
42              
43             =over 4
44              
45             =item B
46              
47             Control whether HTTP errors are fatal.
48              
49             autodie => 0, # make HTTP errors non-fatal
50              
51             The default is to have HTTP errors fatal,
52             as that makes debugging much easier than expecting
53             you to actually check the results of every action.
54              
55             =item B
56              
57             Specify the port where PhantomJS should listen
58              
59             port => 8910
60              
61             =item B
62              
63             Specify the log level of PhantomJS
64              
65             log => 'OFF' # Also INFO, WARN, DEBUG
66              
67             =item B
68              
69             Specify the path to the PhantomJS executable.
70              
71             The default is C as found via C<$ENV{PATH}>.
72             You can also provide this information from the outside
73             by setting C<$ENV{PHANTOMJS_EXE}>.
74              
75             =item B
76              
77             Additional command line arguments to C. (phantomjs -h)
78              
79             phantomjs_arg => ["--proxy=$ENV{HTTP_PROXY}"]
80              
81             =item B
82              
83             Filename of the C Javascript code
84             to launch. The default is the file distributed with this module.
85              
86             launch_ghostdriver => "devel/my/ghostdriver/main.js",
87              
88             =item B
89              
90             Specify additional parameters to the Ghostdriver script.
91              
92             launch_arg => [ "--some-new-parameter=foo" ],
93              
94             Some interesting parameters are:
95              
96             "--webdriver=$port",
97             '--webdriver-logfile=/tmp/webdriver',
98             '--webdriver-loglevel=DEBUG',
99             '--debug=true',
100              
101             note: these set config.xxx values in ghostrdriver/config.js
102              
103             =item B
104              
105             Cookies are not directly persisted. If you pass in a path here,
106             that file will be used to store or retrieve cookies.
107              
108             =item B
109              
110             If you want C to ignore SSL errors, pass a true value here.
111              
112             =item B
113              
114             A premade L object.
115              
116             =item B
117              
118             If set to 1, after each request tests for Javascript errors and warns. Useful
119             for testing with C.
120              
121             =back
122              
123             =cut
124              
125             sub build_command_line {
126 1     1 0 2 my( $class, $options )= @_;
127              
128 1   50     7 $options->{ "log" } ||= 'OFF';
129              
130 1   50     8 $options->{ launch_exe } ||= $ENV{PHANTOMJS_EXE} || 'phantomjs';
      33        
131 1         6 (my $ghostdir_default= __FILE__) =~ s!\.pm$!!;
132 1         21 $ghostdir_default= File::Spec->catfile( $ghostdir_default, 'ghostdriver', 'main.js' );
133 1   33     5 $options->{ launch_ghostdir } ||= $ghostdir_default;
134 1   50     6 $options->{ launch_arg } ||= [];
135 1   50     5 $options->{ phantomjs_arg } ||= [];
136              
137             # config.js defaults config.port to 8910
138             # this is the proper way to overwrite it (not sure wtf the PhantomJS parameter does above)
139 1 50       3 if ($options->{port}) {
140 1         1 push @{ $options->{ launch_arg }}, "--port=$options->{ port }";
  1         4  
141             } # PhantomJS version 1.9.7
142              
143 1         2 push @{ $options->{ launch_arg }}, "--logLevel=\U$options->{ log }";
  1         3  
144              
145 1 50       3 if( my $cookie_file= delete $options->{ cookie_file }) {
146 0         0 push @{ $options->{ phantomjs_arg }}, "--cookies-file=$cookie_file";
  0         0  
147             };
148              
149 1 50       2 if( my $ignore_ssl_errors= delete $options->{ ignore_ssl_errors }) {
150 0         0 push @{ $options->{ phantomjs_arg }}, "--ignore-ssl-errors=yes";
  0         0  
151             };
152              
153             my $program = ($^O =~ /mswin/i and $options->{ launch_exe } =~ /\s/)
154             ? qq("$options->{ launch_exe }")
155 1 50 33     7 : $options->{ launch_exe };
156              
157 1         2 my @cmd=( "|-", $program, @{ $options->{phantomjs_arg}}, $options->{ launch_ghostdir }, @{ $options->{ launch_arg } } );
  1         3  
  1         3  
158 1 50       3 if( $^O =~ /mswin/i ) {
159             # Windows Perl doesn't support pipe-open with list
160 0         0 shift @cmd; # remove pipe-open
161 0         0 @cmd= "| " . join " ", @cmd;
162             };
163              
164             @cmd
165 1         3 };
166              
167             sub new {
168 1     1 1 3 my ($class, %options) = @_;
169              
170 1         3 my $localhost = '127.0.0.1';
171 1 50 33     4 unless ( defined $options{ port } and !$options{pid}) {
172 1         2 my $port = 8910;
173 1         1 while (1) {
174 1         8 my $sock = IO::Socket::INET->new(
175             Proto => 'tcp',
176             PeerAddr => $localhost,
177             PeerPort => $port,
178             Timeout => 1,
179             #V6Only => 1,
180             );
181 1 50       14949 if( $sock ) {
182 0         0 $port++;
183 0         0 $sock->close;
184 0         0 sleep 0.1+rand(0.1);
185 0         0 next;
186             };
187 1         2 last;
188             }
189 1         3 $options{ port } = $port;
190             }
191              
192 1 50       4 if (! exists $options{ autodie }) { $options{ autodie } = 1 };
  0         0  
193              
194 1 50       4 if( ! exists $options{ frames }) {
195 1         4 $options{ frames }= 1;
196             };
197 1 50       2 unless ($options{pid}) {
198 1         8 my @cmd= $class->build_command_line( \%options );
199 1         3 $options{ kill_pid } = 1;
200 1 50       2 if( @cmd > 1 ) {
201             # We can do a proper pipe-open
202 1         2 my $mode = shift @cmd;
203 1 50       4910 $options{ pid } = open $options{fh}, $mode, @cmd
204             or croak "Couldn't launch [@cmd]: $! / $?";
205             } else {
206             # We can't do a proper pipe-open, so do the single-arg open
207             # in the hope that everything has been set up properly
208 0 0         $options{ pid } = open $options{fh}, $cmd[0]
209             or croak "Couldn't launch [$cmd[0]]: $! / $?";
210             };
211              
212             # Just to give PhantomJS time to start up, make sure it accepts connections
213 0   0       my $wait = time + ($options{ wait } || 20);
214 0           while ( time < $wait ) {
215 0           my $t = time;
216             my $socket = IO::Socket::INET->new(
217             PeerHost => $localhost,
218             PeerPort => $options{ port },
219 0           Proto => 'tcp',
220             );
221 0 0         if( $socket ) {
222 0           close $socket;
223 0           sleep 0.1;
224 0           last;
225             };
226 0 0         sleep 0.1 if time - $t < 1;
227             }
228             }
229              
230             # Connect to it
231 0           eval {
232             $options{ driver } ||= Selenium::Remote::Driver->new(
233             'port' => $options{ port },
234             remote_server_addr => $localhost,
235             auto_close => 0,
236             error_handler => sub {
237             #warn ref$_[0];
238             #warn "<<@CARP_NOT>>";
239             #warn ((caller($_))[0,1,2])
240             # for 1..4;
241 0     0     local @CARP_NOT = (@CARP_NOT, ref $_[0],'Try::Tiny');
242             # Reraise the error
243 0           croak $_[1]
244             },
245 0   0       );
246             # (Monkey)patch Selenium::Remote::Driver
247 0           $options{ driver }->commands->get_cmds->{get}->{no_content_success}= 0;
248             };
249              
250             # if PhantomJS started, but so slow or unresponsive that SRD cannot connect to it,
251             # kill it manually to avoid waiting for it indefinitely
252 0 0         if ( $@ ) {
253 0 0         kill 9, delete $options{ pid } if $options{ kill_pid };
254 0           die $@;
255             }
256              
257 0           my $self= bless \%options => $class;
258              
259 0           $self->eval_in_phantomjs(<<'JS');
260             var page= this;
261             page.errors= [];
262             page.alerts= [];
263             page.confirms= {};
264             page.onError= function(msg, trace) {
265             //_log.warn("Caught JS error", msg);
266             page.errors.push({ "message": msg, "trace": trace });
267             };
268             page.onConsoleMessage= function(msg, line, file) {
269             // line and file are declared but will never be used :(
270             page.errors.push({ "message": msg, "trace": [{"line":line,"file":file}] });
271             };
272             page.onAlert = function(msg) {
273             page.alerts.push(msg);
274             };
275             page.onConfirm= function(msg) {
276             return page.confirms[msg];
277             };
278             JS
279              
280 0           $self
281             };
282              
283             =head2 C<< $mech->phantomjs_version >>
284              
285             print $mech->phantomjs_version;
286              
287             Returns the version of the PhantomJS executable that is used.
288              
289             =cut
290              
291             sub phantomjs_version {
292 0     0 1   my( $self )= @_;
293 0   0       $self->{phantomjs_version} ||= do {
294 0           my $version= `$self->{ launch_exe } --version`;
295 0           $version=~ s!\s+!!g;
296 0           $version
297             };
298             }
299              
300             =head2 C<< $mech->ghostdriver_version >>
301              
302             print $mech->ghostdriver_version;
303              
304             Returns the version of the ghostdriver script that is used.
305              
306             =cut
307              
308             sub ghostdriver_version {
309 0     0 1   my( $self )= @_;
310 0   0       $self->{ghostdriver_version} ||= do {
311 0           $self->eval_in_phantomjs('return ghostdriver.version');
312             };
313             }
314              
315             =head2 C<< $mech->driver >>
316              
317             my $selenium= $mech->driver
318              
319             Access the L instance connecting to PhantomJS.
320              
321             =cut
322              
323             sub driver {
324             $_[0]->{driver}
325 0     0 1   };
326              
327             sub autodie {
328 0     0 1   my( $self, $val )= @_;
329 0 0         $self->{autodie} = $val
330             if @_ == 2;
331             $_[0]->{autodie}
332 0           }
333              
334             sub allow {
335 0     0 0   my($self,%options)= @_;
336 0           for my $opt (keys %options) {
337 0 0         if( 'javascript' eq $opt ) {
338 0           $self->eval_in_phantomjs(<<'JS', $options{ $opt });
339             this.settings.javascriptEnabled= arguments[0]
340             JS
341             } else {
342 0           warn "->allow('$opt', ...) is currently a dummy.";
343             };
344             };
345             }
346              
347             =head2 C<< $mech->js_alerts() >>
348              
349             print for $mech->js_alerts();
350              
351             An interface to the Javascript Alerts
352              
353             Returns the list of alerts
354              
355             =cut
356              
357 0     0 1   sub js_alerts { @{ shift->eval_in_phantomjs('return this.alerts') } }
  0            
358              
359             =head2 C<< $mech->clear_js_alerts() >>
360              
361             $mech->clear_js_alerts();
362              
363             Clears all saved alerts
364              
365             =cut
366              
367 0     0 1   sub clear_js_alerts { shift->eval_in_phantomjs('this.alerts = [];') }
368              
369             =head2 C<< $mech->js_errors() >>
370              
371             print $_->{message}
372             for $mech->js_errors();
373              
374             An interface to the Javascript Error Console
375              
376             Returns the list of errors in the JEC
377              
378             Maybe this should be called C or
379             C instead.
380              
381             =cut
382              
383             sub js_errors {
384 0     0 1   my ($self) = @_;
385 0           my $errors= $self->eval_in_phantomjs(<<'JS');
386             return this.errors
387             JS
388 0           @$errors
389             }
390              
391             =head2 C<< $mech->clear_js_errors() >>
392              
393             $mech->clear_js_errors();
394              
395             Clears all Javascript messages from the console
396              
397             =cut
398              
399             sub clear_js_errors {
400 0     0 1   my ($self) = @_;
401 0           my $errors= $self->eval_in_phantomjs(<<'JS');
402             this.errors= [];
403             JS
404              
405             };
406              
407             =head2 C<< $mech->confirm( 'Really do this?' [ => 1 ]) >>
408              
409             Records a confirmation (which is "1" or "ok" by default), to be used
410             whenever javascript fires a confirm dialog. If the message is not found,
411             the answer is "cancel".
412              
413             =cut
414              
415             sub confirm
416             {
417 0     0 1   my ( $self, $msg, $affirmative ) = @_;
418 0 0         $affirmative = 1 unless defined $affirmative;
419 0 0         $affirmative = $affirmative ? 'true' : 'false';
420 0           $self->eval_in_phantomjs("this.confirms['$msg']=$affirmative;");
421             }
422              
423             =head2 C<< $mech->eval_in_page( $str, @args ) >>
424              
425             =head2 C<< $mech->eval( $str, @args ) >>
426              
427             my ($value, $type) = $mech->eval( '2+2' );
428              
429             Evaluates the given Javascript fragment in the
430             context of the web page.
431             Returns a pair of value and Javascript type.
432              
433             This allows access to variables and functions declared
434             "globally" on the web page.
435              
436             This method is special to WWW::Mechanize::PhantomJS.
437              
438             =cut
439              
440             sub eval_in_page {
441 0     0 1   my ($self,$str,@args) = @_;
442              
443             # Report errors from scope of caller
444             # This feels weirdly backwards here, but oh well:
445             local @Selenium::Remote::Driver::CARP_NOT
446 0           = (@Selenium::Remote::Driver::CARP_NOT, (ref $self)); # we trust this
447             local @CARP_NOT
448 0           = (@CARP_NOT, 'Selenium::Remote::Driver', (ref $self)); # we trust this
449 0           my $eval_in_sandbox = $self->driver->execute_script("return $str", @args);
450 0           $self->post_process;
451 0           return $eval_in_sandbox;
452             };
453              
454             {
455 34     34   316 no warnings 'once';
  34         74  
  34         53677  
456             *eval = \&eval_in_page;
457             }
458              
459             =head2 C<< $mech->eval_in_phantomjs $code, @args >>
460              
461             $mech->eval_in_phantomjs(<<'JS', "Foobar/1.0");
462             this.settings.userAgent= arguments[0]
463             JS
464              
465             Evaluates Javascript code in the context of PhantomJS.
466              
467             This allows you to modify properties of PhantomJS.
468              
469             =cut
470              
471             sub eval_in_phantomjs {
472 0     0 1   my ($self, $code, @args) = @_;
473             #my $tab = $self->tab;
474              
475 0           my $cmds= $self->driver->commands->get_cmds; # Initialize
476 0   0       $cmds->{'phantomExecute'}||= {
477             'method' => 'POST',
478             'url' => "session/:sessionId/phantom/execute"
479             };
480              
481 0           my $params= {
482             args => \@args,
483             script => $code,
484             };
485 0           $self->driver->_execute_command({ command => 'phantomExecute' }, $params);
486             };
487              
488             sub agent {
489 0     0 0   my($self, $ua) = @_;
490             # page.settings.userAgent = 'Mozilla/5.0 (Windows NT 5.1; rv:8.0) Gecko/20100101 Firefox/7.0';
491 0           $self->eval_in_phantomjs(<<'JS', $ua);
492             this.settings.userAgent= arguments[0]
493             JS
494             }
495              
496             sub DESTROY {
497 0     0     my $pid= delete $_[0]->{pid};
498              
499             # Purge the filehandle - we should've opened that to /dev/null anyway:
500 0 0         if( my $child_out = $_[0]->{ fh }) {
501 0           local $/;
502 0           1 while <$child_out>;
503             };
504              
505 0           eval {
506 0           my $dr= delete $_[0]->{ driver };
507 0           $dr->quit;
508 0           undef $dr;
509             };
510 0 0         if( $pid ) {
511 0           kill 'SIGKILL' => $pid;
512             };
513 0           %{ $_[0] }= (); # clean out all other held references
  0            
514             }
515              
516             =head2 C<< $mech->highlight_node( @nodes ) >>
517              
518             my @links = $mech->selector('a');
519             $mech->highlight_node(@links);
520             print $mech->content_as_png();
521              
522             Convenience method that marks all nodes in the arguments
523             with
524              
525             background: red;
526             border: solid black 1px;
527             display: block; /* if the element was display: none before */
528              
529             This is convenient if you need visual verification that you've
530             got the right nodes.
531              
532             There currently is no way to restore the nodes to their original
533             visual state except reloading the page.
534              
535             =cut
536              
537             sub highlight_node {
538 0     0 1   my ($self,@nodes) = @_;
539 0           for (@nodes) {
540 0           my $style= $self->eval_in_page(<
541             (function(el) {
542             if( 'none' == el.style.display ) {
543             el.style.display= 'block';
544             };
545             el.style.background= 'red';
546             el.style.border= 'solid black 1px';
547             })(arguments[0]);
548             JS
549             };
550             };
551              
552             =head1 NAVIGATION METHODS
553              
554             =head2 C<< $mech->get( $url, %options ) >>
555              
556             $mech->get( $url );
557              
558             Retrieves the URL C.
559              
560             It returns a faked L object for interface compatibility
561             with L. It seems that Selenium and thus L
562             have no concept of HTTP status code and thus no way of returning the
563             HTTP status code.
564              
565             Note that PhantomJs does not support download of files.
566              
567             =cut
568              
569             sub update_response {
570 0     0 0   my( $self, $phantom_res ) = @_;
571              
572             # just 1 means success
573 0 0 0       $phantom_res = {
574             status => 200,
575             statusText => 'OK',
576             headers => [{
577             name => 'x-www-mechanize-phantomjs-fake-success',
578             value => 1,
579             }],
580             } if ref($phantom_res) eq '' and $phantom_res eq '1';
581              
582             # Now add a status code of 4xx if we don't have one.
583 0 0         if( ! $phantom_res->{status}) {
584 0           $phantom_res->{status}= 400;
585 0           $phantom_res->{statusText}= "Unknown error (added by " . __PACKAGE__ . ")";
586             };
587              
588 0           my @headers= map {;@{$_}{qw(name value)}} @{ $phantom_res->{headers} };
  0            
  0            
  0            
589 0           my $res= HTTP::Response->new( $phantom_res->{status}, $phantom_res->{statusText}, \@headers );
590              
591             # Should we fetch the response body?!
592              
593 0           delete $self->{ current_form };
594              
595 0           $self->{response} = $res;
596 0           return $res
597             };
598              
599             sub get {
600 0     0 1   my ($self, $url, %options ) = @_;
601             # We need to stringify $url so it can pass through JSON
602 0           my $phantom_res= $self->driver->get( "$url" );
603 0           $self->post_process;
604              
605 0           $self->update_response( $phantom_res );
606             };
607              
608             =head2 C<< $mech->get_local( $filename , %options ) >>
609              
610             $mech->get_local('test.html');
611              
612             Shorthand method to construct the appropriate
613             C<< file:// >> URI and load it into PhantomJS. Relative
614             paths will be interpreted as relative to C<$0>.
615              
616             This method accepts the same options as C<< ->get() >>.
617              
618             This method is special to WWW::Mechanize::PhantomJS but could
619             also exist in WWW::Mechanize through a plugin.
620              
621             B: PhantomJs does not handle local files well. Especially
622             subframes do not get loaded properly.
623              
624             =cut
625              
626             sub get_local {
627 0     0 1   my ($self, $htmlfile, %options) = @_;
628 0           require Cwd;
629 0           require File::Spec;
630 0 0         my $fn= File::Spec->file_name_is_absolute( $htmlfile )
631             ? $htmlfile
632             : File::Spec->rel2abs(
633             File::Spec->catfile(dirname($0),$htmlfile),
634             Cwd::getcwd(),
635             );
636 0           $fn =~ s!\\!/!g; # fakey "make file:// URL"
637 0           my $url;
638 0 0         if( $^O =~ /mswin/i ) {
639 0           $url= "file:///$fn";
640             } else {
641 0           $url= "file://$fn";
642             };
643 0           my $res= $self->get($url, %options);
644             # PhantomJS is not helpful with its error messages for local URLs
645 0 0 0       if( 0+$res->headers->header_field_names and ([$res->headers->header_field_names]->[0] ne 'x-www-mechanize-phantomjs-fake-success' or $self->uri ne 'about:blank')) {
      0        
646             # We need to fake the content headers from tags too...
647             # Maybe this even needs to go into ->get()
648 0           $res->code( 200 );
649             } else {
650 0           $res->code( 400 ); # Must have been "not found"
651             };
652 0           $res
653             }
654              
655             =head2 C<< $mech->post( $url, %options ) >>
656              
657             B
658              
659             Selenium currently does not allow a raw POST message
660             and the code for constructing a form on the fly is not working
661             so this method is not implemented.
662              
663             $mech->post( 'http://example.com',
664             params => { param => "Hello World" },
665             headers => {
666             "Content-Type" => 'application/x-www-form-urlencoded',
667             },
668             charset => 'utf-8',
669             );
670              
671             Sends a POST request to C<$url>.
672              
673             A C header will be automatically calculated if
674             it is not given.
675              
676             The following options are recognized:
677              
678             =over 4
679              
680             =item *
681              
682             C - a hash of HTTP headers to send. If not given,
683             the content type will be generated automatically.
684              
685             =item *
686              
687             C - the raw data to send, if you've encoded it already.
688              
689             =back
690              
691             =cut
692              
693             sub post {
694 0     0 1   my ($self, $url, %options) = @_;
695             #my $b = $self->tab->{linkedBrowser};
696 0           $self->clear_current_form;
697              
698             #my $flags = 0;
699             #if ($options{no_cache}) {
700             # $flags = $self->repl->constant('nsIWebNavigation.LOAD_FLAGS_BYPASS_CACHE');
701             #};
702              
703             # If we don't have data, encode the parameters:
704 0 0         if( !$options{ data }) {
705 0           my $req= HTTP::Request::Common::POST( $url, $options{params} );
706             #warn $req->content;
707 0           carp "Faking content from parameters is not yet supported.";
708             #$options{ data } = $req->content;
709             };
710              
711             #$options{ charset } ||= 'utf-8';
712             #$options{ headers } ||= {};
713             #$options{ headers }->{"Content-Type"} ||= "application/x-www-form-urlencoded";
714             #if( $options{ charset }) {
715             # $options{ headers }->{"Content-Type"} .= "; charset=$options{ charset }";
716             #};
717              
718             # Javascript POST implementation taken from
719             # http://stackoverflow.com/questions/133925/javascript-post-request-like-a-form-submit
720 0           $self->eval(<<'JS', $url, $options{ params }, 'POST');
721             function (path, params, method) {
722             method = method || "post"; // Set method to post by default if not specified.
723              
724             // The rest of this code assumes you are not using a library.
725             // It can be made less wordy if you use one.
726             var form = document.createElement("form");
727             form.setAttribute("method", method);
728             form.setAttribute("action", path);
729              
730             for(var key in params) {
731             if(params.hasOwnProperty(key)) {
732             var hiddenField = document.createElement("input");
733             hiddenField.setAttribute("type", "hidden");
734             hiddenField.setAttribute("name", key);
735             hiddenField.setAttribute("value", params[key]);
736              
737             form.appendChild(hiddenField);
738             }
739             }
740              
741             document.body.appendChild(form);
742             form.submit();
743             }
744             JS
745             # Now, how to trick Selenium into fetching the response?
746             }
747              
748             =head2 C<< $mech->add_header( $name => $value, ... ) >>
749              
750             $mech->add_header(
751             'X-WWW-Mechanize-PhantomJS' => "I'm using it",
752             Encoding => 'text/klingon',
753             );
754              
755             This method sets up custom headers that will be sent with B HTTP(S)
756             request that PhantomJS makes.
757              
758             Note that currently, we only support one value per header.
759              
760             =cut
761              
762             sub add_header {
763 0     0 1   my ($self, @headers) = @_;
764 34     34   353 use Data::Dumper;
  34         86  
  34         11098  
765             #warn Dumper $headers;
766              
767 0           while( my ($k,$v) = splice @headers, 0, 2 ) {
768 0           $self->eval_in_phantomjs(<<'JS', , $k, $v);
769             var h= this.customHeaders;
770             h[arguments[0]]= arguments[1];
771             this.customHeaders= h;
772             JS
773             };
774             };
775              
776             =head2 C<< $mech->delete_header( $name , $name2... ) >>
777              
778             $mech->delete_header( 'User-Agent' );
779              
780             Removes HTTP headers from the agent's list of special headers. Note
781             that PhantomJS may still send a header with its default value.
782              
783             =cut
784              
785             sub delete_header {
786 0     0 1   my ($self, @headers) = @_;
787              
788 0           $self->eval_in_phantomjs(<<'JS', @headers);
789             var headers= this.customHeaders;
790             for( var i = 0; i < arguments.length; i++ ) {
791             delete headers[arguments[i]];
792             };
793             this.customHeaders= headers;
794             JS
795             };
796              
797             =head2 C<< $mech->reset_headers >>
798              
799             $mech->reset_headers();
800              
801             Removes all custom headers and makes PhantomJS send its defaults again.
802              
803             =cut
804              
805             sub reset_headers {
806 0     0 1   my ($self) = @_;
807 0           $self->eval_in_phantomjs('this.customHeaders= {}');
808             };
809              
810             =head2 C<< $mech->res() >> / C<< $mech->response(%options) >>
811              
812             my $response = $mech->response(headers => 0);
813              
814             Returns the current response as a L object.
815              
816             =cut
817              
818 0     0 1   sub response { $_[0]->{response} };
819              
820             {
821 34     34   264 no warnings 'once';
  34         79  
  34         51541  
822             *res = \&response;
823             }
824              
825             # Call croak or carp, depending on the C< autodie > setting
826             sub signal_condition {
827 0     0 0   my ($self,$msg) = @_;
828 0 0         if ($self->{autodie}) {
829 0           croak $msg
830             } else {
831 0           carp $msg
832             }
833             };
834              
835             # Call croak on the C< autodie > setting if we have a non-200 status
836             sub signal_http_status {
837 0     0 0   my ($self) = @_;
838 0 0         if ($self->{autodie}) {
839 0 0 0       if ($self->status and $self->status !~ /^2/ and $self->status != 0) {
      0        
840             # there was an error
841 0   0       croak ($self->response(headers => 0)->message || sprintf "Got status code %d", $self->status );
842             };
843             } else {
844             # silent
845             }
846             };
847              
848             =head2 C<< $mech->success() >>
849              
850             $mech->get('http://google.com');
851             print "Yay"
852             if $mech->success();
853              
854             Returns a boolean telling whether the last request was successful.
855             If there hasn't been an operation yet, returns false.
856              
857             This is a convenience function that wraps C<< $mech->res->is_success >>.
858              
859             =cut
860              
861             sub success {
862 0     0 1   my $res = $_[0]->response( headers => 0 );
863 0 0         $res and $res->is_success
864             }
865              
866             =head2 C<< $mech->status() >>
867              
868             $mech->get('http://google.com');
869             print $mech->status();
870             # 200
871              
872             Returns the HTTP status code of the response.
873             This is a 3-digit number like 200 for OK, 404 for not found, and so on.
874              
875             =cut
876              
877             sub status {
878 0     0 1   my ($self) = @_;
879 0           return $self->response( headers => 0 )->code
880             };
881              
882             =head2 C<< $mech->back() >>
883              
884             $mech->back();
885              
886             Goes one page back in the page history.
887              
888             Returns the (new) response.
889              
890             =cut
891              
892             sub back {
893 0     0 1   my ($self) = @_;
894              
895 0           $self->driver->go_back;
896             }
897              
898             =head2 C<< $mech->forward() >>
899              
900             $mech->forward();
901              
902             Goes one page forward in the page history.
903              
904             Returns the (new) response.
905              
906             =cut
907              
908             sub forward {
909 0     0 1   my ($self) = @_;
910 0           $self->driver->go_forward;
911             }
912              
913             =head2 C<< $mech->uri() >>
914              
915             print "We are at " . $mech->uri;
916              
917             Returns the current document URI.
918              
919             =cut
920              
921             sub uri {
922 0     0 1   URI->new( $_[0]->driver->get_current_url )
923             }
924              
925             =head1 CONTENT METHODS
926              
927             =head2 C<< $mech->document() >>
928              
929             Returns the document object as a WebElement.
930              
931             This is WWW::Mechanize::PhantomJS specific.
932              
933             =cut
934              
935             sub document {
936 0     0 1   $_[0]->driver->find_element('html','tag_name');
937             }
938              
939             # If things get nasty, we could fall back to PhantomJS.webpage.plainText
940             # var page = require('webpage').create();
941             # page.open('http://somejsonpage.com', function () {
942             # var jsonSource = page.plainText;
943             sub decoded_content {
944 0     0 0   $_[0]->driver->get_page_source
945             };
946              
947             =head2 C<< $mech->content( %options ) >>
948              
949             print $mech->content;
950             print $mech->content( format => 'html' ); # default
951             print $mech->content( format => 'text' ); # identical to ->text
952              
953             This always returns the content as a Unicode string. It tries
954             to decode the raw content according to its input encoding.
955             This currently only works for HTML pages, not for images etc.
956              
957             Recognized options:
958              
959             =over 4
960              
961             =item *
962              
963             C - the stuff to return
964              
965             The allowed values are C and C. The default is C.
966              
967             =back
968              
969             =cut
970              
971             sub content {
972 0     0 1   my ($self, %options) = @_;
973 0   0       $options{ format } ||= 'html';
974 0   0       my $format = delete $options{ format } || 'html';
975              
976 0           my $content;
977 0 0         if( 'html' eq $format ) {
    0          
978 0           $content= $self->driver->get_page_source
979             } elsif ( $format eq 'text' ) {
980 0           $content= $self->text;
981             } else {
982 0           $self->die( qq{Unknown "format" parameter "$format"} );
983             };
984             };
985              
986             =head2 C<< $mech->text() >>
987              
988             print $mech->text();
989              
990             Returns the text of the current HTML content. If the content isn't
991             HTML, $mech will die.
992              
993             =cut
994              
995             sub text {
996 0     0 1   my $self = shift;
997              
998             # Waugh - this is highly inefficient but conveniently short to write
999             # Maybe this should skip SCRIPT nodes...
1000 0           join '', map { $_->get_text() } $self->xpath('//*/text()');
  0            
1001             }
1002              
1003             =head2 C<< $mech->content_encoding() >>
1004              
1005             print "The content is encoded as ", $mech->content_encoding;
1006              
1007             Returns the encoding that the content is in. This can be used
1008             to convert the content from UTF-8 back to its native encoding.
1009              
1010             =cut
1011              
1012             sub content_encoding {
1013 0     0 1   my ($self) = @_;
1014             # Let's trust the
1015             # Also, a pox on PhantomJS for not having lower-case or upper-case
1016 0 0         if(( my $meta )= $self->xpath( q{//meta[translate(@http-equiv,'ABCDEFGHIJKLMNOPQRSTUVWXYZ','abcdefghijklmnopqrstuvwxyz')="content-type"]}, first => 1 )) {
1017 0           (my $ct= $meta->get_attribute('content')) =~ s/^.*;\s*charset=\s*//i;
1018 0 0         return $ct
1019             if( $ct );
1020             };
1021 0           $self->response->header('Content-Type');
1022             };
1023              
1024             =head2 C<< $mech->update_html( $html ) >>
1025              
1026             $mech->update_html($html);
1027              
1028             Writes C<$html> into the current document. This is mostly
1029             implemented as a convenience method for L.
1030              
1031             =cut
1032              
1033             sub update_html {
1034 0     0 1   my ($self,$content) = @_;
1035 0           $self->eval_in_phantomjs('this.setContent(arguments[0], arguments[1])', $content);
1036             };
1037              
1038             =head2 C<< $mech->base() >>
1039              
1040             print $mech->base;
1041              
1042             Returns the URL base for the current page.
1043              
1044             The base is either specified through a C
1045             tag or is the current URL.
1046              
1047             This method is specific to WWW::Mechanize::PhantomJS.
1048              
1049             =cut
1050              
1051             sub base {
1052 0     0 1   my ($self) = @_;
1053 0           (my $base) = $self->selector('base');
1054             $base = $base->{href}
1055 0 0         if $base;
1056 0   0       $base ||= $self->uri;
1057             };
1058              
1059             =head2 C<< $mech->content_type() >>
1060              
1061             =head2 C<< $mech->ct() >>
1062              
1063             print $mech->content_type;
1064              
1065             Returns the content type of the currently loaded document
1066              
1067             =cut
1068              
1069             sub content_type {
1070 0     0 1   my ($self) = @_;
1071             # Let's trust the
1072             # Also, a pox on PhantomJS for not having lower-case or upper-case
1073 0           my $ct;
1074 0 0         if(my( $meta )= $self->xpath( q{//meta[translate(@http-equiv,'ABCDEFGHIJKLMNOPQRSTUVWXYZ','abcdefghijklmnopqrstuvwxyz')="content-type"]}, first => 1 )) {
1075 0           $ct= $meta->get_attribute('content');
1076             };
1077 0 0 0       if(!$ct and my $r= $self->response ) {
1078 0           my $h= $r->headers;
1079 0           $ct= $h->header('Content-Type');
1080             };
1081 0 0         $ct =~ s/;.*$// if defined $ct;
1082 0           $ct
1083             };
1084              
1085             {
1086 34     34   327 no warnings 'once';
  34         72  
  34         32949  
1087             *ct = \&content_type;
1088             }
1089              
1090             =head2 C<< $mech->is_html() >>
1091              
1092             print $mech->is_html();
1093              
1094             Returns true/false on whether our content is HTML, according to the
1095             HTTP headers.
1096              
1097             =cut
1098              
1099             sub is_html {
1100 0     0 1   my $self = shift;
1101 0   0       return defined $self->ct && ($self->ct eq 'text/html');
1102             }
1103              
1104             =head2 C<< $mech->title() >>
1105              
1106             print "We are on page " . $mech->title;
1107              
1108             Returns the current document title.
1109              
1110             =cut
1111              
1112             sub title {
1113 0     0 1   $_[0]->driver->get_title;
1114             };
1115              
1116             =head1 EXTRACTION METHODS
1117              
1118             =head2 C<< $mech->links() >>
1119              
1120             print $_->text . " -> " . $_->url . "\n"
1121             for $mech->links;
1122              
1123             Returns all links in the document as L objects.
1124              
1125             Currently accepts no parameters. See C<< ->xpath >>
1126             or C<< ->selector >> when you want more control.
1127              
1128             =cut
1129              
1130             our %link_spec = (
1131             a => { url => 'href', },
1132             area => { url => 'href', },
1133             frame => { url => 'src', },
1134             iframe => { url => 'src', },
1135             link => { url => 'href', },
1136             meta => { url => 'content', xpath => (join '',
1137             q{translate(@http-equiv,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',},
1138             q{'abcdefghijklmnopqrstuvwxyz')="refresh"}), },
1139             );
1140             # taken from WWW::Mechanize. This should possibly just be reused there
1141             sub make_link {
1142 0     0 0   my ($self,$node,$base) = @_;
1143              
1144 0           my $tag = lc $node->get_tag_name;
1145 0           my $url;
1146 0 0         if ($tag) {
1147 0 0         if( ! exists $link_spec{ $tag }) {
1148 0           carp "Unknown link-spec tag '$tag'";
1149 0           $url= '';
1150             } else {
1151 0           $url = $node->get_attribute( $link_spec{ $tag }->{url} );
1152             };
1153             };
1154              
1155 0 0         if ($tag eq 'meta') {
1156 0           my $content = $url;
1157 0 0         if ( $content =~ /^\d+\s*;\s*url\s*=\s*(\S+)/i ) {
1158 0           $url = $1;
1159 0 0         $url =~ s/^"(.+)"$/$1/ or $url =~ s/^'(.+)'$/$1/;
1160             }
1161             else {
1162 0           undef $url;
1163             }
1164             };
1165              
1166 0 0         if (defined $url) {
1167 0           my $res = WWW::Mechanize::Link->new({
1168             tag => $tag,
1169             name => $node->get_attribute('name'),
1170             base => $base,
1171             url => $url,
1172             text => $node->get_text(),
1173             attrs => {},
1174             });
1175              
1176 0           $res
1177             } else {
1178             ()
1179 0           };
1180             }
1181              
1182             sub links {
1183 0     0 1   my ($self) = @_;
1184 0           my @links = $self->selector( join ",", sort keys %link_spec);
1185 0           my $base = $self->base;
1186             return map {
1187 0           $self->make_link($_,$base)
  0            
1188             } @links;
1189             };
1190              
1191             =head2 C<< $mech->selector( $css_selector, %options ) >>
1192              
1193             my @text = $mech->selector('p.content');
1194              
1195             Returns all nodes matching the given CSS selector. If
1196             C<$css_selector> is an array reference, it returns
1197             all nodes matched by any of the CSS selectors in the array.
1198              
1199             This takes the same options that C<< ->xpath >> does.
1200              
1201             This method is implemented via L.
1202              
1203             =cut
1204             {
1205 34     34   305 no warnings 'once';
  34         76  
  34         117908  
1206             *selector = \&WWW::Mechanize::Plugin::Selector::selector;
1207             }
1208              
1209             =head2 C<< $mech->find_link_dom( %options ) >>
1210              
1211             print $_->{innerHTML} . "\n"
1212             for $mech->find_link_dom( text_contains => 'CPAN' );
1213              
1214             A method to find links, like L's
1215             C<< ->find_links >> method. This method returns DOM objects from
1216             PhantomJS instead of WWW::Mechanize::Link objects.
1217              
1218             Note that PhantomJS
1219             might have reordered the links or frame links in the document
1220             so the absolute numbers passed via C
1221             might not be the same between
1222             L and L.
1223              
1224             The supported options are:
1225              
1226             =over 4
1227              
1228             =item *
1229              
1230             C<< text >> and C<< text_contains >> and C<< text_regex >>
1231              
1232             Match the text of the link as a complete string, substring or regular expression.
1233              
1234             Matching as a complete string or substring is a bit faster, as it is
1235             done in the XPath engine of PhantomJS.
1236              
1237             =item *
1238              
1239             C<< id >> and C<< id_contains >> and C<< id_regex >>
1240              
1241             Matches the C attribute of the link completely or as part
1242              
1243             =item *
1244              
1245             C<< name >> and C<< name_contains >> and C<< name_regex >>
1246              
1247             Matches the C attribute of the link
1248              
1249             =item *
1250              
1251             C<< url >> and C<< url_regex >>
1252              
1253             Matches the URL attribute of the link (C, C or C).
1254              
1255             =item *
1256              
1257             C<< class >> - the C attribute of the link
1258              
1259             =item *
1260              
1261             C<< n >> - the (1-based) index. Defaults to returning the first link.
1262              
1263             =item *
1264              
1265             C<< single >> - If true, ensure that only one element is found. Otherwise croak
1266             or carp, depending on the C parameter.
1267              
1268             =item *
1269              
1270             C<< one >> - If true, ensure that at least one element is found. Otherwise croak
1271             or carp, depending on the C parameter.
1272              
1273             The method Cs if no link is found. If the C option is true,
1274             it also Cs when more than one link is found.
1275              
1276             =back
1277              
1278             =cut
1279              
1280             our %xpath_quote = (
1281             '"' => '\"',
1282             #"'" => "\\'",
1283             #'[' => '[',
1284             #']' => ']',
1285             #'[' => '[\[]',
1286             #'[' => '\[',
1287             #']' => '[\]]',
1288             );
1289              
1290 0     0 0   sub quote_xpath($line) {
  0            
  0            
1291 0           local $_ = $line;
1292 0 0         s/(['"\[\]])/$xpath_quote{$1} || $1/ge;
  0            
1293 0           return $_
1294             };
1295              
1296             # Copied from WWW::Mechanize 1.97
1297             # Used by find_links to check for matches
1298             # The logic is such that ALL param criteria that are given must match
1299 0     0     sub _match_any_link_params( $self, $link, $p ) {
  0            
  0            
  0            
  0            
1300             # No conditions, anything matches
1301 0 0         return 1 unless keys %$p;
1302              
1303 0 0 0       return if defined $p->{url} && !($link->url eq $p->{url} );
1304 0 0 0       return if defined $p->{url_regex} && !($link->url =~ $p->{url_regex} );
1305 0 0 0       return if defined $p->{url_abs} && !($link->url_abs eq $p->{url_abs} );
1306 0 0 0       return if defined $p->{url_abs_regex} && !($link->url_abs =~ $p->{url_abs_regex} );
1307 0 0 0       return if defined $p->{text} && !(defined($link->text) && $link->text eq $p->{text} );
      0        
1308 0 0 0       return if defined $p->{text_regex} && !(defined($link->text) && $link->text =~ $p->{text_regex} );
      0        
1309 0 0 0       return if defined $p->{name} && !(defined($link->name) && $link->name eq $p->{name} );
      0        
1310 0 0 0       return if defined $p->{name_regex} && !(defined($link->name) && $link->name =~ $p->{name_regex} );
      0        
1311 0 0 0       return if defined $p->{tag} && !($link->tag && $link->tag eq $p->{tag} );
      0        
1312 0 0 0       return if defined $p->{tag_regex} && !($link->tag && $link->tag =~ $p->{tag_regex} );
      0        
1313              
1314 0 0 0       return if defined $p->{id} && !($link->attrs->{id} && $link->attrs->{id} eq $p->{id} );
      0        
1315 0 0 0       return if defined $p->{id_regex} && !($link->attrs->{id} && $link->attrs->{id} =~ $p->{id_regex} );
      0        
1316 0 0 0       return if defined $p->{class} && !($link->attrs->{class} && $link->attrs->{class} eq $p->{class} );
      0        
1317 0 0 0       return if defined $p->{class_regex} && !($link->attrs->{class} && $link->attrs->{class} =~ $p->{class_regex} );
      0        
1318              
1319             # Success: everything that was defined passed.
1320 0           return 1;
1321             }
1322              
1323             sub find_link_dom {
1324 0     0 1   my ($self,%opts) = @_;
1325 0           my %xpath_options;
1326              
1327 0           for (qw(node document frames)) {
1328             # Copy over XPath options that were passed in
1329 0 0         if (exists $opts{ $_ }) {
1330 0           $xpath_options{ $_ } = delete $opts{ $_ };
1331             };
1332             };
1333              
1334 0           my $single = delete $opts{ single };
1335 0   0       my $one = delete $opts{ one } || $single;
1336 0 0 0       if ($single and exists $opts{ n }) {
1337 0           croak "It doesn't make sense to use 'single' and 'n' option together"
1338             };
1339 0   0       my $n = (delete $opts{ n } || 1);
1340 0 0         $n--
1341             if ($n ne 'all'); # 1-based indexing
1342 0           my @spec;
1343              
1344             # Decode text and text_contains into XPath
1345 0           for my $lvalue (qw( text id name class )) {
1346 0           my %lefthand = (
1347             text => 'text()',
1348             );
1349 0           my %match_op = (
1350             '' => q{%s="%s"},
1351             'contains' => q{contains(%s,"%s")},
1352             # Ideally we would also handle *_regex here, but PhantomJS XPath
1353             # does not support fn:matches() :-(
1354             #'regex' => q{matches(%s,"%s","%s")},
1355             );
1356 0   0       my $lhs = $lefthand{ $lvalue } || '@'.$lvalue;
1357 0           for my $op (keys %match_op) {
1358 0           my $v = $match_op{ $op };
1359 0 0         $op = '_'.$op if length($op);
1360 0           my $key = "${lvalue}$op";
1361              
1362 0 0         if (exists $opts{ $key }) {
1363 0           my $p = delete $opts{ $key };
1364 0           push @spec, sprintf $v, $lhs, $p;
1365             };
1366             };
1367             };
1368              
1369 0 0         if (my $p = delete $opts{ url }) {
1370 0           push @spec, sprintf '@href = "%s" or @src="%s"', quote_xpath( $p ), quote_xpath( $p );
1371             }
1372 0           my @tags = (sort keys %link_spec);
1373 0 0         if (my $p = delete $opts{ tag }) {
1374 0           @tags = $p;
1375             };
1376 0 0         if (my $p = delete $opts{ tag_regex }) {
1377 0           @tags = grep /$p/, @tags;
1378             };
1379             my $q = join '|',
1380             map {
1381 0 0         my $xp= exists $link_spec{ $_ } ? $link_spec{$_}->{xpath} : undef;
  0            
1382 0           my @full = map {qq{($_)}} grep {defined} (@spec, $xp);
  0            
  0            
1383 0 0         if (@full) {
1384 0           sprintf "//%s[%s]", $_, join " and ", @full;
1385             } else {
1386 0           sprintf "//%s", $_
1387             };
1388             } (@tags);
1389             #warn $q;
1390              
1391 0           my @res = $self->xpath($q, %xpath_options );
1392              
1393 0 0         if (keys %opts) {
1394             # post-filter the remaining links through WWW::Mechanize
1395             # for all the options we don't support with XPath
1396              
1397 0           my $base = $self->base;
1398 0           require WWW::Mechanize;
1399             @res = grep {
1400 0           $self->_match_any_link_params($self->make_link($_,$base),\%opts)
  0            
1401             } @res;
1402             };
1403              
1404 0 0         if ($one) {
1405 0 0         if (0 == @res) { $self->signal_condition( "No link found matching '$q'" )};
  0            
1406 0 0         if ($single) {
1407 0 0         if (1 < @res) {
1408 0           $self->highlight_node(@res);
1409 0           $self->signal_condition(
1410             sprintf "%d elements found found matching '%s'", scalar @res, $q
1411             );
1412             };
1413             };
1414             };
1415              
1416 0 0         if ($n eq 'all') {
1417             return @res
1418 0           };
1419 0           $res[$n]
1420             }
1421              
1422             =head2 C<< $mech->find_link( %options ) >>
1423              
1424             print $_->text . "\n"
1425             for $mech->find_link( text_contains => 'CPAN' );
1426              
1427             A method quite similar to L's method.
1428             The options are documented in C<< ->find_link_dom >>.
1429              
1430             Returns a L object.
1431              
1432             This defaults to not look through child frames.
1433              
1434             =cut
1435              
1436             sub find_link {
1437 0     0 1   my ($self,%opts) = @_;
1438 0           my $base = $self->base;
1439             croak "Option 'all' not available for ->find_link. Did you mean to call ->find_all_links()?"
1440 0 0 0       if 'all' eq ($opts{n} || '');
1441 0 0         if (my $link = $self->find_link_dom(frames => 0, %opts)) {
1442 0           return $self->make_link($link, $base)
1443             } else {
1444             return
1445 0           };
1446             };
1447              
1448             =head2 C<< $mech->find_all_links( %options ) >>
1449              
1450             print $_->text . "\n"
1451             for $mech->find_all_links( text_regex => qr/google/i );
1452              
1453             Finds all links in the document.
1454             The options are documented in C<< ->find_link_dom >>.
1455              
1456             Returns them as list or an array reference, depending
1457             on context.
1458              
1459             This defaults to not look through child frames.
1460              
1461             =cut
1462              
1463             sub find_all_links {
1464 0     0 1   my ($self, %opts) = @_;
1465 0           $opts{ n } = 'all';
1466 0           my $base = $self->base;
1467             my @matches = map {
1468 0           $self->make_link($_, $base);
  0            
1469             } $self->find_all_links_dom( frames => 0, %opts );
1470 0 0         return @matches if wantarray;
1471 0           return \@matches;
1472             };
1473              
1474             =head2 C<< $mech->find_all_links_dom %options >>
1475              
1476             print $_->{innerHTML} . "\n"
1477             for $mech->find_all_links_dom( text_regex => qr/google/i );
1478              
1479             Finds all matching linky DOM nodes in the document.
1480             The options are documented in C<< ->find_link_dom >>.
1481              
1482             Returns them as list or an array reference, depending
1483             on context.
1484              
1485             This defaults to not look through child frames.
1486              
1487             =cut
1488              
1489             sub find_all_links_dom {
1490 0     0 1   my ($self,%opts) = @_;
1491 0           $opts{ n } = 'all';
1492 0           my @matches = $self->find_link_dom( frames => 0, %opts );
1493 0 0         return @matches if wantarray;
1494 0           return \@matches;
1495             };
1496              
1497             =head2 C<< $mech->follow_link( $link ) >>
1498              
1499             =head2 C<< $mech->follow_link( %options ) >>
1500              
1501             $mech->follow_link( xpath => '//a[text() = "Click here!"]' );
1502              
1503             Follows the given link. Takes the same parameters that C
1504             uses.
1505              
1506             Note that C<< ->follow_link >> will only try to follow link-like
1507             things like C tags.
1508              
1509             =cut
1510              
1511             sub follow_link {
1512 0     0 1   my ($self,$link,%opts);
1513 0 0         if (@_ == 2) { # assume only a link parameter
1514 0           ($self,$link) = @_;
1515 0           $self->click($link);
1516             } else {
1517 0           ($self,%opts) = @_;
1518 0           _default_limiter( one => \%opts );
1519 0           $link = $self->find_link_dom(%opts);
1520 0           $self->click({ dom => $link, %opts });
1521             }
1522             }
1523              
1524             # We need to trace the path from the root element to every webelement
1525             # because stupid GhostDriver/Selenium caches elements per document,
1526             # and not globally, keyed by document. Switching the implied reference
1527             # document makes lots of API calls fail :-(
1528             sub activate_parent_container {
1529 0     0 0   my( $self, $doc )= @_;
1530 0           $self->activate_container( $doc, 1 );
1531             };
1532              
1533             sub activate_container {
1534 0     0 0   my( $self, $doc, $just_parent )= @_;
1535 0           my $driver= $self->driver;
1536              
1537 0 0         if( ! $doc->{__path}) {
1538 0           die "Invalid document without __path encountered. I'm sorry.";
1539             };
1540             # Activate the root window/frame
1541             #warn "Activating root frame:";
1542             #$driver->switch_to_frame();
1543             #warn "Activating root frame done.";
1544              
1545 0           for my $el ( @{ $doc->{__path} }) {
  0            
1546             #warn "Switching frames downwards ($el)";
1547             #warn "Tag: " . $el->get_tag_name;
1548             #use Data::Dumper;
1549             #warn Dumper $el;
1550 0           warn sprintf "Switching during path to %s %s", $el->get_tag_name, $el->get_attribute('src');
1551 0           $driver->switch_to_frame( $el );
1552             };
1553              
1554 0 0         if( ! $just_parent ) {
1555 0           warn sprintf "Activating container %s too", $doc->{id};
1556             # Now, unless it's the root frame, activate the container. The root frame
1557             # already is activated above.
1558 0           warn "Getting tag";
1559 0           my $tag= $doc->get_tag_name;
1560             #my $src= $doc->get_attribute('src');
1561 0 0 0       if( 'html' ne $tag and '' ne $tag) {
1562             #warn sprintf "Switching to final container %s %s", $tag, $src;
1563 0           $driver->switch_to_frame( $doc );
1564             };
1565             #warn sprintf "Switched to final/main container %s %s", $tag, $src;
1566             };
1567             #warn $self->driver->get_current_url;
1568             #warn $self->driver->get_title;
1569             #my $body= $doc->get_attribute('contentDocument');
1570 0           my $body= $driver->find_element('/*', 'xpath');
1571 0 0         if( $body ) {
1572 0           warn "Now active container: " . $body->get_attribute('innerHTML');
1573             #$body= $body->get_attribute('document');
1574             #warn $body->get_attribute('innerHTML');
1575             };
1576             };
1577              
1578             =head2 C<< $mech->xpath( $query, %options ) >>
1579              
1580             my $link = $mech->xpath('//a[id="clickme"]', one => 1);
1581             # croaks if there is no link or more than one link found
1582              
1583             my @para = $mech->xpath('//p');
1584             # Collects all paragraphs
1585              
1586             my @para_text = $mech->xpath('//p/text()', type => $mech->xpathResult('STRING_TYPE'));
1587             # Collects all paragraphs as text
1588              
1589             Runs an XPath query in PhantomJS against the current document.
1590              
1591             If you need more information about the returned results,
1592             use the C<< ->xpathEx() >> function.
1593              
1594             The options allow the following keys:
1595              
1596             =over 4
1597              
1598             =item *
1599              
1600             C<< document >> - document in which the query is to be executed. Use this to
1601             search a node within a specific subframe of C<< $mech->document >>.
1602              
1603             =item *
1604              
1605             C<< frames >> - if true, search all documents in all frames and iframes.
1606             This may or may not conflict with C. This will default to the
1607             C setting of the WWW::Mechanize::PhantomJS object.
1608              
1609             =item *
1610              
1611             C<< node >> - node relative to which the query is to be executed. Note
1612             that you will have to use a relative XPath expression as well. Use
1613              
1614             .//foo
1615              
1616             instead of
1617              
1618             //foo
1619              
1620             =item *
1621              
1622             C<< single >> - If true, ensure that only one element is found. Otherwise croak
1623             or carp, depending on the C parameter.
1624              
1625             =item *
1626              
1627             C<< one >> - If true, ensure that at least one element is found. Otherwise croak
1628             or carp, depending on the C parameter.
1629              
1630             =item *
1631              
1632             C<< maybe >> - If true, ensure that at most one element is found. Otherwise
1633             croak or carp, depending on the C parameter.
1634              
1635             =item *
1636              
1637             C<< all >> - If true, return all elements found. This is the default.
1638             You can use this option if you want to use C<< ->xpath >> in scalar context
1639             to count the number of matched elements, as it will otherwise emit a warning
1640             for each usage in scalar context without any of the above restricting options.
1641              
1642             =item *
1643              
1644             C<< any >> - no error is raised, no matter if an item is found or not.
1645              
1646             =item *
1647              
1648             C<< type >> - force the return type of the query.
1649              
1650             type => $mech->xpathResult('ORDERED_NODE_SNAPSHOT_TYPE'),
1651              
1652             WWW::Mechanize::PhantomJS tries a best effort in giving you the appropriate
1653             result of your query, be it a DOM node or a string or a number. In the case
1654             you need to restrict the return type, you can pass this in.
1655              
1656             The allowed strings are documented in the MDN. Interesting types are
1657              
1658             ANY_TYPE (default, uses whatever things the query returns)
1659             STRING_TYPE
1660             NUMBER_TYPE
1661             ORDERED_NODE_SNAPSHOT_TYPE
1662              
1663             =back
1664              
1665             Returns the matched results.
1666              
1667             You can pass in a list of queries as an array reference for the first parameter.
1668             The result will then be the list of all elements matching any of the queries.
1669              
1670             This is a method that is not implemented in WWW::Mechanize.
1671              
1672             In the long run, this should go into a general plugin for
1673             L.
1674              
1675             =cut
1676              
1677             sub xpath {
1678 0     0 1   my( $self, $query, %options) = @_;
1679              
1680 0 0 0       if ('ARRAY' ne (ref $query||'')) {
1681 0           $query = [$query];
1682             };
1683              
1684 0 0         if( not exists $options{ frames }) {
1685 0           $options{ frames }= $self->{frames};
1686             };
1687              
1688 0           my $single = $options{ single };
1689 0           my $first = $options{ one };
1690 0           my $maybe = $options{ maybe };
1691 0           my $any = $options{ any };
1692 0   0       my $return_first_element = ($single or $first or $maybe or $any );
1693 0   0       $options{ user_info }||= join "|", @$query;
1694              
1695             # Construct some helper variables
1696 0   0       my $zero_allowed = not ($single or $first);
1697 0   0       my $two_allowed = not( $single or $maybe);
1698              
1699             # Sanity check for the common error of
1700             # my $item = $mech->xpath("//foo");
1701 0 0 0       if (! exists $options{ all } and not ($return_first_element)) {
1702 0 0 0       $self->signal_condition(join "\n",
1703             "You asked for many elements but seem to only want a single item.",
1704             "Did you forget to pass the 'single' option with a true value?",
1705             "Pass 'all => 1' to suppress this message and receive the count of items.",
1706             ) if defined wantarray and !wantarray;
1707             };
1708              
1709 0           my @res;
1710              
1711             # Save the current frame, because maybe we switch frames while searching
1712             # We should ideally save the complete path here, not just the current position
1713 0 0         if( $options{ document }) {
1714 0           warn sprintf "Document %s", $options{ document }->{id};
1715             };
1716             #my $original_frame= $self->current_frame;
1717              
1718             DOCUMENTS: {
1719 0   0       my $doc= $options{ document } || $self->document;
  0            
1720              
1721             # This stores the path to this document
1722 0   0       $doc->{__path}||= [];
1723              
1724             # @documents stores pairs of (containing document element, child element)
1725 0           my @documents= ($doc);
1726              
1727             # recursively join the results of sub(i)frames if wanted
1728              
1729 0           while (@documents) {
1730 0           my $doc = shift @documents;
1731              
1732             #$self->activate_container( $doc );
1733              
1734 0           my $q = join "|", @$query;
1735             #warn $q;
1736              
1737 0           my @found;
1738             # Now find the elements
1739 0 0         if ($options{ node }) {
1740             #$doc ||= $options{ node }->get_attribute( 'documentElement' );
1741             #if( $options{ document } and $options{ document }->get_tag_name =~ /^i?frame$/i) {
1742             # $self->driver->switch_to_frame( $options{ document });
1743             #} elsif( $options{ document } and $options{ document }->get_tag_name =~ /^html$/i) {
1744             # $self->driver->switch_to_frame();
1745             #} elsif( $options{ document }) {
1746             # die sprintf "Don't know how to switch to a '%s'", $options{ document }->get_tag_name;
1747             #};
1748 0           @found= map { $self->driver->find_child_elements( $options{ node }, $_ => 'xpath' ) } @$query;
  0            
1749             } else {
1750             #warn "Collecting frames";
1751             #my $tag= $doc->get_tag_name;
1752             #warn "Searching $doc->{id} for @$query";
1753 0           @found= map { $self->driver->find_elements( $_ => 'xpath' ) } @$query;
  0            
1754 0 0         if( ! @found ) {
1755             #warn "Nothing found matching @$query in frame";
1756             #warn $self->content;
1757             #$self->driver->switch_to_frame();
1758             };
1759             #$self->driver->switch_to_frame();
1760             #warn $doc->get_text;
1761             };
1762              
1763             # Remember the path to each found element
1764 0           for( @found ) {
1765             # We reuse the reference here instead of copying the list. So don't modify the list.
1766 0           $_->{__path}= $doc->{__path};
1767             };
1768              
1769 0           push @res, @found;
1770              
1771             # A small optimization to return if we already have enough elements
1772             # We can't do this on $return_first as there might be more elements
1773             #if( @res and $options{ return_first } and grep { $_->{resultSize} } @res ) {
1774             # @res= grep { $_->{resultSize} } @res;
1775             # last DOCUMENTS;
1776             #};
1777 34     34   385 use Data::Dumper;
  34         85  
  34         267506  
1778             #warn Dumper \@documents;
1779 0 0 0       if ($options{ frames } and not $options{ node }) {
1780             #warn "Expanding subframes";
1781             #warn ">Expanding below " . $doc->get_tag_name() . ' - ' . $doc->get_attribute('title');
1782             #local $nesting .= "--";
1783 0           my @d; # = $self->expand_frames( $options{ frames }, $doc );
1784             #warn sprintf("Found %s %s pointing to %s", $_->get_tag_name, $_->{id}, $_->get_attribute('src')) for @d;
1785 0           push @documents, @d;
1786             };
1787             };
1788             };
1789              
1790             # Restore frame context
1791             #warn "Switching back";
1792             #$self->activate_container( $original_frame );
1793              
1794             #@res
1795              
1796             # Determine if we want only one element
1797             # or a list, like WWW::Mechanize::PhantomJS
1798              
1799 0 0 0       if (! $zero_allowed and @res == 0) {
1800 0           $self->signal_condition( "No elements found for $options{ user_info }" );
1801             };
1802 0 0 0       if (! $two_allowed and @res > 1) {
1803             #$self->highlight_node(@res);
1804 0   0       warn $_->get_text() || '' for @res;
1805 0           $self->signal_condition( (scalar @res) . " elements found for $options{ user_info }" );
1806             };
1807              
1808 0 0         $return_first_element ? $res[0] : @res
1809              
1810             }
1811              
1812             =head2 C<< $mech->by_id( $id, %options ) >>
1813              
1814             my @text = $mech->by_id('_foo:bar');
1815              
1816             Returns all nodes matching the given ids. If
1817             C<$id> is an array reference, it returns
1818             all nodes matched by any of the ids in the array.
1819              
1820             This method is equivalent to calling C<< ->xpath >> :
1821              
1822             $self->xpath(qq{//*[\@id="$_"], %options)
1823              
1824             It is convenient when your element ids get mistaken for
1825             CSS selectors.
1826              
1827             =cut
1828              
1829             sub by_id {
1830 0     0 1   my ($self,$query,%options) = @_;
1831 0 0 0       if ('ARRAY' ne (ref $query||'')) {
1832 0           $query = [$query];
1833             };
1834             $options{ user_info } ||= "id "
1835 0   0       . join(" or ", map {qq{'$_'}} @$query)
  0            
1836             . " found";
1837 0           $query = [map { qq{.//*[\@id="$_"]} } @$query];
  0            
1838 0           $self->xpath($query, %options)
1839             }
1840              
1841             =head2 C<< $mech->click( $name [,$x ,$y] ) >>
1842              
1843             $mech->click( 'go' );
1844             $mech->click({ xpath => '//button[@name="go"]' });
1845              
1846             Has the effect of clicking a button (or other element) on the current form. The
1847             first argument is the C of the button to be clicked. The second and third
1848             arguments (optional) allow you to specify the (x,y) coordinates of the click.
1849              
1850             If there is only one button on the form, C<< $mech->click() >> with
1851             no arguments simply clicks that one button.
1852              
1853             If you pass in a hash reference instead of a name,
1854             the following keys are recognized:
1855              
1856             =over 4
1857              
1858             =item *
1859              
1860             C - Find the element to click by the CSS selector
1861              
1862             =item *
1863              
1864             C - Find the element to click by the XPath query
1865              
1866             =item *
1867              
1868             C - Click on the passed DOM element
1869              
1870             You can use this to click on arbitrary page elements. There is no convenient
1871             way to pass x/y co-ordinates with this method.
1872              
1873             =item *
1874              
1875             C - Click on the element with the given id
1876              
1877             This is useful if your document ids contain characters that
1878             do look like CSS selectors. It is equivalent to
1879              
1880             xpath => qq{//*[\@id="$id"]}
1881              
1882             =back
1883              
1884             Returns a L object.
1885              
1886             As a deviation from the WWW::Mechanize API, you can also pass a
1887             hash reference as the first parameter. In it, you can specify
1888             the parameters to search much like for the C calls.
1889              
1890             =cut
1891              
1892             sub click {
1893 0     0 1   my ($self,$name,$x,$y) = @_;
1894 0           my %options;
1895             my @buttons;
1896              
1897 0 0 0       if (! defined $name) {
    0 0        
    0          
1898 0           croak("->click called with undef link");
1899             } elsif (ref $name and blessed($name) and $name->can('click')) {
1900 0           $options{ dom } = $name;
1901             } elsif (ref $name eq 'HASH') { # options
1902 0           %options = %$name;
1903             } else {
1904 0           $options{ name } = $name;
1905             };
1906              
1907 0 0         if (exists $options{ name }) {
1908 0   0       $name = quotemeta($options{ name }|| '');
1909             $options{ xpath } = [
1910 0           sprintf( q{//*[(translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz")="button" and @name="%s") or (translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz")="input" and (@type="button" or @type="submit" or @type="image") and @name="%s")]}, $name, $name),
1911             ];
1912 0 0         if ($options{ name } eq '') {
1913 0           push @{ $options{ xpath }},
  0            
1914             q{//*[(translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz") = "button" or translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz")="input") and @type="button" or @type="submit" or @type="image"]},
1915             ;
1916             };
1917 0           $options{ user_info } = "Button with name '$name'";
1918             };
1919              
1920 0 0         if ($options{ dom }) {
1921 0           @buttons = $options{ dom };
1922             } else {
1923 0           @buttons = $self->_option_query(%options);
1924             };
1925              
1926 0           $buttons[0]->click();
1927 0           $self->post_process;
1928              
1929 0 0         if (defined wantarray) {
1930 0           return $self->response
1931             };
1932             }
1933              
1934             # Internal method to run either an XPath, CSS or id query against the DOM
1935             # Returns the element(s) found
1936             my %rename = (
1937             xpath => 'xpath',
1938             selector => 'selector',
1939             id => 'by_id',
1940             by_id => 'by_id',
1941             );
1942              
1943             sub _option_query {
1944 0     0     my ($self,%options) = @_;
1945 0           my ($method,$q);
1946 0           for my $meth (keys %rename) {
1947 0 0         if (exists $options{ $meth }) {
1948 0           $q = delete $options{ $meth };
1949 0   0       $method = $rename{ $meth } || $meth;
1950             }
1951             };
1952 0           _default_limiter( 'one' => \%options );
1953 0 0         croak "Need either a name, a selector or an xpath key!"
1954             if not $method;
1955 0           return $self->$method( $q, %options );
1956             };
1957              
1958             # Return the default limiter if no other limiting option is set:
1959             sub _default_limiter {
1960 0     0     my ($default, $options) = @_;
1961 0 0         if (! grep { exists $options->{ $_ } } qw(single one maybe all any)) {
  0            
1962 0           $options->{ $default } = 1;
1963             };
1964             return ()
1965 0           };
1966              
1967             =head2 C<< $mech->click_button( ... ) >>
1968              
1969             $mech->click_button( name => 'go' );
1970             $mech->click_button( input => $mybutton );
1971              
1972             Has the effect of clicking a button on the current form by specifying its
1973             name, value, or index. Its arguments are a list of key/value pairs. Only
1974             one of name, number, input or value must be specified in the keys.
1975              
1976             =over 4
1977              
1978             =item *
1979              
1980             C - name of the button
1981              
1982             =item *
1983              
1984             C - value of the button
1985              
1986             =item *
1987              
1988             C - DOM node
1989              
1990             =item *
1991              
1992             C - id of the button
1993              
1994             =item *
1995              
1996             C - number of the button
1997              
1998             =back
1999              
2000             If you find yourself wanting to specify a button through its
2001             C or C, consider using C<< ->click >> instead.
2002              
2003             =cut
2004              
2005             sub click_button {
2006 0     0 1   my ($self,%options) = @_;
2007 0           my $node;
2008             my $xpath;
2009 0           my $user_message;
2010 0 0         if (exists $options{ input }) {
    0          
    0          
    0          
    0          
2011 0           $node = delete $options{ input };
2012             } elsif (exists $options{ name }) {
2013 0           my $v = delete $options{ name };
2014 0           $xpath = sprintf( '//*[(translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz") = "button" and @name="%s") or (translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz")="input" and @type="button" or @type="submit" and @name="%s")]', $v, $v);
2015 0           $user_message = "Button name '$v' unknown";
2016             } elsif (exists $options{ value }) {
2017 0           my $v = delete $options{ value };
2018 0           $xpath = sprintf( '//*[(translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz") = "button" and @value="%s") or (translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz")="input" and (@type="button" or @type="submit") and @value="%s")]', $v, $v);
2019 0           $user_message = "Button value '$v' unknown";
2020             } elsif (exists $options{ id }) {
2021 0           my $v = delete $options{ id };
2022 0           $xpath = sprintf '//*[@id="%s"]', $v;
2023 0           $user_message = "Button name '$v' unknown";
2024             } elsif (exists $options{ number }) {
2025 0           my $v = delete $options{ number };
2026 0           $xpath = sprintf '//*[translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz") = "button" or (translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz") = "input" and @type="submit")][%s]', $v;
2027 0           $user_message = "Button number '$v' out of range";
2028             };
2029 0   0       $node ||= $self->xpath( $xpath,
2030             node => $self->current_form,
2031             single => 1,
2032             user_message => $user_message,
2033             );
2034 0 0         if ($node) {
2035 0           $self->click({ dom => $node, %options });
2036             } else {
2037              
2038 0           $self->signal_condition($user_message);
2039             };
2040              
2041             }
2042              
2043             =head1 FORM METHODS
2044              
2045             =head2 C<< $mech->current_form() >>
2046              
2047             print $mech->current_form->{name};
2048              
2049             Returns the current form.
2050              
2051             This method is incompatible with L.
2052             It returns the DOM C<<
>> object and not
2053             a L instance.
2054              
2055             The current form will be reset by WWW::Mechanize::PhantomJS
2056             on calls to C<< ->get() >> and C<< ->get_local() >>,
2057             and on calls to C<< ->submit() >> and C<< ->submit_with_fields >>.
2058              
2059             =cut
2060              
2061             sub current_form {
2062 0     0 1   my( $self, %options )= @_;
2063             # Find the first element from the currently active element
2064 0 0         $self->form_number(1) unless $self->{current_form};
2065 0           $self->{current_form};
2066             }
2067              
2068             sub clear_current_form {
2069 0     0 0   undef $_[0]->{current_form};
2070             };
2071              
2072             sub active_form {
2073 0     0 0   my( $self, %options )= @_;
2074             # Find the first element from the currently active element
2075 0           my $focus= $self->driver->get_active_element;
2076              
2077 0 0         if( !$focus ) {
2078 0           warn "No active element, hence no active form";
2079             return
2080 0           };
2081              
2082 0           my $form= $self->xpath( './ancestor-or-self::FORM', node => $focus, maybe => 1 );
2083              
2084             }
2085              
2086             =head2 C<< $mech->dump_forms( [$fh] ) >>
2087              
2088             open my $fh, '>', 'form-log.txt'
2089             or die "Couldn't open logfile 'form-log.txt': $!";
2090             $mech->dump_forms( $fh );
2091              
2092             Prints a dump of the forms on the current page to
2093             the filehandle C<$fh>. If C<$fh> is not specified or is undef, it dumps
2094             to C.
2095              
2096             =cut
2097              
2098             sub dump_forms {
2099 0     0 1   my $self = shift;
2100 0   0       my $fh = shift || \*STDOUT;
2101              
2102 0           for my $form ( $self->forms ) {
2103 0   0       print {$fh} "[FORM] ", $form->get_attribute('name') || '', ' ', $form->get_attribute('action'), "\n";
  0            
2104             #for my $f ($self->xpath( './/*', node => $form )) {
2105             #for my $f ($self->xpath( './/*[contains(" "+translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz")+" "," input textarea button select "
2106             # )]', node => $form )) {
2107 0           for my $f ($self->xpath( './/*[contains(" input textarea button select ",concat(" ",translate(local-name(.), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz")," "))]', node => $form )) {
2108 0           my $type;
2109 0 0 0       if($type= $f->get_attribute('type') || '' ) {
2110 0           $type= " ($type)";
2111             };
2112              
2113 0   0       print {$fh} " [", $f->get_attribute('tagName'), $type, "] ", $f->get_attribute('name') || '', "\n";
  0            
2114             };
2115             }
2116 0           return;
2117             }
2118              
2119             =head2 C<< $mech->form_name( $name [, %options] ) >>
2120              
2121             $mech->form_name( 'search' );
2122              
2123             Selects the current form by its name. The options
2124             are identical to those accepted by the L<< /$mech->xpath >> method.
2125              
2126             =cut
2127              
2128             sub form_name {
2129 0     0 1   my ($self,$name,%options) = @_;
2130 0           $name = quote_xpath( $name );
2131 0           _default_limiter( single => \%options );
2132 0           $self->{current_form} = $self->selector("form[name='$name']",
2133             user_info => "form name '$name'",
2134             %options
2135             );
2136             };
2137              
2138             =head2 C<< $mech->form_id( $id [, %options] ) >>
2139              
2140             $mech->form_id( 'login' );
2141              
2142             Selects the current form by its C attribute.
2143             The options
2144             are identical to those accepted by the L<< /$mech->xpath >> method.
2145              
2146             This is equivalent to calling
2147              
2148             $mech->by_id($id,single => 1,%options)
2149              
2150             =cut
2151              
2152             sub form_id {
2153 0     0 1   my ($self,$name,%options) = @_;
2154              
2155 0           _default_limiter( single => \%options );
2156 0           $self->{current_form} = $self->by_id($name,
2157             user_info => "form with id '$name'",
2158             %options
2159             );
2160             };
2161              
2162             =head2 C<< $mech->form_number( $number [, %options] ) >>
2163              
2164             $mech->form_number( 2 );
2165              
2166             Selects the Ith form.
2167             The options
2168             are identical to those accepted by the L<< /$mech->xpath >> method.
2169              
2170             =cut
2171              
2172             sub form_number {
2173 0     0 1   my ($self,$number,%options) = @_;
2174              
2175 0           _default_limiter( single => \%options );
2176 0           $self->{current_form} = $self->xpath("(//form)[$number]",
2177             user_info => "form number $number",
2178             %options
2179             );
2180             };
2181              
2182             =head2 C<< $mech->form_with_fields( [$options], @fields ) >>
2183              
2184             $mech->form_with_fields(
2185             'user', 'password'
2186             );
2187              
2188             Find the form which has the listed fields.
2189              
2190             If the first argument is a hash reference, it's taken
2191             as options to C<< ->xpath >>.
2192              
2193             See also L<< /$mech->submit_form >>.
2194              
2195             =cut
2196              
2197             sub form_with_fields {
2198 0     0 1   my ($self,@fields) = @_;
2199 0           my $options = {};
2200 0 0         if (ref $fields[0] eq 'HASH') {
2201 0           $options = shift @fields;
2202             };
2203 0           my @clauses = map { $self->element_query([qw[input select textarea]], { 'name' => $_ })} @fields;
  0            
2204              
2205              
2206 0           my $q = "//form[" . join( " and ", @clauses)."]";
2207             #warn $q;
2208 0           _default_limiter( single => $options );
2209 0           $self->{current_form} = $self->xpath($q,
2210             user_info => "form with fields [@fields]",
2211             %$options
2212             );
2213             #warn $form;
2214 0           $self->{current_form};
2215             };
2216              
2217             =head2 C<< $mech->forms( %options ) >>
2218              
2219             my @forms = $mech->forms();
2220              
2221             When called in a list context, returns a list
2222             of the forms found in the last fetched page.
2223             In a scalar context, returns a reference to
2224             an array with those forms.
2225              
2226             The options
2227             are identical to those accepted by the L<< /$mech->selector >> method.
2228              
2229             The returned elements are the DOM C<< >> elements.
2230              
2231             =cut
2232              
2233             sub forms {
2234 0     0 1   my ($self, %options) = @_;
2235 0           my @res = $self->selector('form', %options);
2236             return wantarray ? @res
2237 0 0         : \@res
2238             };
2239              
2240             =head2 C<< $mech->field( $selector, $value, [,\@pre_events [,\@post_events]] ) >>
2241              
2242             $mech->field( user => 'joe' );
2243             $mech->field( not_empty => '', [], [] ); # bypass JS validation
2244              
2245             Sets the field with the name given in C<$selector> to the given value.
2246             Returns the value.
2247              
2248             The method understands very basic CSS selectors in the value for C<$selector>,
2249             like the L find_input() method.
2250              
2251             A selector prefixed with '#' must match the id attribute of the input.
2252             A selector prefixed with '.' matches the class attribute. A selector
2253             prefixed with '^' or with no prefix matches the name attribute.
2254              
2255             By passing the array reference C<@pre_events>, you can indicate which
2256             Javascript events you want to be triggered before setting the value.
2257             C<@post_events> contains the events you want to be triggered
2258             after setting the value.
2259              
2260             By default, the events set in the
2261             constructor for C and C
2262             are triggered.
2263              
2264             =cut
2265              
2266             sub field {
2267 0     0 1   my ($self,$name,$value,$pre,$post) = @_;
2268 0           $self->get_set_value(
2269             name => $name,
2270             value => $value,
2271             pre => $pre,
2272             post => $post,
2273             node => $self->current_form,
2274             );
2275             }
2276              
2277             =head2 C<< $mech->value( $selector_or_element, [%options] ) >>
2278              
2279             print $mech->value( 'user' );
2280              
2281             Returns the value of the field given by C<$selector_or_name> or of the
2282             DOM element passed in.
2283              
2284             The legacy form of
2285              
2286             $mech->value( name => value );
2287              
2288             is also still supported but will likely be deprecated
2289             in favour of the C<< ->field >> method.
2290              
2291             For fields that can have multiple values, like a C
2292             the method is context sensitive and returns the first selected
2293             value in scalar context and all values in list context.
2294              
2295             =cut
2296              
2297             sub value {
2298 0 0   0 1   if (@_ == 3) {
2299 0           my ($self,$name,$value) = @_;
2300 0           return $self->field($name => $value);
2301             } else {
2302 0           my ($self,$name,%options) = @_;
2303 0           return $self->get_set_value(
2304             node => $self->current_form,
2305             %options,
2306             name => $name,
2307             );
2308             };
2309             };
2310              
2311             =head2 C<< $mech->get_set_value( %options ) >>
2312              
2313             Allows fine-grained access to getting/setting a value
2314             with a different API. Supported keys are:
2315              
2316             pre
2317             post
2318             name
2319             value
2320              
2321             in addition to all keys that C<< $mech->xpath >> supports.
2322              
2323             =cut
2324              
2325             sub _field_by_name {
2326 0     0     my ($self,%options) = @_;
2327 0           my @fields;
2328 0           my $name = delete $options{ name };
2329 0           my $attr = 'name';
2330 0 0         if ($name =~ s/^\^//) { # if it starts with ^, it's supposed to be a name
    0          
    0          
2331 0           $attr = 'name'
2332             } elsif ($name =~ s/^#//) {
2333 0           $attr = 'id'
2334             } elsif ($name =~ s/^\.//) {
2335 0           $attr = 'class'
2336             };
2337 0 0         if (blessed $name) {
2338 0           @fields = $name;
2339             } else {
2340 0           _default_limiter( single => \%options );
2341 0           my $query = $self->element_query([qw[input select textarea]], { $attr => $name });
2342             #warn $query;
2343 0           @fields = $self->xpath($query,%options);
2344             };
2345             @fields
2346 0           }
2347              
2348             sub escape
2349             {
2350 0     0 0   my $s = shift;
2351 0           $s =~ s/(["\\])/\\$1/g;
2352 0           $s =~ s/\n/\\n/g;
2353 0           $s =~ s/\r/\\r/g;
2354 0           return $s;
2355             }
2356              
2357             sub get_set_value {
2358 0     0 1   my ($self,%options) = @_;
2359 0           my $set_value = exists $options{ value };
2360 0           my $value = delete $options{ value };
2361 0   0       my $pre = delete $options{pre} || $self->{pre_value};
2362 0   0       my $post = delete $options{post} || $self->{post_value};
2363 0           my $name = delete $options{ name };
2364 0           my @fields = $self->_field_by_name(
2365             name => $name,
2366             user_info => "input with name '$name'",
2367             %options );
2368 0 0         $pre = [$pre]
2369             if (! ref $pre);
2370 0 0         $post = [$post]
2371             if (! ref $post);
2372              
2373 0 0         if ($fields[0]) {
2374 0           my $tag = $fields[0]->get_tag_name();
2375 0 0         if ($set_value) {
2376             #for my $ev (@$pre) {
2377             # $fields[0]->__event($ev);
2378             #};
2379              
2380 0           my $get= $self->PhantomJS_elementToJS();
2381 0           my $val= escape($value);
2382 0 0         my $bool = $value ? 'true' : 'false';
2383 0           my $js= <
2384             var g=$get;
2385             var el=g("$fields[0]->{id}");
2386             if (el.type=='checkbox')
2387             el.checked=$bool;
2388             else
2389             el.value="$val";
2390             JS
2391 0           $js= quotemeta($js);
2392 0           $self->eval("eval('$js')"); # for some reason, Selenium/Ghostdriver don't like the JS as plain JS
2393              
2394             #for my $ev (@$post) {
2395             # $fields[0]->__event($ev);
2396             #};
2397             };
2398             # What about 'checkbox'es/radioboxes?
2399              
2400             # Don't bother to fetch the field's value if it's not wanted
2401 0 0         return unless defined wantarray;
2402              
2403             # We could save some work here for the simple case of single-select
2404             # dropdowns by not enumerating all options
2405 0 0         if ('SELECT' eq uc $tag) {
2406 0           my @options = $self->xpath('.//option', node => $fields[0] );
2407 0           my @values = map { $_->{value} } grep { $_->{selected} } @options;
  0            
  0            
2408 0 0         if (wantarray) {
2409             return @values
2410 0           } else {
2411 0           return $values[0];
2412             }
2413             } else {
2414             return $fields[0]->{value}
2415 0           };
2416             } else {
2417             return
2418 0           }
2419             }
2420              
2421             =head2 C<< $mech->submit( $form ) >>
2422              
2423             $mech->submit;
2424              
2425             Submits the form. Note that this does B fire the C
2426             event and thus also does not fire eventual Javascript handlers.
2427             Maybe you want to use C<< $mech->click >> instead.
2428              
2429             The default is to submit the current form as returned
2430             by C<< $mech->current_form >>.
2431              
2432             =cut
2433              
2434             sub submit {
2435 0     0 1   my ($self,$dom_form) = @_;
2436 0   0       $dom_form ||= $self->current_form;
2437 0 0         if ($dom_form) {
2438 0           $dom_form->submit();
2439 0           $self->signal_http_status;
2440              
2441 0           $self->clear_current_form;
2442 0           1;
2443             } else {
2444 0           croak "I don't know which form to submit, sorry.";
2445             }
2446 0           $self->post_process;
2447 0           return $self->response;
2448             };
2449              
2450             =head2 C<< $mech->submit_form( %options ) >>
2451              
2452             $mech->submit_form(
2453             with_fields => {
2454             user => 'me',
2455             pass => 'secret',
2456             }
2457             );
2458              
2459             This method lets you select a form from the previously fetched page,
2460             fill in its fields, and submit it. It combines the form_number/form_name,
2461             set_fields and click methods into one higher level call. Its arguments are
2462             a list of key/value pairs, all of which are optional.
2463              
2464             =over 4
2465              
2466             =item *
2467              
2468             C<< form => $mech->current_form() >>
2469              
2470             Specifies the form to be filled and submitted. Defaults to the current form.
2471              
2472             =item *
2473              
2474             C<< fields => \%fields >>
2475              
2476             Specifies the fields to be filled in the current form
2477              
2478             =item *
2479              
2480             C<< with_fields => \%fields >>
2481              
2482             Probably all you need for the common case. It combines a smart form selector
2483             and data setting in one operation. It selects the first form that contains
2484             all fields mentioned in \%fields. This is nice because you don't need to
2485             know the name or number of the form to do this.
2486              
2487             (calls L<< /$mech->form_with_fields() >> and L<< /$mech->set_fields() >>).
2488              
2489             If you choose this, the form_number, form_name, form_id and fields options
2490             will be ignored.
2491              
2492             =back
2493              
2494             =cut
2495              
2496             sub submit_form {
2497 0     0 1   my ($self,%options) = @_;
2498              
2499 0           my $form = delete $options{ form };
2500 0           my $fields;
2501 0 0         if (! $form) {
2502 0 0         if ($fields = delete $options{ with_fields }) {
2503 0           my @names = keys %$fields;
2504 0           $form = $self->form_with_fields( \%options, @names );
2505 0 0         if (! $form) {
2506 0           $self->signal_condition("Couldn't find a matching form for @names.");
2507             return
2508 0           };
2509             } else {
2510 0   0       $fields = delete $options{ fields } || {};
2511 0           $form = $self->current_form;
2512             };
2513             };
2514              
2515 0 0         if (! $form) {
2516 0           $self->signal_condition("No form found to submit.");
2517             return
2518 0           };
2519 0           $self->do_set_fields( form => $form, fields => $fields );
2520              
2521 0           my $response;
2522 0 0         if ( $options{button} ) {
2523 0   0       $response = $self->click( $options{button}, $options{x} || 0, $options{y} || 0 );
      0        
2524             }
2525             else {
2526 0           $response = $self->submit();
2527             }
2528 0           return $response;
2529              
2530             }
2531              
2532             =head2 C<< $mech->set_fields( $name => $value, ... ) >>
2533              
2534             $mech->set_fields(
2535             user => 'me',
2536             pass => 'secret',
2537             );
2538              
2539             This method sets multiple fields of the current form. It takes a list of
2540             field name and value pairs. If there is more than one field with the same
2541             name, the first one found is set. If you want to select which of the
2542             duplicate field to set, use a value which is an anonymous array which
2543             has the field value and its number as the 2 elements.
2544              
2545             =cut
2546              
2547             sub set_fields {
2548 0     0 1   my ($self, %fields) = @_;
2549 0           my $f = $self->current_form;
2550 0 0         if (! $f) {
2551 0           croak "Can't set fields: No current form set.";
2552             };
2553 0           $self->do_set_fields(form => $f, fields => \%fields);
2554             };
2555              
2556             sub do_set_fields {
2557 0     0 0   my ($self, %options) = @_;
2558 0           my $form = delete $options{ form };
2559 0           my $fields = delete $options{ fields };
2560              
2561 0           while (my($n,$v) = each %$fields) {
2562 0 0         if (ref $v) {
2563 0           ($v,my $num) = @$v;
2564 0 0         warn "Index larger than 1 not supported, ignoring"
2565             unless $num == 1;
2566             };
2567              
2568 0           $self->get_set_value( node => $form, name => $n, value => $v, %options );
2569             }
2570             };
2571              
2572             =head2 C<< $mech->expand_frames( $spec ) >>
2573              
2574             my @frames = $mech->expand_frames();
2575              
2576             Expands the frame selectors (or C<1> to match all frames)
2577             into their respective PhantomJS nodes according to the current
2578             document. All frames will be visited in breadth first order.
2579              
2580             This is mostly an internal method.
2581              
2582             =cut
2583              
2584             sub expand_frames {
2585 0     0 1   my ($self, $spec, $document) = @_;
2586 0   0       $spec ||= $self->{frames};
2587 0 0         my @spec = ref $spec ? @$spec : $spec;
2588 0   0       $document ||= $self->document;
2589              
2590 0 0 0       if (! ref $spec and $spec !~ /\D/ and $spec == 1) {
      0        
2591             # All frames
2592 0           @spec = qw( frame iframe );
2593             };
2594              
2595             # Optimize the default case of only names in @spec
2596 0           my @res;
2597 0 0         if (! grep {ref} @spec) {
  0            
2598 0           @res = $self->selector(
2599             \@spec,
2600             document => $document,
2601             frames => 0, # otherwise we'll recurse :)
2602             );
2603             } else {
2604             @res =
2605             map { #warn "Expanding $_";
2606 0 0         ref $_
  0            
2607             ? $_
2608             # Just recurse into the above code path
2609             : $self->expand_frames( $_, $document );
2610             } @spec;
2611             }
2612              
2613             @res
2614 0           };
2615              
2616              
2617             =head2 C<< $mech->current_frame >>
2618              
2619             my $last_frame= $mech->current_frame;
2620             # Switch frame somewhere else
2621              
2622             # Switch back
2623             $mech->activate_container( $last_frame );
2624              
2625             Returns the currently active frame as a WebElement.
2626              
2627             This is mostly an internal method.
2628              
2629             See also
2630              
2631             L
2632              
2633             Frames are currently not really supported.
2634              
2635             =cut
2636              
2637             sub current_frame {
2638 0     0 1   my( $self )= @_;
2639 0           my @res;
2640 0           my $current= $self->make_WebElement( $self->eval('window'));
2641 0           warn sprintf "Current_frame: bottom: %s", $current->{id};
2642              
2643             # Now climb up until the root window
2644 0           my $f= $current;
2645 0           my @chain;
2646 0           warn "Walking up to root document";
2647 0           while( $f= $self->driver->execute_script('return arguments[0].frameElement', $f )) {
2648 0           $f= $self->make_WebElement( $f );
2649 0           unshift @res, $f;
2650             warn sprintf "One more level up, now in %s",
2651 0           $f->{id};
2652 0           warn $self->driver->execute_script('return arguments[0].title', $res[0]);
2653             unshift @chain,
2654 0           sprintf "Frame chain: %s %s", $res[0]->get_tag_name, $res[0]->{id};
2655             # Activate that frame
2656 0           $self->switch_to_parent_frame();
2657 0           warn "Going up once more, maybe";
2658             };
2659 0           warn "Chain complete";
2660             warn $_
2661 0           for @chain;
2662              
2663             # Now fake the element into
2664 0           my $el= $self->make_WebElement( $current );
2665 0           for( @res ) {
2666 0           warn sprintf "Path has (web element) id %s", $_->{id};
2667             };
2668 0           $el->{__path}= \@res;
2669 0           $el
2670             }
2671              
2672             sub switch_to_parent_frame {
2673             #use JSON;
2674 0     0 0   my ( $self ) = @_;
2675              
2676 0   0       $self->{driver}->{commands}->{'switchToParentFrame'}||= {
2677             'method' => 'POST',
2678             'url' => "session/:sessionId/frame/parent"
2679             };
2680              
2681             #my $json_null = JSON::null;
2682 0           my $params;
2683             #$id = ( defined $id ) ? $id : $json_null;
2684              
2685 0           my $res = { 'command' => 'switchToParentFrame' };
2686 0           return $self->driver->_execute_command( $res, $params );
2687             }
2688              
2689             sub make_WebElement {
2690 0     0 0   my( $self, $e )= @_;
2691 0 0 0       return $e
2692             if( blessed $e and $e->isa('Selenium::Remote::WebElement'));
2693 0   0       my $res= Selenium::Remote::WebElement->new( $e->{WINDOW} || $e->{ELEMENT}, $self->driver );
2694             croak "No id in " . Dumper $res
2695 0 0         unless $res->{id};
2696              
2697 0           $res
2698             }
2699              
2700             =head1 CONTENT RENDERING METHODS
2701              
2702             =head2 C<< $mech->content_as_png( [\%coordinates ] ) >>
2703              
2704             my $png_data = $mech->content_as_png();
2705              
2706             # Create scaled-down 480px wide preview
2707             my $png_data = $mech->content_as_png(undef, { width => 480 });
2708              
2709             Returns the given tab or the current page rendered as PNG image.
2710              
2711             All parameters are optional.
2712              
2713             =over 4
2714              
2715             =item C< \%coordinates >
2716              
2717             If the coordinates are given, that rectangle will be cut out.
2718             The coordinates should be a hash with the four usual entries,
2719             C,C,C,C.
2720              
2721             =back
2722              
2723             This method is specific to WWW::Mechanize::PhantomJS.
2724              
2725             Currently, the data transfer between PhantomJS and Perl
2726             is done Base64-encoded.
2727              
2728             =cut
2729              
2730             sub content_as_png {
2731 0     0 1   my ($self, $rect) = @_;
2732 0   0       $rect ||= {};
2733              
2734 0 0         if( scalar keys %$rect ) {
2735              
2736 0           $self->eval_in_phantomjs( 'this.clipRect= arguments[0]', $rect );
2737             };
2738              
2739 0           return $self->render_content( format => 'png' );
2740             };
2741              
2742             =head2 C<< $mech->viewport_size >>
2743              
2744             print Dumper $mech->viewport_size;
2745             $mech->viewport_size({ width => 1388, height => 792 });
2746              
2747             Returns (or sets) the new size of the viewport (the "window").
2748              
2749             =cut
2750              
2751             sub viewport_size {
2752 0     0 1   my( $self, $new )= @_;
2753              
2754 0           $self->eval_in_phantomjs( <<'JS', $new );
2755             if( arguments[0]) {
2756             this.viewportSize= arguments[0];
2757             };
2758             return this.viewportSize;
2759             JS
2760             };
2761              
2762             =head2 C<< $mech->element_as_png( $element ) >>
2763              
2764             my $shiny = $mech->selector('#shiny', single => 1);
2765             my $i_want_this = $mech->element_as_png($shiny);
2766              
2767             Returns PNG image data for a single element
2768              
2769             =cut
2770              
2771             sub element_as_png {
2772 0     0 1   my ($self, $element) = @_;
2773              
2774 0           my $cliprect = $self->element_coordinates( $element );
2775              
2776 0           my $code = <<'JS';
2777             var old= this.clipRect;
2778             this.clipRect= arguments[0];
2779             JS
2780              
2781 0           my $old= $self->eval_in_phantomjs( $code, $cliprect );
2782 0           my $png= $self->content_as_png();
2783             #warn Dumper $old;
2784 0           $self->eval_in_phantomjs( $code, $old );
2785 0           $png
2786             };
2787              
2788             =head2 C<< $mech->render_element( %options ) >>
2789              
2790             my $shiny = $mech->selector('#shiny', single => 1);
2791             my $i_want_this= $mech->render_element(
2792             element => $shiny,
2793             format => 'pdf',
2794             );
2795              
2796             Returns the data for a single element
2797             or writes it to a file. It accepts
2798             all options of C<< ->render_content >>.
2799              
2800             =cut
2801              
2802             sub render_element {
2803 0     0 1   my ($self, %options) = @_;
2804             my $element= delete $options{ element }
2805 0 0         or croak "No element given to render.";
2806              
2807 0           my $cliprect = $self->element_coordinates( $element );
2808              
2809 0           my $code = <<'JS';
2810             var old= this.clipRect;
2811             this.clipRect= arguments[0];
2812             JS
2813              
2814 0           my $old= $self->eval_in_phantomjs( $code, $cliprect );
2815 0           my $res= $self->render_content(
2816             %options
2817             );
2818             #warn Dumper $old;
2819 0           $self->eval_in_phantomjs( $code, $old );
2820 0           $res
2821             };
2822              
2823             =head2 C<< $mech->element_coordinates( $element ) >>
2824              
2825             my $shiny = $mech->selector('#shiny', single => 1);
2826             my ($pos) = $mech->element_coordinates($shiny);
2827             print $pos->{left},',', $pos->{top};
2828              
2829             Returns the page-coordinates of the C<$element>
2830             in pixels as a hash with four entries, C, C, C and C.
2831              
2832             This function might get moved into another module more geared
2833             towards rendering HTML.
2834              
2835             =cut
2836              
2837             sub element_coordinates {
2838 0     0 1   my ($self, $element) = @_;
2839 0           my $cliprect = $self->eval('arguments[0].getBoundingClientRect()', $element );
2840             };
2841              
2842             =head2 C<< $mech->render_content(%options) >>
2843              
2844             my $pdf_data = $mech->render( format => 'pdf' );
2845              
2846             $mech->render_content(
2847             format => 'jpg',
2848             filename => '/path/to/my.jpg',
2849             );
2850              
2851             Returns the current page rendered in the specified format
2852             as a bytestring or stores the current page in the specified
2853             filename.
2854              
2855             The filename must be absolute. We are dealing with external processes here!
2856              
2857             This method is specific to WWW::Mechanize::PhantomJS.
2858              
2859             Currently, the data transfer between PhantomJS and Perl
2860             is done through a temporary file, so directly using
2861             the C option may be faster.
2862              
2863             =cut
2864              
2865             sub render_content {
2866 0     0 1   my ($self, %options) = @_;
2867             #$rect ||= {};
2868             #$target_rect ||= {};
2869 0           my $outname= $options{ filename };
2870 0           my $format= $options{ format };
2871 0           my $wantresult;
2872              
2873             my @delete;
2874 0 0         if( ! $outname) {
2875 0           require File::Temp;
2876 0           (my $fh, $outname)= File::Temp::tempfile();
2877 0           close $fh;
2878 0           push @delete, $outname;
2879 0           $wantresult= 1;
2880             };
2881 0           require File::Spec;
2882 0           $outname= File::Spec->rel2abs($outname, '.');
2883              
2884 0           $self->eval_in_phantomjs(<<'JS', $outname, $format);
2885             var outname= arguments[0];
2886             var format= arguments[1];
2887             this.render( outname, { "format": format });
2888             JS
2889              
2890 0           my $result;
2891 0 0         if( $wantresult ) {
2892 0 0         open my $fh, '<', $outname
2893             or die "Couldn't read tempfile '$outname': $!";
2894 0           binmode $fh, ':raw';
2895 0           local $/;
2896 0           $result= <$fh>;
2897             };
2898              
2899 0           for( @delete ) {
2900 0 0         unlink $_
2901             or warn "Couldn't clean up tempfile: $_': $!";
2902             };
2903 0           $result
2904             }
2905              
2906             =head2 C<< $mech->content_as_pdf(%options) >>
2907              
2908             my $pdf_data = $mech->content_as_pdf();
2909              
2910             $mech->content_as_pdf(
2911             filename => '/path/to/my.pdf',
2912             );
2913              
2914             Returns the current page rendered in PDF format as a bytestring.
2915              
2916             This method is specific to WWW::Mechanize::PhantomJS.
2917              
2918             Currently, the data transfer between PhantomJS and Perl
2919             is done through a temporary file, so directly using
2920             the C option may be faster.
2921              
2922             =cut
2923              
2924             sub content_as_pdf {
2925 0     0 1   my ($self, %options) = @_;
2926              
2927 0           return $self->render_content( format => 'pdf', %options );
2928             };
2929              
2930             =head1 INTERNAL METHODS
2931              
2932             These are methods that are available but exist mostly as internal
2933             helper methods. Use of these is discouraged.
2934              
2935             =head2 C<< $mech->element_query( \@elements, \%attributes ) >>
2936              
2937             my $query = $mech->element_query(['input', 'select', 'textarea'],
2938             { name => 'foo' });
2939              
2940             Returns the XPath query that searches for all elements with Cs
2941             in C<@elements> having the attributes C<%attributes>. The C<@elements>
2942             will form an C condition, while the attributes will form an C
2943             condition.
2944              
2945             =cut
2946              
2947             sub element_query {
2948 0     0 1   my ($self, $elements, $attributes) = @_;
2949             my $query =
2950             './/*[(' .
2951             join( ' or ',
2952             map {
2953 0           sprintf qq{local-name(.)="%s"}, lc $_
2954             } @$elements
2955             )
2956             . ') and '
2957             . join( " and ",
2958 0           map { sprintf q{@%s="%s"}, $_, $attributes->{$_} }
  0            
2959             sort keys(%$attributes)
2960             )
2961             . ']';
2962             };
2963              
2964             =head2 C<< $mech->PhantomJS_elementToJS >>
2965              
2966             Returns the Javascript fragment to turn a Selenium::Remote::PhantomJS
2967             id back to a Javascript object.
2968              
2969             =cut
2970              
2971             sub PhantomJS_elementToJS {
2972             <<'JS'
2973             function(id,doc_opt){
2974             var d = doc_opt || document;
2975             var c= d['$wdc_'];
2976             return c[id]
2977             };
2978             JS
2979 0     0 1   }
2980              
2981             sub post_process
2982             {
2983 0     0 0   my $self = shift;
2984 0 0         if ( $self->{report_js_errors} ) {
2985 0 0         if ( my @errors = $self->js_errors ) {
2986 0           $self->report_js_errors(@errors);
2987 0           $self->clear_js_errors;
2988             }
2989             }
2990             }
2991              
2992             sub report_js_errors
2993             {
2994 0     0 1   my ( $self, @errors ) = @_;
2995             @errors = map {
2996 0           $_->{message} .
2997 0           ( @{$_->{trace}} ? " at $_->{trace}->[-1]->{file} line $_->{trace}->[-1]->{line}" : '') .
2998 0 0 0       ( @{$_->{trace}} && $_->{trace}->[-1]->{function} ? " in function $_->{trace}->[-1]->{function}" : '')
    0          
2999             } @errors;
3000 0           Carp::carp("javascript error: @errors") ;
3001             }
3002              
3003             1;
3004              
3005             =head1 INCOMPATIBILITIES WITH WWW::Mechanize
3006              
3007             As this module is in a very early stage of development,
3008             there are many incompatibilities. The main thing is
3009             that only the most needed WWW::Mechanize methods
3010             have been implemented by me so far.
3011              
3012             =head2 Unsupported Methods
3013              
3014             At least the following methods are unsupported:
3015              
3016             =over 4
3017              
3018             =item *
3019              
3020             C<< ->find_all_inputs >>
3021              
3022             This function is likely best implemented through C<< $mech->selector >>.
3023              
3024             =item *
3025              
3026             C<< ->find_all_submits >>
3027              
3028             This function is likely best implemented through C<< $mech->selector >>.
3029              
3030             =item *
3031              
3032             C<< ->images >>
3033              
3034             This function is likely best implemented through C<< $mech->selector >>.
3035              
3036             =item *
3037              
3038             C<< ->find_image >>
3039              
3040             This function is likely best implemented through C<< $mech->selector >>.
3041              
3042             =item *
3043              
3044             C<< ->find_all_images >>
3045              
3046             This function is likely best implemented through C<< $mech->selector >>.
3047              
3048             =back
3049              
3050             =head2 Functions that will likely never be implemented
3051              
3052             These functions are unlikely to be implemented because
3053             they make little sense in the context of PhantomJS.
3054              
3055             =over 4
3056              
3057             =item *
3058              
3059             C<< ->clone >>
3060              
3061             =item *
3062              
3063             C<< ->credentials( $username, $password ) >>
3064              
3065             =item *
3066              
3067             C<< ->get_basic_credentials( $realm, $uri, $isproxy ) >>
3068              
3069             =item *
3070              
3071             C<< ->clear_credentials() >>
3072              
3073             =item *
3074              
3075             C<< ->put >>
3076              
3077             I have no use for it
3078              
3079             =item *
3080              
3081             C<< ->post >>
3082              
3083             Selenium does not support POST requests
3084              
3085             =back
3086              
3087             =head1 TODO
3088              
3089             =over 4
3090              
3091             =item *
3092              
3093             Add C<< limit >> parameter to C<< ->xpath() >> to allow an early exit-case
3094             when searching through frames.
3095              
3096             =item *
3097              
3098             Implement downloads via
3099              
3100             L
3101              
3102             =item *
3103              
3104             Implement download progress
3105              
3106             =back
3107              
3108             =head1 INSTALLING
3109              
3110             =over 4
3111              
3112             =back
3113              
3114             =head2 Install the C executable
3115              
3116             =over
3117              
3118             =item *
3119              
3120             Installing on Ubuntu
3121              
3122             Version: 1.9.8
3123             Platform: x86_64
3124              
3125             Install or update latest system software:
3126              
3127             C<< sudo apt-get update >>
3128              
3129             C<< sudo apt-get install build-essential chrpath libssl-dev libxft-dev >>
3130              
3131             Install the following packages needed by PhantomJS:
3132              
3133             C<< sudo apt-get install libfreetype6 libfreetype6-dev >>
3134              
3135             C<< sudo apt-get install libfontconfig1 libfontconfig1-dev >>
3136              
3137             Get PhantomJS from the L
3138              
3139             C<< cd ~ >>
3140              
3141             C<< export PHANTOM_JS="phantomjs-1.9.8-linux-x86_64" >>
3142              
3143             C<< wget https://bitbucket.org/ariya/phantomjs/downloads/$PHANTOM_JS.tar.bz2 >>
3144              
3145             C<< sudo tar xvjf $PHANTOM_JS.tar.bz2 >>
3146              
3147             Once downloaded move Phantomjs folder:
3148              
3149             C<< sudo mv $PHANTOM_JS /usr/local/share >>
3150              
3151             C<< sudo ln -sf /usr/local/share/$PHANTOM_JS/bin/phantomjs /usr/local/bin >>
3152              
3153             C<< sudo ln -sf /usr/local/share/$PHANTOM_JS/bin/phantomjs /usr/bin/phantomjs >>
3154              
3155             Test it has been installed on your system:
3156              
3157             C<< phantomjs --version >>
3158              
3159             =back
3160              
3161             =head1 SEE ALSO
3162              
3163             =over 4
3164              
3165             =item *
3166              
3167             L - the PhantomJS homepage
3168              
3169             =item *
3170              
3171             L - the ghostdriver homepage
3172              
3173             =item *
3174              
3175             L - the module whose API grandfathered this module
3176              
3177             =item *
3178              
3179             L - another WWW::Mechanize-workalike with Javascript support
3180              
3181             =item *
3182              
3183             L - a similar module with a visible application
3184              
3185             =back
3186              
3187             =head1 REPOSITORY
3188              
3189             The public repository of this module is
3190             L.
3191              
3192             =head1 SUPPORT
3193              
3194             The public support forum of this module is
3195             L.
3196              
3197             =head1 TALKS
3198              
3199             I've given a talk about this module at Perl conferences:
3200              
3201             L
3202              
3203             L
3204              
3205             L
3206              
3207             =for html
3208