2 files changed, 96 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;
diff --git a/perllib/Open311/Endpoint/Schema/Regex.pm b/perllib/Open311/Endpoint/Schema/Regex.pm
new file mode 100644
index 000000000..a79542198
--- /dev/null
+++ b/perllib/Open311/Endpoint/Schema/Regex.pm
@@ -0,0 +1,43 @@
+use strict; use warnings;
+package Open311::Endpoint::Schema::Regex;
+use parent 'Data::Rx::CommonType::EasyNew';
+
+use Carp ();
+
+sub type_uri {
+    'tag:wiki.open311.org,GeoReport_v2:rx/regex',
+}
+
+sub guts_from_arg {
+    my ($class, $arg, $rx) = @_;
+    $arg ||= {};
+
+    my $pattern = delete $arg->{pattern};
+    my $message = delete $arg->{message};
+    if (my @unexpected = keys %$arg) {
+        Carp::croak sprintf "Unknown arguments %s in constructing %s",
+            (join ',' => @unexpected), $class->type_uri;
+    }
+
+    return {
+        str_schema => $rx->make_schema('//str'),
+        pattern => qr/$pattern/,
+        message => $message,
+    };
+}
+
+sub assert_valid {
+    my ($self, $value) = @_;
+
+    $self->{str_schema}->assert_valid( $value );
+
+    return 1 if $value =~ $self->{pattern};
+
+    $self->fail({
+        error => [ qw(type) ],
+        message => $self->{message} || "found value doesn't match regex",
+        value => $value,
+    })
+}
+
+1;