Improvements to the VICI Perl bindings by Andreas Hofmeister

- Switch.pm, which was implemented as a source filter, has been deprecated in
  Perl 5.10 and was later removed from the core modules in Perl 5.14 or so.

  Unfortunately, its replacement, the given/when/default construct, has since
  been downgraded to "experimental" status because of problems with the underlying
  "smart-match" operator.

  Thus, as of Perl 5.22, Perl still has no actually usable "switch"-like construct.

  So just use boring, old and ugly "if/elsif/else" constructs instead, which are
  compatible with almost any Perl version.

- None of the Perl modules here does anything that would require "AutoLoader".

- "Exporter" can be used to export plain functions into another modules name
  space. But the things that were exported here are meant to be called as
  methods.  In this case, it is neither necessary nor advisable to export those
  symbols.

  Just export nothing (the POD documentation already said so).

- It is usually the calling script that enables (or does not enable) warnings
  globally. When a module says "use warnings;" however, the caller looses control
  over what warnings should be enabled in that module.
This commit is contained in:
Andreas Hofmeister 2015-12-18 14:17:57 +01:00 committed by Andreas Steffen
parent 2d9c68b8a8
commit a073e4c95e
4 changed files with 127 additions and 189 deletions

View File

@ -1,17 +1,8 @@
package Vici::Message; package Vici::Message;
require Exporter;
use AutoLoader qw(AUTOLOAD);
our @ISA = qw(Exporter);
our @EXPORT = qw(
new, from_data, hash, encode, raw, result
);
our $VERSION = '0.9'; our $VERSION = '0.9';
use strict; use strict;
use warnings;
use Switch;
use Vici::Transport; use Vici::Transport;
use constant { use constant {
@ -85,52 +76,46 @@ sub parse {
(my $key, $data) = unpack('C/a*a*', $data); (my $key, $data) = unpack('C/a*a*', $data);
switch ($type) if ( $type == KEY_VALUE )
{ {
case KEY_VALUE (my $value, $data) = unpack('n/a*a*', $data);
{ $hash->{$key} = $value;
(my $value, $data) = unpack('n/a*a*', $data); }
$hash->{$key} = $value; elsif ( $type == SECTION_START )
} {
case SECTION_START my %section = ();
{ $data = parse($data, \%section);
my %section = (); $hash->{$key} = \%section;
$data = parse($data, \%section); }
$hash->{$key} = \%section; elsif ( $type == LIST_START )
} {
case LIST_START my @list = ();
{ my $more = 1;
my @list = ();
my $more = 1;
while (length($data) > 0 and $more) while (length($data) > 0 and $more)
{
(my $type, $data) = unpack('Ca*', $data);
if ( $type == LIST_ITEM )
{ {
(my $type, $data) = unpack('Ca*', $data); (my $value, $data) = unpack('n/a*a*', $data);
switch ($type) push(@list, $value);
{ }
case LIST_ITEM elsif ( $type == LIST_END )
{ {
(my $value, $data) = unpack('n/a*a*', $data); $more = 0;
push(@list, $value); $hash->{$key} = \@list;
} }
case LIST_END else
{ {
$more = 0; die "message parsing error: ", $type, "\n"
$hash->{$key} = \@list;
}
else
{
die "message parsing error: ", $type, "\n"
}
}
} }
} }
else }
{ else
die "message parsing error: ", $type, "\n" {
} die "message parsing error: ", $type, "\n"
} }
} }
return $data; return $data;
} }
@ -141,31 +126,28 @@ sub encode_hash {
while ( (my $key, my $value) = each %$hash ) while ( (my $key, my $value) = each %$hash )
{ {
switch (ref($value)) if ( ref($value) eq 'HASH' )
{ {
case 'HASH' $enc .= pack('CC/a*', SECTION_START, $key);
{ $enc .= encode_hash($value);
$enc .= pack('CC/a*', SECTION_START, $key); $enc .= pack('C', SECTION_END);
$enc .= encode_hash($value); }
$enc .= pack('C', SECTION_END); elsif ( ref($value) eq 'ARRAY' )
} {
case 'ARRAY' $enc .= pack('CC/a*', LIST_START, $key);
{
$enc .= pack('CC/a*', LIST_START, $key);
foreach my $item (@$value) foreach my $item (@$value)
{
$enc .= pack('Cn/a*', LIST_ITEM, $item);
}
$enc .= pack('C', LIST_END);
}
else
{ {
$enc .= pack('CC/a*n/a*', KEY_VALUE, $key, $value); $enc .= pack('Cn/a*', LIST_ITEM, $item);
} }
$enc .= pack('C', LIST_END);
}
else
{
$enc .= pack('CC/a*n/a*', KEY_VALUE, $key, $value);
} }
} }
return $enc; return $enc;
} }
sub raw_hash { sub raw_hash {
@ -185,38 +167,35 @@ sub raw_hash {
} }
$raw .= $key; $raw .= $key;
switch (ref($value)) if ( ref($value) eq 'HASH' )
{ {
case 'HASH' $raw .= '{' . raw_hash($value) . '}';
{ }
$raw .= '{' . raw_hash($value) . '}'; elsif ( ref($value) eq 'ARRAY' )
} {
case 'ARRAY' my $first_item = 1;
{ $raw .= '[';
my $first_item = 1;
$raw .= '[';
foreach my $item (@$value) foreach my $item (@$value)
{
if ($first_item)
{
$first_item = 0;
}
else
{
$raw .= ' ';
}
$raw .= $item;
}
$raw .= ']';
}
else
{ {
$raw .= '=' . $value; if ($first_item)
{
$first_item = 0;
}
else
{
$raw .= ' ';
}
$raw .= $item;
} }
$raw .= ']';
}
else
{
$raw .= '=' . $value;
} }
} }
return $raw; return $raw;
} }
1; 1;

View File

@ -1,17 +1,8 @@
package Vici::Packet; package Vici::Packet;
require Exporter;
use AutoLoader qw(AUTOLOAD);
our @ISA = qw(Exporter);
our @EXPORT = qw(
new, request, register, unregister, streamed_request
);
our $VERSION = '0.9'; our $VERSION = '0.9';
use strict; use strict;
use warnings;
use Switch;
use Vici::Message; use Vici::Message;
use Vici::Transport; use Vici::Transport;
@ -45,21 +36,18 @@ sub request {
my $response = $self->{'Transport'}->receive(); my $response = $self->{'Transport'}->receive();
my ($type, $data) = unpack('Ca*', $response); my ($type, $data) = unpack('Ca*', $response);
switch ($type) if ( $type == CMD_RESPONSE )
{ {
case CMD_RESPONSE return Vici::Message->from_data($data);
{ }
return Vici::Message->from_data($data); elsif ( $type == CMD_UNKNOWN )
} {
case CMD_UNKNOWN die "unknown command '", $command, "'\n"
{ }
die "unknown command '", $command, "'\n" else
} {
else die "invalid response type\n"
{ }
die "invalid response type\n"
}
};
} }
sub register { sub register {
@ -70,21 +58,18 @@ sub register {
my $response = $self->{'Transport'}->receive(); my $response = $self->{'Transport'}->receive();
my ($type, $data) = unpack('Ca*', $response); my ($type, $data) = unpack('Ca*', $response);
switch ($type) if ( $type == EVENT_CONFIRM )
{ {
case EVENT_CONFIRM return
{ }
return elsif ( $type == EVENT_UNKNOWN )
} {
case EVENT_UNKNOWN die "unknown event '", $event, "'\n"
{ }
die "unknown event '", $event, "'\n" else
} {
else die "invalid response type\n"
{ }
die "invalid response type\n"
}
};
} }
sub unregister { sub unregister {
@ -95,21 +80,18 @@ sub unregister {
my $response = $self->{'Transport'}->receive(); my $response = $self->{'Transport'}->receive();
my ($type, $data) = unpack('Ca*', $response); my ($type, $data) = unpack('Ca*', $response);
switch ($type) if ( $type == EVENT_CONFIRM )
{ {
case EVENT_CONFIRM return
{ }
return elsif ( $type == EVENT_UNKNOWN )
} {
case EVENT_UNKNOWN die "unknown event '", $event, "'\n"
{ }
die "unknown event '", $event, "'\n" else
} {
else die "invalid response type\n"
{ }
die "invalid response type\n"
}
};
} }
sub streamed_request { sub streamed_request {
@ -123,33 +105,30 @@ sub streamed_request {
my $more = 1; my $more = 1;
my @list = (); my @list = ();
while ($more) while ($more)
{ {
my $response = $self->{'Transport'}->receive(); my $response = $self->{'Transport'}->receive();
my ($type, $data) = unpack('Ca*', $response); my ($type, $data) = unpack('Ca*', $response);
switch ($type) if ( $type == EVENT )
{ {
case EVENT (my $event_name, $data) = unpack('C/a*a*', $data);
{
(my $event_name, $data) = unpack('C/a*a*', $data);
if ($event_name eq $event) if ($event_name eq $event)
{ {
my $msg = Vici::Message->from_data($data); my $msg = Vici::Message->from_data($data);
push(@list, $msg); push(@list, $msg);
} }
} }
case CMD_RESPONSE elsif ( $type == CMD_RESPONSE )
{ {
$self->unregister($event); $self->unregister($event);
$more = 0; $more = 0;
} }
else else
{ {
$self->unregister($event); $self->unregister($event);
die "invalid response type\n"; die "invalid response type\n";
}
} }
} }
return \@list; return \@list;

View File

@ -1,20 +1,8 @@
package Vici::Session; package Vici::Session;
require Exporter;
use AutoLoader qw(AUTOLOAD);
our @ISA = qw(Exporter);
our @EXPORT = qw(
new, version, stats, reload_settings, initiate, terminate, install,
uninstall, list_sas, list_policies, list_conns, get_conns, list_certs,
list_authorities, get_authorities, load_conn, unload_conn, load_cert,
load_key, load_shared, clear_creds, load_authority, unload_authority,
load_pool, unload_pool, get_pools, get_algorithms
);
our $VERSION = '0.9'; our $VERSION = '0.9';
use strict; use strict;
use warnings;
use Vici::Packet; use Vici::Packet;
use Vici::Message; use Vici::Message;

View File

@ -1,16 +1,8 @@
package Vici::Transport; package Vici::Transport;
require Exporter;
use AutoLoader qw(AUTOLOAD);
our @ISA = qw(Exporter);
our @EXPORT = qw(
new, send, receive
);
our $VERSION = '0.9'; our $VERSION = '0.9';
use strict; use strict;
use warnings;
sub new { sub new {
my $class = shift; my $class = shift;