File Coverage

blib/lib/WWW/Mechanize/PhantomJS.pm
Criterion Covered Total %
statement 93 760 12.2
branch 12 288 4.1
condition 7 180 3.8
subroutine 20 109 18.3
pod 68 86 79.0
total 200 1423 14.0


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