123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252 |
- # 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::Usage ();
- use TestRail::API;
- use IO::Interactive::Tiny ();
- use Term::ANSIColor 2.01 qw(colorstrip);
- use Term::ReadKey ();
- use Scalar::Util qw{blessed};
- =head1 SCRIPT HELPER FUNCTIONS
- =head2 help
- Print the perldoc for $0 and exit.
- =cut
- sub help {
- Pod::Usage::pod2usage( '-verbose' => 2, '-noperldoc' => 1, '-exitval' => 'NOEXIT' );
- return 0;
- }
- =head2 userInput
- Wait for user input and return it.
- =cut
- 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 = <STDIN>;
- chomp($input) if $input;
- }
- Term::ReadKey::ReadMode(0) unless $echo_ok;
- print "\n";
- return $input;
- }
- =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 TestRail install below:\n";
- $options->{$key} = TestRail::Utils::userInput( $key ne 'password' );
- 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 TAP2TestFiles(file)
- Returns ARRAY of TAP output for the various test files therein.
- file is optional, will read TAP from STDIN if not passed.
- =cut
- 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;
- }
- =head2 getRunInformation
- Return the relevant project definition, plan, run and milestone definition HASHREFs for the provided options.
- 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;
- #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);
- }
- =head2 getHandle(opts)
- Convenience method for binaries and testing.
- Returns a new TestRail::API when passed an options hash such as is built by most of the binaries,
- or returned by parseConfig.
- Has a special 'mock' hash key that can only be used by those testing this distribution during 'make test'.
- =cut
- 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__
- =head1 SPECIAL THANKS
- Thanks to cPanel Inc, for graciously funding the creation of this module.
|