Utils.pm 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128
  1. # ABSTRACT: Utilities for the testrail command line functions.
  2. # PODNAME: TestRail::Utils
  3. =head1 DESCRIPTION
  4. Utilities for the testrail command line functions.
  5. =cut
  6. package TestRail::Utils;
  7. use strict;
  8. use warnings;
  9. =head1 FUNCTIONS
  10. =head2 userInput
  11. Wait for user input and return it.
  12. =cut
  13. sub userInput {
  14. local $| = 1;
  15. my $rt = <STDIN>;
  16. chomp $rt;
  17. return $rt;
  18. }
  19. =head2 interrogateUser($options,@keys)
  20. Wait for specified keys via userInput, and put them into $options HASHREF, if they are not already defined.
  21. Returns modified $options HASHREF.
  22. Dies if the user provides no value.
  23. =cut
  24. sub interrogateUser {
  25. my ($options,@keys) = @_;
  26. foreach my $key (@keys) {
  27. if (!$options->{$key}) {
  28. print "Type the $key for your testLink install below:\n";
  29. $options->{$key} = TestRail::Utils::userInput();
  30. die "$key cannot be blank!" unless $options->{$key};
  31. }
  32. }
  33. return $options;
  34. }
  35. =head2 parseConfig(homedir)
  36. Parse .testrailrc in the provided home directory.
  37. Returns:
  38. ARRAY - (apiurl,password,user)
  39. =cut
  40. sub parseConfig {
  41. my ($homedir,$login_only) = @_;
  42. my $results = {};
  43. my $arr =[];
  44. open(my $fh, '<', $homedir . '/.testrailrc') or return (undef,undef,undef);#couldn't open!
  45. while (<$fh>) {
  46. chomp;
  47. @$arr = split(/=/,$_);
  48. if (scalar(@$arr) != 2) {
  49. warn("Could not parse $_ in '$homedir/.testrailrc'!\n");
  50. next;
  51. }
  52. $results->{lc($arr->[0])} = $arr->[1];
  53. }
  54. close($fh);
  55. return ($results->{'apiurl'},$results->{'password'},$results->{'user'}) if $login_only;
  56. return $results;
  57. }
  58. =head2 getFilenameFromTAPLine($line)
  59. Analyze TAP output by prove and look for filename boundaries (no other way to figure out what file is run).
  60. 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.
  61. Apparently this is the TAP way of specifying the file that's run...which is highly inadequate.
  62. Inputs:
  63. STRING LINE - some line of TAP
  64. Returns:
  65. STRING filename of the test that output the TAP.
  66. =cut
  67. sub getFilenameFromTapLine {
  68. my $orig = shift;
  69. $orig =~ s/ *$//g; # Strip all trailing whitespace
  70. #Special case
  71. my ($is_skipall) = $orig =~ /(.*)\.+ skipped:/;
  72. return $is_skipall if $is_skipall;
  73. my @process_split = split(/ /,$orig);
  74. return 0 unless scalar(@process_split);
  75. my $dotty = pop @process_split; #remove the ........ (may repeat a number of times)
  76. return 0 if $dotty =~ /\d/; #Apparently looking for literal dots returns numbers too. who knew?
  77. chomp $dotty;
  78. my $line = join(' ',@process_split);
  79. #IF it ends in a bunch of dots
  80. #AND it isn't an ok/not ok
  81. #AND it isn't a comment
  82. #AND it isn't blank
  83. #THEN it's a test name
  84. return $line if ($dotty =~ /^\.+$/ && !($line =~ /^ok|not ok/) && !($line =~ /^# /) && $line);
  85. return 0;
  86. }
  87. 1;
  88. __END__
  89. =head1 SPECIAL THANKS
  90. Thanks to cPanel Inc, for graciously funding the creation of this module.