TestRail-Perl/lib/TestRail/Utils.pm

# ABSTRACT: Utilities for the testrail command line functions, and their main loops.
# PODNAME: TestRail::Utils

package TestRail::Utils;

use strict;
use warnings;

use Carp qw{confess cluck};
use Pod::Perldoc 3.10;

use Scalar::Util qw{blessed};
use File::Find;
use Cwd qw{abs_path};
use File::Basename qw{basename};

=head1 SCRIPT HELPER FUNCTIONS

=head2 help

Print the perldoc for $0 and exit.

=cut

sub help {
    @ARGV = ($0);
    Pod::Perldoc->run();
    exit 0;
}

=head2 userInput

Wait for user input and return it.

=cut

sub userInput {
 local $| = 1;
 my $rt = <STDIN>;
 chomp $rt;
 return $rt;
}

=head2 interrogateUser($options,@keys)

Wait for specified keys via userInput, and put them into $options HASHREF, if they are not already defined.
Returns modified $options HASHREF.
Dies if the user provides no value.

=cut

sub interrogateUser {
    my ($options,@keys) = @_;
    foreach my $key (@keys) {
        if (!$options->{$key}) {
            print "Type the $key for your testLink install below:\n";
            $options->{$key} = TestRail::Utils::userInput();
            die "$key cannot be blank!" unless $options->{$key};
        }
    }
    return $options;
}

=head2 parseConfig(homedir)

Parse .testrailrc in the provided home directory.

Returns:

ARRAY - (apiurl,password,user)

=cut

sub parseConfig {
    my ($homedir,$login_only) = @_;
    my $results = {};
    my $arr =[];

    open(my $fh, '<', $homedir . '/.testrailrc') or return (undef,undef,undef);#couldn't open!
    while (<$fh>) {
        chomp;
        @$arr = split(/=/,$_);
        if (scalar(@$arr) != 2) {
            warn("Could not parse $_ in '$homedir/.testrailrc'!\n");
            next;
        }
        $results->{lc($arr->[0])} = $arr->[1];
    }
    close($fh);
    return ($results->{'apiurl'},$results->{'password'},$results->{'user'}) if $login_only;
    return $results;
}

=head2 getFilenameFromTAPLine($line)

Analyze TAP output by prove and look for filename boundaries (no other way to figure out what file is run).
Long story short: don't end 'unknown' TAP lines with any number of dots if you don't want it interpreted as a test name.
Apparently this is the TAP way of specifying the file that's run...which is highly inadequate.

Inputs:

STRING LINE - some line of TAP

Returns:

STRING filename of the test that output the TAP.

=cut

sub getFilenameFromTapLine {
    my $orig = shift;

    $orig =~ s/ *$//g; # Strip all trailing whitespace

    #Special case
    my ($is_skipall) = $orig =~ /(.*)\.+ skipped:/;
    return $is_skipall if $is_skipall;

    my @process_split = split(/ /,$orig);
    return 0 unless scalar(@process_split);
    my $dotty = pop @process_split; #remove the ........ (may repeat a number of times)
    return 0 if $dotty =~ /\d/; #Apparently looking for literal dots returns numbers too. who knew?
    chomp $dotty;
    my $line = join(' ',@process_split);

    #IF it ends in a bunch of dots
    #AND it isn't an ok/not ok
    #AND it isn't a comment
    #AND it isn't blank
    #THEN it's a test name

    return $line if ($dotty =~ /^\.+$/ && !($line =~ /^ok|not ok/) && !($line =~ /^# /) && $line);
    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);
}

=head2 findTests(opts,case1,...,caseN)

Given an ARRAY of tests, find tests meeting your criteria (or not) in the specified directory.

=over 4

=item HASHREF C<OPTS> - Options for finding tests:

=over 4

=item STRING C<MATCH> - Only return tests which exist in the path provided.  Mutually exclusive with no-match.

=item STRING C<NO-MATCH> - Only return tests which aren't in the path provided (orphan tests).  Mutually exclusive with match.

=item BOOL C<NO-RECURSE> - Do not do a recursive scan for files.

=item BOOL C<NAMES-ONLY> - Only return the names of the tests rather than the entire test objects.

=back

=item ARRAY C<CASES> - Array of cases to translate to pathnames based on above options.

=back

Returns tests found that meet the criteria laid out in the options.
Provides absolute path to tests if match is passed; this is the 'full_title' key if names-only is false/undef.
Dies if mutually exclusive options are passed.

=cut

sub findTests {
    my ($opts,@cases) = @_;

    confess "Error! match and no-match options are mutually exclusive.\n" if ($opts->{'match'} && $opts->{'no-match'});
    my @tests = @cases;
    my (@realtests);

    if ($opts->{'match'} || $opts->{'no-match'}) {
        my $dir = $opts->{'match'} ? $opts->{'match'} : $opts->{'no-match'};
        if (!$opts->{'no-recurse'}) {
            File::Find::find( sub { push(@realtests,$File::Find::name) if -f }, $dir );
            @tests = grep {my $real = $_->{'title'}; grep { $real eq basename($_) } @realtests} @cases; #XXX if you have dups in your tree, be-ware
        } else {
            #Handle special windows case -- glob doesn't prepend abspath
            @realtests = glob("$dir/*");
            @tests = map {
                $_->{'title'} = "$dir/".$_->{'title'} if( $^O eq 'MSWin32' );
                $_
            } grep {my $fname = $_->{'title'}; grep { basename($_) eq $fname} @realtests } @cases;
        }
        @tests = map {{'title' => $_}} grep {my $otest = basename($_); scalar(grep {basename($_->{'title'}) eq $otest} @tests) == 0} @realtests if $opts->{'no-match'}; #invert the list in this case.
    }

    @tests = map { abs_path($_->{'title'}) } @tests if $opts->{'match'} && $opts->{'names-only'};
    @tests = map { $_->{'full_title'} = abs_path($_->{'title'}); $_ } @tests if $opts->{'match'} && !$opts->{'names-only'};
    @tests = map { $_->{'title'} } @tests if !$opts->{'match'} && $opts->{'names-only'};

    return @tests;
}

1;

__END__

=head1 SPECIAL THANKS

Thanks to cPanel Inc, for graciously funding the creation of this module.