File Coverage

blib/lib/MooseX/DataModel.pm

Criterion	Covered	Total	%
statement	95	96	98.9
branch	34	40	85.0
condition	11	12	91.6
subroutine	13	13	100.0
pod	3	4	75.0
total	156	165	94.5

package MooseX::DataModel {
  use Moose;
  use Moose::Exporter;
  use Moose::Util::TypeConstraints qw/find_type_constraint register_type_constraint coerce subtype from via/;
  our $VERSION = "1.01";

  Moose::Exporter->setup_import_methods(
    with_meta => [ qw/ key array object / ],
    also => [ 'Moose', 'Moose::Util::TypeConstraints' ],
  );

  sub key {
    my ($meta, $key_name, %properties) = @_;

    die "Must specify isa in an object declaration" if (not defined $properties{isa});

    $properties{ is } = 'ro';

    my $location = delete $properties{ location };
    $properties{ init_arg } = $location if ($location);

    my $type = $properties{isa};

    if (my $constraint = find_type_constraint($type)) {
      if ($constraint->isa('Moose::Meta::TypeConstraint::Class') and
          (not $constraint->has_coercion or
           not $constraint->coercion->has_coercion_for_type('HashRef'))
         ){
        coerce $type, from 'HashRef', via {
          $type->new(%$_)
        }
      }

      if ($constraint->has_coercion){
        $properties{ coerce } = 1
      }
    } else {
      die "FATAL: Didn't find a type constraint for $key_name";
    }

    $meta->add_attribute($key_name, \%properties);
  }

  sub _alias_for_paramtype {
    my $name = shift;
    $name =~ s/\[(.*)]$/Of$1/;
    return $name;
  }

  sub object {
    my ($meta, $key_name, %properties) = @_;

    die "Must specify isa in an object declaration" if (not defined $properties{isa});

    my $location = delete $properties{ location };
    $properties{ init_arg } = $location if ($location);

    my ($inner_type, $type, $type_alias);

    if (ref($properties{isa})) {
      $type = find_type_constraint($properties{isa});
      die "FATAL: Didn't find a type constraint for $key_name" if (not defined $type);

      $type_alias = _alias_for_paramtype('HashRef[' . $properties{isa}->name . ']');
      $type = Moose::Meta::TypeConstraint::Parameterized->new(
        name   => $type_alias,
        parent => find_type_constraint('HashRef'),
        type_parameter => $properties{isa}
      );
      register_type_constraint($type);

      $inner_type = $properties{isa}->name;
    } else {
      $inner_type = $properties{isa};
      $type_alias = _alias_for_paramtype("HashRef[$inner_type]");

      $type = find_type_constraint("HashRef[$inner_type]");

      if (not defined $type) {
        subtype $type_alias, { as => "HashRef[$inner_type]" };
      }
    }

    my $key_isa = delete $properties{key_isa};

    my $type_constraint = find_type_constraint($inner_type);
    if (defined $type_constraint and not $type_constraint->has_coercion) {
      coerce $inner_type, from 'HashRef', via {
        return $inner_type->new(%$_);
      }
    }

    if (not find_type_constraint($type_alias)->has_coercion) {
      coerce $type_alias, from 'HashRef', via {
        my $uncoerced = $_;
        my $coerce_routine = $type_constraint;
        return { map { ($_ => $coerce_routine->coerce($uncoerced->{$_}, $_[1])) } keys %$uncoerced }
      };
    }

    $properties{ coerce } = 1;
    $properties{ isa } = $type_alias;
    $properties{ is } = 'ro';

    $meta->add_attribute($key_name, \%properties);
  }

  sub array {
    my ($meta, $key_name, %properties) = @_;

    die "Must specify isa in an array declaration" if (not defined $properties{isa});

    my $location = delete $properties{ location };
    $properties{ init_arg } = $location if ($location);

    my ($inner_type, $type, $type_alias);

    if (ref($properties{isa})) {
      $type = find_type_constraint($properties{isa});
      die "FATAL: Didn't find a type constraint for $key_name" if (not defined $type);

      $type_alias = _alias_for_paramtype('ArrayRef[' . $properties{isa}->name . ']');
      $type = Moose::Meta::TypeConstraint::Parameterized->new(
        name   => $type_alias,
        parent => find_type_constraint('ArrayRef'),
        type_parameter => $properties{isa}
      );
      register_type_constraint($type);

      $inner_type = $properties{isa}->name;
      $properties{ isa } = $type;
    } else {
      $inner_type = $properties{isa};
      $type_alias = _alias_for_paramtype("ArrayRef[$inner_type]");

      $type = find_type_constraint($type_alias);

      if (not defined $type) {
        subtype $type_alias, { as => "ArrayRef[$inner_type]" };
      }
      $properties{ isa } = $type_alias;
    }

    my $type_constraint = find_type_constraint($inner_type);
    if (defined $type_constraint and not $type_constraint->has_coercion) {
      coerce $inner_type, from 'HashRef', via {
        return $inner_type->new(%$_);
      }
    }

    if (not find_type_constraint($type_alias)->has_coercion) {
      coerce $type_alias, from 'ArrayRef', via {
        my $type_c = find_type_constraint($inner_type);
        my $parent = $_[1];
        if ($type_c->has_coercion) {
          return [ map { $type_c->coerce($_) } @$_ ]
        } else {
          return [ map { $_ } @$_ ]
        }
      };
    }

    $properties{ coerce } = 1;
    $properties{ is } = 'ro';
    $meta->add_attribute($key_name, \%properties);
  }

  sub new_from_json {
    my ($class, $json) = @_;
    require JSON::MaybeXS;
    return $class->new(JSON::MaybeXS::decode_json($json));
  }

}

1;
### main pod documentation begin ###

=encoding UTF-8

=head1 NAME

MooseX::DataModel - Create object models from datastructures

=head1 SYNOPSIS

  package MyModel {
    use MooseX::DataModel;

    version => (isa => 'Int');
    description => (isa => 'Str', required => 1);

    sub do_something {
      my $self = shift;
      if(shift->version == 3) ...
    }
    # Moose is imported for your convenience
    has foo => (...);
  }

  my $obj = MyModel->MooseX::DataModel::new_from_json('{"version":3,"description":"a json document"}');
  # $obj is just a plain old Moose object
  print $obj->version;

  my $obj = MyModel->new({ version => 6, description => 'A description' });
  $obj->do_something;

=head1 DESCRIPTION

Working with "plain datastructures" (nested hashrefs, arrayrefs and scalars) that come from other
systems can be a pain.

Normally those datastructures are not arbitrary: they have some structure to them: most of them
come to express "object like" things. MooseX::DataModel tries to make converting these datastructures
into objects in an easy, declarative fashion.

Lots of times

MooseX::DataModel also helps you validate the datastructures. If you get an object back, it conforms
to your object model. So if you declare a required key, and the passed datastructure doesn't contain
it: you will get an exception. If the type of the key passed is different from the one declared: you
get an exception. The advantage over using a JSON validator, is that after validation you still have
your original datastructure. With MooseX::DataModel you get full-blown objects, to which you can
attach logic.

=head1 USAGE

Just use MooseX::DataModel in a class. It will import three keywords C<key>, C<array>, C<object>.
With these keywords we can specify attributes in our class

=head2 key attribute => (isa => $type, [required => 1, location => $location])

Declares an attribute named "attribute" that is of type $type. $type can be a string with a
Moose type constraint (Str, Int), or any user defined subtype (MyPositiveInt). Also it can
be the name of a class. If it's a class, MooseX::DataModel will coerce a HashRef to the
specified class (using the HashRef as the objects' constructor parameters).

  package VersionObject {
    use MooseX::DataModel;
    key major => (isa => 'Int');
    key minor => (isa => 'Int');
  }
  package MyObject {
    use MooseX::DataModel;
    key version => (isa => 'VersionObject');
  }

  my $o = MyObject->MooseX::DataModel::new_from_json('{"version":{"major":3,"minor":5}}');
  # $o->version->isa('VersionObject') == true
  print $o->version->major;
  # prints 3
  print $o->version->minor;
  # prints 5

required => 1: declare that this attribute is obliged to be set in the passed datastructure

  package MyObject {
    use MooseX::DataModel;
    key version => (isa => 'Int', required => 1);
  }
  my $o = MyObject->MooseX::DataModel::new_from_json('{"document_version":3}');
  # exception, since "version" doesn't exist

  my $o = MyObject->MooseX::DataModel::new_from_json('{"version":3}');
  print $o->version;
  # prints 3

location => $location: $location is a string that specifies in what key of the datastructure to
find the attributes' value:

  package MyObject {
    use MooseX::DataModel;
    key Version => (isa => 'Int', location => 'document_version');
  }
  my $o = MyObject->MooseX::DataModel::new_from_json('{"document_version":3}');
  print $o->Version;
  # prints 3

=head2 array attribute => (isa => $type, [required => 1, location => $location])

Declares an attribute that holds an array whose elements are of a certain type.

$type, required and location work as in "key"

  package MyObject {
    use MooseX::DataModel;
    key name => (isa => 'Str', required => 1);
    array likes => (isa => 'Str', required => 1, location => 'his_tastes');
  }
  my $o = MyObject->MooseX::DataModel::new_from_json('{"name":"pplu":"his_tastes":["cars","ice cream"]}");
  print $o->likes->[0];
  # prints 'cars'

=head2 object attribute => (isa => $type, [required => 1, location => $location])

Declares an attribute that holds an hash ("JS object") whose elements are of a certain type. This
is useful when in the datastructure you have a hash with arbitrary keys (for known keys you would
describe an object with the "key" keyword.

$type, required and location work as in "key"

  package MyObject {
    use MooseX::DataModel;
    key name => (isa => 'Str', required => 1);
    object likes => (isa => 'Int', required => 1, location => 'his_tastes');
  }
  my $o = MyObject->MooseX::DataModel::new_from_json('{"name":"pplu":"his_tastes":{"cars":9,"ice cream":6}}");
  print $o->likes->{ cars };
  # prints 9

=head1 METHODS

=head2 new

Your class gets the default Moose constructor. You can pass it a hashref with the datastructure

  my $o = MyObject->new({ name => 'pplu', his_tastes => { cars => 9, 'ice cream' => 6 }});

=head2 MooseX::DataModel::from_json

There is a convenience constructor for parsing a JSON (so you don't have to do it from the outside)

  my $o = MyObject->MooseX::DataModel::from_json("JSON STRING");

=head1 INNER WORKINGS

All this can be done with plain Moose, using subtypes, coercions and declaring the
appropiate attributes (that's what really happens on the inside, although it's not guaranteed
to stay that way forever). MooseX::DataModel just wants to help you write less code :)

=head1 BUGS and SOURCE

The source code is located here: https://github.com/pplu/moosex-datamodel

Please report bugs to:

=head1 COPYRIGHT and LICENSE

    Copyright (c) 2015 by CAPSiDE

    This code is distributed under the Apache 2 License. The full text of the license can be found in the LICENSE file included with this module.

=cut