File Coverage

blib/lib/Zabbix2/API/CRUDE.pm
Criterion Covered Total %
statement 17 74 22.9
branch 0 26 0.0
condition 0 3 0.0
subroutine 6 17 35.2
pod 9 9 100.0
total 32 129 24.8


line stmt bran cond sub pod time code
1             package Zabbix2::API::CRUDE;
2            
3 13     13   8375 use strict;
  13         31  
  13         412  
4 13     13   79 use warnings;
  13         24  
  13         319  
5 13     13   258 use 5.010;
  13         49  
6 13     13   69 use Carp;
  13         31  
  13         821  
7            
8 13     13   86 use Scalar::Util qw/blessed/;
  13         25  
  13         705  
9 13     13   77 use Moo;
  13         27  
  13         81  
10            
11             has 'data' => (is => 'ro',
12             writer => '_set_data',
13             default => sub { {} });
14             has 'root' => (is => 'ro',
15             required => 1);
16            
17             sub short_class {
18 0     0 1   my $self = shift;
19 0   0       my $class = blessed($self) // $self;
20 0           $class =~ s/^Zabbix2::API:://;
21 0           return $class;
22             }
23            
24             sub id {
25 0     0 1   my ($self, $value) = @_;
26 0 0         if (defined $value) {
27 0           $self->data->{$self->_prefix('id')} = $value;
28             }
29 0           return $self->data->{$self->_prefix('id')};
30             }
31            
32             sub node_id {
33 0     0 1   my $self = shift;
34 0 0         croak(sprintf(q{%s class object does not have a local ID, can't tell the node ID},
35             $self->short_class)) unless $self->id;
36 0 0         return unless $self->id > 100_000_000_000_000;
37             # this is how Zabbix operates, don't blame me
38 0           return int($self->id/100_000_000_000_000);
39             }
40            
41             sub _prefix {
42 0     0     croak 'Class '.(ref shift).' does not implement required method _prefix()';
43             }
44            
45             sub _extension {
46 0     0     croak 'Class '.(ref shift).' does not implement required method _extension()';
47             }
48            
49             sub name {
50 0     0 1   croak 'Class '.(ref shift).' does not implement required method name()';
51             }
52            
53             sub pull {
54 0     0 1   my $self = shift;
55 0 0         croak(sprintf(q{Cannot pull data from server into a %s without ID}, $self->short_class))
56             unless $self->id;
57 0           my $data = $self->root->query(method => $self->_prefix('.get'),
58             params => { $self->_prefix('ids') => [ $self->id ],
59             $self->_extension })->[0];
60 0 0         croak(sprintf(q{%s class object has a local ID that does not appear to exist on the server},
61             $self->short_class)) unless $data;
62 0           $self->_set_data($data);
63 0           return $self;
64             }
65            
66             sub exists {
67 0     0 1   my $self = shift;
68 0 0         if (my $id = $self->id) {
69 0           my $response = $self->root->query(method => $self->_prefix('.get'),
70             params => { $self->_prefix('ids') => [$id],
71             countOutput => 1 });
72 0           return !!$response;
73             } else {
74 0           croak(sprintf(q{Cannot tell if a '%s' object exists on the server without the %s property},
75             $self->_prefix, $self->_prefix('id')));
76             }
77             }
78            
79             sub create {
80            
81 0     0 1   my $self = shift;
82            
83             ## remove the readonly properties
84 0           my %data = %{$self->data};
  0            
85 0 0         if ($self->can('_readonly_properties')) {
86 0           delete @data{keys(%{$self->_readonly_properties})};
  0            
87             }
88            
89 0           my $results = $self->root->query(method => $self->_prefix('.create'),
90             params => \%data);
91 0           my $id = $results->{$self->_prefix('ids')}->[0];
92 0           $self->id($id);
93            
94             ## if lazy_push: done, else fetch the new updated data
95            
96 0 0         if ($self->root->pull_after_push_mode) {
97 0           $self->pull;
98             }
99            
100 0           return $self;
101            
102             }
103            
104             sub update {
105            
106 0     0 1   my $self = shift;
107            
108             ## save the ID because it is likely to be one of the readonly
109             ## properties
110            
111 0 0         if (my $id = $self->id) {
112             ## remove the readonly properties
113 0           my %data = %{$self->data};
  0            
114 0 0         if ($self->can('_readonly_properties')) {
115 0           delete @data{keys(%{$self->_readonly_properties})};
  0            
116             }
117            
118 0           eval {
119 0           $self->root->query(method => $self->_prefix('.update'),
120             params => { $self->_prefix('id') => $id,
121             %data });
122             };
123 0 0         croak $@ if $@;
124            
125 0 0         if ($self->root->pull_after_push_mode) {
126 0           $self->pull;
127             }
128             } else {
129 0           croak(sprintf(q{Cannot update new %s, need to create it or fetch it first},
130             $self->short_class));
131             }
132            
133 0           return $self;
134            
135             }
136            
137             sub delete {
138 0     0 1   my $self = shift;
139 0 0         if ($self->id) {
140 0           my $response = $self->root->query(method => $self->_prefix('.delete'),
141             params => [ $self->id ]);
142             } else {
143 0           croak(sprintf(q{Useless call of delete() on a %s that does not have a %s},
144             $self->_prefix, $self->_prefix('id')));
145             }
146 0           return $self;
147             }
148            
149             1;
150             __END__