Re-factor to use Type::Tiny for parameters

Modularize testrail-lock

Changes

@@ -8,6 +8,7 @@ Revision history for Perl module TestRail::API
     - Modify all bin/ scripts to use POD as their help output, move help() to TestRail::Utils
     - Modify all bin/ scripts to parse all the ~/.testrailrc options
     - Fix an issue where statusNamesToIDs would return status IDs in the wrong order.
+    - Re-factor to use Type::Tiny parameter checking.
 
 0.028 2015-06-16 TEODESIAN
     - Hotfix: forgot to include a module in the prove plugin.  How did this pass compile.t? A mystery.

bin/testrail-lock

@@ -81,18 +81,12 @@ use strict;
 use warnings;
 use utf8;
 
-use TestRail::API;
 use TestRail::Utils;
 
 use Getopt::Long;
 use File::HomeDir qw{my_home};
-use File::Find;
-use Cwd qw{abs_path};
-use File::Basename qw{basename};
 use Sys::Hostname qw{hostname};
 
-my $hostname = hostname();
-
 my $opts = {};
 
 #Parse config file if we are missing api url/key or user
@@ -116,100 +110,11 @@ GetOptions(
 );
 
 if ($opts->{help}) { help(); }
+$opts->{'hostname'} = hostname;
 
 TestRail::Utils::interrogateUser($opts,qw{apiurl user password project run lockname});
 
-if ($opts->{mock}) {
-    use Test::LWP::UserAgent::TestRailMock;
-    $opts->{browser} = $Test::LWP::UserAgent::TestRailMock::mockObject;
-    $opts->{debug} = 1;
-}
-
-my $tr = TestRail::API->new($opts->{apiurl},$opts->{user},$opts->{password},$opts->{'encoding'},$opts->{'debug'});
-$tr->{'browser'} = $opts->{'browser'} if $opts->{'browser'};
-$tr->{'debug'} = 0;
-
-my $project = $tr->getProjectByName($opts->{'project'});
-if (!$project) {
-    warn "No such project '$opts->{project}'.\n";
-    exit 6;
-}
-
-my ($run,$plan);
-
-if ($opts->{'plan'}) {
-    $plan = $tr->getPlanByName($project->{'id'},$opts->{'plan'});
-    if (!$plan) {
-        warn "No such plan '$opts->{plan}'!\n";
-        exit 1;
-    }
-    $run = $tr->getChildRunByName($plan,$opts->{'run'}, $opts->{'configs'});
-} else {
-    $run = $tr->getRunByName($project->{'id'},$opts->{'run'});
-}
-
-if (!$run) {
-    warn "No such run '$opts->{run}' matching the provided configs (if any).\n";
-    exit 2;
-}
-
-my $status_ids;
-
-# Process statuses
-@$status_ids = $tr->statusNamesToIds($opts->{'lockname'},'untested','retest');
-my ($lock_status_id,$untested_id,$retest_id) = @$status_ids;
-
-my $cases = $tr->getTests($run->{'id'});
-my @statuses_to_check_for = ($untested_id,$retest_id);
-@statuses_to_check_for = ($lock_status_id) if $opts->{'simulate_race_condition'}; #Unit test stuff
-
-# Limit to only non-locked and open cases
-@$cases = grep { my $tstatus = $_->{'status_id'}; scalar(grep { $tstatus eq $_ } @statuses_to_check_for) } @$cases;
-@$cases = sort { $a->{'priority_id'} <=> $b->{'priority_id'} } @$cases; #Sort by priority
-
-TRY_AGAIN:
-
-my $test = shift @$cases;
-
-if (!$test) {
-    warn "No outstanding cases in the provided run.\n";
-    exit 3;
-}
-
-my $res = $tr->createTestResults($test->{'id'},$lock_status_id,"Test Locked by $hostname.\n\nIf this result is preceded immediately by another lock statement like this, please disregard, as a lock collision occurred.");
-
-#If we've got more than 100 lock conflicts, we have big-time problems
-my $results = $tr->getTestResults($test->{'id'},100);
-
-#Remember, we're returned results from newest to oldest...
-my $next_one = 0;
-foreach my $result (@$results) {
-    unless ($result->{'status_id'} == $lock_status_id) {
-        #Clearly no lock conflict going on here if next_one is true
-        last if $next_one;
-        #Otherwise just skip it until we get to the test we locked
-        next;
-    }
-
-    if ($result->{id} == $res->{'id'}) {
-        $next_one = 1;
-        next;
-    }
-
-    if ($next_one) {
-        #If we got this far, a lock conflict occurred. Try the next one.
-        warn "Lock conflict detected.  Trying again...\n";
-        goto TRY_AGAIN;
-    }
-}
-
-if (!$next_one) {
-    warn "Failed to lock case!";
-    exit 4;
-}
-
-print $test->{'title'}."\n";
-
+print TestRail::Utils::pickAndLockTest($opts)."\n";
 exit 0;
 
 __END__

lib/Test/LWP/UserAgent/TestRailMock.pm

@@ -2113,7 +2113,7 @@ $mockObject->map_response(qr/\Q$VAR1\E/,HTTP::Response->new($VAR2, $VAR3, $VAR4,
 
 {
 
-$VAR1 = 'index.php?/api/v2/get_runs/9&limit=250';
+$VAR1 = 'index.php?/api/v2/get_runs/9&offset=0&limit=250';
 $VAR2 = '200';
 $VAR3 = 'OK';
 $VAR4 = bless( {
@@ -2169,7 +2169,7 @@ $mockObject->map_response(qr/\Q$VAR1\E/,HTTP::Response->new($VAR2, $VAR3, $VAR4,
 
 {
 
-$VAR1 = 'index.php?/api/v2/get_plans/9&limit=250';
+$VAR1 = 'index.php?/api/v2/get_plans/9&offset=0&limit=250';
 $VAR2 = '200';
 $VAR3 = 'OK';
 $VAR4 = bless( {

lib/TestRail/Utils.pm

@@ -1,20 +1,15 @@
-# ABSTRACT: Utilities for the testrail command line functions.
+# ABSTRACT: Utilities for the testrail command line functions, and their main loops.
 # PODNAME: TestRail::Utils
 
-=head1 DESCRIPTION
-
-Utilities for the testrail command line functions.
-
-=cut
-
 package TestRail::Utils;
 
 use strict;
 use warnings;
 
+use Carp qw{confess cluck};
 use Pod::Perldoc 3.10;
 
-=head1 FUNCTIONS
+=head1 SCRIPT HELPER FUNCTIONS
 
 =head2 help
 
@@ -133,6 +128,38 @@ sub getFilenameFromTapLine {
     return 0;
 }
 
+
+=head2 getRunInformation
+
+Return the relevant project definition, plan and run definition HASHREFs for the provided options.
+Practically all the binaries need this information, so it has been subroutined out.
+
+
+Dies in the event the project/plan/run could not be found.
+
+=cut
+
+sub getRunInformation {
+    my ($tr,$opts) = @_;
+    confess("First argument must be instance of TestRail::API") unless blessed($tr) eq 'TestRail::API';
+
+    my $project = $tr->getProjectByName($opts->{'project'});
+    confess "No such project '$opts->{project}'.\n" if !$project;
+
+    my ($run,$plan);
+
+    if ($opts->{'plan'}) {
+        $plan = $tr->getPlanByName($project->{'id'},$opts->{'plan'});
+        confess "No such plan '$opts->{plan}'!\n" if !$plan;
+        $run = $tr->getChildRunByName($plan,$opts->{'run'}, $opts->{'configs'});
+    } else {
+        $run = $tr->getRunByName($project->{'id'},$opts->{'run'});
+    }
+
+    confess "No such run '$opts->{run}' matching the provided configs (if any).\n" if !$run;
+    return ($project,$plan,$run);
+}
+
 1;
 
 __END__

lib/TestRail/Utils/Lock.pm

@@ -0,0 +1,147 @@
+# ABSTRACT: Pick high priority cases for execution and lock them via the test results mechanism.
+# PODNAME: TestRail::Utils::Lock
+
+package TestRail::Utils::Lock;
+
+use strict;
+use warnings;
+
+use Carp qw{confess cluck};
+
+use Types::Standard qw( slurpy ClassName Object Str Int Bool HashRef ArrayRef Maybe Optional);
+use Type::Params qw( compile );
+
+use TestRail::API;
+use TestRail::Utils;
+
+=head1 DESCRIPTION
+
+Lock a test case via usage of the test result field.
+Has a hard limit of looking for 250 results, which is the only weakness of this locking approach.
+If you have other test runners that result in such tremendous numbers of lock collisions,
+it will result in 'hard-locked' cases, where manual intervention will be required to free the case.
+
+However in that case, one would assume you could afford to write a reaper script to detect and
+correct this condition, or consider altering your run strategy to reduce the probability of lock collisions.
+
+=head2 pickAndLockTest(options,[handle])
+
+Pick and lock a test case in a TestRail Run, and return it if successful, confess() on failure.
+
+testrail-lock's primary routine.
+
+=over 4
+
+=item HASHREF C<OPTIONS> - valid keys/values correspond to the longnames of arguments taken by L<testrail-lock>.
+
+=item TestRail::API C<HANDLE> - Instance of TestRail::API, in the case where the caller already has a valid object.
+
+There are two special keys, 'mock' and 'simulate_race_condition' in the HASHREF that are used for testing.
+
+=back
+
+=cut
+
+sub pickAndLockTest {
+    my ($opts, $tr) = @_;
+
+    if ($opts->{mock}) {
+        require Test::LWP::UserAgent::TestRailMock; #LazyLoad
+        $opts->{browser} = $Test::LWP::UserAgent::TestRailMock::mockObject;
+        $opts->{debug} = 1;
+    }
+
+    $tr //= TestRail::API->new($opts->{apiurl},$opts->{user},$opts->{password},$opts->{'encoding'},$opts->{'debug'});
+    $tr->{'browser'} = $opts->{'browser'} if $opts->{'browser'};
+    $tr->{'debug'} = 0;
+
+    my ($project,$plan,$run) = TestRail::Utils::getRunInformation($tr,$opts);
+
+    my $status_ids;
+
+    # Process statuses
+    @$status_ids = $tr->statusNamesToIds($opts->{'lockname'},'untested','retest');
+    my ($lock_status_id,$untested_id,$retest_id) = @$status_ids;
+
+    my $cases = $tr->getTests($run->{'id'});
+    my @statuses_to_check_for = ($untested_id,$retest_id);
+    @statuses_to_check_for = ($lock_status_id) if $opts->{'simulate_race_condition'}; #Unit test stuff
+
+    # Limit to only non-locked and open cases
+    @$cases = grep { my $tstatus = $_->{'status_id'}; scalar(grep { $tstatus eq $_ } @statuses_to_check_for) } @$cases;
+    @$cases = sort { $a->{'priority_id'} <=> $b->{'priority_id'} } @$cases; #Sort by priority
+
+    my $test = shift @$cases;
+
+    confess "No outstanding cases in the provided run.\n" if !$test;
+
+    my $title;
+    foreach my $test (@$cases) {
+        $title = lockTest($test,$lock_status_id,$tr);
+        last if $title;
+    }
+
+    confess "Failed to lock case!" if !$title;
+
+    return $title;
+}
+
+=head2 lockTest(test,lock_status_id,handle)
+
+Lock the specified test.
+
+=over 4
+
+=item HASHREF C<TEST> - Test object returned by getTest, or a similar method.
+
+=item INTEGER C<LOCK_STATUS_ID> - Status used to denote locking of test
+
+=item TestRail::API C<HANDLE> - Instance of TestRail::API
+
+=back
+
+Returns undef in the event a lock could not occur, and warns on lock collisions.
+
+=cut
+
+sub lockTest {
+    state $check = compile(HashRef, Int, Object);
+    my ($test,$lock_status_id,$handle) = $check->(@_);
+
+    my $res = $tr->createTestResults(
+        $test->{id},
+        $lock_status_id,
+        "Test Locked by $opts->{hostname}.\n
+        If this result is preceded immediately by another lock statement like this, please disregard it;
+        a lock collision occurred."
+    );
+
+    #If we've got more than 100 lock conflicts, we have big-time problems
+    my $results = $tr->getTestResults($test->{id},100);
+
+    #Remember, we're returned results from newest to oldest...
+    my $next_one = 0;
+    foreach my $result (@$results) {
+        unless ($result->{'status_id'} == $lock_status_id) {
+            #Clearly no lock conflict going on here if next_one is true
+            last if $next_one;
+            #Otherwise just skip it until we get to the test we locked
+            next;
+        }
+
+        if ($result->{id} == $res->{'id'}) {
+            $next_one = 1;
+            next;
+        }
+
+        if ($next_one) {
+            #If we got this far, a lock conflict occurred. Try the next one.
+            warn "Lock conflict detected.  Try again...\n";
+            return undef;
+        }
+    }
+    return $test->{'title'} if $next_one;
+    return undef;
+}
+
+1;

t/TestRail-API.t

@@ -16,7 +16,7 @@ my $pw     = $ENV{'TESTRAIL_PASSWORD'};
 #Mock if nothing is provided
 my $is_mock = (!$apiurl && !$login && !$pw);
 
-like(exception {TestRail::API->new('trash');}, qr/invalid uri/i, "Non-URIs bounce constructor");
+like(exception {TestRail::API->new('trash','bogus','bogus');}, qr/invalid uri/i, "Non-URIs bounce constructor");
 
 #XXX for some insane reason 'hokum.bogus' seems to be popular with cpantesters
 my $bogoError = exception {TestRail::API->new('http://hokum.bogus','lies','moreLies',undef,0); };
@@ -166,7 +166,7 @@ my $results = $tr->getTestResults($tests->[0]->{'id'});
 is($results->[0]->{'id'},$result->{'id'},"Can get results for test");
 
 #Bulk add results
-my $results = $tr->bulkAddResults($new_run->{'id'}, [{ 'test_id' => $tests->[0]->{'id'},'status_id' => $statusTypes->[0]->{'id'}, "comment" => "REAPER FORCES INBOUND" }]);
+$results = $tr->bulkAddResults($new_run->{'id'}, [{ 'test_id' => $tests->[0]->{'id'},'status_id' => $statusTypes->[0]->{'id'}, "comment" => "REAPER FORCES INBOUND" }]);
 ok(defined($results->[0]->{'id'}),"Can bulk add test results");
 
 #Test status and assignedto filtering

t/author-classSafety.t

@@ -1,31 +0,0 @@
-use strict;
-use warnings;
-
-use TestRail::API;
-use Test::More;
-use Test::Fatal;
-use Class::Inspector;
-
-#plan('skip_all' => "these tests are for testing by the author") unless $ENV{'AUTHOR_TESTING'};
-
-my $tr = TestRail::API->new('http://hokum.bogus','bogus','bogus',undef,1);
-
-#Call instance methods as class and vice versa
-like( exception {$tr->new();}, qr/.*must be called statically.*/, "Calling constructor on instance dies");
-
-my @methods = Class::Inspector->methods('TestRail::API');
-my @excludeModules = qw{Scalar::Util Carp Clone Try::Tiny HTTP::Request LWP::UserAgent Data::Validate::URI};
-my @tmp = ();
-my @excludedMethods = ();
-foreach my $module (@excludeModules) {
-    @tmp = Class::Inspector->methods($module);
-    push(@excludedMethods,@{$tmp[0]});
-}
-
-foreach my $method (@{$methods[0]}) {
-    next if grep {$method eq $_} qw{new buildStepResults _checkInteger _checkString};
-    next if grep {$_ eq $method} @excludedMethods;
-    like( exception {TestRail::API->$method}, qr/.*called by an instance.*/ , "Calling $method requires an instance");
-}
-
-done_testing();

t/server_dead.t

@@ -40,7 +40,7 @@ is($tr->getCaseByName(1,1,1,'hug'),-500,'getCaseByName returns error');
 is($tr->getCaseTypeByName('zap'),-500,'getCaseTypeByName returns error');
 is($tr->getCaseTypes(),-500,'getCaseTypes returns error');
 is($tr->getCases(1,2,3),-500,'getCases returns error');
-is($tr->getMilestoneByID(1,1),-500,'getMilestoneByID returns error');
+is($tr->getMilestoneByID(1),-500,'getMilestoneByID returns error');
 is($tr->getMilestoneByName(1,'hug'),-500,'getMilestoneByName returns error');
 is($tr->getMilestones(1),-500,'getMilestones returns error');
 is($tr->getPlanByID(1),-500,'getPlanByID returns error');