File Coverage

blib/lib/WWW/Mechanize/PhantomJS.pm
Criterion Covered Total %
statement 90 763 11.8
branch 12 288 4.1
condition 8 183 4.3
subroutine 19 109 17.4
pod 69 87 79.3
total 198 1430 13.8


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