Browse Source

Initial Release of Selenium::Client

See README.md and POD for details
George S. Baugh 5 years ago
parent
commit
3a68c83723

+ 16 - 0
.gitignore

@@ -15,6 +15,7 @@ nytprof.out
 
 
 # Dizt::Zilla
 # Dizt::Zilla
 /.build/
 /.build/
+/Selenium-Specification-*
 
 
 # Module::Build
 # Module::Build
 _build/
 _build/
@@ -33,3 +34,18 @@ inc/
 /MANIFEST.bak
 /MANIFEST.bak
 /pm_to_blib
 /pm_to_blib
 /*.zip
 /*.zip
+
+#vim
+*.swp
+*.swo
+*.swn
+
+# Drivers
+geckodriver
+chromedriver
+geckodriver.exe
+chromedriver.exe
+msedgedriver.exe
+
+# macos
+.DS_store

+ 5 - 0
Changes

@@ -0,0 +1,5 @@
+Revision history for Selenium-Client
+
+1.00  2021-02-04
+
+    - Initial release

+ 0 - 21
LICENSE

@@ -1,21 +0,0 @@
-MIT License
-
-Copyright (c) 2021 Troglodyne Internet Widgets
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.

+ 34 - 1
README.md

@@ -1,2 +1,35 @@
-# seleinum-specification-perl
+# selenium-client-perl
+
+WC3 Standard selenium client
+
+Automatically spins up/down drivers when pointing at localhost and nothing is already listening on the provided port
+
+Working Drivers:
+
+* Gecko
+* Chrome
+* MicrosoftEdge
+* Safari
+
+Also can auto-fetch the SeleniumHQ JAR file and run it.
+This feature is only tested with the Selenium 4.0 or better JARs.
+
+Also contains:
+
+- Selenium::Specification
+
 Module to turn the Online specification documents for Selenium into JSON specifications for use by API clients
 Module to turn the Online specification documents for Selenium into JSON specifications for use by API clients
+
+Soon to come:
+
+- Selenium::Server
+
+Pure perl selenium server (that proxies commands to browser drivers, much like the SeleniumHQ Jar)
+
+- Selenium::Grid
+
+Pure perl selenium grid API server
+
+- Selenium::Client::SRD
+
+Drop-in replacement for Selenium::Remote::Driver

+ 1 - 0
at/other.html

@@ -0,0 +1 @@
+ZIPPY

+ 216 - 0
at/sanity.test

@@ -0,0 +1,216 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test2::V0;
+
+#XXX Test2 Knows Better TM
+no warnings 'experimental';
+use feature qw/signatures/;
+
+use Test::Fatal;
+use FindBin;
+use Cwd qw{abs_path};
+use JSON;
+use Data::Dumper;
+
+use Selenium::Client;
+
+my $extra = '';
+$extra = '/' if grep { $^O eq $_ } qw{msys MSWin32};
+
+my $sut  = 'file://' . $extra . abs_path("$FindBin::Bin/test.html");
+my $sut2 = 'file://' . $extra . abs_path("$FindBin::Bin/other.html");
+
+my @browsers = qw{firefox chrome};
+push(@browsers, 'MicrosoftEdge') if grep { $^O eq $_ } qw{MSWin32 msys};
+push(@browsers, 'safari') if $^O eq 'darwin';
+foreach my $browser (@browsers) {
+    my @drivers = qw{Gecko Auto SeleniumHQ::Jar};
+    @drivers = qw{Chrome Auto SeleniumHQ::Jar} if $browser eq 'chrome';
+    @drivers = qw{Edge Auto SeleniumHQ::Jar}   if $browser eq 'MicrosoftEdge';
+    @drivers = qw{Safari Auto SeleniumHQ::Jar} if $browser eq 'safari';
+
+    foreach my $driver (@drivers) {
+        subtest "$browser (using $driver): Spec compliance" => sub {
+            my %options = ( driver => $driver, browser => $browser,);# debug => 1 );
+
+            # TODO remove when it goes public
+            $options{driver_version} = '4.0.0-alpha-7' if $driver eq 'SeleniumHQ::Jar';
+
+            my $driver = Selenium::Client->new( %options );
+
+            my $status = $driver->Status();
+            ok($status->{ready}, "Driver up and running");
+
+            my ($capabilities,$session) = $driver->NewSession(
+                capabilities => {
+                    alwaysMatch => {
+                        browserName  => $browser,
+                    },
+                }
+            );
+            isa_ok($capabilities,"Selenium::Capabilities");
+            isa_ok($session, "Selenium::Session");
+
+            is( exception { $session->SetTimeouts( script => 1000, implicit => 1000, pageLoad => 1000 ) }, undef, "Can set timeouts");
+
+            #XXX GetTimeouts like every other thing *chokes* on data not being *just right* despite spec having undefined behavior here
+            my $expected = { script => 1000, implicit => 1000, pageLoad => 1000 };
+
+            SKIP: {
+                skip("Selenium 4.0 GetTimeouts is broken, and as we know all broken things HANG 30 SECONDS!!!",1);
+                my $t = $session->GetTimeouts( script => undef, implicit => undef, pageLoad => undef );
+                is($t,$expected, "GetTimeouts works");
+            }
+
+            is( exception { $session->NavigateTo( url => $sut ) }, undef, "Can open page");
+
+            #Alerts
+            alertify($session);
+
+            is($session->GetCurrentURL(), $sut, "Can get current URL");
+            is($session->GetTitle(), 'Test Page', "Can get page title");
+            is(exception { $session->NavigateTo( 'url' => $sut2 ) }, undef, "Can open other page");
+            is($session->GetPageSource(),"<html><head></head><body>ZIPPY\n</body></html>","Can get page source");
+            is(exception { $session->Back() }, undef, "Can navigate to the last page visited with back()");
+
+            alertify($session) unless $browser eq 'safari';
+            is(exception { $session->Forward() }, undef, "Can navigate back to previously visited page with forward()");
+
+            $session->Back();
+
+            #XXX webkit re-issues alerts on back()
+            alertify($session) if grep { $browser eq $_ } qw{chrome MicrosoftEdge};
+
+            is(exception { $session->Refresh() }, undef, "Can refresh the page");
+            alertify($session);
+
+            my $handle = "".$session->GetWindowHandle();
+            ok($handle,"Can get window handle");
+            my $link = $session->FindElement( using => 'css selector', value => '#linky' );
+            $link->ElementClick();
+
+            my @newhandles = map { "".$_ } $session->GetWindowHandles();
+
+            my ($newhandle) = grep { $_ ne $handle } @newhandles;
+            die("Could not get existing handle from getwindowhandles") unless $newhandle;
+            is( exception { $session->SwitchToWindow( handle => $newhandle ) }, undef, "Can switch to new window");
+            like($session->GetPageSource(), qr/ZIPPY/i, "Got right window");
+            is( exception { $session->SwitchToWindow( handle => $handle ) }, undef, "Can switch to old window");
+
+            like($session->GetPageSource(), qr/Howdy/i, "Switched window correctly");
+            $session->SwitchToWindow( handle => $newhandle );
+            is( exception { $session->CloseWindow() }, undef, "CloseWindow closes current window context");
+            $session->SwitchToWindow( handle => $handle );
+
+            #move it around
+            my %erekt = ( height => 100, width => 500, x => 50, y => 50);
+            is( exception { $session->SetWindowRect(%erekt) }, undef, "Can set window rect");
+            my $rekt = $session->GetWindowRect();
+
+            SKIP: {
+                skip("Window rect set is basically never correctly obeyed",1);
+                is($rekt, \%erekt, "Can get window rect");
+            }
+            #Frames
+            my $frame = $session->FindElement( using => 'css selector', value => '#frame' );
+            is( exception { $session->SwitchToFrame( id => $frame->{elementid} ) }, undef, "Can switch into frame");
+            is( exception { $session->SwitchToParentFrame() }, undef, "Can travel up the frame stack");
+
+            #Maximize etc
+            is( exception { $session->MaximizeWindow() }, undef, "Can maximize window");
+            is( exception { $session->MinimizeWindow() }, undef, "Can minimize window");
+            is( exception { $session->FullscreenWindow() }, undef, "Can Fullscreen window");
+
+            #Element Method Testing
+            my $element = $session->FindElement( using => 'css selector', value => 'input[name=text]' );
+            isa_ok($element,'Selenium::Element');
+            my $prop = $element->GetElementProperty( name => 'title' );
+            is($prop,'default', "Can get element properties");
+
+            my @inputs = $session->FindElements( using => 'css selector', value => 'input' );
+            is( scalar(@inputs), 5, "Can find multiple elements correctly");
+
+            my $finder = $session->FindElement( using => 'css selector', value => 'form' );
+            my $found  = $finder->FindElementFromElement( using => 'css selector', 'value' => 'label' );
+            todo "Property/Attribute get is broken in Selenium" => sub {
+                is($found->GetElementAttribute( name => 'for' ), 'text', "Can find child properly");
+            };
+
+            my @radios = $finder->FindElementsFromElement( using => 'css selector', 'value' => 'input[type=radio]' );
+            is(scalar(@radios), 2, "Can find child elements properly");
+
+            my ($unselected, $selected) = @radios;
+            ok(!$unselected->IsElementSelected(),"IsElementSelected works");
+            todo "IsElementSelected appears to always return false, lol" => sub {
+                ok($selected->IsElementSelected(), "IsElementSelected works");
+            };
+            my @checked = $session->FindElements( using => 'css selector', value => 'input:checked');
+            is(scalar(@checked),1,"But we can at least work around that using css :checked pseudoselector");
+
+            is(exception { $session->GetActiveElement() }, undef, "Can get active element");
+
+            my $invisible = $session->FindElement( using => 'css selector', value => '#no-see-em' );
+            is($invisible->GetElementCSSValue( propertyname => 'display' ),'none',"Can get CSS values for elements");
+            is(lc($invisible->GetElementTagName()),'button', "Can get element tag name");
+
+            my $hammertime = $session->FindElement( using => 'css selector', value => '#hammertime' );
+            ok(!$hammertime->IsElementEnabled(),"IsElementEnabled works");
+
+            my $clickme = $session->FindElement( using => 'css selector', value => '#clickme' );
+            is($clickme->GetElementText(),'PARTY HARD', "Can get element text");
+
+            my $rkt = $clickme->GetElementRect();
+            ok(defined $rkt->{x},"GetElementRect appears to function");
+
+            my $input = $session->FindElement( using => 'css selector', value => 'input[name=text]' );
+            $input->ElementClear();
+            $input->ElementSendKeys( text => "tickle" );
+            is($input->GetElementProperty( name => 'value' ), 'tickle', "Can clear and send keys to a text input");
+
+            is($session->ExecuteScript( script => qq/ return document.querySelector('input').value /, args => [] ),'tickle',"ExecuteScript works");
+            is($session->ExecuteAsyncScript( script => qq/ return arguments[arguments.length - 1](document.querySelector('input').value) /, args => [] ),'tickle',"ExecuteAsyncScript works");
+
+            # Screenshots
+            ok($session->TakeScreenshot(),"Can take screenshot");
+            ok($input->TakeElementScreenshot(), "Can take element screenshot");
+
+            # Perform / Release Actions
+            is( exception {
+                $session->PerformActions( actions => [ { type => 'key', id => 'key', actions => [ { type => 'keyDown', value => 'a' } ] } ] )
+            }, undef, "Can perform general actions");
+            is( exception { $session->ReleaseActions() }, undef, "Can release general actions");
+            is($input->GetElementProperty( name => 'value' ), 'ticklea', "Key sent worked");
+
+            # Cookies -- Browsers don't allow cookies for local stuff, so let's do it against CPAN
+            # XXX lol this site is slow
+            $session->SetTimeouts( script => 1000, implicit => 1000, pageLoad => 10000 );
+
+            $session->NavigateTo( url => 'http://cpan.org' );
+            $session->AddCookie( cookie => { name => 'tickle', value => 'hug' } );
+            my @jar = $session->GetAllCookies();
+            ok(scalar(grep { $_->{name} eq 'tickle' } @jar), "Can set cookies and read them");
+            ok($session->GetNamedCookie( name => 'tickle' ),"Can GetNamedCookie");
+            $session->DeleteCookie( name => 'tickle' );
+            isnt(exception { $session->GetNamedCookie( name => 'tickle') }, undef, "DeleteCookie works");
+            $session->AddCookie( cookie => { name => 'tickle', value => 'hug' } );
+            $session->DeleteAllCookies();
+            isnt( exception { $session->GetNamedCookie( name => 'tickle' ) }, undef, "DeleteAllCookies works");
+
+#        is( exception { $session->DeleteSession() }, undef, "Can delete session");
+
+        };
+    }
+}
+
+sub alertify ($session) {
+    is(eval { $session->GetAlertText() } // $@,'BEEE DOOO', "Can get alert text");
+    is( exception { $session->AcceptAlert() }, undef, "Can dismiss alert");
+    is(eval { $session->GetAlertText() } // $@,'Are you a fugitive from Justice?', "Can get alert text on subsequent alert");
+    is( exception { $session->SendAlertText( text => "HORGLE") }, undef,"send_keys_to_prompt works");
+    is( exception { $session->DismissAlert() }, undef, "Can accept alert");
+}
+
+done_testing();

+ 39 - 0
at/test.html

@@ -0,0 +1,39 @@
+<!DOCTYPE html>
+<html>
+    <head>
+         <meta charset="UTF-8" />
+        <title>Test Page</title>
+        <style>
+            .red {
+                color:red;
+            }
+        </style>
+        <script type="text/javascript">
+            window.onload = function() {
+                alert("BEEE DOOO");
+                prompt("Are you a fugitive from Justice?","Yes");
+            };
+        </script>
+        <meta http-equiv="set-cookie" content="GorgonGlaze=Petrified%20Grits; expires=Sat, 25-Nov-2120 12:00:00 GMT; path=/;" />
+    </head>
+    <body>
+        <h1>
+            Howdy Howdy Howdy
+        </h1>
+        <form id="howIsBabbyFormed" action="other.html">
+            <label for="text" class="red">Text</label>
+            <input name="text" title="default" type="text" value="default"></input>
+            <input id="radio1" name="radio2" type="radio"></input>
+            <input id="radio2" name="radio2" type="radio" checked></input>
+            <input id="hammertime" type="submit" disabled></input>
+            <input id="hidon" type="hidden"></input>
+        </form>
+        <br />
+        <button id="no-see-em" style="display:none;">Tickle</button>
+        <button id="clickme" onclick="alert('PARTY');">PARTY HARD</button>
+        <br />
+        <a href="other.html" target="_blank" id="linky" class="red">Test Link</a>
+        <br />
+        <iframe id="frame" src="other.html" />
+    </body>
+</html>

+ 61 - 0
bin/build_selenium_spec.pl

@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+package Bin::build_selenium_spec;
+
+#ABSTRACT: Convenience script to fetch the selenium specification from WC3
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw/signatures/;
+
+use Getopt::Long qw{GetOptionsFromArray};
+use Pod::Usage;
+
+use Selenium::Specification;
+
+exit main(@ARGV) unless caller;
+
+sub main(@args) {
+    my %options;
+    GetOptionsFromArray(\@args,
+        'verbose' => \$options{verbose},
+        'dir=s'   => \$options{dir},
+        'force'   => \$options{force},
+        'help'    => \$options{help},
+    );
+    return pod2usage(verbose => 2, noperldoc => 1) if $options{help};
+    Selenium::Specification::fetch(%options);
+}
+
+1;
+
+__END__
+
+=head1 build_selenium_spec.pl
+
+Fetches the latest versions of the Selenium specification(s) from the internet and stores them in
+
+    ~/.selenium/specs
+
+As a variety of JSON files.
+
+=head1 USAGE
+
+=head2 -h --help
+
+Print this message
+
+=head2 -v, --verbose
+
+Print messages rather than being silent
+
+=head2 -d --dir $DIR
+
+Put the files in a different directory than the default.
+
+=head2 -f --force
+
+Force a re-fetch even if your copy is newer than that available online.
+Use to correct corrupted specs.

+ 72 - 0
dist.ini

@@ -0,0 +1,72 @@
+name = Selenium-Client
+version = 1.0
+author = George S. Baugh <george@troglodyne.net>
+license = MIT
+copyright_holder = George S. Baugh
+copyright_year = 2021
+
+[GatherDir]
+include_dotfiles = 1
+exclude_match = .*\.swp
+exclude_match = .*\.swo
+
+[PruneCruft]
+except = \.travis.yml
+
+[ManifestSkip]
+[MetaYAML]
+[MetaJSON]
+[License]
+[Readme]
+[ExtraTests]
+[ExecDir]
+[ShareDir]
+[MakeMaker]
+[Manifest]
+
+[PkgVersion]
+[AutoPrereqs]
+[MetaProvides::Package]
+
+[PodWeaver]
+
+[FileFinder::ByName]
+dir = lib
+match = \.pm$
+
+[Git::Contributors]
+
+[@TestingMania]
+critic_config = perlcriticrc
+
+[TestRelease]
+[ConfirmRelease]
+[UploadToCPAN]
+
+[CheckMetaResources]
+[CheckPrereqsIndexed]
+[CheckChangesHasContent]
+
+[Prereqs / RuntimeRequires]
+perl = 5.020
+Moo = 1.005
+List::Util = 1.33
+
+[GithubMeta]
+issues = 1
+user = troglodyne-internet-widgets
+
+[Encoding]
+filename = t/www/icon.gif
+filename = t/www/invalid-extension.xpi
+filename = t/www/redisplay.xpi
+encoding = bytes
+
+; `dzil authordeps` doesn't know about the Pod Weaver dependenciess:
+; authordep Pod::Weaver::Section::Contributors = 0
+; authordep Pod::Weaver::Plugin::Encoding = 0
+; authordep Pod::Weaver::Section::SeeAlso = 0
+; authordep Pod::Weaver::Section::GenerateSection = 0
+; authordep Pod::Elemental::Transformer::List = 0
+; authordep Test::Pod::Coverage = 0
+; authordep Term::UI = 0

+ 519 - 0
lib/Selenium/Client.pm

@@ -0,0 +1,519 @@
+package Selenium::Client;
+
+# ABSTRACT: Module for communicating with WC3 standard selenium servers
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw/signatures/;
+
+use JSON::MaybeXS();
+use HTTP::Tiny();
+use Carp qw{confess};
+use File::Path qw{make_path};
+use File::HomeDir();
+use File::Slurper();
+use Sub::Install();
+use Net::EmptyPort();
+use Capture::Tiny qw{capture_merged};
+
+use Selenium::Specification;
+
+=head1 CONSTRUCTOR
+
+=head2 new(%options) = Selenium::Client
+
+Either connects to a driver at the specified host and port, or spawns one locally.
+
+Spawns a server on a random port in the event the host is "localhost" (or 127.0.0.1) and nothing is reachable on the provided port.
+
+Returns a Selenium::Client object with all WC3 methods exposed.
+
+To view all available methods and their documentation, the catalog() method is provided.
+
+Remote Server options:
+
+=over 4
+
+=item C<version> ENUM (stable,draft,unstable) - WC3 Spec to use.
+        
+Default: stable
+
+=item C<host> STRING - hostname of your server.
+        
+Default: localhost
+
+=item C<prefix> STRING - any prefix needed to communicate with the server, such as /wd, /hub, /wd/hub, or /grid
+        
+Default: ''
+
+=item C<port> INTEGER - Port which the server is listening on.
+
+Default: 4444
+Note: when spawning, this will be ignored and a random port chosen instead.
+
+=item C<scheme> ENUM (http,https) - HTTP scheme to use
+        
+Default: http
+
+=item C<nofetch> BOOL - Do not check for a newer copy of the WC3 specifications on startup if we already have them available.
+        
+Default: 1
+
+=item C<client_dir> STRING - Where to store specs and other files downloaded when spawning servers.
+        
+Default: ~/.selenium
+
+=item C<debug> BOOLEAN - Whether to print out various debugging output.
+        
+Default: false
+
+=item C<auto_close> BOOLEAN - Automatically close spawned selenium servers and sessions.
+
+Only turn this off when you are debugging.
+
+Default: true
+
+=item C<post_callbacks> ARRAY[CODE] - Executed after each request to the selenium server.
+
+Callbacks are passed $self, an HTTP::Tiny response hashref and the request hashref.
+Use this to implement custom error handlers, testing harness modifications etc.
+
+Return a truthy value to immediately exit the request subroutine after all cbs are executed.
+Truthy values (if any are returned) are returned in order encountered.
+
+=back
+
+When using remote servers, you should take extra care that they automatically clean up after themselves.
+We cannot guarantee the state of said servers after interacting with them.
+
+Spawn Options:
+
+=over 4
+
+=item C<driver> STRING - Plug-in module used to spawn drivers when needed.
+
+Included are 'Auto', 'SeleniumHQ::Jar', 'Gecko', 'Chrome', 'Edge'
+Default: Auto
+
+The 'Auto' Driver will pick whichever direct driver looks like it will work for your chosen browser.
+If we can't find one, we'll fall back to SeleniumHQ::Jar.
+
+=item C<browser> STRING - desired browser.  Used by the 'Auto' Driver.
+
+Default: Blank
+
+=item C<driver_version> STRING - Version of your driver software you wish to download and run.
+
+Blank and Partial versions will return the latest sub-version available.
+Only relevant to Drivers which auto-download (currently only SeleniumHQ::Jar).
+
+Default: Blank
+
+=back
+
+Driver modules should be in the Selenium::Driver namespace.
+They may implement additional parameters which can be passed into the options hash.
+
+=cut
+
+sub new($class,%options) {
+    $options{version}    //= 'stable';
+    $options{port}       //= 4444;
+
+    #XXX geckodriver doesn't bind to localhost lol
+    $options{host}       //= '127.0.0.1';
+    $options{host} = '127.0.0.1' if $options{host} eq 'localhost';
+
+    $options{nofetch}    //= 1;
+    $options{scheme}     //= 'http';
+    $options{prefix}     //= '';
+    $options{ua}         //= HTTP::Tiny->new();
+    $options{client_dir} //= File::HomeDir::my_home()."/.selenium";
+    $options{driver}     //= "SeleniumHQ::Jar";
+    $options{post_callbacks} //= [];
+    $options{auto_close} //= 1;
+    $options{browser}    //= '';
+
+    #Grab the spec
+    $options{spec}       = Selenium::Specification::read($options{version},$options{nofetch});
+
+    my $self = bless(\%options, $class);
+    $self->{sessions} = [];
+
+    $self->_build_subs();
+    $self->_spawn() if $options{host} eq '127.0.0.1';
+    return $self;
+}
+
+=head1 METHODS
+
+=head2 Most of the methods are dynamic based on the selenium spec
+
+This means that the Selenium::Client class can directly call all selenium methods.
+We provide a variety of subclasses as sugar around this:
+
+    Selenium::Session
+    Selenium::Capabilities
+    Selenium::Element
+
+Which will simplify correctly passing arguments in the case of sessions and elements.
+However, this does not change the fact that you still must take great care.
+We do no validation whatsoever of the inputs, and the selenium server likes to hang when you give it an invalid input.
+So take great care and understand this is what "script hung and died" means -- you passed the function an unrecognized argument.
+
+This is because Selenium::Specification cannot (yet!) parse the inputs and outputs for each endpoint at this time.
+As such we can't just filter against the relevant prototype.
+
+In any case, all subs will look like this, for example:
+
+    $client->Method( key => value, key1 => value1, ...) = (@return_per_key)
+
+The options passed in are basically JSON serialized and passed directly as a POST body (or included into the relevant URL).
+We return a list of items which are a hashref per item in the result (some of them blessed).
+For example, NewSession will return a Selenium::Capabilities and Selenium::Session object.
+The order in which they are returned will be ordered alphabetically.
+
+=head2 catalog(BOOL verbose=0) = HASHREF
+
+Returns the entire method catalog.
+Prints out every method and a link to the relevant documentation if verbose is true.
+
+=cut
+
+sub catalog($self,$printed=0) {
+    return $self->{spec} unless $printed;
+    foreach my $method (keys(%{$self->{spec}})) {
+        print "$method: $self->{spec}{$method}{href}\n";
+    }
+    return $self->{spec};
+}
+
+sub _build_subs($self) {
+    foreach my $sub (keys(%{$self->{spec}})) {
+        Sub::Install::install_sub(
+            {
+                code => sub {
+                    my $self = shift;
+                    return $self->_request($sub,@_);
+                },
+                as   => $sub,
+                into => "Selenium::Client",
+            }
+        ) unless "Selenium::Client"->can($sub);
+    }
+}
+
+#Check if server already up and spawn if no
+sub _spawn($self) {
+    return $self->Status() if Net::EmptyPort::wait_port( $self->{port}, 1 );
+
+    # Pick a random port for the new server
+    $self->{port} = Net::EmptyPort::empty_port();
+
+    my $driver_file = "Selenium/Driver/$self->{driver}.pm";
+    $driver_file =~ s/::/\//g;
+    eval { require $driver_file } or confess "Could not load $driver_file, check your PERL5LIB: $@";
+    my $driver = "Selenium::Driver::$self->{driver}";
+
+    $driver->build_spawn_opts($self);
+    return $self->_do_spawn();
+}
+
+sub _do_spawn($self) {
+
+    #XXX on windows we will *never* terminate if we are listening for *anything*
+    #XXX so we have to just bg & ignore, unfortunately (also have to system())
+    if (_is_windows()) {
+        $self->{pid} = qq/$self->{driver}:$self->{port}/;
+        my $cmdstring = join(' ', "start /MIN", qq{"$self->{pid}"}, @{$self->{command}}, '>', $self->{log_file}, '2>&1');
+        print "$cmdstring\n" if $self->{debug};
+        system($cmdstring);
+        return $self->_wait();
+    }
+
+    print "@{$self->{command}}\n" if $self->{debug};
+    my $pid = fork // confess("Could not fork");
+    if ($pid) {
+        $self->{pid} = $pid;
+        return $self->_wait();
+    }
+    open(my $fh, '>>', $self->{log_file});
+    capture_merged { exec(@{$self->{command}}) } stdout => $fh;
+}
+
+sub _wait ($self) {
+    print "Waiting for port to come up..." if $self->{debug};
+    Net::EmptyPort::wait_port( $self->{port}, 30 )
+      or confess("Server never came up on port $self->{port} after 30s!");
+    print "done\n" if $self->{debug};
+    return $self->Status();
+}
+
+sub DESTROY($self) {
+    return unless $self->{auto_close};
+
+    print "Shutting down active sessions...\n" if $self->{debug};
+    #murder all sessions we spawned so that die() cleans up properly
+    if ($self->{ua} && @{$self->{sessions}}) {
+        foreach my $session (@{$self->{sessions}}) {
+            # An attempt was made.  The session *might* already be dead.
+            eval { $self->DeleteSession( sessionid => $session ) };
+        }
+    }
+
+    #Kill the server if we spawned one
+    return unless $self->{pid};
+    print "Attempting to kill server process...\n" if $self->{debug};
+
+    if (_is_windows()) {
+        my $killer = qq[taskkill /FI "WINDOWTITLE eq $self->{pid}"];
+        print "$killer\n" if $self->{debug};
+        #$killer .= ' > nul 2&>1' unless $self->{debug};
+        system($killer);
+        return 1;
+    }
+
+    my $sig = 'TERM';
+    kill $sig, $self->{pid};
+
+    print "Issued SIG$sig to $self->{pid}, waiting...\n" if $self->{debug};
+    return waitpid( $self->{pid}, 0 );
+}
+
+sub _is_windows {
+    return grep { $^O eq $_ } qw{msys MSWin32};
+}
+
+#XXX some of the methods require content being null, some require it to be an obj with no params LOL
+our @bad_methods = qw{AcceptAlert DismissAlert Back Forward Refresh ElementClick MaximizeWindow MinimizeWindow FullscreenWindow SwitchToParentFrame ElementClear};
+
+#Exempt some calls from return processing
+our @no_process = qw{Status GetWindowRect GetElementRect GetAllCookies};
+
+sub _request($self, $method, %params) {
+    my $subject = $self->{spec}->{$method};
+
+    #TODO handle compressed output from server
+    my %options = (
+        headers => {
+            'Content-Type'    => 'application/json; charset=utf-8',
+            'Accept'          => 'application/json; charset=utf-8',
+            'Accept-Encoding' => 'identity',
+        },
+    );
+    $options{content} = '{}' if grep { $_ eq $method } @bad_methods;
+
+    my $url = "$self->{scheme}://$self->{host}:$self->{port}$subject->{uri}";
+
+    # Remove parameters to inject into child objects
+    my $inject_key   = exists $params{inject} ? delete $params{inject} : undef;
+    my $inject_value = $inject_key ? $params{$inject_key} : '';
+    my $inject;
+    $inject = { to_inject => { $inject_key => $inject_value } } if $inject_key && $inject_value;
+
+    # Keep sessions for passing to grandchildren
+    $inject->{to_inject}{sessionid} = $params{sessionid} if exists $params{sessionid};
+
+    foreach my $param (keys(%params)) {
+        confess "$param is required for $method" unless exists $params{$param};
+        delete $params{$param} if $url =~ s/{\Q$param\E}/$params{$param}/g;
+    }
+
+    if (%params) {
+        $options{content} = JSON::MaybeXS::encode_json(\%params);
+        $options{headers}{'Content-Length'} = length($options{content});
+    }
+
+    print "$subject->{method} $url\n" if $self->{debug};
+    print "Body: $options{content}\n" if $self->{debug} && exists $options{content};
+
+    my $res = $self->{ua}->request($subject->{method}, $url, \%options);
+
+    my @cbret;
+    foreach my $cb (@{$self->{post_callbacks}}) {
+        if ($cb && ref $cb eq 'CODE') {
+            @options{qw{url method}} = ($url,$subject->{method});
+            $options{content} = \%params if %params;
+            my $ret = $cb->($self, $res, \%options);
+            push(@cbret,$ret) if $ret;
+        }
+        return $cbret[0] if @cbret == 1;
+        return @cbret if @cbret;
+    }
+
+    print "$res->{status} : $res->{content}\n" if $self->{debug} && ref $res eq 'HASH';
+
+    my $decoded_content = eval { JSON::MaybeXS::decode_json($res->{content}) };
+    confess "$res->{reason} :\n Consult $subject->{href}\nRaw Error:\n$res->{content}\n" unless $res->{success};
+
+    if (grep { $method eq $_ } @no_process) {
+        return @{$decoded_content->{value}} if ref $decoded_content->{value} eq 'ARRAY';
+        return $decoded_content->{value};
+    }
+    return $self->_objectify($decoded_content,$inject);
+}
+
+our %classes = (
+    capabilities => { class => 'Selenium::Capabilities' },
+    sessionId    => {
+        class => 'Selenium::Session',
+        destroy_callback => sub {
+                my $self = shift;
+                $self->DeleteSession() unless $self->{deleted};
+        },
+        callback => sub {
+            my ($self,$call) = @_;
+            $self->{deleted} = 1 if $call eq 'DeleteSession';
+        },
+    },
+    # Whoever thought this parameter name was a good idea...
+    'element-6066-11e4-a52e-4f735466cecf' => {
+        class => 'Selenium::Element',
+    },
+);
+
+sub _objectify($self,$result,$inject) {
+    my $subject = $result->{value};
+    return $subject unless grep { ref $subject eq $_ } qw{ARRAY HASH};
+    $subject = [$subject] unless ref $subject eq 'ARRAY';
+
+    my @objs;
+    foreach my $to_objectify (@$subject) {
+        # If we have just data return it
+        return @$subject if ref $to_objectify ne 'HASH';
+
+        my @objects = keys(%$to_objectify);
+        foreach my $object (@objects) {
+            my $has_class = exists $classes{$object};
+
+            my $base_object = $inject // {};
+            $base_object->{lc($object)} = $to_objectify->{$object};
+            $base_object->{sortField} = lc($object);
+
+            my $to_push = $has_class ?
+                $classes{$object}{class}->new($self, $base_object ) :
+                $to_objectify;
+            $to_push->{sortField} = lc($object);
+            # Save sessions for destructor
+            push(@{$self->{sessions}}, $to_push->{sessionid}) if ref $to_push eq 'Selenium::Session';
+            push(@objs,$to_push);
+        }
+    }
+    @objs = sort { $a->{sortField} cmp $b->{sortField} } @objs;
+    return $objs[0] if @objs == 1;
+    return @objs;
+}
+
+1;
+
+=head1 SUBCLASSES
+
+=head2 Selenium::Capabilities
+
+Returned as first element from NewSession().
+Query this object for various things about the server capabilities.
+
+=head2 Selenium::Session
+
+Returned as second element of NewSession().
+Has a destructor which will automatically clean itself up when we go out of scope.
+Alternatively, when the driver object goes out of scope, all sessions it spawned will be destroyed.
+
+You can call Selenium methods on this object which require a sessionid without passing it explicitly.
+
+=head2 Selenium::Element
+
+Returned from find element calls.
+
+You can call Selenium methods on this object which require a sessionid and elementid without passing them explicitly.
+
+=cut
+
+package Selenium::Capabilities;
+
+use parent qw{Selenium::Subclass};
+1;
+package Selenium::Session;
+
+use parent qw{Selenium::Subclass};
+1;
+package Selenium::Element;
+
+use parent qw{Selenium::Subclass};
+1;
+
+__END__
+
+=head1 STUPID SELENIUM TRICKS
+
+There are a variety of quirks with Selenium drivers that you just have to put up with, don't log bugs on these behaviors.
+
+=head3 alerts
+
+If you have an alert() open on the page, all calls to the selenium server will 500 until you dismiss or accept it.
+
+Also be aware that chrome  will re-fire alerts when you do a forward() or back() event, unlike firefox.
+
+=head3 tag names
+
+Safari returns ALLCAPS names for tags.  amazing
+
+=head2 properties and attributes
+
+Many I<valid> properties/attributes will I<never> be accessible via GetProperty() or GetAttribute().
+
+For example, getting the "for" value of a <label> element is flat-out impossible using either GetProperty or GetAttribute.
+There are many other such cases, the most common being "non-standard" properties such as aria-* or things used by JS templating engines.
+You are better off using JS shims to do any element inspection.
+
+Similarly the IsElementSelected() method is quite unreliable.
+We can work around this however by just using the CSS :checked pseudoselector when looking for elements, as that actually works.
+
+It is this for these reasons that you should consider abandoning Selenium for something that can actually do this correctly such as L<Playwright>.
+
+=head3 windows
+
+When closing windows, be aware you will be NOT be shot back to the last window you had focused before switching to the current one.
+You have to manually switch back to an existing one.
+
+Opening _blank targeted links *does not* automatically switch to the new window.
+The procedure for handling links of such a sort to do this is as follows:
+
+    # Get current handle
+    my $handle = $session->GetWindowHandle();
+
+    # Assuming the element is an href with target=_blank ...
+    $element->ClickElement();
+
+    # Get all handles and filter for the ones that we aren't currently using
+    my @handles = $session->GetWindowHandles();
+    my @new_handles = grep { $handle != $_ } @handles;
+
+    # Use pop() as it will always be returned in the order windows are opened
+    $session->SwitchToWindow( handle => pop(@new_handles) );
+
+Different browser drivers also handle window handles differently.
+Chrome in particular demands you stringify handles returned from the driver.
+It also seems to be a lot less cooperative than firefox when setting the WindowRect.
+
+=head3 arguments
+
+If you make a request of the server with arguments it does not understand it will hang for 30s, so set a SIGALRM handler if you insist on doing so.
+
+=head2 MSWin32 issues
+
+The default version of the Java JRE from java.com is quite simply ancient on windows, and SeleniumHQ develops against JDK 11 and better.
+So make sure your JDK bin dir is in your PATH I<before> the JRE path (or don't install an ancient JRE lol)
+
+If you don't, you'll probably get insta-explosions due to their usage of new language features.
+Kind of like how you'll die if you use a perl without signatures with this module :)
+
+Also, due to perl pseudo-forks hanging forever if anything is ever waiting on read() in windows, we don't fork to spawn binaries.
+Instead we use C<start> to open a new cmd.exe window, which will show up in your task tray.
+Don't close this or your test will fail for obvious reasons.
+
+=head1 AUTHOR
+
+George S. Baugh <george@troglodyne.net>

+ 43 - 0
lib/Selenium/Driver/Auto.pm

@@ -0,0 +1,43 @@
+package Selenium::Driver::Auto;
+
+#ABSTRACT: Automatically choose the best driver available for your browser choice
+
+use strict;
+use warnings;
+
+use Carp qw{confess};
+use File::Which;
+
+# Abstract: Automatically figure out which driver you want
+
+=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
+
+sub build_spawn_opts {
+    # Uses object call syntax
+    my (undef,$object) = @_;
+
+    if ($object->{browser} eq 'firefox') {
+        require Selenium::Driver::Gecko;
+        return Selenium::Driver::Gecko->build_spawn_opts($object);
+    } elsif ($object->{browser} eq 'chrome') {
+        require Selenium::Driver::Chrome;
+        return Selenium::Driver::Chrome->build_spawn_opts($object);
+    } elsif ($object->{browser} eq 'MicrosoftEdge') {
+        require Selenium::Driver::Edge;
+        return Selenium::Driver::Edge->build_spawn_opts($object);
+    } elsif ($object->{browser} eq 'safari') {
+        require Selenium::Driver::Safari;
+        return Selenium::Driver::Safari->build_spawn_opts($object);
+    }
+    require Selenium::Driver::SeleniumHQ::Jar;
+    return Selenium::Driver::SeleniumHQ::Jar->build_spawn_opts($object);
+}
+
+1;

+ 50 - 0
lib/Selenium/Driver/Chrome.pm

@@ -0,0 +1,50 @@
+package Selenium::Driver::Chrome;
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw/signatures/;
+
+use Carp qw{confess};
+use File::Which;
+
+#ABSTRACT: Tell Selenium::Client how to spawn chromedriver
+
+=head1 Mode of Operation
+
+Spawns a chromedriver server on the provided port (which the caller will assign randomly)
+Relies on chromedriver being in your $PATH
+Pipes log output to ~/.selenium/perl-client/$port.log
+
+=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
+
+sub _driver {
+    return 'chromedriver';
+}
+
+sub build_spawn_opts($class,$object) {
+    $object->{driver_class}       = $class;
+    $object->{driver_version}     //= '';
+    $object->{log_file}           //= "$object->{client_dir}/perl-client/selenium-$object->{port}.log";
+    $object->{driver_file} = File::Which::which($class->_driver());
+    die "Could not find driver!" unless $object->{driver_file};
+
+    my @config = ('--port='.$object->{port});
+
+    # Build command string
+    $object->{command} //= [
+        $object->{driver_file},
+        @config,
+    ];
+    return $object;
+}
+
+1;

+ 23 - 0
lib/Selenium/Driver/Edge.pm

@@ -0,0 +1,23 @@
+package Selenium::Driver::Edge;
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw/signatures/;
+
+use parent qw{Selenium::Driver::Chrome};
+
+#ABSTRACT: Tell Selenium::Client how to spawn edgedriver
+
+=head1 Mode of Operation
+
+Like edge, this is a actually chrome.  So refer to Selenium::Driver::Chrome documentation.
+
+=cut
+
+sub _driver {
+    return 'msedgedriver.exe';
+}
+
+1;

+ 46 - 0
lib/Selenium/Driver/Gecko.pm

@@ -0,0 +1,46 @@
+package Selenium::Driver::Gecko;
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw/signatures/;
+
+use Carp qw{confess};
+use File::Which;
+
+#ABSTRACT: Tell Selenium::Client how to spawn geckodriver
+
+=head1 Mode of Operation
+
+Spawns a geckodriver server on the provided port (which the caller will assign randomly)
+Relies on geckodriver being in your $PATH
+Pipes log output to ~/.selenium/perl-client/$port.log
+
+=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
+
+sub build_spawn_opts($class,$object) {
+    $object->{driver_class}       = $class;
+    $object->{driver_version}     //= '';
+    $object->{log_file}           //= "$object->{client_dir}/perl-client/selenium-$object->{port}.log";
+    $object->{driver_file} = File::Which::which('geckodriver');
+    die "Could not find driver!" unless $object->{driver_file};
+
+    my @config = ('--port', $object->{port});
+
+    # Build command string
+    $object->{command} //= [
+        $object->{driver_file},
+        @config,
+    ];
+    return $object;
+}
+
+1;

+ 45 - 0
lib/Selenium/Driver/Safari.pm

@@ -0,0 +1,45 @@
+package Selenium::Driver::Safari;
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw/signatures/;
+
+use Carp qw{confess};
+use File::Which;
+
+#ABSTRACT: Tell Selenium::Client how to spawn safaridriver
+
+=head1 Mode of Operation
+
+Spawns a geckodriver server on the provided port (which the caller will assign randomly)
+Relies on geckodriver being in your $PATH
+Pipes log output to ~/.selenium/perl-client/$port.log
+
+=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
+
+sub build_spawn_opts($class,$object) {
+    $object->{driver_class} = $class;
+    $object->{driver_version}     //= '';
+    $object->{log_file}           //= "$object->{client_dir}/perl-client/selenium-$object->{port}.log";
+    $object->{driver_file} = File::Which::which('safaridriver');
+
+    my @config = ('--port', $object->{port});
+
+    # Build command string
+    $object->{command} //= [
+        $object->{driver_file},
+        @config,
+    ];
+    return $object;
+}
+
+1;

+ 145 - 0
lib/Selenium/Driver/SeleniumHQ/Jar.pm

@@ -0,0 +1,145 @@
+package Selenium::Driver::SeleniumHQ::Jar;
+
+use strict;
+use warnings;
+
+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;

+ 255 - 0
lib/Selenium/Specification.pm

@@ -0,0 +1,255 @@
+package Selenium::Specification;
+
+# ABSTRACT: Module for building a machine readable specification for Selenium
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw/signatures/;
+
+use List::Util qw{uniq};
+use HTML::Parser();
+use JSON::MaybeXS();
+use File::HomeDir();
+use File::Slurper();
+use DateTime::Format::HTTP();
+use HTTP::Tiny();
+use File::Path qw{make_path};
+use File::Spec();
+
+#TODO make a JSONWire JSON spec since it's not changing
+
+# URLs and the container ID
+our %spec_urls = (
+    unstable => {
+       url         => 'https://w3c.github.io/webdriver/',
+       section_id  => 'endpoints',
+    },
+    draft => {
+        url        => "https://www.w3.org/TR/webdriver2/",
+        section_id => 'endpoints',
+    },
+    stable => {
+        url        => "https://www.w3.org/TR/webdriver1/",
+        section_id => 'list-of-endpoints',
+    },
+);
+
+our $browser = HTTP::Tiny->new();
+my %state;
+my $parse = [];
+my $dir = File::Spec->catdir( File::HomeDir::my_home(),".selenium","specs" );
+our $method = {};
+
+=head1 SUBROUTINES
+
+=head2 read($type STRING, $nofetch BOOL)
+
+Reads the copy of the provided spec type, and fetches it if a cached version is not available.
+
+=cut
+
+sub read($type='stable', $nofetch=1) {
+    my $file =  File::Spec->catfile( "$dir","$type.json");
+    fetch( once => $nofetch );
+    die "could not write $file: $@" unless -f $file;
+    my $buf = File::Slurper::read_text($file);
+    my $array = JSON::MaybeXS::decode_json($buf);
+    my %hash;
+    @hash{map { $_->{name} } @$array} = @$array;
+    return \%hash;
+}
+
+=head2 fetch(%OPTIONS HASH)
+
+Builds a spec hash based upon the WC3 specification documents, and writes it to disk.
+
+=cut
+
+#TODO needs to grab args and argtypes still
+sub fetch (%options) {
+    $dir = $options{dir} if $options{dir};
+
+    my $rc = 0;
+    foreach my $spec ( sort keys(%spec_urls) ) {
+        make_path( $dir ) unless -d $dir;
+        my $file =  File::Spec->catfile( "$dir","$spec.json");
+        my $last_modified = -f $file ? (stat($file))[9] : undef;
+
+        if ($options{once} && $last_modified) {
+            print STDERR "Skipping fetch, using cached result" if $options{verbose};
+            next;
+        }
+
+        $last_modified = 0 if $options{force};
+
+        my $spc = _build_spec($last_modified, %{$spec_urls{$spec}});
+        if (!$spc) {
+            print STDERR "Could not retrieve $spec_urls{$spec}{url}, skipping" if $options{verbose};
+            $rc = 1;
+            next;
+        }
+
+        # Second clause is for an edge case -- if the header is not set for some bizarre reason we should obey force still
+        if (ref $spc ne 'ARRAY' && $last_modified) {
+            print STDERR "Keeping cached result '$file', as page has not changed since last fetch.\n" if $options{verbose};
+            next;
+        }
+
+        _write_spec($spc, $file);
+        print "Wrote $file\n" if $options{verbose};
+    }
+    return $rc;
+}
+
+
+
+sub _write_spec ($spec, $file) {
+    my $spec_json = JSON::MaybeXS::encode_json($spec);
+    return File::Slurper::write_text($file, $spec_json);
+}
+
+sub _build_spec($last_modified, %spec) {
+    my $page = $browser->get($spec{url});
+    return unless $page->{success};
+
+    if ($page->{headers}{'last-modified'} && $last_modified ) {
+        my $modified = DateTime::Format::HTTP->parse_datetime($page->{headers}{'last-modified'})->epoch();
+        return 'cache' if $modified < $last_modified;
+    }
+
+    my $html = $page->{content};
+
+    $parse = [];
+    %state = ( id => $spec{section_id} );
+    my $parser = HTML::Parser->new(
+        handlers => {
+            start => [\&_handle_open,  "tagname,attr"],
+            end   => [\&_handle_close, "tagname"],
+            text  => [\&_handle_text,  "text"],
+        }
+    );
+    $parser->parse($html);
+
+    # Now that we have parsed the methods, let us go ahead and build the argspec based on the anchors for each endpoint.
+    foreach my $m (@$parse) {
+        $method = $m;
+        %state = ();
+        my $mparser = HTML::Parser->new(
+            handlers => {
+                start => [\&_endpoint_open,  "tagname,attr"],
+                end   => [\&_endpoint_close, "tagname"],
+                text  => [\&_endpoint_text,  "text"],
+            },
+        );
+        $mparser->parse($html);
+    }
+
+    return _fixup(\%spec,$parse);
+}
+
+sub _fixup($spec,$parse) {
+    @$parse = map {
+        $_->{href}    = "$spec->{url}$_->{href}";
+        #XXX correct TYPO in the spec
+        $_->{uri} =~ s/{sessionid\)/{sessionid}/g;
+        @{$_->{output_params}} = grep { $_ ne 'null' } uniq @{$_->{output_params}};
+        $_
+    } @$parse;
+
+    return $parse;
+}
+
+sub _handle_open($tag,$attr) {
+
+    if ( $tag eq 'section' && ($attr->{id} || '') eq $state{id} ) {
+        $state{active} = 1;
+        return;
+    }
+    if ($tag eq 'tr') {
+        $state{method}  = 1;
+        $state{headers} = [qw{method uri name}];
+        $state{data}    = {};
+        return;
+    }
+    if ($tag eq 'td') {
+        $state{heading} = shift @{$state{headers}};
+        return;
+    }
+    if ($tag eq 'a' && $state{heading} && $attr->{href}) {
+        $state{data}{href} = $attr->{href};
+    }
+}
+
+sub _handle_close($tag) {
+    if ($tag eq 'section') {
+        $state{active} = 0;
+        return;
+    }
+    if ($tag eq 'tr' && $state{active}) {
+        if ($state{past_first}) {
+            push(@$parse, $state{data});
+        }
+
+        $state{past_first} = 1;
+        $state{method} = 0;
+        return;
+    }
+}
+
+sub _handle_text($text) {
+    return unless $state{active} && $state{method} && $state{past_first} && $state{heading};
+    $text =~ s/\s//gm;
+    return unless $text;
+    $state{data}{$state{heading}} .= $text;
+}
+
+# Endpoint parsers
+
+sub _endpoint_open($tag,$attr) {
+    my $id = $method->{href};
+    $id =~ s/^#//;
+
+    if ($attr->{id} && $attr->{id} eq $id) {
+        $state{active} = 1;
+    }
+    if ($tag eq 'ol') {
+        $state{in_tag} = 1;
+    }
+    if ($tag eq 'dt' && $state{in_tag} && $state{last_tag} eq 'dl') {
+        $state{in_dt} = 1;
+    }
+    if ($tag eq 'code' && $state{in_dt} && $state{in_tag} && $state{last_tag} eq 'dt') {
+        $state{in_code} = 1;
+    }
+
+    $state{last_tag} = $tag;
+}
+
+sub _endpoint_close($tag) {
+    return unless $state{active};
+    if ($tag eq 'section') {
+        $state{active} = 0;
+        $state{in_tag} = 0;
+    }
+    if ($tag eq 'ol') {
+        $state{in_tag} = 0;
+    }
+    if ($tag eq 'dt') {
+        $state{in_dt} = 0;
+    }
+    if ($tag eq 'code') {
+        $state{in_code} = 0;
+    }
+}
+
+sub _endpoint_text($text) {
+    if ($state{active} && $state{in_tag} && $state{in_code} && $state{in_dt} && $state{last_tag} eq 'code') {
+        $method->{output_params} //= [];
+        $text =~ s/\s//gm;
+        push(@{$method->{output_params}},$text) if $text;
+    }
+}
+
+1;

+ 79 - 0
lib/Selenium/Subclass.pm

@@ -0,0 +1,79 @@
+package Selenium::Subclass;
+
+#ABSTRACT: Generic template for Selenium sugar subclasses like Selenium::Session
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw/signatures/;
+
+=head1 CONSTRUCTOR
+
+=head2 $class->new($parent Selenium::Client, $data HASHREF)
+
+You should probably not use this directly; objects should be created as part of normal operation.
+
+=cut
+
+sub new ($class,$parent,$data) {
+    my %lowkey;
+    @lowkey{map { lc $_ } keys(%$data)} = values(%$data);
+    $lowkey{parent} = $parent;
+
+    my $self = bless(\%lowkey,$class);
+
+    $self->_build_subs($class);
+    return $self;
+}
+
+sub _request ($self, $method, %params) {
+
+    #XXX BAD SPEC AUTHOR, BAD!
+    if ( $self->{sortfield} eq 'element-6066-11e4-a52e-4f735466cecf') {
+        $self->{sortfield} = 'elementid';
+        $self->{elementid} = delete $self->{'element-6066-11e4-a52e-4f735466cecf'};
+    }
+
+    # Inject our sortField param, and anything else we need to
+    $params{$self->{sortfield}} = $self->{$self->{sortfield}};
+    my $inject = $self->{to_inject};
+    @params{keys(%$inject)} = values(%$inject) if ref $inject eq 'HASH';
+
+    # and insure it is injected into child object requests
+    $params{inject} = $self->{sortfield};
+
+    $self->{callback}->($self,$method,%params) if $self->{callback};
+
+    return $self->{parent}->_request($method, %params);
+}
+
+sub DESTROY($self) {
+    return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
+    $self->{destroy_callback}->($self) if $self->{destroy_callback};
+}
+
+#TODO filter spec so we don't need parent anymore, and can have a catalog() method
+sub _build_subs($self,$class) {
+    #Filter everything out which doesn't have {sortField} in URI
+    my $k = lc($self->{sortfield});
+
+    #XXX deranged field name
+    $k = 'elementid' if $self->{sortfield} eq 'element-6066-11e4-a52e-4f735466cecf';
+
+    foreach my $sub (keys(%{$self->{parent}{spec}})) {
+        next unless $self->{parent}{spec}{$sub}{uri} =~ m/{\Q$k\E}/;
+        Sub::Install::install_sub(
+            {
+                code => sub {
+                    my $self = shift;
+                    return $self->_request($sub,@_);
+                },
+                as   => $sub,
+                into => $class,
+            }
+        ) unless $class->can($sub);
+    }
+}
+
+1;

+ 1 - 0
perlcriticrc

@@ -0,0 +1 @@
+exclude = RequireUseStrict|RequireUseWarnings|ProhibitSubroutinePrototypes