selenium-client-perl/lib/Selenium/Driver/SeleniumHQ/Jar.pm

package Selenium::Driver::SeleniumHQ::Jar;

use strict;
use warnings;

use v5.28;

no warnings 'experimental';
use feature qw/signatures/;

use Carp qw{confess};
use File::Basename qw{basename};
use File::Path qw{make_path};
use File::Spec();
use XML::LibXML();
use HTTP::Tiny();

#ABSTRACT: Download the latest version of seleniumHQ's selenium.jar, and tell Selenium::Client how to spawn it

=head1 Mode of Operation

Downloads the latest Selenium JAR (or the provided driver_version).
Expects java to already be installed.

Spawns a selnium server on the provided port (which the caller will assign randomly)
Pipes log output to ~/.selenium/perl-client/$port.log
Uses a config file ~/.selenium/perl-client/$port.toml if the selenium version supports this

=head1 SUBROUTINES

=head2 build_spawn_opts($class,$object)

Builds a command string which can run the driver binary.
All driver classes must build this.

=cut

our $index = 'http://selenium-release.storage.googleapis.com';

sub build_spawn_opts($class,$object) {
    $object->{driver_class}       = $class;
    $object->{driver_interpreter} //= 'java';
    $object->{driver_version}     //= '';
    $object->{log_file}           //= File::Spec->catfile($object->{client_dir},"perl-client","selenium-$object->{port}.log");
    ($object->{driver_file}, $object->{driver_major_version}) = find_and_fetch( File::Spec->catdir($object->{client_dir},"jars"), $object->{driver_version},$object->{ua});
    $object->{driver_config} //= _build_config($object);

    #XXX port in config is currently IGNORED
    my @java_opts;
    my @config = ((qw{standalone --config}), $object->{driver_config}, '--port', $object->{port});

    # Handle older seleniums that are WC3 compliant
    if ( $object->{driver_major_version} < 4 ) {
        $object->{prefix} = '/wd/hub';
        @java_opts = qw{-Dwebedriver.gecko.driver=geckodriver -Dwebdriver.chrome.driver=chromedriver};
        @config = ();
    }

    # Build command string
    # XXX relies on gecko/chromedriver in $PATH
    $object->{command} //= [
        $object->{driver_interpreter},
        @java_opts,
        qw{-jar},
        $object->{driver_file},
        @config,
    ];
    return $object;
}

sub _build_config($self) {
    my $dir = File::Spec->catdir($self->{client_dir},"perl-client");
    make_path( $dir ) unless -d $dir;


    my $file = File::Spec->catfile($dir,"config-$self->{port}.toml");
    return $file if -f $file;

    # TODO add some self-signed SSL to this
    my $config = <<~EOF;
        [node]
        detect-drivers = true
        [server]
        allow-cors = true
        hostname = "localhost"
        max-threads = 36
        port = --PORT--
        [logging]
        enable = true
        log-encoding = UTF-8
        log-file = --REPLACE--
        plain-logs = true
        structured-logs = false
        tracing = true
        EOF

    #XXX double escape backslash because windows; like YAML, TOML is a poor choice always
    #XXX so, you'll die if there are backslashes in your username or homedir choice (lunatic)
    my $log_corrected = $self->{log_file};
    $log_corrected =~ s/\\/\\\\/g;

    $config =~ s/--REPLACE--/\"$log_corrected\"/gm;
    $config =~ s/--PORT--/$self->{port}/gm;

    File::Slurper::write_text($file, $config);
    return $file;
}

=head2 find_and_fetch($dir STRING, $version STRING, $user_agent HTTP::Tiny)

Does an index lookup of the various selenium JARs available and returns either the latest one
or the version provided.  Stores the JAR in the provided directory.

=cut

sub find_and_fetch($dir, $version='', $ua='') {
    $ua ||= HTTP::Tiny->new();
    my $res = $ua->get($index);
    confess "$res->{reason} :\n$res->{content}\n" unless $res->{success};
    my $parsed = XML::LibXML->load_xml(string => $res->{content});

    #XXX - XPATH NO WORKY, HURR DURR
    my @files;
    foreach my $element ($parsed->findnodes('//*')) {
        my $contents = $element->getChildrenByTagName("Contents");
        my @candidates = sort { $b cmp $a } grep { m/selenium-server/ && m/\.jar$/ } map {
            $_->getChildrenByTagName('Key')->to_literal().'';
        } @$contents;
        push(@files,@candidates);
    }

    @files = grep { m/\Q$version\E/ } @files if $version;
    my $jar = shift @files;
    my $url = "$index/$jar";

    make_path( $dir ) unless -d $dir;
    my $fname = File::Spec->catfile($dir, basename($jar));
    my ($v) = $fname =~ m/-(\d)\.\d\.\d.*\.jar$/;
    return ($fname,$v) if -f $fname;

    $res = $ua->mirror($url, $fname);

    confess "$res->{reason} :\n$res->{content}\n" unless $res->{success};
    return ($fname,$v);
}

1;