File Coverage

File:lib/OpenAPI/Handler/View.pm
Coverage:85.4%

linestmtbrancondsubpodtimecode
1package OpenAPI;
2
3
22
22
22
22
193
70
203
use strict;
4
22
22
22
22
240
73
185
use warnings;
5
22
22
22
22
253
93
207
use vars qw($Dumper);
6
7sub POST_view {
8
11
11
0
77
    my ($self, $bits) = @_;
9
11
100
106
    my $data = _HASH($self->{_req_data}) or
10        die "The view schema must be a HASH.\n";
11
10
313
    my $view = $bits->[1];
12
13
10
30
    my $name;
14
10
100
58
    if ($view eq '~') {
15
1
6
        $view = $data->{name};
16    }
17
18
10
50
67
137
    if ($name = delete $data->{name} and $name ne $view) {
19
0
0
        $self->warning("name \"$name\" in POST content ignored.");
20    }
21
22
10
64
    $data->{name} = $view;
23
10
77
    return $self->new_view($data);
24}
25
26sub get_views {
27
7
7
0
43
    my ($self, $params) = @_;
28
7
64
    my $select = SQL::Select->new(
29        qw< name description >
30    )->from('_views');
31
7
20
    return $self->select("$select", { use_hash => 1 });
32}
33
34sub GET_view_list {
35
5
5
0
35
    my ($self, $bits) = @_;
36
5
32
    my $views = $self->get_views;
37
5
50
104
    $views ||= [];
38
39
5
6
27
75
    map { $_->{src} = "/=/view/$_->{name}" } @$views;
40
5
39
    $views;
41}
42
43sub GET_view {
44
13
13
0
96
    my ($self, $bits) = @_;
45
13
82
    my $view = $bits->[1];
46
47
13
100
87
    if ($view eq '~') {
48
2
17
        return $self->get_views;
49    }
50
11
100
94
    if (!$self->has_view($view)) {
51
3
14
        die "View \"$view\" not found.\n";
52    }
53
7
361
    my $select = SQL::Select->new( qw< name definition description > )
54        ->from('_views')
55        ->where(name => Q($view));
56
57
7
23
    return $self->select("$select", {use_hash => 1})->[0];
58}
59
60sub PUT_view {
61
6
6
0
51
    my ($self, $bits) = @_;
62
6
46
    my $view = $bits->[1];
63
6
50
70
    my $data = _HASH($self->{_req_data}) or
64        die "column spec must be a non-empty HASH.\n";
65    ### $view
66    ### $data
67
6
100
261
    die "View \"$view\" not found.\n" unless $self->has_view($view);
68
69
5
291
    my $update = SQL::Update->new('_views');
70
5
48
    $update->where(name => Q($view));
71
72
5
50
    my $new_name = delete $data->{name};
73
5
100
43
    if (defined $new_name) {
74
2
50
20
        _IDENT($new_name) or
75            die "Bad view name: ", $Dumper->($new_name), "\n";
76
2
24
        $update->set( name => Q($new_name) );
77    }
78
79
5
42
    my $new_def = delete $data->{definition};
80
5
100
42
    if (defined $new_def) {
81
2
50
22
        _STRING($new_def) or
82            die "Bad view definition: ", $Dumper->($new_def), "\n";
83
2
79
        $update->set(definition => Q($new_def));
84    }
85
86
5
34
    my $new_desc = delete $data->{description};
87
5
100
36
    if (defined $new_desc) {
88
1
50
9
        _STRING($new_desc) or die "Bad view definition: ", $Dumper->($new_desc);
89
1
31
        $update->set(description => Q($new_desc));
90    }
91    ### Update SQL: "$update"
92
5
100
43
    if (%$data) {
93
1
5
        die "Unknown keys in POST data: ", join(' ', keys %$data), "\n";
94    }
95
96
4
12
    my $retval = $self->do("$update") + 0;
97
4
50
15
    return { success => $retval >= 0 ? 1 : 0 };
98}
99
100sub exec_view {
101
30
30
0
290
    my ($self,$view, $bits, $cgi) = @_;
102
30
440
    my $select = MiniSQL::Select->new;
103
30
816
    my $sql = "select definition from _views where name = " . Q($view);
104    ### laser exec_view: "$sql"
105
30
280
    my $view_def = $self->select($sql)->[0][0];
106
30
23519
    my $fix_var = $bits->[2];
107
30
100
100
274
    _IDENT($fix_var) or $fix_var eq '~' or die "Bad parameter name: ", $Dumper->($fix_var), "\n";
108
29
193
    my $fix_var_value = $bits->[3];
109
29
100
    my $exists;
110
29
99
    my %vars;
111
112
29
278
    foreach my $var ($cgi->url_param) {
113
17
132
        $vars{$var} = $cgi->url_param($var);
114    }
115
116
29
100
67
452
    if ($fix_var ne '~' and $fix_var_value ne '~') {
117
13
110
        $vars{$fix_var} = $fix_var_value;
118    }
119
120
29
98
    my $res;
121
29
106
    eval {
122
29
622
        $res = $select->parse(
123            $view_def,
124            { quote => \&Q, quote_ident => \&QI, vars => \%vars }
125        );
126    };
127
29
100
312
    if ($@) {
128
1
4
        die "minisql: $@\n";
129    }
130
131
28
28
115
246
    my @unbound = @{ $res->{unbound} };
132
28
100
187
    if (@unbound) {
133
7
28
        die "Parameters required: @unbound\n";
134    }
135
21
304
    return $self->select($res->{sql}, { use_hash=>1, read_only=>1 });
136
137}
138
139sub GET_view_exec {
140
31
31
0
247
    my ($self, $bits) = @_;
141
31
203
    my $view = $bits->[1];
142
143
31
100
254
    die "View \"$view\" not found.\n" unless $self->has_view($view);
144
30
1697
    return $self->exec_view($view, $bits, $self->{_cgi});
145}
146
147sub view_count {
148
10
10
0
43
    my $self = shift;
149
10
61
    return $self->select("select count(*) from _views")->[0][0];
150}
151
152sub new_view {
153
10
10
0
57
    my ($self, $data) = @_;
154
10
59
    my $nviews = $self->view_count;
155
10
5716
    my $res;
156
10
50
88
    if ($nviews >= $VIEW_LIMIT) {
157        #warn "===================================> $num\n";
158
0
0
        die "Exceeded view count limit $VIEW_LIMIT.\n";
159    }
160
161
10
50
86
    my $name = delete $data->{name} or
162        die "No 'name' specified.\n";
163
10
50
64
    _IDENT($name) or die "Bad view name: ", $Dumper->($name), "\n";
164
165
10
70
    my $minisql = delete $data->{definition};
166
10
100
61
    if (!defined $minisql) {
167
1
4
        die "No 'definition' specified.\n";
168    }
169
9
100
59
    _STRING($minisql) or die "Bad definition: ", $Dumper->($minisql), "\n";
170
171
8
178
    my $desc = delete $data->{description};
172
8
100
43
    if (defined $desc) {
173
3
50
16
        _STRING($desc) or die "View description must be a string.\n";
174    }
175
176
8
50
85
    if (%$data) {
177
0
0
        die "Unknown keys: ", join(" ", keys %$data), "\n";
178    }
179
180
8
102
    my $select = MiniSQL::Select->new;
181
8
34
    eval {
182
8
134
        $res = $select->parse(
183            $minisql,
184            { quote => \&Q, quote_ident => \&QI }
185        );
186    };
187
8
100
72
    if ($@) {
188
2
5
        die "minisql: $@\n";
189    }
190
191    #
192    # check to see if modes exists
193    #
194
6
6
19
48
    my @models = @{ $res->{models} };
195
6
32
    foreach my $model (@models){
196
11
100
155
        if (!$self->has_model($model)) {
197
2
7
            die "Model \"$model\" not found.\n";
198        }
199    }
200
201
4
134
    my $insert = SQL::Insert
202        ->new('_views')
203        ->cols( qw<name definition description> )
204        ->values( Q($name, $minisql, $desc) );
205
206
4
50
49
    return { success => $self->do($insert) ? 1 : 0 };
207
208}
209
210sub DELETE_view {
211
2
2
0
14
    my ($self, $bits) = @_;
212
2
14
    my $view = $bits->[1];
213
2
50
67
14
    _IDENT($view) or $view eq '~' or
214        die "Bad view name: ", $Dumper->($view), "\n";
215
2
100
15
    if ($view eq '~') {
216
1
7
        return $self->DELETE_view_list;
217    }
218
1
50
12
    if (!$self->has_view($view)) {
219
0
0
        die "View \"$view\" not found.\n";
220    }
221
1
59
    my $sql = "delete from _views where name = " . Q($view);
222
1
50
12
    return { success => $self->do($sql) >= 0 ? 1 : 0 };
223}
224
225sub DELETE_view_list {
226
3
3
0
21
    my ($self, $bits) = @_;
227
3
13
    my $sql = "truncate _views;";
228
3
50
24
    return { success => $self->do($sql) >= 0 ? 1 : 0 };
229}
230
231sub has_view {
232
49
49
0
353
    my ($self, $view) = @_;
233
234
49
100
380
    _IDENT($view) or die "Bad view name: $view\n";
235
236
48
588
    my $select = SQL::Select->new('count(name)')
237        ->from('_views')
238        ->where(name => Q($view))
239        ->limit(1);
240
48
167
    return $self->select("$select",)->[0][0];
241}
242
2431;
244