File Coverage

blib/lib/Net/Duo/Object.pm

Criterion	Covered	Total	%
statement	125	133	93.9
branch	39	50	78.0
condition	4	5	80.0
subroutine	16	17	94.1
pod	5	5	100.0
total	189	210	90.0

# Helper base class for Duo objects.
#
# The Duo API contains a variety of objects, represented as JSON objects with
# multiple fields.  This objects often embed other objects inside them.  To
# provide a nice Perl API with getters, setters, and commit and delete methods
# on individual objects, we want to wrap these Duo REST API objects in Perl
# classes.
#
# This module serves as a base class for such objects and does the dirty work
# of constructing an object from decoded JSON data and building the accessors
# automatically from a field specification.

package Net::Duo::Object 1.01;

use 5.014;
use strict;
use warnings;

use Carp qw(croak);
use JSON ();
use Sub::Install;

# Helper function to parse the data for a particular field specification.
#
# $spec - The field specification (a value in the hash from _fields)
#
# Returns: The type in scalar context
#          The type and then a reference to a hash of flags in array context
sub _field_type {
    my ($spec) = @_;
    my ($type, @flags);

    # If the specification is a reference, it's an array, with the first value
    # as type and the rest as flags.  Otherwise, it's a simple type.
    if (ref($spec) eq 'ARRAY') {
        ($type, @flags) = @{$spec};
    } else {
        $type = $spec;
    }

    # Return the appropriate value or values.
    return wantarray ? ($type, { map { $_ => 1 } @flags }) : $type;
}

# Helper function to do the data translation from the results of JSON parsing
# to our internal representation.  This mostly consists of converting nested
# objects into proper objects, but it also makes a deep copy of the data.
#
# This is broken into a separate function so that it can be used by both new()
# and commit().
#
# $self     - Class of object we're creating or an object of the right type
# $data_ref - Reference to parsed data from JSON
# $duo      - Net::Duo object to use for subobjects
#
# Returns: Reference to hash suitable for blessing as an object
sub _convert_data {
    my ($self, $data_ref, $duo) = @_;

    # Retrieve the field specification for this object.
    my $fields = $self->_fields;

    # Make a deep copy of the data following the field specification.
    my %result;
  FIELD:
    for my $field (keys %{$fields}) {
        next FIELD if (!exists($data_ref->{$field}));
        my $type  = _field_type($fields->{$field});
        my $value = $data_ref->{$field};
        if ($type eq 'simple') {
            $result{$field} = $value;
        } elsif ($type eq 'array') {
            $result{$field} = [@{$value}];
        } elsif (defined($value)) {
            my @objects;
            for my $object (@{$value}) {
                push(@objects, $type->new($duo, $object));
            }
            $result{$field} = \@objects;
        }
    }

    # Return the new data structure.
    return \%result;
}

# Create a new Net::Duo object.  This constructor can be inherited by all
# object classes.  It takes the decoded JSON and uses the field specification
# for the object to construct an object via deep copying.
#
# The child class must provide a static method fields() that returns a field
# specification.  See the documentation for more details.
#
# $class    - Class of object to create
# $duo      - Net::Duo object to use for further API calls on this object
# $data_ref - Object data as a reference to a hash (usually decoded from JSON)
#
# Returns: Newly-created object
sub new {
    my ($class, $duo, $data_ref) = @_;
    my $self = $class->_convert_data($data_ref, $duo);
    $self->{_duo} = $duo;
    bless($self, $class);
    return $self;
}

# Create a new object in Duo.  This constructor must be overridden by
# subclasses to pass in the additional URI parameter for the Duo API endpoint.
# It takes a reference to a hash representing the object values and returns
# the new object as an appropriately-blessed object.  Currently, no local data
# checking is performed on the provided data.
#
# The child class must provide a static method fields() that returns a field
# specification.  See the documentation for more details.
#
# $class    - Class of object to create
# $duo      - Net::Duo object to use to create the object
# $uri      - Duo endpoint to use for creation
# $data_ref - Data for new object as a reference to a hash
#
# Returns: Newly-created object
#  Throws: Net::Duo::Exception on any problem creating the object
sub create {
    my ($class, $duo, $uri, $data_ref) = @_;

    # Retrieve the field specification for this object.
    my $fields = $class->_fields;

    # Make a copy of the data and convert all boolean values.
    my %data = %{$data_ref};
  FIELD:
    for my $field (keys %data) {
        my ($type, $flags) = _field_type($fields->{$field});
        if ($flags->{boolean}) {
            $data{$field} = $data{$field} ? 'true' : 'false';
        } elsif ($flags->{zero_or_one}) {
            $data{$field} = $data{$field} ? 1 : 0;
        }
    }

    # Create the object in Duo.
    my $self = $duo->call_json('POST', $uri, \%data);

    # Add the Net::Duo object.
    $self->{_duo} = $duo;

    # Bless and return the new object.
    bless($self, $class);
    return $self;
}

# Commit changes to the object to Duo.  This method must be overridden by
# subclasses to pass in the additional URI parameter for the Duo API endpoint.
# It sends all of the fields that have been modified by setters, and then
# clears the flags that track modifications if the commit was successful.
#
# The child class must provide a static method fields() that returns a field
# specification.  See the documentation for more details.
#
# $self - Subclass of Net::Duo::Object
# $uri  - Duo endpoint to use for updates
#
# Returns: undef
#  Throws: Net::Duo::Exception on any problem modifying the object in Duo
sub commit {
    my ($self, $uri) = @_;

    # Retrieve the field specification for this object.
    my $fields = $self->_fields;

    # Iterate through the changed fields to build the data for Duo.  Remap
    # boolean fields to true or false here.
    my %data;
    for my $field (keys %{ $self->{_changed} }) {
        my ($type, $flags) = _field_type($fields->{$field});
        if ($flags->{boolean}) {
            $data{$field} = $self->{$field} ? 'true' : 'false';
        } elsif ($flags->{zero_or_one}) {
            $data{$field} = $self->{$field} ? 1 : 0;
        } else {
            $data{$field} = $self->{$field};
        }
    }

    # Modify the object in Duo.  Duo will return the resulting new object,
    # which we want to convert back to our internal representation.
    my $new_data_ref = $self->{_duo}->call_json('POST', $uri, \%data);
    $new_data_ref = $self->_convert_data($new_data_ref, $self->{_duo});

    # Duo may have changed or canonicalized the data, or someone else may have
    # changed other parts of the object, so replace all of our data with what
    # Duo now says the object looks like.  Save our private fields.  This is
    # more extensible than having a whitelist of private fields.
    delete $self->{_changed};
    for my $field (keys %{$self}) {
        next if ($field !~ m{ \A _ }xms);
        $new_data_ref->{$field} = $self->{$field};
    }
    %{$self} = %{$new_data_ref};
    return;
}

# Create all the accessor methods for the object fields.  This method is
# normally called via code outside of any method in the object class so that
# it is run when the class is first imported.
#
# The child class must provide a static method fields() that returns a field
# specification.  See the documentation for more details.
#
# $class - Class whose accessors we're initializing
#
# Returns: undef
sub install_accessors {
    my ($class) = @_;

    # Retrieve the field specification for this object.
    my $fields = $class->_fields;

    # Create an accessor for each one.
    for my $field (keys %{$fields}) {
        my ($type, $flags) = _field_type($fields->{$field});

        # For fields containing arrays, return a copy of the array instead
        # of the reference to the internal data structure in the object,
        # preventing client manipulation of our internals.
        my $code;
        if ($type eq 'simple') {
            $code = sub { my $self = shift; return $self->{$field} };
        } else {
            $code = sub {
                my $self = shift;
                return if !$self->{$field};
                return @{ $self->{$field} };
            };
        }

        # Create and install the accessor.
        my $spec = { code => $code, into => $class, as => $field };
        Sub::Install::install_sub($spec);

        # If the "set" flag is set, also generate a setter.
        if ($flags->{set}) {
            if ($type eq 'simple') {
                $code = sub {
                    my ($self, $value) = @_;
                    $self->{$field} = $value;
                    $self->{_changed}{$field} = 1;
                    return;
                };
            } else {
                $code = sub {
                    my ($self, @values) = @_;
                    $self->{$field} = [@values];
                    $self->{_changed}{$field} = 1;
                    return;
                };
            }
            $spec = { code => $code, into => $class, as => "set_$field" };
            Sub::Install::install_sub($spec);
        }
    }
    return;
}

# Returns the current contents of the object as JSON.  The json() method of
# nested objects is called to convert them in turn.
#
# $self - The object to convert to JSON
#
# Returns: JSON representation of the object using the Duo data model
sub json {
    my ($self) = @_;

    # Create a JSON encoder and decoder.
    my $json = JSON->new->utf8(1);

    # Retrieve the field specification for this object.
    my $fields = $self->_fields;

    # Iterate through the fields to build the data structure we'll convert to
    # JSON.  We have to do some data mapping and call the json() method on any
    # embedded objects.  This is unnecessarily inefficient since it converts
    # the children to JSON and then back again, purely for coding convenience.
    my %data;
  FIELD:
    for my $field (keys %{$self}) {
        next FIELD if ($field =~ m{ \A _ }xms);
        my ($type, $flags) = _field_type($fields->{$field});
        if ($type eq 'simple' || $type eq 'array') {
            if ($flags->{boolean}) {
                $data{$field} = $self->{$field} ? JSON::true : JSON::false;
            } elsif ($flags->{zero_or_one}) {
                $data{$field} = $self->{$field} ? 1 : 0;
            } else {
                $data{$field} = $self->{$field};
            }
        } else {
            my @children = map { $_->json } @{ $self->{$field} // [] };
            $data{$field} = [map { $json->decode($_) } @children];
        }
    }

    # Convert the result to JSON and return it.
    return $json->encode(\%data);
}

1;
__END__