# I'm an abstract base class
package Net::DHCP::Control::Generic;
use Net::DHCP::Control::ServerHandle;
use Net::DHCP::Control ':DEFAULT', 'TP_UNSPECIFIED';
%OPTS =
(new => { host => '127.0.0.1',
port => scalar(Net::DHCP::Control::DHCP_PORT()),
key_name => undef,
key_type => undef,
key => undef,
attrs => {},
handle => undef,
handle_factory => 'Net::DHCP::Control::ServerHandle',
callback => undef,
callback_data => undef,
},
);
# Initialize the dhcpctl library when this module is loaded
Net::DHCP::Control::initialize();
sub croak {
require Carp;
*croak = \&Carp::croak;
shift;
for (@_) {
s/%ERR/$Net::DHCP::Control::STATUS/g;
}
goto &croak;
}
sub new {
my ($base, %opts) = @_;
my $class = ref $base || $base;
$base->validate_options(\%opts);
my $authenticator;
my $handle = delete($opts{handle})
|| $opts{handle_factory}->new($opts{handle_factory}->select_opts(\%opts, 'new'))
|| return;
my $objkind = $ {"$class\::KIND"}
or $base->croak("Missing $class\::KIND variable; aborting");
my $object = Net::DHCP::Control::new_object($handle, $objkind)
or return;
if ($opts{callback}) {
Net::DHCP::Control::set_callback($object, $opts{callback}, $opts{callback_data})
or return;
}
my $self = { OBJ => $object,
KIND => $objkind,
HANDLE => $handle,
OPTS => \%opts,
AUTH => $authenticator,
CLASS => $class,
};
while (my ($name, $val) = each %{$opts{attrs}}) {
my $type = $class->typeof_attr($name) || TP_UNSPECIFIED;
Net::DHCP::Control::set_value($object, $name, $val, $type);
}
Net::DHCP::Control::open_object($object, $handle) or return;
unless ($opts{callback}) {
Net::DHCP::Control::wait_for_completion($object) or return;
}
bless $self => $class;
}
for my $key (qw(obj kind handle opts auth class lazy)) {
my $methname = $key;
*$methname = sub { $_[0]->{uc $methname} };
}
sub get {
my ($self, $name, $type) = @_;
$type ||= $self->typeof_attr($name);
my $z = Net::DHCP::Control::get_value($self->obj, $name, $type);
$z;
}
sub refresh {
my ($self) = @_;
Net::DHCP::Control::object_refresh($self);
}
sub set {
my ($self, $name, $value, $type) = @_;
$type ||= $self->typeof_attr($name);
Net::DHCP::Control::set_value($self->obj, $name, $value, $type) or return;
return 1 if $self->lazy;
$self->update;
}
sub update {
my $self = shift;
Net::DHCP::Control::object_update($self->handle, $self->obj) or return;
Net::DHCP::Control::wait_for_completion($self->obj) or return;
}
sub typeof_attr {
my ($self, $name) = @_;
my $class = ref $self ? $self->class : $self;
$ {"$class\::ATTRS"}{$name};
}
sub attrs {
my ($self, $name) = @_;
my $class = ref $self ? $self->class : $self;
keys % {"$class\::ATTRS"};
}
# return all available information about an object as a hash
sub get_all {
my $self = shift;
my %result;
for my $attr ($self->attrs) {
$result{$attr} = $self->get($attr);
}
%result;
}
sub validate_options {
my $base = shift;
my $class = ref $base || $base;
my $meth = (caller(1))[3]; # Subroutine name
$meth =~ s/.*:://;
my $op = shift;
my $ok = do { no strict 'refs'; $ {"$class\::OPTS"}{$meth} };
my @EXTRA;
for my $k (keys %$op) {
unless (exists $ok->{$k}) {
push @EXTRA, $k;
}
}
if (@EXTRA) {
my $options = @EXTRA > 1 ? 'options' : 'option';
$class->croak("Unknown $options '@EXTRA' to method $class\::$meth");
}
my @MISSING;
for my $k (keys %$ok) {
my $default_value = $ok->{$k};
my $is_required = defined($default_value)
&& $default_value eq "REQUIRED";
if (not exists $op->{$k}) {
if ($is_required) {
push @MISSING, $k;
} else {
$op->{$k} = $default_value;
}
}
}
if (@MISSING) {
my $options = @MISSING > 1 ? 'options' : 'option';
$class->croak("Mandatory $options '@MISSING' missing in call to method $class\::$meth");
}
}
sub select_opts {
my ($self, $opts, $meth) = @_;
my $class = ref $self || $self;
my $ok = do { no strict 'refs'; $ {"$class\::OPTS"}{$meth} };
my %selected;
for my $k (keys %$ok) {
$selected{$k} = $opts->{$k};
}
%selected;
}
sub DESTROY {
my $handle = $_[0]{OBJ};
if ($handle) {
Net::DHCP::Control::deallocate($handle);
}
}
1;