view release on metacpan or  search on metacpan

lib/Data/Rx.pm  view on Meta::CPAN

#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) = @_;