aboutsummaryrefslogtreecommitdiffstats
path: root/perllib/Open311/Endpoint
diff options
context:
space:
mode:
Diffstat (limited to 'perllib/Open311/Endpoint')
-rw-r--r--perllib/Open311/Endpoint/Result.pm38
-rw-r--r--perllib/Open311/Endpoint/Schema.pm174
-rw-r--r--perllib/Open311/Endpoint/Schema/Comma.pm53
-rw-r--r--perllib/Open311/Endpoint/Schema/Regex.pm43
-rw-r--r--perllib/Open311/Endpoint/Service.pm53
-rw-r--r--perllib/Open311/Endpoint/Service/Attribute.pm82
-rw-r--r--perllib/Open311/Endpoint/Service/Request.pm107
-rw-r--r--perllib/Open311/Endpoint/Spark.pm116
8 files changed, 666 insertions, 0 deletions
diff --git a/perllib/Open311/Endpoint/Result.pm b/perllib/Open311/Endpoint/Result.pm
new file mode 100644
index 000000000..2d3c42154
--- /dev/null
+++ b/perllib/Open311/Endpoint/Result.pm
@@ -0,0 +1,38 @@
+package Open311::Endpoint::Result;
+use Moo;
+
+has status => (
+ is => 'ro',
+);
+has data => (
+ is => 'ro',
+);
+
+sub success {
+ my ($class, $data) = @_;
+ return $class->new({
+ status => 200,
+ data => $data,
+ });
+}
+
+sub error {
+ my ($class, $code, @errors) = @_;
+ $code ||= 400;
+ return $class->new({
+ status => $code,
+ data => {
+ errors => [
+ map {
+ ref $_ eq 'HASH' ? $_ :
+ {
+ code => $code,
+ description => $_,
+ }
+ } @errors,
+ ],
+ },
+ });
+}
+
+1;
diff --git a/perllib/Open311/Endpoint/Schema.pm b/perllib/Open311/Endpoint/Schema.pm
new file mode 100644
index 000000000..e30f9ad90
--- /dev/null
+++ b/perllib/Open311/Endpoint/Schema.pm
@@ -0,0 +1,174 @@
+package Open311::Endpoint::Schema;
+use Moo;
+use Data::Rx;
+
+use Open311::Endpoint::Schema::Comma;
+use Open311::Endpoint::Schema::Regex;
+
+use Carp 'confess';
+has endpoint => (
+ is => 'ro',
+ handles => [qw/
+ get_jurisdiction_id_required_clause
+ get_jurisdiction_id_optional_clause
+ get_identifier_type
+ /],
+);
+
+sub enum {
+ my ($self, $type, @values) = @_;
+ return {
+ type => '//any',
+ of => [ map {
+ {
+ type => $type,
+ value => $_,
+ }
+ } @values ],
+ };
+}
+
+sub format_boolean {
+ my ($self, $value) = @_;
+ return $value ? 'true' : 'false';
+}
+
+has schema => (
+ is => 'lazy',
+ default => sub {
+ my $self = shift;
+
+ my $schema = Data::Rx->new({
+ sort_keys => 1,
+ prefix => {
+ open311 => 'tag:wiki.open311.org,GeoReport_v2:rx/',
+ },
+ type_plugins => [qw(
+ Open311::Endpoint::Schema::Comma
+ Open311::Endpoint::Schema::Regex
+ )],
+ });
+
+ $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/bool',
+ $self->enum( '//str', qw[ true false ] ));
+
+ $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/datetime',
+ {
+ type => '/open311/regex',
+ pattern => qr{
+ ^
+ \d{4} - \d{2} - \d{2} # yyyy-mm-dd
+ T
+ \d{2} : \d{2} : \d{2} # hh:mm:ss
+ (?:
+ Z # "Zulu" time, e.g. UTC
+ | [+-] \d{2} : \d{2} # +/- hh:mm offset
+ )
+ $
+ }ax, # use ascii semantics so /d means [0-9], and allow formatting
+ message => "found value isn't a datetime",
+ });
+
+ $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/example/identifier',
+ {
+ type => '/open311/regex',
+ pattern => qr{^ \w+ $}ax,
+ message => "found value isn't a valid identifier",
+ });
+
+ $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/status',
+ $self->enum( '//str', qw[ open closed ] ));
+
+ $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/post_type',
+ $self->enum( '//str', qw[ realtime batch blackbox ] ));
+
+ $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/service',
+ {
+ type => '//rec',
+ required => {
+ service_name => '//str',
+ type => '/open311/post_type',
+ metadata => '/open311/bool',
+ description => '//str',
+ service_code => '//str',
+ },
+ optional => {
+ keywords => '//str',
+ group => '//str',
+ }
+ }
+ );
+ $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/value',
+ {
+ type => '//rec',
+ required => {
+ key => '//str',
+ name => '//str',
+ }
+ }
+ );
+
+ $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/attribute',
+ {
+ type => '//rec',
+ required => {
+ code => '//str',
+ datatype => $self->enum( '//str', qw[ string number datetime text singlevaluelist multivaluelist ] ),
+ datatype_description => '//str',
+ description => '//str',
+ order => '//int',
+ required => '/open311/bool',
+ variable => '/open311/bool',
+ },
+ optional => {
+ values => {
+ type => '//arr',
+ contents => '/open311/value',
+ },
+ },
+ }
+ );
+
+ $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/service_definition',
+ {
+ type => '//rec',
+ required => {
+ service_code => '//str',
+ attributes => {
+ type => '//arr',
+ contents => '/open311/attribute',
+ }
+ },
+ }
+ );
+ $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/service_request',
+ {
+ type => '//rec',
+ required => {
+ service_request_id => $self->get_identifier_type('service_request_id'),
+ status => '/open311/status',
+ service_name => '//str',
+ service_code => $self->get_identifier_type('service_code'),
+ requested_datetime => '/open311/datetime',
+ updated_datetime => '/open311/datetime',
+ address => '//str',
+ address_id => '//str',
+ zipcode => '//str',
+ lat => '//num',
+ long => '//num',
+ media_url => '//str',
+ },
+ optional => {
+ request => '//str',
+ description => '//str',
+ agency_responsible => '//str',
+ service_notice => '//str',
+ },
+ }
+ );
+
+ return $schema;
+ },
+);
+
+1;
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;
diff --git a/perllib/Open311/Endpoint/Service.pm b/perllib/Open311/Endpoint/Service.pm
new file mode 100644
index 000000000..282e5f921
--- /dev/null
+++ b/perllib/Open311/Endpoint/Service.pm
@@ -0,0 +1,53 @@
+package Open311::Endpoint::Service;
+use Moo;
+use MooX::HandlesVia;
+use Types::Standard ':all';
+use namespace::clean;
+
+has service_name => (
+ is => 'ro',
+ isa => Str,
+);
+
+has service_code => (
+ is => 'ro',
+ isa => Str,
+);
+
+has default_service_notice => (
+ is => 'ro',
+ isa => Maybe[Str],
+ predicate => 1,
+);
+
+has description => (
+ is => 'ro',
+ isa => Str,
+);
+
+has keywords => (
+ is => 'ro',
+ isa => ArrayRef[Str],
+);
+
+has group => (
+ is => 'ro',
+ isa => Str,
+);
+
+has type => (
+ is => 'ro',
+ isa => Enum[qw/ realtime batch blackbox /],
+);
+
+has attributes => (
+ is => 'ro',
+ isa => ArrayRef[ InstanceOf['Open311::Endpoint::Service::Attribute'] ],
+ handles_via => 'Array',
+ handles => {
+ has_attributes => 'count',
+ get_attributes => 'elements',
+ }
+);
+
+1;
diff --git a/perllib/Open311/Endpoint/Service/Attribute.pm b/perllib/Open311/Endpoint/Service/Attribute.pm
new file mode 100644
index 000000000..f88919408
--- /dev/null
+++ b/perllib/Open311/Endpoint/Service/Attribute.pm
@@ -0,0 +1,82 @@
+package Open311::Endpoint::Service::Attribute;
+use Moo;
+use MooX::HandlesVia;
+use Types::Standard ':all';
+use namespace::clean;
+
+# from http://wiki.open311.org/GeoReport_v2#GET_Service_Definition
+
+# A unique identifier for the attribute
+has code => (
+ is => 'ro',
+ isa => Str,
+);
+
+# true denotes that user input is needed
+# false means the attribute is only used to present information to the user within the description field
+#
+# NB: unsure what false means for the rest of the options here, e.g. should remainder of fields by Maybe[] ?
+has variable => (
+ is => 'ro',
+ isa => Bool,
+ default => sub { 1 },
+);
+
+# Denotes the type of field used for user input.
+has datatype => (
+ is => 'ro',
+ isa => Enum[qw/ string number datetime text singlevaluelist multivaluelist /],
+);
+
+has required => (
+ is => 'ro',
+ isa => Bool,
+);
+
+# A description of the datatype which helps the user provide their input
+has datatype_description => (
+ is => 'ro',
+ isa => Str,
+);
+
+# A description of the attribute field with instructions for the user to find
+# and identify the requested information
+has description => (
+ is => 'ro',
+ isa => Str,
+);
+
+# NB: we don't model the "Order" field here, as that's really for the Service
+# object to return
+
+# only relevant for singlevaluelist or multivaluelist
+has values => (
+ is => 'ro',
+ isa => HashRef,
+ default => sub { {} },
+ handles_via => 'Hash',
+ handles => {
+ get_value => 'get',
+ get_values => 'keys',
+ has_values => 'count',
+ values_kv => 'kv',
+ }
+);
+
+sub schema_definition {
+ my $self = shift;
+
+ my @values = map +{ type => '//str', value => $_ }, $self->get_values;
+ my %schema_types = (
+ string => '//str',
+ number => '//num',
+ datetime => '//str', # TODO
+ text => '//str',
+ singlevaluelist => { type => '//any', of => [@values] },
+ multivaluelist => { type => '//arr', of => [@values] },
+ );
+
+ return $schema_types{ $self->datatype };
+}
+
+1;
diff --git a/perllib/Open311/Endpoint/Service/Request.pm b/perllib/Open311/Endpoint/Service/Request.pm
new file mode 100644
index 000000000..b56cee393
--- /dev/null
+++ b/perllib/Open311/Endpoint/Service/Request.pm
@@ -0,0 +1,107 @@
+package Open311::Endpoint::Service::Request;
+use Moo;
+use Types::Standard ':all';
+use namespace::clean;
+
+has service => (
+ is => 'ro',
+ isa => InstanceOf['Open311::Endpoint::Service'],
+ handles => [
+ qw/ service_code service_name /
+ ],
+);
+
+has service_request_id => (
+ is => 'ro',
+ isa => Maybe[Str],
+ predicate => 1,
+);
+
+has token => (
+ is => 'ro',
+ isa => Maybe[Str],
+ predicate => 1,
+);
+
+has service_notice => (
+ is => 'ro',
+ isa => Maybe[Str],
+ predicate => 1,
+);
+
+has account_id => (
+ is => 'ro',
+ isa => Maybe[Str],
+ predicate => 1,
+);
+
+has status => (
+ is => 'rw',
+ isa => Enum[qw/ open closed /],
+ default => sub { 'open' },
+);
+
+has description => (
+ is => 'ro',
+ isa => Maybe[Str],
+);
+
+has agency_responsible => (
+ is => 'ro',
+ isa => Maybe[Str],
+);
+
+has requested_datetime => (
+ is => 'ro',
+ isa => Maybe[ InstanceOf['DateTime'] ],
+);
+
+has updated_datetime => (
+ is => 'ro',
+ isa => Maybe[ InstanceOf['DateTime'] ],
+);
+
+has expected_datetime => (
+ is => 'ro',
+ isa => Maybe[ InstanceOf['DateTime'] ],
+);
+
+has address => (
+ is => 'ro',
+ isa => Str,
+ default => sub { '' },
+);
+
+has address_id => (
+ is => 'ro',
+ isa => Str,
+ default => sub { '' },
+);
+
+has zipcode => (
+ is => 'ro',
+ isa => Str,
+ default => sub { '' },
+);
+
+has latlong => (
+ is => 'ro',
+ isa => Tuple[ Num, Num ],
+ default => sub { [0,0] },
+ handles_via => 'Array',
+ handles => {
+ #lat => [ get => 0 ],
+ #long => [ get => 1 ],
+ }
+);
+
+sub lat { shift->latlong->[0] }
+sub long { shift->latlong->[1] }
+
+has media_url => (
+ is => 'ro',
+ isa => Str,
+ default => sub { '' },
+);
+
+1;
diff --git a/perllib/Open311/Endpoint/Spark.pm b/perllib/Open311/Endpoint/Spark.pm
new file mode 100644
index 000000000..ae179cecc
--- /dev/null
+++ b/perllib/Open311/Endpoint/Spark.pm
@@ -0,0 +1,116 @@
+package Open311::Endpoint::Spark;
+use Moo;
+use Data::Visitor::Callback;
+
+=head1 NAME
+
+Open311::Endpoint::Spark - transform from canonical data-structure to XML or JSON
+
+=head1 SUMMARY
+
+The Open311 docs discuss the Spark convention, to transform between XML and JSON.
+
+ http://wiki.open311.org/JSON_and_XML_Conversion#The_Spark_Convention
+
+These options seem fragile, and require starting with the verbose XML form,
+which isn't really natural in Perl. Instead, we'll start with a standard
+Perl data structure, with a single extra hash wrapper, and will:
+
+ * for JSON, remove the outside hash wrapper
+
+ * for XML, for arrays, insert an extra layer with the singular name:
+ (this is the way XML::Simple knows how to do this nesting)
+
+So:
+
+ # FROM
+ {
+ foo => {
+ bars => [ 1, 2, 3 ]
+ }
+ }
+
+ # JSON (note the 'foo' has been removed
+ {
+ bars: [
+ 1,
+ 2,
+ 3
+ ]
+ }
+
+ # XML intermediate
+ {
+ foo => {
+ bars => {
+ bar => [ 1, 2, 3 ]
+ }
+ }
+ }
+
+ # XML result
+ <foo>
+ <bars>
+ <bar>1</bar>
+ <bar>2</bar>
+ <bar>3</bar>
+ </bars>
+ </foo>
+
+=cut
+
+sub process_for_json {
+ my ($self, $data) = @_;
+ if (ref $data eq 'HASH' and scalar keys %$data == 1) {
+ my $inner = $data->{ (keys %$data)[0] };
+ $data = $inner if ref $inner;
+ }
+ return $data;
+}
+
+sub process_for_xml {
+ my ($self, $data) = @_;
+
+ # NB: in place mutation
+ _process_for_xml($data);
+ return $data;
+}
+
+# NB: in place mutation
+sub _process_for_xml {
+ my $data = shift;
+ return unless ref $data;
+
+ if (ref $data eq 'HASH') {
+ while ( my ($k, $v) = each %$data) {
+ if (ref $v eq 'ARRAY') {
+ my $singular = _singularize($k);
+ # add extra layer
+ $data->{$k} = {
+ $singular => $v,
+ };
+ }
+ _process_for_xml($v);
+ }
+ }
+ elsif (ref $data eq 'ARRAY') {
+ for my $item (@$data) {
+ _process_for_xml($item);
+ }
+ }
+}
+
+my %singular_map = (
+ service_requests => 'request',
+);
+sub _singularize {
+ my $name = shift;
+ return $singular_map{ $name }
+ || do {
+ # strip final 's' if present
+ $name =~ s/s$//;
+ return $name;
+ };
+}
+
+1;
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-26 22:51:33 +0000