File Coverage

blib/lib/Selenium/Driver/SeleniumHQ/Jar.pm
Criterion Covered Total %
statement 35 111 31.5
branch 0 26 0.0
condition 0 17 0.0
subroutine 12 16 75.0
pod 2 3 66.6
total 49 173 28.3


line stmt bran cond sub pod time code
1             package Selenium::Driver::SeleniumHQ::Jar;
2             $Selenium::Driver::SeleniumHQ::Jar::VERSION = '2.01';
3 1     1   250236 use strict;
  1         2  
  1         47  
4 1     1   7 use warnings;
  1         3  
  1         103  
5              
6 1     1   22 use v5.28;
  1         5  
7              
8 1     1   6 no warnings 'experimental';
  1         4  
  1         61  
9 1     1   6 use feature qw/signatures/;
  1         3  
  1         193  
10              
11 1     1   8 use Carp qw{confess};
  1         2  
  1         102  
12 1     1   10 use File::Basename qw{basename};
  1         2  
  1         77  
13 1     1   21 use File::Path qw{make_path};
  1         2  
  1         65  
14 1     1   6 use File::Spec();
  1         2  
  1         28  
15 1     1   1264 use XML::LibXML();
  1         56979  
  1         73  
16 1     1   891 use HTTP::Tiny();
  1         59566  
  1         67  
17 1     1   922 use Github::ReleaseFetcher;
  1         113179  
  1         2041  
18              
19             #ABSTRACT: Download the latest version of seleniumHQ's selenium.jar, and tell Selenium::Client how to spawn it
20              
21              
22             our $index = 'http://selenium-release.storage.googleapis.com';
23              
24 0     0 1   sub build_spawn_opts ( $class, $object ) {
  0            
  0            
  0            
25 0           $object->{driver_class} = $class;
26 0   0       $object->{driver_interpreter} //= 'java';
27 0   0       $object->{driver_version} //= '';
28 0   0       $object->{log_file} //= File::Spec->catfile( $object->{client_dir}, "perl-client", "selenium-$object->{port}.log" );
29              
30             # Default to new selenium versions, but allow fetching old stuff
31 0           $object->{driver_major_version} = 4;
32 0 0         ( $object->{driver_major_version} ) = $object->{driver_version} =~ m/-(\d+)\.\d+\.\d.*\.jar$/ if $object->{driver_version};
33              
34 0 0         die "Could not determine driver major version!" unless $object->{driver_major_version};
35              
36 0 0         if ( $object->{driver_major_version} < 4 ) {
37 0           ( $object->{driver_file}, $object->{driver_major_version} ) = find_and_fetch_old_releases( File::Spec->catdir( $object->{client_dir}, "jars" ), $object->{driver_version}, $object->{ua} );
38             }
39             else {
40 0           ( $object->{driver_file}, $object->{driver_major_version} ) = find_and_fetch( File::Spec->catdir( $object->{client_dir}, "jars" ), $object->{driver_version}, $object->{ua} );
41             }
42 0   0       $object->{driver_config} //= _build_config($object);
43              
44             #XXX port in config is currently IGNORED
45 0           my @java_opts;
46 0           my @config = ( (qw{standalone --config}), $object->{driver_config}, '--port', $object->{port} );
47              
48             # Handle older seleniums that are WC3 compliant
49 0 0         if ( $object->{driver_major_version} < 4 ) {
50 0           $object->{prefix} = '/wd/hub';
51 0           @java_opts = qw{-Dwebedriver.gecko.driver=geckodriver -Dwebdriver.chrome.driver=chromedriver};
52 0           @config = ();
53             }
54              
55             # Build command string
56             # XXX relies on gecko/chromedriver in $PATH
57             $object->{command} //= [
58             $object->{driver_interpreter},
59             @java_opts,
60             qw{-jar},
61             $object->{driver_file},
62 0   0       @config,
63             ];
64 0           return $object;
65             }
66              
67 0     0     sub _build_config ($self) {
  0            
  0            
68 0           my $dir = File::Spec->catdir( $self->{client_dir}, "perl-client" );
69 0 0         make_path($dir) unless -d $dir;
70              
71 0           my $file = File::Spec->catfile( $dir, "config-$self->{port}.toml" );
72 0 0         return $file if -f $file;
73              
74             # TODO add some self-signed SSL to this
75 0           my $config = <<~EOF;
76             [node]
77             detect-drivers = true
78             [server]
79             allow-cors = true
80             hostname = "localhost"
81             max-threads = 36
82             port = --PORT--
83             [logging]
84             enable = true
85             log-encoding = UTF-8
86             log-file = --REPLACE--
87             plain-logs = true
88             structured-logs = false
89             tracing = true
90             EOF
91              
92             #XXX double escape backslash because windows; like YAML, TOML is a poor choice always
93             #XXX so, you'll die if there are backslashes in your username or homedir choice (lunatic)
94 0           my $log_corrected = $self->{log_file};
95 0           $log_corrected =~ s/\\/\\\\/g;
96              
97 0           $config =~ s/--REPLACE--/\"$log_corrected\"/gm;
98 0           $config =~ s/--PORT--/$self->{port}/gm;
99              
100 0           File::Slurper::write_text( $file, $config );
101 0           return $file;
102             }
103              
104              
105 0     0 1   sub find_and_fetch ( $dir, $version = undef, $ua = undef ) {
  0            
  0            
  0            
  0            
106 0 0         make_path($dir) unless -d $dir;
107              
108 0   0       $version ||= undef;
109              
110 0           my @files = Github::ReleaseFetcher::fetch( $dir, 'SeleniumHQ', 'selenium', qr/\.jar$/, undef, $version, $ua );
111 0           my $latest_jar_at_version = pop(@files);
112 0           my ($actual_version) = $latest_jar_at_version =~ m/-(\d+)\.\d+\.\d.*\.jar$/;
113              
114 0           return ( $latest_jar_at_version, $actual_version );
115             }
116              
117 0     0 0   sub find_and_fetch_old_releases ( $dir, $version = '', $ua = '' ) {
  0            
  0            
  0            
  0            
118 0   0       $ua ||= HTTP::Tiny->new();
119 0           my $res = $ua->get($index);
120 0 0         confess "$res->{reason} :\n$res->{content}\n" unless $res->{success};
121 0           my $parsed = XML::LibXML->load_xml( string => $res->{content} );
122              
123             #XXX - XPATH NO WORKY, HURR DURR
124 0           my @files;
125 0           foreach my $element ( $parsed->findnodes('//*') ) {
126 0           my $contents = $element->getChildrenByTagName("Contents");
127 0 0         my @candidates = sort { $b cmp $a } grep { m/selenium-server/ && m/\.jar$/ } map { $_->getChildrenByTagName('Key')->to_literal() . ''; } @$contents;
  0            
  0            
  0            
128 0           push( @files, @candidates );
129             }
130              
131 0 0         @files = grep { m/\Q$version\E/ } @files if $version;
  0            
132 0           my $jar = shift @files;
133 0           my $url = "$index/$jar";
134              
135 0 0         make_path($dir) unless -d $dir;
136 0           my $fname = File::Spec->catfile( $dir, basename($jar) );
137 0           my ($v) = $fname =~ m/-(\d+)\.\d+\.\d.*\.jar$/;
138 0 0         return ( $fname, $v ) if -f $fname;
139              
140 0           $res = $ua->mirror( $url, $fname );
141              
142 0 0         confess "$res->{reason} :\n$res->{content}\n" unless $res->{success};
143 0           return ( $fname, $v );
144             }
145              
146             1;
147              
148             __END__
149              
150             =pod
151              
152             =encoding UTF-8
153              
154             =head1 NAME
155              
156             Selenium::Driver::SeleniumHQ::Jar - Download the latest version of seleniumHQ's selenium.jar, and tell Selenium::Client how to spawn it
157              
158             =head1 VERSION
159              
160             version 2.01
161              
162             =head1 Mode of Operation
163              
164             Downloads the latest Selenium JAR (or the provided driver_version).
165             Expects java to already be installed.
166              
167             Can find both the new releases on github and the old releases on google storage.
168              
169             Spawns a selnium server on the provided port (which the caller will assign randomly)
170             Pipes log output to ~/.selenium/perl-client/$port.log
171             Uses a config file ~/.selenium/perl-client/$port.toml if the selenium version supports this
172              
173             =head1 SUBROUTINES
174              
175             =head2 build_spawn_opts($class,$object)
176              
177             Builds a command string which can run the driver binary.
178             All driver classes must build this.
179              
180             =head2 find_and_fetch($dir STRING, $version STRING, $user_agent HTTP::Tiny)
181              
182             Does an index lookup of the various selenium JARs available and returns either the latest one
183             or the version provided. Stores the JAR in the provided directory.
184              
185             Also fetches any versions we don't already have.
186              
187             =head1 SEE ALSO
188              
189             Please see those modules/websites for more information related to this module.
190              
191             =over 4
192              
193             =item *
194              
195             L<Selenium::Client|Selenium::Client>
196              
197             =back
198              
199             =head1 BUGS
200              
201             Please report any bugs or feature requests on the bugtracker website
202             L<https://github.com/troglodyne-internet-widgets/selenium-client-perl/issues>
203              
204             When submitting a bug or request, please include a test-file or a
205             patch to an existing test-file that illustrates the bug or desired
206             feature.
207              
208             =head1 AUTHORS
209              
210             Current Maintainers:
211              
212             =over 4
213              
214             =item *
215              
216             George S. Baugh <george@troglodyne.net>
217              
218             =back
219              
220             =head1 COPYRIGHT AND LICENSE
221              
222             Copyright (c) 2024 Troglodyne LLC
223              
224              
225             Permission is hereby granted, free of charge, to any person obtaining a copy
226             of this software and associated documentation files (the "Software"), to deal
227             in the Software without restriction, including without limitation the rights
228             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
229             copies of the Software, and to permit persons to whom the Software is
230             furnished to do so, subject to the following conditions:
231             The above copyright notice and this permission notice shall be included in all
232             copies or substantial portions of the Software.
233             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
234             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
235             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
236             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
237             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
238             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
239             SOFTWARE.
240              
241             =cut