aboutsummaryrefslogtreecommitdiffstats
path: root/perllib/Open311/Endpoint/Schema/Comma.pm
diff options
context:
space:
mode:
authorHakim Cassimally <hakim@mysociety.org>2014-03-13 16:56:02 +0000
committerHakim Cassimally <hakim@mysociety.org>2014-10-16 16:56:26 +0000
commitd1fee928f02dbc30d3a38b746155ce5b12be4a1b (patch)
tree5e8bdccbd69863e69098b9aa900c1e71745f8eb5 /perllib/Open311/Endpoint/Schema/Comma.pm
parent592f4c0ba0f822b55bb242cb12768ce771599d09 (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.pm53
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;