File Coverage

blib/lib/WWW/Mechanize/PhantomJS.pm
Criterion Covered Total %
statement 104 800 13.0
branch 12 318 3.7
condition 8 255 3.1
subroutine 24 115 20.8
pod 69 87 79.3
total 217 1575 13.7


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