Data-Rx/lib/Data/Rx.pm
use v5.12.0;
use warnings;
package Data::Rx 0.200008;
# ABSTRACT: perl implementation of Rx schema system
use Data::Rx::Util;
use Data::Rx::TypeBundle::Core;
#pod =head1 SYNOPSIS
#pod
#pod my $rx = Data::Rx->new;
#pod
#pod my $success = {
#pod type => '//rec',
#pod required => {
#pod location => '//str',
#pod status => { type => '//int', value => 201 },
#pod },
#pod optional => {
#pod comments => {
#pod type => '//arr',
#pod contents => '//str',
#pod },
#pod },
#pod };
#pod
#pod my $schema = $rx->make_schema($success);
#pod
#pod my $reply = $json->decode( $agent->get($http_request) );
#pod
#pod die "invalid reply" unless $schema->check($reply);
#pod
#pod =head1 COMPLEX CHECKS
#pod
#pod Note that a "schema" can be represented either as a name or as a definition.
#pod In the L</SYNOPSIS> above, note that we have both, '//str' and
#pod C<{ type =E<gt> '//int', value =E<gt> 201 }>.
#pod With the L<collection types|http://rx.codesimply.com/coretypes.html#collect>
#pod provided by Rx, you can validate many complex structures. See L</learn_types>
#pod for how to teach your Rx schema object about the new types you create.
#pod
#pod When required, see L<Data::Rx::Manual::CustomTypes> for details on creating a
#pod custom type plugin as a Perl module.
#pod
#pod =head1 SCHEMA METHODS
#pod
#pod The objects returned by C<make_schema> should provide the methods detailed in
#pod this section.
#pod
#pod =head2 check
#pod
#pod my $ok = $schema->check($input);
#pod
#pod This method just returns true if the input is valid under the given schema, and
#pod false otherwise. For more information, see C<assert_valid>.
#pod
#pod =head2 assert_valid
#pod
#pod $schema->assert_valid($input);
#pod
#pod This method will throw an exception if the input is not valid under the schema.
#pod The exception will be a L<Data::Rx::FailureSet>. This has two important
#pod methods: C<stringify> and C<failures>. The first provides a string form of the
#pod failure. C<failures> returns a list of L<Data::Rx::Failure> objects.
#pod
#pod Failure objects have a few methods of note:
#pod
#pod error_string - a human-friendly description of what went wrong
#pod stringify - a stringification of the error, data, and check string
#pod error_types - a list of types for the error; like tags
#pod
#pod data_string - a string describing where in the input the error occured
#pod value - the value found at the data path
#pod
#pod check_string - a string describing which part of the schema found the error
#pod
#pod =head1 SEE ALSO
#pod
#pod L<http://rx.codesimply.com/>
#pod
#pod =cut
sub _expand_uri {
my ($self, $str) = @_;
return $str if $str =~ /\A\w+:/;
if ($str =~ m{\A/(.*?)/(.+)\z}) {
my ($prefix, $rest) = ($1, $2);
my $lookup = $self->{prefix};
Carp::croak "unknown prefix '$prefix' in type name '$str'"
unless exists $lookup->{$prefix};
return "$lookup->{$prefix}$rest";
}
Carp::croak "couldn't understand Rx type name '$str'";
}
#pod =method new
#pod
#pod my $rx = Data::Rx->new(\%arg);
#pod
#pod This returns a new Data::Rx object.
#pod
#pod Valid arguments are:
#pod
#pod prefix - optional; a hashref of prefix pairs for type shorthand
#pod type_plugins - optional; an arrayref of type or type bundle plugins
#pod no_core_types - optional; if true, core type bundle is not loaded
#pod sort_keys - optional; see the sort_keys section.
#pod
#pod The prefix hashref should look something like this:
#pod
#pod {
#pod 'pobox' => 'tag:pobox.com,1995:rx/core/',
#pod 'skynet' => 'tag:skynet.mil,1997-08-29:types/rx/',
#pod }
#pod
#pod =cut
sub new {
my ($class, $arg) = @_;
$arg ||= {};
$arg->{prefix} ||= {};
my @plugins = @{ $arg->{type_plugins} || [] };
unshift @plugins, $class->core_bundle unless $arg->{no_core_bundle};
my $self = {
prefix => { },
handler => { },
sort_keys => !!$arg->{sort_keys},
};
bless $self => $class;
$self->register_type_plugin($_) for @plugins;
$self->add_prefix($_ => $arg->{prefix}{ $_ }) for keys %{ $arg->{prefix} };
return $self;
}
#pod =method make_schema
#pod
#pod my $schema = $rx->make_schema($schema);
#pod
#pod This returns a new schema checker method for the given Rx input. This object
#pod will have C<check> and C<assert_valid> methods to test data with.
#pod
#pod =cut
sub make_schema {
my ($self, $schema) = @_;
$schema = { type => "$schema" } unless ref $schema;
Carp::croak("no type name given") unless my $type = $schema->{type};
my $type_uri = $self->_expand_uri($type);
die "unknown type uri: $type_uri" unless exists $self->{handler}{$type_uri};
my $handler = $self->{handler}{$type_uri};
my $schema_arg = {%$schema};
delete $schema_arg->{type};
my $checker;
if (ref $handler) {
if (keys %$schema_arg) {
Carp::croak("composed type does not take check arguments");
}
$checker = $self->make_schema($handler->{'schema'});
} else {
$checker = $handler->new_checker($schema_arg, $self, $type);
}
return $checker;
}
#pod =method register_type_plugin
#pod
#pod $rx->register_type_plugin($type_or_bundle);
#pod
#pod Given a type plugin, this registers the plugin with the Data::Rx object.
#pod Bundles are expanded recursively and all their plugins are registered.
#pod
#pod Type plugins must have a C<type_uri> method and a C<new_checker> method.
#pod See L<Data::Rx::Manual::CustomTypes> for details.
#pod
#pod =cut
sub register_type_plugin {
my ($self, $starting_plugin) = @_;
my @plugins = ($starting_plugin);
PLUGIN: while (my $plugin = shift @plugins) {
if ($plugin->isa('Data::Rx::TypeBundle')) {
my %pairs = $plugin->prefix_pairs;
$self->add_prefix($_ => $pairs{ $_ }) for keys %pairs;
unshift @plugins, $plugin->type_plugins;
} else {
my $uri = $plugin->type_uri;
Carp::confess("a type plugin is already registered for $uri")
if $self->{handler}{ $uri };
$self->{handler}{ $uri } = $plugin;
}
}
}
#pod =method learn_type
#pod
#pod $rx->learn_type($uri, $schema);
#pod
#pod This defines a new type as a schema composed of other types.
#pod
#pod For example:
#pod
#pod $rx->learn_type('tag:www.example.com:rx/person',
#pod { type => '//rec',
#pod required => {
#pod firstname => '//str',
#pod lastname => '//str',
#pod },
#pod optional => {
#pod middlename => '//str',
#pod },
#pod },
#pod );
#pod
#pod =cut
sub learn_type {
my ($self, $uri, $schema) = @_;
Carp::confess("a type handler is already registered for $uri")
if $self->{handler}{ $uri };
die "invalid schema for '$uri': $@"
unless eval { $self->make_schema($schema) };
$self->{handler}{ $uri } = { schema => $schema };
}
#pod =method add_prefix
#pod
#pod $rx->add_prefix($name => $prefix_string);
#pod
#pod For example:
#pod
#pod $rx->add_prefix('.meta' => 'tag:codesimply.com,2008:rx/meta/');
#pod
#pod =cut
sub add_prefix {
my ($self, $name, $base) = @_;
Carp::confess("the prefix $name is already registered")
if $self->{prefix}{ $name };
$self->{prefix}{ $name } = $base;
}
#pod =method sort_keys
#pod
#pod $rx->sort_keys(1);
#pod
#pod When sort_keys is enabled, causes Rx checkers for //rec and //map to
#pod sort the keys before validating. This results in failures being
#pod produced in a consistent order.
#pod
#pod =cut
sub sort_keys {
my $self = shift;
$self->{sort_keys} = !!$_[0] if @_;
return $self->{sort_keys};
}
sub core_bundle {
return 'Data::Rx::TypeBundle::Core';
}
sub core_type_plugins {
my ($self) = @_;
Carp::cluck("core_type_plugins deprecated; use Data::Rx::TypeBundle::Core");
Data::Rx::TypeBundle::Core->type_plugins;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Data::Rx - perl implementation of Rx schema system
=head1 VERSION
version 0.200008
=head1 SYNOPSIS
my $rx = Data::Rx->new;
my $success = {
type => '//rec',
required => {
location => '//str',
status => { type => '//int', value => 201 },
},
optional => {
comments => {
type => '//arr',
contents => '//str',
},
},
};
my $schema = $rx->make_schema($success);
my $reply = $json->decode( $agent->get($http_request) );
die "invalid reply" unless $schema->check($reply);
=head1 PERL VERSION
This library should run on perls released even a long time ago. It should work
on any version of perl released in the last five years.
Although it may work on older versions of perl, no guarantee is made that the
minimum required version will not be increased. The version may be increased
for any reason, and there is no promise that patches will be accepted to lower
the minimum required perl.
=head1 METHODS
=head2 new
my $rx = Data::Rx->new(\%arg);
This returns a new Data::Rx object.
Valid arguments are:
prefix - optional; a hashref of prefix pairs for type shorthand
type_plugins - optional; an arrayref of type or type bundle plugins
no_core_types - optional; if true, core type bundle is not loaded
sort_keys - optional; see the sort_keys section.
The prefix hashref should look something like this:
{
'pobox' => 'tag:pobox.com,1995:rx/core/',
'skynet' => 'tag:skynet.mil,1997-08-29:types/rx/',
}
=head2 make_schema
my $schema = $rx->make_schema($schema);
This returns a new schema checker method for the given Rx input. This object
will have C<check> and C<assert_valid> methods to test data with.
=head2 register_type_plugin
$rx->register_type_plugin($type_or_bundle);
Given a type plugin, this registers the plugin with the Data::Rx object.
Bundles are expanded recursively and all their plugins are registered.
Type plugins must have a C<type_uri> method and a C<new_checker> method.
See L<Data::Rx::Manual::CustomTypes> for details.
=head2 learn_type
$rx->learn_type($uri, $schema);
This defines a new type as a schema composed of other types.
For example:
$rx->learn_type('tag:www.example.com:rx/person',
{ type => '//rec',
required => {
firstname => '//str',
lastname => '//str',
},
optional => {
middlename => '//str',
},
},
);
=head2 add_prefix
$rx->add_prefix($name => $prefix_string);
For example:
$rx->add_prefix('.meta' => 'tag:codesimply.com,2008:rx/meta/');
=head2 sort_keys
$rx->sort_keys(1);
When sort_keys is enabled, causes Rx checkers for //rec and //map to
sort the keys before validating. This results in failures being
produced in a consistent order.
=head1 COMPLEX CHECKS
Note that a "schema" can be represented either as a name or as a definition.
In the L</SYNOPSIS> above, note that we have both, '//str' and
C<{ type =E<gt> '//int', value =E<gt> 201 }>.
With the L<collection types|http://rx.codesimply.com/coretypes.html#collect>
provided by Rx, you can validate many complex structures. See L</learn_types>
for how to teach your Rx schema object about the new types you create.
When required, see L<Data::Rx::Manual::CustomTypes> for details on creating a
custom type plugin as a Perl module.
=head1 SCHEMA METHODS
The objects returned by C<make_schema> should provide the methods detailed in
this section.
=head2 check
my $ok = $schema->check($input);
This method just returns true if the input is valid under the given schema, and
false otherwise. For more information, see C<assert_valid>.
=head2 assert_valid
$schema->assert_valid($input);
This method will throw an exception if the input is not valid under the schema.
The exception will be a L<Data::Rx::FailureSet>. This has two important
methods: C<stringify> and C<failures>. The first provides a string form of the
failure. C<failures> returns a list of L<Data::Rx::Failure> objects.
Failure objects have a few methods of note:
error_string - a human-friendly description of what went wrong
stringify - a stringification of the error, data, and check string
error_types - a list of types for the error; like tags
data_string - a string describing where in the input the error occured
value - the value found at the data path
check_string - a string describing which part of the schema found the error
=head1 SEE ALSO
L<http://rx.codesimply.com/>
=head1 AUTHOR
Ricardo SIGNES <cpan@semiotic.systems>
=head1 CONTRIBUTORS
=for stopwords Daniel Lucraft Hakim Cassimally Jeremy Vonderfecht Ricardo Signes Ronald J Kimball
=over 4
=item *
Daniel Lucraft <dan@fluentradical.com>
=item *
Hakim Cassimally <hakim@mysociety.org>
=item *
Jeremy Vonderfecht <CesiumLifeJacket@gmail.com>
=item *
Ricardo Signes <rjbs@semiotic.systems>
=item *
Ronald J Kimball <rjk@tamias.net>
=item *
Vonderfecht <vond085@we19772.pnl.gov>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2023 by Ricardo SIGNES.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut