| 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; |