File Coverage

blib/lib/TestRail/Utils.pm

Criterion	Covered	Total	%
statement	96	119	80.6
branch	35	60	58.3
condition	5	9	55.5
subroutine	16	18	88.8
pod	8	8	100.0
total	160	214	74.7

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

package TestRail::Utils;
$TestRail::Utils::VERSION = '0.051';
use strict;
use warnings;

use Carp qw{confess cluck};
use Pod::Usage ();
use TestRail::API;

use IO::Interactive::Tiny ();
use Term::ANSIColor 2.01 qw(colorstrip);
use Term::ReadKey ();
use Scalar::Util qw{blessed};

sub help {
    Pod::Usage::pod2usage(
        '-verbose'   => 2,
        '-noperldoc' => 1,
        '-exitval'   => 'NOEXIT'
    );
    return 0;
}

sub userInput {
    my ($echo_ok) = @_;
    my $input = "";

    # I'm going to be super paranoid here and consider everything to be sensitive info by default.
    Term::ReadKey::ReadMode('noecho') unless $echo_ok;
    {
        local $SIG{'INT'} = sub { Term::ReadKey::ReadMode(0); exit 130; };
        $input = ;
        chomp($input) if $input;
    }
    Term::ReadKey::ReadMode(0) unless $echo_ok;
    print "\n";
    return $input;
}

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

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;
}

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;
}

sub TAP2TestFiles {
    my $file = shift;
    my ( $fh, $fcontents, @files );

    if ($file) {
        open( $fh, '<', $file );
        while (<$fh>) {
            $_ = colorstrip($_);    #strip prove brain damage

            if ( getFilenameFromTapLine($_) ) {
                push( @files, $fcontents ) if $fcontents;
                $fcontents = '';
            }
            $fcontents .= $_;
        }
        close($fh);
        push( @files, $fcontents ) if $fcontents;
    }
    else {
        #Just read STDIN, print help if no file was passed
        die
          "ERROR: no file passed, and no data piped in! See --help for usage.\n"
          if IO::Interactive::Tiny::is_interactive();
        while (<>) {
            $_ = colorstrip($_);    #strip prove brain damage
            if ( getFilenameFromTapLine($_) ) {
                push( @files, $fcontents ) if $fcontents;
                $fcontents = '';
            }
            $fcontents .= $_;
        }
        push( @files, $fcontents ) if $fcontents;
    }
    return @files;
}

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;

    #If the run/plan has a milestone set, then return it too
    my $milestone;
    my $mid = $plan ? $plan->{'milestone_id'} : $run->{'milestone_id'};
    if ($mid) {
        $milestone = $tr->getMilestoneByID($mid);
        confess "Could not fetch run milestone!"
          unless $milestone;    #hope this doesn't happen
    }

    return ( $project, $plan, $run, $milestone );
}

sub getHandle {
    my $opts = shift;

    $opts->{'debug'} = 1 if ( $opts->{'browser'} );

    my $tr = TestRail::API->new(
        $opts->{apiurl},     $opts->{user}, $opts->{password},
        $opts->{'encoding'}, $opts->{'debug'}
    );
    if ( $opts->{'browser'} ) {
        $tr->{'browser'} = $opts->{'browser'};
        $tr->{'debug'}   = 0;
    }
    return $tr;
}

1;

__END__