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


line stmt bran cond sub pod time code
1             # ABSTRACT: Utilities for the testrail command line functions, and their main loops.
2             # PODNAME: TestRail::Utils
3              
4             package TestRail::Utils;
5             $TestRail::Utils::VERSION = '0.051';
6 14     14   232258 use strict;
  14         55  
  14         460  
7 14     14   78 use warnings;
  14         31  
  14         455  
8              
9 14     14   82 use Carp qw{confess cluck};
  14         27  
  14         841  
10 14     14   8061 use Pod::Usage ();
  14         622392  
  14         454  
11 14     14   4065 use TestRail::API;
  14         44  
  14         523  
12              
13 14     14   8600 use IO::Interactive::Tiny ();
  14         216  
  14         504  
14 14     14   8793 use Term::ANSIColor 2.01 qw(colorstrip);
  14         119577  
  14         12124  
15 14     14   7296 use Term::ReadKey ();
  14         29879  
  14         487  
16 14     14   114 use Scalar::Util qw{blessed};
  14         33  
  14         18452  
17              
18             sub help {
19 9     9 1 1993 Pod::Usage::pod2usage(
20             '-verbose' => 2,
21             '-noperldoc' => 1,
22             '-exitval' => 'NOEXIT'
23             );
24 9         240845 return 0;
25             }
26              
27             sub userInput {
28 0     0 1 0 my ($echo_ok) = @_;
29 0         0 my $input = "";
30              
31             # I'm going to be super paranoid here and consider everything to be sensitive info by default.
32 0 0       0 Term::ReadKey::ReadMode('noecho') unless $echo_ok;
33             {
34 0     0   0 local $SIG{'INT'} = sub { Term::ReadKey::ReadMode(0); exit 130; };
  0         0  
  0         0  
  0         0  
35 0         0 $input = ;
36 0 0       0 chomp($input) if $input;
37             }
38 0 0       0 Term::ReadKey::ReadMode(0) unless $echo_ok;
39 0         0 print "\n";
40 0         0 return $input;
41             }
42              
43             sub interrogateUser {
44 43     43 1 359 my ( $options, @keys ) = @_;
45 43         233 foreach my $key (@keys) {
46 188 50       534 if ( !$options->{$key} ) {
47 0         0 print "Type the $key for your TestRail install below:\n";
48 0         0 $options->{$key} = TestRail::Utils::userInput( $key ne 'password' );
49 0 0       0 die "$key cannot be blank!" unless $options->{$key};
50             }
51             }
52 43         122 return $options;
53             }
54              
55             sub parseConfig {
56 2     2 1 8382 my ( $homedir, $login_only ) = @_;
57 2         5 my $results = {};
58 2         5 my $arr = [];
59              
60 2 50       82 open( my $fh, '<', $homedir . '/.testrailrc' )
61             or return ( undef, undef, undef ); #couldn't open!
62 2         59 while (<$fh>) {
63 34         56 chomp;
64 34         104 @$arr = split( /=/, $_ );
65 34 100       72 if ( scalar(@$arr) != 2 ) {
66 4         102 warn("Could not parse $_ in '$homedir/.testrailrc'!\n");
67 4         26 next;
68             }
69 30         124 $results->{ lc( $arr->[0] ) } = $arr->[1];
70             }
71 2         23 close($fh);
72 2 100       32 return ( $results->{'apiurl'}, $results->{'password'}, $results->{'user'} )
73             if $login_only;
74 1         11 return $results;
75             }
76              
77             sub getFilenameFromTapLine {
78 392     392 1 5294 my $orig = shift;
79              
80 392         2877 $orig =~ s/ *$//g; # Strip all trailing whitespace
81              
82             #Special case
83 392         835 my ($is_skipall) = $orig =~ /(.*)\.+ skipped:/;
84 392 100       764 return $is_skipall if $is_skipall;
85              
86 390         1131 my @process_split = split( / /, $orig );
87 390 100       844 return 0 unless scalar(@process_split);
88 363         560 my $dotty =
89             pop @process_split; #remove the ........ (may repeat a number of times)
90 363 100       977 return 0
91             if $dotty =~
92             /\d/; #Apparently looking for literal dots returns numbers too. who knew?
93 244         367 chomp $dotty;
94 244         532 my $line = join( ' ', @process_split );
95              
96             #IF it ends in a bunch of dots
97             #AND it isn't an ok/not ok
98             #AND it isn't a comment
99             #AND it isn't blank
100             #THEN it's a test name
101              
102 244 50 66     965 return $line
      66        
      33        
103             if ( $dotty =~ /^\.+$/
104             && !( $line =~ /^ok|not ok/ )
105             && !( $line =~ /^# / )
106             && $line );
107 204         475 return 0;
108             }
109              
110             sub TAP2TestFiles {
111 9     9 1 1537 my $file = shift;
112 9         19 my ( $fh, $fcontents, @files );
113              
114 9 50       26 if ($file) {
115 9         361 open( $fh, '<', $file );
116 9         219 while (<$fh>) {
117 197         431 $_ = colorstrip($_); #strip prove brain damage
118              
119 197 100       1702 if ( getFilenameFromTapLine($_) ) {
120 17 100       85 push( @files, $fcontents ) if $fcontents;
121 17         34 $fcontents = '';
122             }
123 197         680 $fcontents .= $_;
124             }
125 9         116 close($fh);
126 9 50       57 push( @files, $fcontents ) if $fcontents;
127             }
128             else {
129             #Just read STDIN, print help if no file was passed
130 0 0       0 die
131             "ERROR: no file passed, and no data piped in! See --help for usage.\n"
132             if IO::Interactive::Tiny::is_interactive();
133 0         0 while (<>) {
134 0         0 $_ = colorstrip($_); #strip prove brain damage
135 0 0       0 if ( getFilenameFromTapLine($_) ) {
136 0 0       0 push( @files, $fcontents ) if $fcontents;
137 0         0 $fcontents = '';
138             }
139 0         0 $fcontents .= $_;
140             }
141 0 0       0 push( @files, $fcontents ) if $fcontents;
142             }
143 9         61 return @files;
144             }
145              
146             sub getRunInformation {
147 46     46 1 8104 my ( $tr, $opts ) = @_;
148 46 50       181 confess("First argument must be instance of TestRail::API")
149             unless blessed($tr) eq 'TestRail::API';
150              
151 46         200 my $project = $tr->getProjectByName( $opts->{'project'} );
152 46 100       413 confess "No such project '$opts->{project}'.\n" if !$project;
153              
154 45         84 my ( $run, $plan );
155              
156 45 100       126 if ( $opts->{'plan'} ) {
157 24         101 $plan = $tr->getPlanByName( $project->{'id'}, $opts->{'plan'} );
158 24 100       2026 confess "No such plan '$opts->{plan}'!\n" if !$plan;
159             $run =
160 23         113 $tr->getChildRunByName( $plan, $opts->{'run'}, $opts->{'configs'} );
161             }
162             else {
163 21         114 $run = $tr->getRunByName( $project->{'id'}, $opts->{'run'} );
164             }
165              
166 44 100       1173 confess
167             "No such run '$opts->{run}' matching the provided configs (if any).\n"
168             if !$run;
169              
170             #If the run/plan has a milestone set, then return it too
171 41         64 my $milestone;
172 41 100       117 my $mid = $plan ? $plan->{'milestone_id'} : $run->{'milestone_id'};
173 41 100       100 if ($mid) {
174 20         75 $milestone = $tr->getMilestoneByID($mid);
175 20 50       832 confess "Could not fetch run milestone!"
176             unless $milestone; #hope this doesn't happen
177             }
178              
179 41         177 return ( $project, $plan, $run, $milestone );
180             }
181              
182             sub getHandle {
183 37     37 1 796 my $opts = shift;
184              
185 37 50       371 $opts->{'debug'} = 1 if ( $opts->{'browser'} );
186              
187             my $tr = TestRail::API->new(
188             $opts->{apiurl}, $opts->{user}, $opts->{password},
189 37         670 $opts->{'encoding'}, $opts->{'debug'}
190             );
191 37 50       162 if ( $opts->{'browser'} ) {
192 37         1012 $tr->{'browser'} = $opts->{'browser'};
193 37         97 $tr->{'debug'} = 0;
194             }
195 37         132 return $tr;
196             }
197              
198             1;
199              
200             __END__