File Coverage

blib/lib/App/Dochazka/CLI/Commands/RestTest/Top.pm
Criterion Covered Total %
statement 68 99 68.6
branch n/a
condition 0 2 0.0
subroutine 22 31 70.9
pod n/a
total 90 132 68.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              
34 20     20   241 use 5.012;
  20         38  
35 20     20   59 use strict;
  20         21  
  20         284  
36 20     20   55 use warnings;
  20         21  
  20         400  
37              
38 20     20   53 use App::CELL qw( $CELL );
  20         17  
  20         1400  
39 20     20   77 use Web::MREST::CLI;
  20         22  
  20         14525  
40              
41              
42              
43              
44             =head1 NAME
45              
46             App::Dochazka::CLI::Commands::Top - Dispatch targets for top-level commands
47              
48              
49              
50              
51             =head1 FUNCTIONS
52              
53             =cut
54              
55             # just the bare $METHOD
56             sub _method {
57 8     8   2951 my ( $ts, $th ) = @_;
58 8         18 my $method = $ts->[0];
59 8         36 return [ $method, "", $th->{_REST} ];
60             }
61              
62             # $METHOD BUGREPORT
63             sub _method_bugreport {
64 8     8   2911 my ( $ts, $th ) = @_;
65 8         15 my $method = $ts->[0];
66              
67 8         51 return [ $method, 'bugreport', $th->{_REST} ];
68             }
69              
70             # $METHOD CONFIGINFO
71             sub _method_configinfo {
72 0     0   0 my ( $ts, $th ) = @_;
73 0         0 my $method = $ts->[0];
74              
75 0         0 return [ $method, 'configinfo', $th->{_REST} ];
76             }
77              
78             # $METHOD COOKIEJAR
79             sub _method_cookiejar {
80 0     0   0 my ( $ts, $th ) = @_;
81 0         0 my $method = $ts->[0];
82              
83 0   0     0 my $cookie_jar = Web::MREST::CLI::cookie_jar() || "No cookies in jar";
84              
85 0         0 return $CELL->status_ok( 'COOKIE_JAR', payload => $cookie_jar );
86             }
87              
88             # $METHOD DBSTATUS
89             sub _method_dbstatus {
90 8     8   2907 my ( $ts, $th ) = @_;
91 8         16 my $method = $ts->[0];
92              
93 8         37 return [ $method, 'dbstatus', $th->{_REST} ];
94             }
95              
96             # $METHOD DOCU
97             sub _method_docu {
98 8     8   2865 my ( $ts, $th ) = @_;
99 8         14 my $method = $ts->[0];
100              
101 8         32 return [ $method, 'docu', $th->{_REST} ];
102             }
103              
104             # $METHOD DOCU POD
105             sub _method_docu_pod {
106 8     8   2900 my ( $ts, $th ) = @_;
107 8         14 my $method = $ts->[0];
108              
109 8         33 return [ $method, 'docu/pod', $th->{_REST} ];
110             }
111              
112             # $METHOD DOCU POD _DOCU
113             sub _method_docu_pod_docu {
114 0     0   0 my ( $ts, $th ) = @_;
115 0         0 my $method = $ts->[0];
116              
117 0         0 return [ $method, 'docu/pod', $th->{_DOCU} ];
118             }
119              
120             # $METHOD DOCU HTML
121             sub _method_docu_html {
122 8     8   2959 my ( $ts, $th ) = @_;
123 8         20 my $method = $ts->[0];
124              
125 8         38 return [ $method, 'docu/html', $th->{_REST} ];
126             }
127              
128             # $METHOD DOCU HTML $DOCU
129             sub _method_docu_html_docu {
130 0     0   0 my ( $ts, $th ) = @_;
131 0         0 my $method = $ts->[0];
132              
133 0         0 return [ $method, 'docu/html', $th->{_DOCU} ];
134             }
135              
136             # $METHOD DOCU TEXT
137             sub _method_docu_text {
138 8     8   2906 my ( $ts, $th ) = @_;
139 8         15 my $method = $ts->[0];
140              
141 8         33 return [ $method, 'docu/text', $th->{_REST} ];
142             }
143              
144             # $METHOD DOCU TEXT $DOCU
145             sub _method_docu_text_docu {
146 0     0   0 my ( $ts, $th ) = @_;
147 0         0 my $method = $ts->[0];
148              
149 0         0 return [ $method, 'docu/text', $th->{_DOCU} ];
150             }
151              
152             # $METHOD ECHO
153             sub _method_echo {
154 8     8   3383 my ( $ts, $th ) = @_;
155 8         18 my $method = $ts->[0];
156              
157 8         50 return [ $method, 'echo', $th->{_REST} ];
158             }
159              
160             # $METHOD FORBIDDEN
161             sub _method_forbidden {
162 8     8   2928 my ( $ts, $th ) = @_;
163 8         13 my $method = $ts->[0];
164              
165 8         37 return [ $method, 'forbidden', $th->{_REST} ];
166             }
167              
168             # $METHOD HOLIDAY _TSRANGE
169             sub _method_holiday_tsrange {
170 0     0   0 my ( $ts, $th ) = @_;
171 0         0 my $method = $ts->[0];
172 0         0 my $tsrange = $th->{_TSRANGE};
173              
174 0         0 return [ $method, "holiday/$tsrange", $th->{_REST} ];
175             }
176              
177             # $METHOD NOOP
178             sub _method_noop {
179 8     8   2887 my ( $ts, $th ) = @_;
180 8         15 my $method = $ts->[0];
181              
182 8         35 return [ $method, 'noop', $th->{_REST} ];
183             }
184              
185             # $METHOD PARAM
186             sub _method_param {
187 8     8   2920 my ( $ts, $th ) = @_;
188 8         15 my $method = $ts->[0];
189              
190 8         33 return [ $method, 'param', $th->{_REST} ];
191             }
192              
193             # $METHOD PARAM CORE
194             sub _method_param_core {
195 0     0   0 my ( $ts, $th ) = @_;
196 0         0 my $method = $ts->[0];
197              
198 0         0 return [ $method, "param/core", $th->{_REST} ];
199             }
200              
201             # $METHOD PARAM META
202             sub _method_param_meta {
203 0     0   0 my ( $ts, $th ) = @_;
204 0         0 my $method = $ts->[0];
205 0         0 my $term = $th->{_TERM};
206              
207 0         0 return [ $method, "param/meta", $th->{_REST} ];
208             }
209              
210             # $METHOD PARAM SITE
211             sub _method_param_site {
212 0     0   0 my ( $ts, $th ) = @_;
213 0         0 my $method = $ts->[0];
214 0         0 my $term = $th->{_TERM};
215              
216 0         0 return [ $method, "param/site", $th->{_REST} ];
217             }
218              
219             # $METHOD PARAM CORE
220             sub _method_param_core_term {
221 8     8   2952 my ( $ts, $th ) = @_;
222 8         16 my $method = $ts->[0];
223 8         13 my $term = $th->{_TERM};
224              
225 8         46 return [ $method, "param/core/$term", $th->{_REST} ];
226             }
227              
228             # $METHOD PARAM META
229             sub _method_param_meta_term {
230 8     8   2966 my ( $ts, $th ) = @_;
231 8         12 my $method = $ts->[0];
232 8         14 my $term = $th->{_TERM};
233              
234 8         37 return [ $method, "param/meta/$term", $th->{_REST} ];
235             }
236              
237             # $METHOD PARAM SITE
238             sub _method_param_site_term {
239 8     8   2830 my ( $ts, $th ) = @_;
240 8         15 my $method = $ts->[0];
241 8         11 my $term = $th->{_TERM};
242              
243 8         43 return [ $method, "param/site/$term", $th->{_REST} ];
244             }
245              
246             # $METHOD SESSION
247             sub _method_session {
248 8     8   2892 my ( $ts, $th ) = @_;
249 8         16 my $method = $ts->[0];
250              
251 8         48 return [ $method, 'session', $th->{_REST} ];
252             }
253              
254             # $METHOD VERSION
255             sub _method_version {
256 8     8   2914 my ( $ts, $th ) = @_;
257 8         15 my $method = $ts->[0];
258              
259 8         31 return [ $method, 'version', $th->{_REST} ];
260             }
261              
262             # $METHOD WHOAMI
263             sub _method_whoami {
264 8     8   2902 my ( $ts, $th ) = @_;
265 8         17 my $method = $ts->[0];
266              
267 8         35 return [ $method, 'whoami', $th->{_REST} ];
268             }
269              
270             1;