[SCM] Abstraction layer over the JSON-RPC API provided by Zabbix branch, master, updated. debian/0.004+git20120629-1-11-g3fd43ce
Dmitry Smirnov
onlyjob at member.fsf.org
Fri Mar 29 05:55:04 UTC 2013
The following commit has been merged in the master branch:
commit 2411eb1afaab0a8e6cf11cff41965a6bf6fe9e54
Author: Dmitry Smirnov <onlyjob at member.fsf.org>
Date: Fri Mar 29 14:58:45 2013 +1100
Imported Upstream version 0.009
diff --git a/Build.PL b/Build.PL
index 5ad856f..ec66644 100644
--- a/Build.PL
+++ b/Build.PL
@@ -23,9 +23,9 @@ my $builder = Module::Build->new(
'Params::Validate' => 0
},
add_to_cleanup => [ 'Zabbix::API-*' ],
- release_status => 'testing',
+ release_status => 'stable',
meta_merge => { resources =>
- { repository => 'git://github.com/SFR-ZABBIX/Zabbix-API.git' } },
+ { repository => 'git://github.com/fgabolde/Zabbix-API.git' } },
);
$builder->create_build_script();
diff --git a/CHANGES b/CHANGES
index 77fa0a3..22315b4 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,35 @@
+March 8, 2013 - Version 0.009
+ * MediaType support, provided by Ray Link
+
+March 5, 2013 - Version 0.008
+ * Item class:
+ * graphs() accessor
+ * Graph class:
+ * url() accessor
+
+February 15, 2013 - Version 0.007
+ * User class:
+ * set_usergroups() method
+ * Removed stash misfeature. Since it never worked no one should be
+ impacted...
+
+February 14, 2013 - Version 0.006
+ * User class:
+ * set_password() method
+ * API class:
+ * fetch_single method
+
+January 25, 2013 - Version 0.005
+ * Hostgroup class:
+ * name() accessor
+ * hosts() accessor
+ * Template support from Chris Larsen
+ * Proxy support from Chris Larsen
+ * Item class:
+ * history() accessor
+ * User support
+ * UserGroup support
+
February 23, 2012 - Version 0.004
* Trigger support
* Action support
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..16c9787
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,44 @@
+Build.PL
+CHANGES
+examples/fetch-all-hosts.pl
+lib/Zabbix/API.pm
+lib/Zabbix/API/Action.pm
+lib/Zabbix/API/CRUDE.pm
+lib/Zabbix/API/Graph.pm
+lib/Zabbix/API/Host.pm
+lib/Zabbix/API/HostGroup.pm
+lib/Zabbix/API/Item.pm
+lib/Zabbix/API/Macro.pm
+lib/Zabbix/API/Map.pm
+lib/Zabbix/API/MediaType.pm
+lib/Zabbix/API/Proxy.pm
+lib/Zabbix/API/Screen.pm
+lib/Zabbix/API/Template.pm
+lib/Zabbix/API/Trigger.pm
+lib/Zabbix/API/User.pm
+lib/Zabbix/API/UserGroup.pm
+lib/Zabbix/API/Utils.pm
+LICENSE
+MANIFEST This list of files
+META.json
+META.yml
+README
+t/actions.t
+t/connect-and-fetch.t
+t/graphs.t
+t/hostgroups.t
+t/hosts.t
+t/items.t
+t/kwalitee.t
+t/lib/Zabbix/API/TestUtils.pm
+t/macros.t
+t/maps.t
+t/parse-formula.t
+t/perl-critic.t
+t/perlcriticrc
+t/pod-coverage.t
+t/pod-syntax.t
+t/screens.t
+t/triggers.t
+t/usergroups.t
+t/users.t
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
deleted file mode 100644
index d0ecae6..0000000
--- a/MANIFEST.SKIP
+++ /dev/null
@@ -1,59 +0,0 @@
-
-#!start included /home/fgabolde/perl5/perlbrew/perls/zabbix-5.10.1/lib/5.10.1/ExtUtils/MANIFEST.SKIP
-# Avoid version control files.
-\bRCS\b
-\bCVS\b
-\bSCCS\b
-,v$
-\B\.svn\b
-\B\.git\b
-\B\.gitignore\b
-\b_darcs\b
-
-# Avoid Makemaker generated and utility files.
-\bMANIFEST\.bak
-\bMakefile$
-\bblib/
-\bMakeMaker-\d
-\bpm_to_blib\.ts$
-\bpm_to_blib$
-\bblibdirs\.ts$ # 6.18 through 6.25 generated this
-
-# Avoid Module::Build generated and utility files.
-\bBuild$
-\b_build/
-
-# Avoid temp and backup files.
-~$
-\.old$
-\#$
-\b\.#
-\.bak$
-
-# Avoid Devel::Cover files.
-\bcover_db\b
-#!end included /home/fgabolde/perl5/perlbrew/perls/zabbix-5.10.1/lib/5.10.1/ExtUtils/MANIFEST.SKIP
-
-# Avoid configuration metadata file
-^MYMETA\.
-
-# Avoid Module::Build generated and utility files.
-\bBuild$
-\bBuild.bat$
-\b_build
-\bBuild.COM$
-\bBUILD.COM$
-\bbuild.com$
-^MANIFEST\.SKIP
-
-# Avoid archives of this distribution
-\bZabbix-API-[\d\.\_]+
-
-# debian-specific files
-\bdebian\b
-
-# produced by kwalitee tests
-^Debian_CPANTS.txt
-
-# smoke tests
-^smoke.tgz
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..04912e5
--- /dev/null
+++ b/META.json
@@ -0,0 +1,119 @@
+{
+ "abstract" : "Access the JSON-RPC API of a Zabbix server",
+ "author" : [
+ "Fabrice Gabolde <fabrice.gabolde at uperto.com>",
+ "Marc Dequenes <marc.dequenes at uperto.com>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921",
+ "license" : [
+ "open_source"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Zabbix-API",
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "File::Spec" : "0",
+ "Test::Exception" : "0",
+ "Test::More" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "Module::Build" : "0.36_14"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "JSON" : "0",
+ "LWP" : "0",
+ "Params::Validate" : "0",
+ "perl" : "5.010001"
+ }
+ }
+ },
+ "provides" : {
+ "Zabbix::API" : {
+ "file" : "lib/Zabbix/API.pm",
+ "version" : "0.009"
+ },
+ "Zabbix::API::Action" : {
+ "file" : "lib/Zabbix/API/Action.pm",
+ "version" : 0
+ },
+ "Zabbix::API::CRUDE" : {
+ "file" : "lib/Zabbix/API/CRUDE.pm",
+ "version" : 0
+ },
+ "Zabbix::API::Graph" : {
+ "file" : "lib/Zabbix/API/Graph.pm",
+ "version" : 0
+ },
+ "Zabbix::API::Host" : {
+ "file" : "lib/Zabbix/API/Host.pm",
+ "version" : 0
+ },
+ "Zabbix::API::HostGroup" : {
+ "file" : "lib/Zabbix/API/HostGroup.pm",
+ "version" : 0
+ },
+ "Zabbix::API::Item" : {
+ "file" : "lib/Zabbix/API/Item.pm",
+ "version" : 0
+ },
+ "Zabbix::API::Macro" : {
+ "file" : "lib/Zabbix/API/Macro.pm",
+ "version" : 0
+ },
+ "Zabbix::API::Map" : {
+ "file" : "lib/Zabbix/API/Map.pm",
+ "version" : 0
+ },
+ "Zabbix::API::MediaType" : {
+ "file" : "lib/Zabbix/API/MediaType.pm",
+ "version" : 0
+ },
+ "Zabbix::API::Proxy" : {
+ "file" : "lib/Zabbix/API/Proxy.pm",
+ "version" : 0
+ },
+ "Zabbix::API::Screen" : {
+ "file" : "lib/Zabbix/API/Screen.pm",
+ "version" : 0
+ },
+ "Zabbix::API::Template" : {
+ "file" : "lib/Zabbix/API/Template.pm",
+ "version" : 0
+ },
+ "Zabbix::API::Trigger" : {
+ "file" : "lib/Zabbix/API/Trigger.pm",
+ "version" : 0
+ },
+ "Zabbix::API::User" : {
+ "file" : "lib/Zabbix/API/User.pm",
+ "version" : 0
+ },
+ "Zabbix::API::UserGroup" : {
+ "file" : "lib/Zabbix/API/UserGroup.pm",
+ "version" : 0
+ },
+ "Zabbix::API::Utils" : {
+ "file" : "lib/Zabbix/API/Utils.pm",
+ "version" : 0
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "license" : [
+ "http://www.gnu.org/licenses/gpl-3.0.txt"
+ ],
+ "repository" : {
+ "url" : "git://github.com/fgabolde/Zabbix-API.git"
+ }
+ },
+ "version" : "0.009"
+}
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..bfc9151
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,79 @@
+---
+abstract: 'Access the JSON-RPC API of a Zabbix server'
+author:
+ - 'Fabrice Gabolde <fabrice.gabolde at uperto.com>'
+ - 'Marc Dequenes <marc.dequenes at uperto.com>'
+build_requires:
+ File::Spec: 0
+ Test::Exception: 0
+ Test::More: 0
+configure_requires:
+ Module::Build: 0.36_14
+dynamic_config: 1
+generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921'
+license: open_source
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Zabbix-API
+provides:
+ Zabbix::API:
+ file: lib/Zabbix/API.pm
+ version: 0.009
+ Zabbix::API::Action:
+ file: lib/Zabbix/API/Action.pm
+ version: 0
+ Zabbix::API::CRUDE:
+ file: lib/Zabbix/API/CRUDE.pm
+ version: 0
+ Zabbix::API::Graph:
+ file: lib/Zabbix/API/Graph.pm
+ version: 0
+ Zabbix::API::Host:
+ file: lib/Zabbix/API/Host.pm
+ version: 0
+ Zabbix::API::HostGroup:
+ file: lib/Zabbix/API/HostGroup.pm
+ version: 0
+ Zabbix::API::Item:
+ file: lib/Zabbix/API/Item.pm
+ version: 0
+ Zabbix::API::Macro:
+ file: lib/Zabbix/API/Macro.pm
+ version: 0
+ Zabbix::API::Map:
+ file: lib/Zabbix/API/Map.pm
+ version: 0
+ Zabbix::API::MediaType:
+ file: lib/Zabbix/API/MediaType.pm
+ version: 0
+ Zabbix::API::Proxy:
+ file: lib/Zabbix/API/Proxy.pm
+ version: 0
+ Zabbix::API::Screen:
+ file: lib/Zabbix/API/Screen.pm
+ version: 0
+ Zabbix::API::Template:
+ file: lib/Zabbix/API/Template.pm
+ version: 0
+ Zabbix::API::Trigger:
+ file: lib/Zabbix/API/Trigger.pm
+ version: 0
+ Zabbix::API::User:
+ file: lib/Zabbix/API/User.pm
+ version: 0
+ Zabbix::API::UserGroup:
+ file: lib/Zabbix/API/UserGroup.pm
+ version: 0
+ Zabbix::API::Utils:
+ file: lib/Zabbix/API/Utils.pm
+ version: 0
+requires:
+ JSON: 0
+ LWP: 0
+ Params::Validate: 0
+ perl: 5.010001
+resources:
+ license: http://www.gnu.org/licenses/gpl-3.0.txt
+ repository: git://github.com/fgabolde/Zabbix-API.git
+version: 0.009
diff --git a/lib/Zabbix/API.pm b/lib/Zabbix/API.pm
index fc82091..d36c22e 100644
--- a/lib/Zabbix/API.pm
+++ b/lib/Zabbix/API.pm
@@ -12,7 +12,7 @@ use Scalar::Util qw/weaken/;
use JSON;
use LWP::UserAgent;
-our $VERSION = '0.004';
+our $VERSION = '0.009';
sub new {
@@ -20,7 +20,8 @@ sub new {
my %args = validate(@_, { server => 1,
verbosity => 0,
env_proxy => 0,
- lazy => 0 });
+ lazy => 0,
+ ua => { optional => 1 } });
my $self = \%args;
@@ -29,12 +30,11 @@ sub new {
$self->{env_proxy} = 0 unless exists $self->{env_proxy};
$self->{lazy} = 0 unless exists $self->{lazy};
- $self->{stash} = {};
-
$self->{ua} = LWP::UserAgent->new(agent => 'Zabbix API client (libwww-perl)',
from => 'fabrice.gabolde at uperto.com',
show_progress => $self->{verbosity},
- env_proxy => $self->{env_proxy},);
+ env_proxy => $self->{env_proxy},)
+ unless $self->{ua};
$self->{cookie} = '';
@@ -44,22 +44,9 @@ sub new {
}
-sub stash {
-
- ## mutator for stash
-
- my ($self, $value) = @_;
-
- if (defined $value) {
-
- $self->{stash} = $value;
- return $self->{stash};
+sub useragent {
- } else {
-
- return $self->{stash};
-
- }
+ return shift->{ua};
}
@@ -83,34 +70,6 @@ sub verbosity {
}
-sub reference {
-
- my ($self, $thing) = @_;
-
- $self->{stash}->{$thing->prefix}->{$thing->id} = $thing;
-
- return $self;
-
-}
-
-sub dereference {
-
- my ($self, $thing) = @_;
-
- delete $self->{stash}->{$thing->prefix}->{$thing->id};
-
- return $self;
-
-}
-
-sub refof {
-
- my ($self, $thing) = @_;
-
- return $self->{stash}->{$thing->prefix}->{$thing->id};
-
-}
-
sub cookie {
my $self = shift;
@@ -290,21 +249,24 @@ sub fetch {
my $things = [ map { $class->new(root => $self, data => $_) } @{$response} ];
- foreach my $thing (@{$things}) {
+ return $things;
- if (my $replacement = $self->refof($thing)) {
+}
- $thing = $replacement;
+sub fetch_single {
- } else {
+ my ($self, @args) = @_;
- $self->reference($thing);
+ my $results = $self->fetch(@args);
+ my $result_count = scalar @{$results};
- }
+ if ($result_count > 1) {
+
+ croak qq{Too many results for 'fetch_single': expected 0 or 1, got $result_count"};
}
- return $things;
+ return $results->[0];
}
@@ -427,6 +389,21 @@ C<Zabbix::API::> will be prepended if it is missing.
Returns an arrayref of CLASS instances.
+=item fetch_single(CLASS, [params => HASHREF])
+
+Like C<fetch>, but also checks how many objects the server sent back.
+If no objects were sent, returns C<undef>. If one object was sent,
+returns that. If more objects were sent, throws an exception. This
+helps against malformed queries; Zabbix tends to return B<all> objects
+of a class when a query contains strange parameters (like "searhc" or
+"fliter").
+
+=item useragent
+
+Accessor for the L<LWP::UserAgent> object that handles HTTP queries
+and responses. Several useful options can be set: timeout, redirects,
+etc.
+
=item verbosity([VERBOSITY])
Mutator for the verbosity level.
@@ -455,35 +432,6 @@ C<Data::Dumper>) the queries sent to the server and the responses received.
=head1 LOW-LEVEL ACCESS
-A few methods are not intended for general consumption, but you never know.
-Plus it gives me a space to document them and raises POD coverage.
-
-=over 4
-
-=item reference(OBJECT)
-
-"Indexes" the object in a local stash. The C<fetch> method (and the objects'
-C<pull>) plugs into this so that you have only one real object, and modifying a
-host directly and modifying an item's host (via C<< ->host >> is the same thing.
-
-=item dereference(OBJECT)
-
-Removes the object's index in the local stash. This is called by the objects'
-C<delete> method.
-
-=item refof(OBJECT)
-
-Returns the correct reference to an object fetched from the server; in other
-words, looks in the stash for an object that has the same C<id>. This is used
-in indexing objects, to ensure that the stashed objects are updated instead of
-just creating doubles.
-
-=item stash([STASH])
-
-Mutator for the local stash (a hashref of type => id => object).
-
-=back
-
Several attributes are available if you want to dig into the class' internals,
through the standard blessed-hash-as-an-instance mechanism. Those are:
@@ -503,12 +451,6 @@ different).
A string containing the current session's auth cookie, or the empty string if
unauthenticated.
-=item ua
-
-The LWP::UserAgent object that handles HTTP queries and responses. This is
-probably the most interesting attribute since several useful options can be
-set: timeout, redirects, etc.
-
=item env_proxy
Direct access to the LWP::UserAgent B<initial> configuration regarding
@@ -541,9 +483,7 @@ don't know about each other! Of course this is also true if someone else is
fiddling with the hosts directly on the web interface or in any other way.
To work around this, you have to C<pull()> just before you start changing
-things. Currently C<Zabbix::API> does its best to return existing references
-when you C<fetch()> from the server; ideally C<$host> and C<$same_host> would
-also point to the same object, but they don't.
+things.
=head2 MOOSE, ABSENCE OF
@@ -587,7 +527,7 @@ Fabrice Gabolde <fabrice.gabolde at uperto.com>
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2011 SFR
+Copyright (C) 2011, 2012, 2013 SFR
This library is free software; you can redistribute it and/or modify it under
the terms of the GPLv3.
diff --git a/lib/Zabbix/API/CRUDE.pm b/lib/Zabbix/API/CRUDE.pm
index b906139..1589fe5 100644
--- a/lib/Zabbix/API/CRUDE.pm
+++ b/lib/Zabbix/API/CRUDE.pm
@@ -23,6 +23,23 @@ sub id {
}
+sub node_id {
+
+ my ($self, $value) = @_;
+
+ if (defined $value) {
+
+ croak 'Accessor node_id() called as mutator';
+
+ }
+
+ return unless $self->id;
+ return unless $self->id > 100000000000000;
+ # this is how Zabbix operates, don't blame me
+ return int($self->id/100000000000000);
+
+}
+
sub prefix {
croak 'Class '.(ref shift).' does not implement required method prefix()';
@@ -80,17 +97,6 @@ sub pull {
$self->extension
})->[0];
- # uniquify objects
- if (my $replacement = $self->{root}->refof($self)) {
-
- $self = $replacement;
-
- } else {
-
- $self->{root}->reference($self);
-
- }
-
}
return $self;
@@ -189,10 +195,6 @@ sub delete {
$self->{root}->query(method => $self->prefix('.delete'),
params => [ $self->id ]);
- delete $self->{root}->{stash}->{$self->prefix('s')}->{$self->id};
-
- $self->{root}->dereference($self);
-
} else {
carp sprintf(q{Useless call of delete() on a %s that does not have a %s}, $self->prefix, $self->prefix('id'));
@@ -261,6 +263,13 @@ hosts, C<hostid>). What this means is, it must accept zero or one argument; if
zero, return the current ID or undef; if one, set the current ID in the raw data
hash (see the C<data()> method) and return it.
+=item node_id()
+
+This method returns the current object's node ID, for distributed
+setups. For objects in non-distributed setups, whose IDs do not
+include a node ID, and objects that have never been pushed to the
+server, this method will return false.
+
=item prefix([SUFFIX]) (abstract method)
This method must return a string that corresponds to its type (e.g. C<host>).
diff --git a/lib/Zabbix/API/Graph.pm b/lib/Zabbix/API/Graph.pm
index 777c655..31f57f1 100644
--- a/lib/Zabbix/API/Graph.pm
+++ b/lib/Zabbix/API/Graph.pm
@@ -5,6 +5,7 @@ use warnings;
use 5.010;
use Carp;
+use Params::Validate qw/validate :types/;
use parent qw/Zabbix::API::CRUDE/;
sub new {
@@ -89,6 +90,28 @@ sub items {
}
+sub url {
+
+ ## return url for a graph
+
+ my $self = shift;
+
+ my $base_url = $self->{root}->{server};
+ $base_url =~ s{(?:/api_jsonrpc\.php)?$}{};
+
+ my %args = validate(@_, { width => { type => SCALAR, optional => 1, regex => qr/^\d+$/ },
+ period => { type => SCALAR, optional => 1, regex => qr/^\d+$/ },
+ start_time => { type => SCALAR, optional => 1, regex => qr/^\d{14}$/ } });
+
+ my $url = $base_url.'/chart2.php?graphid='.$self->id;
+ $url .= '&width='.$args{width} if $args{width};
+ $url .= '&period='.$args{period} if $args{period};
+ $url .= '&stime='.$args{start_time} if $args{start_time};
+
+ return $url;
+
+}
+
sub push {
# override CRUDE's push()
@@ -214,7 +237,30 @@ will Do The Right Thing (assuming you agree with my definition of the Right
Thing). Items that have been created this way will not be removed from the
server if they are removed from the graph, however.
-Overridden from C<Zabbix::API::CRUDE>.
+Overriden from C<Zabbix::API::CRUDE>.
+
+=item url([width => WIDTH], [period => PERIOD], [start_time => START_TIME])
+
+This method returns a URL to an image on the Zabbix server. The image
+of width C<WIDTH> will represent the current graph, plotted for data
+starting at C<START_TIME> (a UNIX timestamp) over C<PERIOD> seconds.
+It uses the current connection's host name to guess what path to base
+the URL on.
+
+All three parameters are optional.
+
+If the current user agent has cookies enabled, you can even fetch the
+image directly, since your API session is completely valid for all
+regular requests:
+
+ my $zabbix = Zabbix::API->new(server => ...,
+ ua => LWP::UserAgent->new(cookie_jar => { file => 'cookie.jar' }),
+ ...);
+ my $graph = $zabbix->fetch_single('Graph', ...);
+ my $response = $zabbix->{ua}->get($graph->url);
+ open my $image, '>', 'graph.png' or die $!;
+ $image->print($response->decoded_content);
+ $image->close;
=back
diff --git a/lib/Zabbix/API/HostGroup.pm b/lib/Zabbix/API/HostGroup.pm
index c921958..44c19ab 100644
--- a/lib/Zabbix/API/HostGroup.pm
+++ b/lib/Zabbix/API/HostGroup.pm
@@ -7,6 +7,8 @@ use Carp;
use parent qw/Zabbix::API::CRUDE/;
+use Zabbix::API::Host;
+
sub id {
## mutator for id
@@ -70,6 +72,26 @@ sub name {
}
+sub hosts {
+
+ my ($self, $value) = @_;
+
+ if (defined $value) {
+
+ die 'Accessor hosts called as mutator';
+
+ } else {
+
+ my $hosts = $self->{root}->fetch('Host', params => { groupids => [ $self->id ] });
+
+ $self->{hosts} = $hosts;
+
+ return $self->{hosts};
+
+ }
+
+}
+
1;
__END__
=pod
@@ -103,6 +125,10 @@ Accessor for the hostgroup's name (the "name" attribute); returns the empty
string if no name is set, for instance if the hostgroup has not been created on
the server yet.
+=item hosts()
+
+Accessor for the hostgroup's hosts.
+
=back
=head1 SEE ALSO
diff --git a/lib/Zabbix/API/Item.pm b/lib/Zabbix/API/Item.pm
index eb1b964..3889a10 100644
--- a/lib/Zabbix/API/Item.pm
+++ b/lib/Zabbix/API/Item.pm
@@ -5,6 +5,8 @@ use warnings;
use 5.010;
use Carp;
+use Params::Validate qw/validate validate_with :types/;
+
use parent qw/Exporter Zabbix::API::CRUDE/;
use constant {
@@ -165,6 +167,31 @@ sub name {
}
+sub graphs {
+
+ ## accessor for this item's graphs
+
+ my ($self, $value) = @_;
+
+ if (defined $value) {
+
+ croak 'Accessor graphs called as mutator';
+
+ } else {
+
+ unless (exists ($self->{graphs})) {
+
+ my $graphs = $self->{root}->fetch('Graph', params => { itemids => [ $self->id ] });
+ $self->{graphs} = $graphs;
+
+ }
+
+ }
+
+ return $self->{graphs};
+
+}
+
sub host {
## accessor for host
@@ -194,6 +221,44 @@ sub host {
}
+sub history {
+
+ ## accessor for history
+
+ ## DOES NOT CACHE!
+
+ my $self = shift;
+
+ my %extra_parameters = validate_with(params => \@_,
+ spec => { time_from => { type => SCALAR, optional => 1 },
+ time_till => { type => SCALAR, optional => 1 } },
+ allow_extra => 1);
+
+ my $history = $self->{root}->query(method => 'history.get',
+ params => { %extra_parameters,
+ itemids => [ $self->id ],
+ output => 'extend' });
+
+ return $history;
+
+}
+
+sub delay {
+
+ ## mutator for the item's polling period
+
+ my ($self, $value) = @_;
+
+ if ($value) {
+
+ $self->data->{delay} = $value;
+
+ }
+
+ return $self->data->{delay};
+
+}
+
1;
__END__
=pod
@@ -256,6 +321,35 @@ Accessor for a local C<host> attribute, which it also happens to set from the
server data if it isn't set already. The host is an instance of
C<Zabbix::API::Host>.
+=item graphs()
+
+Like C<host()>, returning an arrayref of C<Zabbix::API::Graph>
+instances in which this item is involved.
+
+=item history(PARAMS)
+
+Accessor for the item's history data. Calling this method does not store the
+history data into the object, unlike other accessors. History data is an AoH:
+
+ [ { itemid => ITEMID,
+ clock => UNIX_TIMESTAMP,
+ value => VALUE }, ... ]
+
+C<PARAMS> should be a hash containing arguments for the C<history.get> method
+(see here: L<http://www.zabbix.com/documentation/1.8/api/history/get>). The
+time_from and time_till keys (with UNIX timestamps as values) are mandatory.
+The C<itemids> and C<output> parameters are already set and cannot be
+overwritten by the contents of C<PARAMS>.
+
+=item delay(NEW_DELAY)
+
+Mutator for the item's C<delay> value; that is, the polling period in
+seconds. This is just a shortcut to set C<delay> in the C<data>
+hashref. The method doesn't call C<pull()> or C<push()>, you need to
+do it manually.
+
+Returns the newly-set value.
+
=back
=head1 EXPORTS
diff --git a/lib/Zabbix/API/Map.pm b/lib/Zabbix/API/Map.pm
index 00bc556..4cdff04 100644
--- a/lib/Zabbix/API/Map.pm
+++ b/lib/Zabbix/API/Map.pm
@@ -214,7 +214,7 @@ the selements array, transforming them into C<elementid> and C<elementtype>
attributes (and setting the C<label> attribute to the hostname if it isn't set
already), and pushing the hosts to the server if they don't exist already.
-Overridden from C<Zabbix::API::CRUDE>.
+Overriden from C<Zabbix::API::CRUDE>.
B<** WARNING **> Due to the way maps API calls are implemented in Zabbix,
updating a map will delete it and create it anew. The C<sysmapid> B<will>
diff --git a/lib/Zabbix/API/MediaType.pm b/lib/Zabbix/API/MediaType.pm
new file mode 100644
index 0000000..f36f8fb
--- /dev/null
+++ b/lib/Zabbix/API/MediaType.pm
@@ -0,0 +1,174 @@
+package Zabbix::API::MediaType;
+
+use strict;
+use warnings;
+use 5.010;
+use Carp;
+
+use parent qw/Exporter Zabbix::API::CRUDE/;
+
+use constant {
+ MEDIA_TYPE_EMAIL => 0,
+ MEDIA_TYPE_EXEC => 1,
+ MEDIA_TYPE_SMS => 2,
+ MEDIA_TYPE_JABBER => 3,
+ MEDIA_TYPE_EZ_TEXTING => 100,
+};
+
+our @EXPORT_OK = qw/
+MEDIA_TYPE_EMAIL
+MEDIA_TYPE_EXEC
+MEDIA_TYPE_SMS
+MEDIA_TYPE_JABBER
+MEDIA_TYPE_EZ_TEXTING/;
+
+our %EXPORT_TAGS = (
+ media_types => [
+ qw/MEDIA_TYPE_EMAIL
+ MEDIA_TYPE_EXEC
+ MEDIA_TYPE_SMS
+ MEDIA_TYPE_JABBER
+ MEDIA_TYPE_EZ_TEXTING/
+ ],
+);
+
+sub id {
+
+ ## mutator for id
+
+ my ($self, $value) = @_;
+
+ if (defined $value) {
+
+ $self->data->{mediatypeid} = $value;
+ return $self->data->{mediatypeid};
+
+ } else {
+
+ return $self->data->{mediatypeid};
+
+ }
+
+}
+
+sub prefix {
+
+ my (undef, $suffix) = @_;
+
+ if ($suffix) {
+
+ return 'mediatype'.$suffix;
+
+ } else {
+
+ return 'mediatype';
+
+ }
+
+}
+
+sub extension {
+
+ return ( output => 'extend',
+ select_users => 'extend',
+ select_medias => 'extend' );
+
+
+}
+
+sub collides {
+
+ my $self = shift;
+
+ return @{$self->{root}->query(method => $self->prefix('.get'),
+ params => { filter => { description => $self->data->{description} },
+ $self->extension })};
+
+}
+
+sub name {
+
+ my $self = shift;
+
+ return $self->data->{description} || '';
+
+}
+
+sub type {
+
+ my $self = shift;
+
+ return $self->data->{type} || -1;
+
+}
+
+1;
+__END__
+=pod
+
+=head1 NAME
+
+Zabbix::API::MediaType -- Zabbix media type objects
+
+=head1 SYNOPSIS
+
+ use Zabbix::API::MediaType;
+ # fetch a meda type by name
+ my $mediatype = $zabbix->fetch('MediaType', params => { filter => { description => "My Media Type" } })->[0];
+
+ # and update it
+
+ $mediatype->data->{exec_path} = 'my_notifier.pl';
+ $mediatype->push;
+
+=head1 DESCRIPTION
+
+Handles CRUD for Zabbix media_type objects.
+
+This is a subclass of C<Zabbix::API::CRUDE>; see there for inherited methods.
+
+=head1 METHODS
+
+=over 4
+
+=item name()
+
+Accessor for the media type's name (the "description" attribute); returns the
+empty string if no description is set, for instance if the media type
+has not been created on the server yet.
+
+=item type()
+
+Accessor for the media type's type.
+
+=back
+
+=head1 EXPORTS
+
+Some constants:
+
+ MEDIA_TYPE_EMAIL
+ MEDIA_TYPE_EXEC
+ MEDIA_TYPE_SMS
+ MEDIA_TYPE_JABBER
+ MEDIA_TYPE_EZ_TEXTING
+
+These are used to specify the media type's type. They are not exported by
+default, only on request; or you could import the C<:media_types> tag.
+
+=head1 SEE ALSO
+
+L<Zabbix::API::CRUDE>.
+
+=head1 AUTHOR
+
+Ray Link; maintained by Fabrice Gabolde <fabrice.gabolde at uperto.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2013 SFR
+
+This library is free software; you can redistribute it and/or modify it under
+the terms of the GPLv3.
+
+=cut
diff --git a/lib/Zabbix/API/Screen.pm b/lib/Zabbix/API/Screen.pm
index 42f3e1e..db864ff 100644
--- a/lib/Zabbix/API/Screen.pm
+++ b/lib/Zabbix/API/Screen.pm
@@ -231,7 +231,7 @@ Since graphs do the same thing with their C<Item> graphitems, you can create a
bunch of items, put them in a bunch of graphs, put those in a screen, push the
screen, sit back and enjoy the fireworks.
-Overridden from C<Zabbix::API::CRUDE>.
+Overriden from C<Zabbix::API::CRUDE>.
=back
diff --git a/lib/Zabbix/API/User.pm b/lib/Zabbix/API/User.pm
new file mode 100644
index 0000000..8455916
--- /dev/null
+++ b/lib/Zabbix/API/User.pm
@@ -0,0 +1,282 @@
+package Zabbix::API::User;
+
+use strict;
+use warnings;
+use 5.010;
+use Carp;
+
+use parent qw/Exporter Zabbix::API::CRUDE/;
+
+use constant {
+ USER_TYPE_USER => 1,
+ USER_TYPE_ADMIN => 2,
+ USER_TYPE_SUPERADMIN => 3,
+};
+
+our @EXPORT_OK = qw/
+USER_TYPE_USER
+USER_TYPE_ADMIN
+USER_TYPE_SUPERADMIN/;
+
+our %EXPORT_TAGS = (
+ user_types => [
+ qw/USER_TYPE_USER
+ USER_TYPE_ADMIN
+ USER_TYPE_SUPERADMIN/
+ ],
+ );
+
+sub id {
+
+ ## mutator for id
+
+ my ($self, $value) = @_;
+
+ if (defined $value) {
+
+ $self->data->{userid} = $value;
+ return $self->data->{userid};
+
+ } else {
+
+ return $self->data->{userid};
+
+ }
+
+}
+
+sub prefix {
+
+ my (undef, $suffix) = @_;
+
+ if ($suffix) {
+
+ return 'user'.$suffix;
+
+ } else {
+
+ return 'user';
+
+ }
+
+}
+
+sub extension {
+
+ return ( output => 'extend',
+ select_usrgrps => 'refer' );
+
+}
+
+sub collides {
+
+ my $self = shift;
+
+ return @{$self->{root}->query(method => $self->prefix('.get'),
+ params => { filter => { alias => $self->data->{alias} },
+ $self->extension })};
+
+}
+
+sub name {
+
+ my $self = shift;
+
+ return $self->data->{alias} || '[no username?]';
+
+}
+
+sub usergroups {
+
+ ## accessor for usergroups
+
+ my ($self, $value) = @_;
+
+ if (defined $value) {
+
+ die 'Accessor usergroups called as mutator';
+
+ } else {
+
+ my $usergroups = $self->{root}->fetch('UserGroup', params => { usrgrpids => [ map { $_->{usrgrpid} } @{$self->data->{usrgrps}} ] });
+ $self->{usergroups} = $usergroups;
+
+ return $self->{usergroups};
+
+ }
+
+}
+
+sub _usergroup_or_name_to_usergroup {
+
+ my $zabbix = shift;
+ my $usergroup_or_name = shift;
+ my $usergroup;
+
+ if (ref $usergroup_or_name and eval { $usergroup_or_name->isa('Zabbix::API::UserGroup') }) {
+
+ # it's a UserGroup object, keep it
+ $usergroup = $usergroup_or_name;
+
+ } elsif (not ref $usergroup_or_name) {
+
+ $usergroup = $zabbix->fetch('UserGroup', params => { filter => { name => $usergroup_or_name } })->[0];
+
+ unless ($usergroup) {
+
+ die 'Parameter to add_to_usergroup or set_usergroups must be a Zabbix::API::UserGroup object or an existing usergroup name';
+
+ }
+
+ } else {
+
+ die 'Parameter to add_to_usergroup or set_usergroups must be a Zabbix::API::UserGroup object or an existing usergroup name';
+
+ }
+
+ return $usergroup;
+
+}
+
+sub add_to_usergroup {
+
+ my ($self, $usergroup_or_name) = @_;
+ my $usergroup = _usergroup_or_name_to_usergroup($self->{root}, $usergroup_or_name);
+
+ die 'User does not exist (yet?) on server'
+ unless $self->created;
+
+ $self->{root}->query(method => 'usergroup.massAdd',
+ params => { usrgrpids => [ $usergroup->id ],
+ userids => [ $self->id ] });
+
+ return $self;
+
+}
+
+sub set_usergroups {
+
+ my ($self, @list_of_usergroups_or_names) = @_;
+
+ die 'User does not exist (yet?) on server'
+ unless $self->created;
+
+ my @list_of_usergroups = map { _usergroup_or_name_to_usergroup($self->{root}, $_) } @list_of_usergroups_or_names;
+
+ $self->{root}->query(method => 'user.update',
+ params => { userid => $self->id,
+ usrgrps => [ map { $_->id } @list_of_usergroups ] });
+
+ return $self;
+
+}
+
+sub set_password {
+
+ my ($self, $password) = @_;
+ $self->data->{passwd} = $password;
+ return $self;
+
+}
+
+1;
+__END__
+=pod
+
+=head1 NAME
+
+Zabbix::API::User -- Zabbix user objects
+
+=head1 SYNOPSIS
+
+ use Zabbix::API::User;
+ # fetch a single user by login ("alias")
+ my $user = $zabbix->fetch('User', params => { filter => { alias => 'luser' } })->[0];
+
+ # and delete it
+ $user->delete;
+
+=head1 DESCRIPTION
+
+Handles CRUD for Zabbix user objects.
+
+This is a subclass of C<Zabbix::API::CRUDE>; see there for inherited methods.
+
+=head1 METHODS
+
+=over 4
+
+=item usergroups()
+
+Returns an arrayref of the user's usergroups (possibly empty) as
+L<Zabbix::API::UserGroup> objects.
+
+=item add_to_usergroup(USERGROUP_OR_NAME)
+
+Takes a L<Zabbix::API::UserGroup> instance or a valid usergroup name,
+and adds the current user to the group. Returns C<$self>.
+
+=item set_usergroups(LIST_OF_USERGROUPS_OR_NAMES)
+
+Takes a list of L<Zabbix::API::UserGroup> instances or valid usergroup
+names, and sets the user/usergroup relationship appropriately.
+Returns C<$self>.
+
+=item set_password(NEW_PASSWORD)
+
+Sets the user's password. The modified user is not pushed
+automatically to the server.
+
+=item name()
+
+Accessor for the user's name (the "alias" attribute).
+
+=item collides()
+
+This method returns a list of users colliding (i.e. matching) this
+one. If there if more than one colliding user found the implementation
+can not know on which one to perform updates and will bail out.
+
+=back
+
+=head1 EXPORTS
+
+User types are implemented as constants:
+
+ USER_TYPE_USER
+ USER_TYPE_ADMIN
+ USER_TYPE_SUPERADMIN
+
+Promote (or demote) users by setting their C<$user->data->{type}>
+attribute to one of these.
+
+Nothing is exported by default; you can use the tag C<:user_types> (or
+import by name).
+
+=head1 BUGS AND ODDITIES
+
+Apparently when logging in via the web page Zabbix does not care about
+the case of your username (e.g. "admin", "Admin" and "ADMIN" will all
+work). I have not tested this for filtering/searching/colliding
+users.
+
+=head2 WHERE'S THE remove_from_usergroup METHOD?
+
+L<This|https://support.zabbix.com/browse/ZBX-6124> is where it is.
+
+=head1 SEE ALSO
+
+L<Zabbix::API::CRUDE>.
+
+=head1 AUTHOR
+
+Fabrice Gabolde <fabrice.gabolde at uperto.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2013 SFR
+
+This library is free software; you can redistribute it and/or modify it under
+the terms of the GPLv3.
+
+=cut
diff --git a/lib/Zabbix/API/UserGroup.pm b/lib/Zabbix/API/UserGroup.pm
new file mode 100644
index 0000000..128b4d6
--- /dev/null
+++ b/lib/Zabbix/API/UserGroup.pm
@@ -0,0 +1,250 @@
+package Zabbix::API::UserGroup;
+
+use strict;
+use warnings;
+use 5.010;
+use Carp;
+
+use parent qw/Zabbix::API::CRUDE/;
+
+use Zabbix::API::User;
+
+sub id {
+
+ ## mutator for id
+
+ my ($self, $value) = @_;
+
+ if (defined $value) {
+
+ $self->data->{usrgrpid} = $value;
+ return $self->data->{usrgrpid};
+
+ } else {
+
+ return $self->data->{usrgrpid};
+
+ }
+
+}
+
+sub prefix {
+
+ my (undef, $suffix) = @_;
+
+ if ($suffix and $suffix =~ m/ids?/) {
+
+ return 'usrgrp'.$suffix;
+
+ } elsif ($suffix) {
+
+ return 'usergroup'.$suffix;
+
+ } else {
+
+ return 'usergroup';
+
+ }
+
+}
+
+sub extension {
+
+ return ( output => 'extend' );
+
+}
+
+sub collides {
+
+ my $self = shift;
+
+ return @{$self->{root}->query(method => $self->prefix('.get'),
+ params => { filter => { name => $self->data->{name} },
+ $self->extension })};
+
+}
+
+sub name {
+
+ my $self = shift;
+
+ return $self->data->{name} || '[no user group name?]';
+
+}
+
+sub users {
+
+ my ($self, $value) = @_;
+
+ if (defined $value) {
+
+ $self->data->{users} = $value;
+ return $self->data->{users};
+
+ } else {
+
+ my $users = $self->{root}->fetch('User', params => { usrgrpids => [ $self->id ] });
+ $self->{users} = $users;
+
+ return $self->{users};
+
+ }
+
+}
+
+sub push {
+
+ # override CRUDE's push()
+
+ my ($self, $data) = @_;
+
+ $data //= $self->data;
+
+ foreach my $user (@{$data->{users}}) {
+
+ if (exists $user->{user}) {
+
+ if (eval { $user->{user}->isa('Zabbix::API::User') }) {
+
+ $user->{user}->push;
+ $user->{userid} = $user->{user}->id;
+
+ } else {
+
+ croak 'Type mismatch: user attribute should be an instance of Zabbix::API::User';
+
+ }
+
+ }
+
+ }
+
+ # copying the anonymous hashes so we can delete stuff without touching the
+ # originals
+ my $users_copy = [ map { { %{$_} } } @{$data->{users}} ];
+
+ foreach my $user (@{$users_copy}) {
+
+ delete $user->{user};
+
+ }
+
+ # copying the data hashref so we can replace its users with the fake
+ my $data_copy = { %{$data} };
+
+ # the old switcheroo
+ $data_copy->{users} = $users_copy;
+
+ return $self->SUPER::push($data_copy);
+
+}
+
+sub pull {
+
+ # override CRUDE's pull()
+
+ my ($self, $data) = @_;
+
+ if (defined $data) {
+
+ $self->{data} = $data;
+
+ } else {
+
+ my %stash = map { $_->id => $_ } grep { eval { $_->isa('Zabbix::API::User') } } @{$self->users};
+
+ $self->SUPER::pull;
+
+ ## no critic (ProhibitCommaSeparatedStatements)
+ # restore stashed items that have been removed by pulling
+ $self->users(
+ [map {
+ { %{$_},
+ user =>
+ $stash{$_->{userid}} // Zabbix::API::User->new(root => $self->{root},
+ data => { userid => $_->{userid} })->pull
+ }
+ }
+ @{$self->users}]
+ );
+ ## use critic
+
+ }
+
+ return $self;
+
+}
+
+1;
+__END__
+=pod
+
+=head1 NAME
+
+Zabbix::API::UserGroup -- Zabbix usergroup objects
+
+=head1 SYNOPSIS
+
+ use Zabbix::API::UserGroup;
+
+ my $group = $zabbix->fetch(...);
+
+ $group->delete;
+
+=head1 DESCRIPTION
+
+Handles CRUD for Zabbix usergroup objects.
+
+This is a very simple subclass of C<Zabbix::API::CRUDE>. Only the
+required methods are implemented (and in a very simple fashion on top
+of that).
+
+=head1 METHODS
+
+=over 4
+
+=item name()
+
+Accessor for the usergroup's name (the "name" attribute); returns the
+empty string if no name is set, for instance if the usergroup has not
+been created on the server yet.
+
+=item users()
+
+Mutator for the usergroup's users.
+
+=item push()
+
+This method handles extraneous C<< user => Zabbix::API::User >>
+attributes in the users array, transforming them into C<userid>
+attributes, and pushing the users to the server if they don't exist
+already. The original user attributes are kept but hidden from the
+C<CRUDE> C<push> method, and restored after the C<pull> method is
+called.
+
+This means you can put C<Zabbix::API::User> objects in your data and
+the module will Do The Right Thing (assuming you agree with my
+definition of the Right Thing). Users that have been created this way
+will not be removed from the server if they are removed from the
+graph, however.
+
+Overriden from C<Zabbix::API::CRUDE>.
+
+=back
+
+=head1 SEE ALSO
+
+L<Zabbix::API::CRUDE>.
+
+=head1 AUTHOR
+
+Fabrice Gabolde <fabrice.gabolde at uperto.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2013 SFR
+
+This library is free software; you can redistribute it and/or modify it under
+the terms of the GPLv3.
+
+=cut
diff --git a/t/connect-and-fetch.t b/t/connect-and-fetch.t
index bda6779..1202986 100644
--- a/t/connect-and-fetch.t
+++ b/t/connect-and-fetch.t
@@ -3,7 +3,7 @@ use Test::Exception;
if ($ENV{ZABBIX_SERVER}) {
- plan tests => 9;
+ plan tests => 11;
} else {
@@ -28,7 +28,7 @@ dies_ok(sub { $zabber->query(method => 'item.get',
key_ => 'system.uptime' } }) },
'... and querying Zabbix with no auth cookie fails (assuming no API access is given to the public)');
-eval { $zabber->login(user => 'api_access', password => 'api') };
+eval { $zabber->login(user => 'apiuser', password => 'apipass') };
ok($zabber->cookie,
'... and authenticating with correct login/pw succeeds');
@@ -38,6 +38,13 @@ ok($zabber->query(method => 'item.get',
key_ => 'system.uptime' } }),
'... and querying Zabbix with auth cookie succeeds (assuming API access given to this user)');
+ok($zabber->fetch_single('Item', params => { itemids => [ 18496 ] }),
+ '... and fetch_single does not complain when getting a unique item');
+
+throws_ok(sub { $zabber->fetch_single('Item', params => { itemids => [ 18496, 18502] }) },
+ qr/Too many results for 'fetch_single': expected 0 or 1, got \d+/,
+ '... and fetch_single throws an exception when fetching an item that is not unique');
+
TODO: {
local $TODO = 'user.logout is not documented *at all*';
diff --git a/t/usergroups.t b/t/usergroups.t
new file mode 100644
index 0000000..fd3844e
--- /dev/null
+++ b/t/usergroups.t
@@ -0,0 +1,104 @@
+use strict;
+use warnings;
+use 5.010;
+
+use Test::More;
+use Test::Exception;
+use Data::Dumper;
+
+use Zabbix::API;
+use Zabbix::API::User;
+
+use lib 't/lib';
+use Zabbix::API::TestUtils;
+
+if ($ENV{ZABBIX_SERVER}) {
+
+ plan tests => 21;
+
+} else {
+
+ plan skip_all => 'Needs an URL in $ENV{ZABBIX_SERVER} to run tests.';
+
+}
+
+use_ok('Zabbix::API::UserGroup');
+
+my $zabber = Zabbix::API::TestUtils::canonical_login;
+
+ok(my $default = $zabber->fetch('UserGroup', params => { search => { name => 'API access' } })->[0],
+ '... and a usergroup known to exist can be fetched');
+
+isa_ok($default, 'Zabbix::API::UserGroup',
+ '... and that usergroup');
+
+ok($default->created,
+ '... and it returns true to existence tests');
+
+my $usergroup = Zabbix::API::UserGroup->new(root => $zabber,
+ data => { name => 'Mad Cats' });
+
+isa_ok($usergroup, 'Zabbix::API::UserGroup',
+ '... and a usergroup created manually');
+
+lives_ok(sub { $usergroup->push }, '... and pushing a new usergroup works');
+
+ok($usergroup->created, '... and the pushed usergroup returns true to existence tests (id is '.$usergroup->id.')');
+
+$usergroup->data->{name} = 'Mad Unicorns';
+
+$usergroup->push;
+
+is($usergroup->data->{name}, 'Mad Unicorns',
+ '... and pushing a modified usergroup updates its data on the server');
+
+# testing update by collision
+my $same_usergroup = Zabbix::API::UserGroup->new(root => $zabber,
+ data => { name => 'Mad Unicorns' });
+
+lives_ok(sub { $same_usergroup->push }, '... and pushing an identical usergroup works');
+
+ok($same_usergroup->created, '... and the pushed identical usergroup returns true to existence tests');
+
+is($same_usergroup->id, $usergroup->id, '... and the identical usergroup has the same id ('.$usergroup->id.')');
+
+# is_deeply($usergroup->users, [], '... and the newly-created usergroup contains no users');
+
+# my $user = Zabbix::API::User->new(root => $zabber,
+# data => { alias => 'luser',
+# name => 'Louis',
+# surname => 'User' });
+
+# $usergroup->users([ { user => $user } ]);
+
+# lives_ok(sub { $usergroup->push }, '... and adding a user works');
+# $usergroup->pull;
+
+# is_deeply([ map { $_->id } @{$usergroup->users} ], [ $user->id ],
+# '... and the user is on the server now');
+
+# $usergroup->users([ { userid => $user->id } ]);
+
+# lives_ok(sub { $usergroup->push }, '... and adding a user by id works');
+# $usergroup->pull;
+
+# is_deeply([ map { $_->id } @{$usergroup->users} ], [ $user->id ],
+# '... and the user is on the server now');
+
+# is_deeply([ map { $_->id } @{$user->usergroups} ], [ $usergroup->id ],
+# '... and the user in the usergroup has a usergroup now');
+
+# lives_ok(sub { $usergroup->delete }, '... and deleting a usergroup works');
+
+ok(!$usergroup->created,
+ '... and deleting a usergroup removes it from the server');
+
+ok(!$same_usergroup->created,
+ '... and the identical usergroup is removed as well') or $same_usergroup->delete;
+
+# is_deeply($user->usergroups, [],
+# '... and the user in the usergroup has no usergroup now');
+
+# $user->delete;
+
+eval { $zabber->logout };
diff --git a/t/users.t b/t/users.t
new file mode 100644
index 0000000..0a91b43
--- /dev/null
+++ b/t/users.t
@@ -0,0 +1,89 @@
+use strict;
+use warnings;
+use 5.010;
+
+use Test::More;
+use Test::Exception;
+use Data::Dumper;
+
+use Zabbix::API;
+
+use lib 't/lib';
+use Zabbix::API::TestUtils;
+
+if ($ENV{ZABBIX_SERVER}) {
+
+ plan tests => 18;
+
+} else {
+
+ plan skip_all => 'Needs an URL in $ENV{ZABBIX_SERVER} to run tests.';
+
+}
+
+use_ok('Zabbix::API::User');
+
+my $zabber = Zabbix::API::TestUtils::canonical_login;
+
+ok(my $default = $zabber->fetch('User', params => { search => { alias => $ENV{ZABBIX_API_USER} } })->[0],
+ '... and a user known to exist can be fetched');
+
+isa_ok($default, 'Zabbix::API::User',
+ '... and that user');
+
+ok($default->created,
+ '... and it returns true to existence tests');
+
+my $user = Zabbix::API::User->new(root => $zabber,
+ data => { alias => 'luser',
+ name => 'Louis',
+ surname => 'User' });
+
+isa_ok($user, 'Zabbix::API::User',
+ '... and a user created manually');
+
+lives_ok(sub { $user->push }, '... and pushing a new user works');
+
+ok($user->created, '... and the pushed user returns true to existence tests (id is '.$user->id.')');
+
+$user->data->{name} = 'Louise';
+
+$user->push;
+
+is($user->data->{name}, 'Louise',
+ '... and pushing a modified user updates its data on the server');
+
+# testing update by collision
+my $same_user = Zabbix::API::User->new(root => $zabber,
+ data => { alias => 'luser',
+ name => 'Loki',
+ surname => 'Usurper' });
+
+lives_ok(sub { $same_user->push }, '... and pushing an identical user works');
+
+ok($same_user->created, '... and the pushed identical user returns true to existence tests');
+
+$user->pull;
+
+is($user->data->{name}, 'Loki',
+ '... and the modifications on the identical user are pushed');
+
+is($same_user->id, $user->id, '... and the identical user has the same id ('.$user->id.')');
+
+is_deeply($user->usergroups, [], '... and the newly-created user belongs to no groups');
+
+lives_ok(sub { $user->add_to_usergroup('Guests') },
+ '... and adding a user to a usergroup works');
+
+is_deeply([ map { $_->data->{name} } @{$user->usergroups} ], ['Guests'],
+ '... and the newly-created user can be added to groups');
+
+lives_ok(sub { $user->delete }, '... and deleting a user works');
+
+ok(!$user->created,
+ '... and deleting a user removes it from the server');
+
+ok(!$same_user->created,
+ '... and the identical user is removed as well') or $same_user->delete;
+
+eval { $zabber->logout };
--
Abstraction layer over the JSON-RPC API provided by Zabbix
More information about the Pkg-perl-cvs-commits
mailing list