Utils.pm 4.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177
  1. # ABSTRACT: Utilities for the testrail command line functions, and their main loops.
  2. # PODNAME: TestRail::Utils
  3. package TestRail::Utils;
  4. use strict;
  5. use warnings;
  6. use Carp qw{confess cluck};
  7. use Pod::Perldoc 3.10;
  8. use Scalar::Util qw{blessed};
  9. =head1 SCRIPT HELPER FUNCTIONS
  10. =head2 help
  11. Print the perldoc for $0 and exit.
  12. =cut
  13. sub help {
  14. @ARGV = ($0);
  15. Pod::Perldoc->run();
  16. exit 0;
  17. }
  18. =head2 userInput
  19. Wait for user input and return it.
  20. =cut
  21. sub userInput {
  22. local $| = 1;
  23. my $rt = <STDIN>;
  24. chomp $rt;
  25. return $rt;
  26. }
  27. =head2 interrogateUser($options,@keys)
  28. Wait for specified keys via userInput, and put them into $options HASHREF, if they are not already defined.
  29. Returns modified $options HASHREF.
  30. Dies if the user provides no value.
  31. =cut
  32. sub interrogateUser {
  33. my ($options,@keys) = @_;
  34. foreach my $key (@keys) {
  35. if (!$options->{$key}) {
  36. print "Type the $key for your testLink install below:\n";
  37. $options->{$key} = TestRail::Utils::userInput();
  38. die "$key cannot be blank!" unless $options->{$key};
  39. }
  40. }
  41. return $options;
  42. }
  43. =head2 parseConfig(homedir)
  44. Parse .testrailrc in the provided home directory.
  45. Returns:
  46. ARRAY - (apiurl,password,user)
  47. =cut
  48. sub parseConfig {
  49. my ($homedir,$login_only) = @_;
  50. my $results = {};
  51. my $arr =[];
  52. open(my $fh, '<', $homedir . '/.testrailrc') or return (undef,undef,undef);#couldn't open!
  53. while (<$fh>) {
  54. chomp;
  55. @$arr = split(/=/,$_);
  56. if (scalar(@$arr) != 2) {
  57. warn("Could not parse $_ in '$homedir/.testrailrc'!\n");
  58. next;
  59. }
  60. $results->{lc($arr->[0])} = $arr->[1];
  61. }
  62. close($fh);
  63. return ($results->{'apiurl'},$results->{'password'},$results->{'user'}) if $login_only;
  64. return $results;
  65. }
  66. =head2 getFilenameFromTapLine($line)
  67. Analyze TAP output by prove and look for filename boundaries (no other way to figure out what file is run).
  68. 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.
  69. Apparently this is the TAP way of specifying the file that's run...which is highly inadequate.
  70. Inputs:
  71. STRING LINE - some line of TAP
  72. Returns:
  73. STRING filename of the test that output the TAP.
  74. =cut
  75. sub getFilenameFromTapLine {
  76. my $orig = shift;
  77. $orig =~ s/ *$//g; # Strip all trailing whitespace
  78. #Special case
  79. my ($is_skipall) = $orig =~ /(.*)\.+ skipped:/;
  80. return $is_skipall if $is_skipall;
  81. my @process_split = split(/ /,$orig);
  82. return 0 unless scalar(@process_split);
  83. my $dotty = pop @process_split; #remove the ........ (may repeat a number of times)
  84. return 0 if $dotty =~ /\d/; #Apparently looking for literal dots returns numbers too. who knew?
  85. chomp $dotty;
  86. my $line = join(' ',@process_split);
  87. #IF it ends in a bunch of dots
  88. #AND it isn't an ok/not ok
  89. #AND it isn't a comment
  90. #AND it isn't blank
  91. #THEN it's a test name
  92. return $line if ($dotty =~ /^\.+$/ && !($line =~ /^ok|not ok/) && !($line =~ /^# /) && $line);
  93. return 0;
  94. }
  95. =head2 getRunInformation
  96. Return the relevant project definition, plan, run and milestone definition HASHREFs for the provided options.
  97. Dies in the event the project/plan/run could not be found.
  98. =cut
  99. sub getRunInformation {
  100. my ($tr,$opts) = @_;
  101. confess("First argument must be instance of TestRail::API") unless blessed($tr) eq 'TestRail::API';
  102. my $project = $tr->getProjectByName($opts->{'project'});
  103. confess "No such project '$opts->{project}'.\n" if !$project;
  104. my ($run,$plan);
  105. if ($opts->{'plan'}) {
  106. $plan = $tr->getPlanByName($project->{'id'},$opts->{'plan'});
  107. confess "No such plan '$opts->{plan}'!\n" if !$plan;
  108. $run = $tr->getChildRunByName($plan,$opts->{'run'}, $opts->{'configs'});
  109. } else {
  110. $run = $tr->getRunByName($project->{'id'},$opts->{'run'});
  111. }
  112. confess "No such run '$opts->{run}' matching the provided configs (if any).\n" if !$run;
  113. #If the run/plan has a milestone set, then return it too
  114. my $milestone;
  115. my $mid = $plan ? $plan->{'milestone_id'} : $run->{'milestone_id'};
  116. if ($mid) {
  117. $milestone = $tr->getMilestoneByID($mid);
  118. confess "Could not fetch run milestone!" unless $milestone; #hope this doesn't happen
  119. }
  120. return ($project, $plan, $run, $milestone);
  121. }
  122. 1;
  123. __END__
  124. =head1 SPECIAL THANKS
  125. Thanks to cPanel Inc, for graciously funding the creation of this module.