diff options
author | Hakim Cassimally <hakim@mysociety.org> | 2014-03-13 16:56:02 +0000 |
---|---|---|
committer | Hakim Cassimally <hakim@mysociety.org> | 2014-10-16 16:56:26 +0000 |
commit | d1fee928f02dbc30d3a38b746155ce5b12be4a1b (patch) | |
tree | 5e8bdccbd69863e69098b9aa900c1e71745f8eb5 /perllib/Open311/Endpoint/Schema/Comma.pm | |
parent | 592f4c0ba0f822b55bb242cb12768ce771599d09 (diff) |
Open311 Endpoint
Subsystems include
* ::Spark encoding conventions for xml/json
* ::Schema using Rx to validate form of inputs and outputs,
including validation for, e.g., dates and CSV as part of Open311
Handles following paths:
* Open311 attributes for Service Definition
http://wiki.open311.org/GeoReport_v2#GET_Service_Definition
* POST service request
* GET Service Requests
* GET Service Request
Objects:
* ::Service
* ::Service::Request
Diffstat (limited to 'perllib/Open311/Endpoint/Schema/Comma.pm')
-rw-r--r-- | perllib/Open311/Endpoint/Schema/Comma.pm | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/perllib/Open311/Endpoint/Schema/Comma.pm b/perllib/Open311/Endpoint/Schema/Comma.pm new file mode 100644 index 000000000..f6ac1bcc7 --- /dev/null +++ b/perllib/Open311/Endpoint/Schema/Comma.pm @@ -0,0 +1,53 @@ +use strict; use warnings; +package Open311::Endpoint::Schema::Comma; +use parent 'Data::Rx::CommonType::EasyNew'; + +use Carp (); + +sub type_uri { + 'tag:wiki.open311.org,GeoReport_v2:rx/comma', +} + +sub guts_from_arg { + my ($class, $arg, $rx) = @_; + $arg ||= {}; + + my $contents = delete $arg->{contents} + or Carp::croak "No contents for comma-separated list"; + my $trim = delete $arg->{trim}; + if (my @unexpected = keys %$arg) { + Carp::croak sprintf "Unknown arguments %s in constructing %s", + (join ',' => @unexpected), $class->type_uri; + } + + return { + trim => $trim, + str_schema => $rx->make_schema('//str'), + subschema => $rx->make_schema( $contents ), + }; +} + +sub assert_valid { + my ($self, $value) = @_; + + $self->{str_schema}->assert_valid( $value ); + + my @values = split ',' => $value; + + my $subschema = $self->{subschema}; + my $trim = $self->{trim}; + + for my $subvalue (@values) { + + if ($self->{trim}) { + $subvalue =~s/^\s*//; + $subvalue =~s/\s*$//; + } + + $subschema->assert_valid( $subvalue ); + } + + return 1; +} + +1; |