File Coverage

blib/lib/App/Dochazka/CLI/Test.pm
Criterion Covered Total %
statement 35 50 70.0
branch n/a
condition n/a
subroutine 11 13 84.6
pod 3 4 75.0
total 49 67 73.1


line stmt bran cond sub pod time code
1             # *************************************************************************
2             # Copyright (c) 2014-2016, SUSE LLC
3             #
4             # All rights reserved.
5             #
6             # Redistribution and use in source and binary forms, with or without
7             # modification, are permitted provided that the following conditions are met:
8             #
9             # 1. Redistributions of source code must retain the above copyright notice,
10             # this list of conditions and the following disclaimer.
11             #
12             # 2. Redistributions in binary form must reproduce the above copyright
13             # notice, this list of conditions and the following disclaimer in the
14             # documentation and/or other materials provided with the distribution.
15             #
16             # 3. Neither the name of SUSE LLC nor the names of its contributors may be
17             # used to endorse or promote products derived from this software without
18             # specific prior written permission.
19             #
20             # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21             # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22             # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23             # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
24             # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
25             # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
26             # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
27             # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
28             # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
29             # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30             # POSSIBILITY OF SUCH DAMAGE.
31             # *************************************************************************
32             #
33             # Test module - reusable components
34             #
35             package App::Dochazka::CLI::Test;
36              
37 16     16   64259 use 5.012;
  16         37  
38 16     16   56 use strict;
  16         19  
  16         251  
39 16     16   47 use warnings;
  16         15  
  16         336  
40              
41 16     16   48 use App::CELL qw( $CELL $log $meta $site );
  16         13  
  16         1413  
42 16     16   750 use App::Dochazka::CLI::Parser qw( look_up_command process_command );
  16         17  
  16         640  
43 16     16   53 use App::Dochazka::CLI::Util qw( init_prompt );
  16         23  
  16         528  
44 16     16   49 use Exporter qw( import );
  16         18  
  16         338  
45 16     16   47 use Test::More;
  16         18  
  16         112  
46 16     16   3164 use Web::MREST::CLI qw( init_cli_client );
  16         19  
  16         4697  
47              
48              
49              
50              
51             =head1 NAME
52              
53             App::Dochazka::CLI::Test - Reusable test routines
54              
55              
56              
57              
58             =head1 PACKAGE VARIABLES AND EXPORTS
59              
60             =cut
61              
62             our @EXPORT_OK = qw(
63             delete_interval_test
64             do_parse_test
65             fetch_interval_test
66             init_unit
67             );
68              
69              
70              
71              
72             =head1 FUNCTIONS
73              
74              
75             =head2 init_unit
76              
77             =cut
78              
79             sub init_unit {
80 15     15 1 3065 init_prompt();
81 15         63 my $status = init_cli_client( distro => 'App-Dochazka-CLI', );
82 15         118649 return $status;
83             }
84              
85              
86             =head2 delete_interval
87              
88             =cut
89              
90             sub delete_interval_test {
91 0     0 0 0 my ( $iid ) = @_;
92 0         0 note( 'delete the interval we just created' );
93 0         0 note( my $cmd = "DELETE INTERVAL IID $iid" );
94 0         0 my $rv = process_command( $cmd );
95 0         0 is( ref( $rv ), 'App::CELL::Status' );
96 0         0 is( $rv->level, 'OK' );
97 0         0 is( $rv->code, 'DOCHAZKA_CUD_OK', "IID $iid deleted" );
98             }
99              
100              
101             =head2 do_parse_test
102              
103             A piece of testing code we run for entries in CommandMap.pm
104              
105             Takes the "normalized command", i.e. the C property returned by C;
106             especially do not send it the raw command entered by the user!
107              
108             For usage, see C<< t/parser/parse_test.t >>
109              
110             =cut
111              
112             sub do_parse_test {
113 117     117 1 20253 my ( $nc, $handler ) = @_;
114 117         259 my $coderef = look_up_command( $nc );
115 117         467 is( ref( $coderef ), 'CODE', "look_up_command( $nc ) returns a code reference" );
116 117         34401 my $status = $coderef->( 'PARSE_TEST' => 1 );
117 117         31650 ok( $status->ok );
118 117         32740 is( $status->payload, $handler, "handler of $nc is $handler" );
119             }
120              
121              
122             =head2 fetch_interval_test
123              
124             Takes a "command component" and a search string to look for. The command
125             component is inserted into
126              
127             INTERVAL FETCH $cmd_component
128              
129             and the search string is looked for in the response.
130              
131             Returns the response (payload) string for (optional) further testing.
132              
133             =cut
134              
135             sub fetch_interval_test {
136 0     0 1   my ( $cmd_component, $search_str ) = @_;
137              
138 0           note( my $cmd = "INTERVAL FETCH $cmd_component" );
139 0           my $rv = process_command( $cmd );
140 0           is( ref( $rv ), 'App::CELL::Status' );
141 0           is( $rv->level, 'OK' );
142 0           is( $rv->code, 'DOCHAZKA_CLI_NORMAL_COMPLETION' );
143 0           like( $rv->payload, qr/Attendance intervals of worker.+$search_str/ms );
144              
145 0           return $rv->payload;
146             }
147              
148              
149             1;