aboutsummaryrefslogtreecommitdiffstats
path: root/perllib/Open311/Endpoint
diff options
context:
space:
mode:
Diffstat (limited to 'perllib/Open311/Endpoint')
-rw-r--r--perllib/Open311/Endpoint/Integration/Exor.pm458
-rw-r--r--perllib/Open311/Endpoint/Integration/Warwick.pm47
-rw-r--r--perllib/Open311/Endpoint/Result.pm38
-rw-r--r--perllib/Open311/Endpoint/Role/ConfigFile.pm30
-rw-r--r--perllib/Open311/Endpoint/Role/mySociety.pm159
-rw-r--r--perllib/Open311/Endpoint/Schema.pm177
-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.pm55
-rw-r--r--perllib/Open311/Endpoint/Service/Attribute.pm82
-rw-r--r--perllib/Open311/Endpoint/Service/Exor.pm44
-rw-r--r--perllib/Open311/Endpoint/Service/Request.pm110
-rw-r--r--perllib/Open311/Endpoint/Service/Request/Update.pm57
-rw-r--r--perllib/Open311/Endpoint/Service/Request/mySociety.pm51
-rw-r--r--perllib/Open311/Endpoint/Spark.pm117
15 files changed, 0 insertions, 1521 deletions
diff --git a/perllib/Open311/Endpoint/Integration/Exor.pm b/perllib/Open311/Endpoint/Integration/Exor.pm
deleted file mode 100644
index 0d5264115..000000000
--- a/perllib/Open311/Endpoint/Integration/Exor.pm
+++ /dev/null
@@ -1,458 +0,0 @@
-package Open311::Endpoint::Integration::Exor;
-use Web::Simple;
-extends 'Open311::Endpoint';
-with 'Open311::Endpoint::Role::mySociety';
-with 'Open311::Endpoint::Role::ConfigFile';
-use DBI;
-use MooX::HandlesVia;
-use DateTime::Format::Oracle; # default format 'YYYY-MM-DD HH24:MI:SS' # NB: hh24 (not hh)
-use Encode qw(from_to);
-
-# declare our constants, as we may not be able to easily install DBD::Oracle
-# on a development system!
-# t/open311/endpoint/warwick.t disables DBD::Oracle from loading, so the default
-# stubbed values will be used instead:
-sub ORA_DATE ();
-sub ORA_NUMBER ();
-sub ORA_VARCHAR2 ();
-no warnings 'redefine';
-use DBD::Oracle qw(:ora_types);
-
-BEGIN {
-*ORA_DATE = *ORA_NUMBER = *ORA_VARCHAR2 = sub () { 1 }
- unless $DBD::Oracle::VERSION;
-}
-
-has ora_dt => (
- is => 'lazy',
- default => sub {
- $ENV{NLS_DATE_FORMAT} = 'YYYY-MM-DD HH24:MI';
- return 'DateTime::Format::Oracle'
- },
- # NB: we just return the class name. This is to smooth over odd API,
- # for consistency with w3_dt
-);
-
-sub parse_ora_date {
- my ($self, $date_string) = @_;
-
- my $date = $self->ora_dt->parse_datetime( $date_string );
-
- # will be in floating time_zone so set
- $date->set_time_zone( $self->time_zone );
-
- return $date;
-}
-
-has max_limit => (
- is => 'ro',
- default => 1000,
-);
-
-has encode_to_win1252 => (
- is => 'ro',
- default => 1,
-);
-
-has _connection_details => (
- is => 'lazy',
- default => sub {
- my $self = shift;
- my $DB_HOST = $self->db_host;
- my $ORACLE_SID = $self->oracle_sid;
- my $DB_PORT = $self->db_port;
- my $USERNAME = $self->db_username;
- my $PASSWORD = $self->db_password;
- return [ "dbi:Oracle:host=$DB_HOST;sid=$ORACLE_SID;port=$DB_PORT", $USERNAME, $PASSWORD ]
- },
- handles_via => 'Array',
- handles => {
- connection_details => 'elements',
- dsn => [ get => 0 ],
- },
-);
-
-has dbh => (
- is => 'lazy',
- default => sub {
- my $self = shift;
- return DBI->connect( $self->connection_details );
- }
-);
-
-has db_host => (
- is => 'ro',
- default => 'localhost',
-);
-
-has oracle_sid => (
- is => 'ro',
- default => '1000', # DUMMY
-);
-
-has db_port => (
- is => 'ro',
- default => 1531,
-);
-
-has db_username => (
- is => 'ro',
- default => 'FIXMYSTREET',
-);
-
-has db_password => (
- is => 'ro',
- default => 'SUPERSEEKRIT', # DUMMY
-);
-
-has strip_control_characters => (
- is => 'ro',
- default => 'ruthless',
-);
-
-has testing => (
- is => 'ro',
- default => 0,
-);
-
-has ce_cat => (
- is => 'ro',
- default => 'DEF',
-);
-
-has ce_class => (
- is => 'ro',
- default => 'N/A',
-);
-
-has ce_cpr_id => (
- is => 'ro',
- default => 5,
-);
-
-has ce_contact_type => (
- is => 'ro',
- default => 'PU',
-);
-
-has ce_status_code => (
- is => 'ro',
- default => 'RE',
-);
-
-has ce_compl_user_type => (
- is => 'ro',
- default => 'USER',
-);
-
-#------------------------------------------------------------------
-# pem_field_types
-# return hash of types by field name: any not explicitly set here
-# can be defaulted to VARCHAR2
-#------------------------------------------------------------------
-has get_pem_field_types => (
- is => 'ro',
- handles_via => 'Hash',
- default => sub {
- {
- ':ce_incident_datetime' => ORA_DATE,
- ':ce_x' => ORA_NUMBER,
- ':ce_y' => ORA_NUMBER,
- ':ce_date_expires' => ORA_DATE,
- ':ce_issue_number' => ORA_NUMBER,
- ':ce_status_date' => ORA_DATE,
- ':ce_compl_ack_date' => ORA_DATE,
- ':ce_compl_peo_date' => ORA_DATE,
- ':ce_compl_target' => ORA_DATE,
- ':ce_compl_complete' => ORA_DATE,
- ':ce_compl_from' => ORA_DATE,
- ':ce_compl_to' => ORA_DATE,
- ':ce_compl_corresp_date' => ORA_DATE,
- ':ce_compl_corresp_deliv_date' => ORA_DATE,
- ':ce_compl_no_of_petitioners' => ORA_NUMBER,
- ':ce_compl_est_cost' => ORA_NUMBER,
- ':ce_compl_adv_cost' => ORA_NUMBER,
- ':ce_compl_act_cost' => ORA_NUMBER,
- ':ce_compl_follow_up1' => ORA_DATE,
- ':ce_compl_follow_up2' => ORA_DATE,
- ':ce_compl_follow_uo3' => ORA_DATE,
- ':ce_date_time_arrived' => ORA_DATE,
- ':error_value' => ORA_NUMBER,
- ':ce_doc_id' => ORA_NUMBER,
- }
- },
- handles => {
- get_pem_field_type => 'get',
-
- },
-);
-
-sub pem_field_type {
- my ($self, $field) = @_;
- return $self->get_pem_field_type($field) || ORA_VARCHAR2;
-}
-
-
-sub services {
- # not currently used as Warwick.pm uses a hardcoded list.
- die "TODO";
-}
-
-sub _strip_ruthless {
- my $text = shift or return '';
- $text =~ s/[[:cntrl:]]/ /g; # strip all control chars, simples
- return $text;
-}
-
-sub _strip_non_ruthless {
- my $text = shift or return '';
- # slightly odd doubly negated character class
- $text =~ s/[^\t\n[:^cntrl:]]/ /g; # leave tabs and newlines
- return $text;
-}
-sub strip {
- my ($self, $text, $max_len, $prefer_non_ruthless) = @_;
- use Carp 'confess';
- confess 'EEEK' unless $self;
- if (my $scc = $self->strip_control_characters) {
- if ($scc eq 'ruthless') {
- $text = _strip_ruthless($text);
- }
- elsif ($prefer_non_ruthless) {
- $text = _strip_non_ruthless($text);
- }
- else {
- $text = _strip_ruthless($text);
- }
- }
- return $max_len ? substr($text, 0, $max_len) : $text;
-}
-
-sub post_service_request {
- my ($self, $service, $args) = @_;
- die "No such service" unless $service;
-
- if ($args->{media_url}) {
- # don't put URL for full images into the database (because they're too big to see on a Blackberry)
- $args->{media_url} =~ s/\.full(\.jpe?g)$/$1/;
- $args->{description} .= $self->strip( "\n\n") . 'Photo: ' . $args->{media_url};
- }
- my $attributes = $args->{attributes};
- my $location = $attributes->{closest_address};
-
- if ($location) {
- # strip out everything apart from "Nearest" preamble
- $location=~s/(Nearest road)[^:]+:/$1:/;
- $location=~s/(Nearest postcode)[^:]+:(.*?)(\(\w+ away\))?\s*(\n|$)/$1: $2/;
- }
-
- my %bindings;
- # comments here are suggested values
- # field lengths are from OCC's Java portlet
- # fixed values (configurable via config)
- $bindings{":ce_cat"} = $self->ce_cat;
- $bindings{":ce_class"} = $self->ce_class;
- $bindings{":ce_contact_type"} = $self->ce_contact_type;
- $bindings{":ce_status_code"} = $self->ce_status_code;
- $bindings{":ce_compl_user_type"}= $self->ce_compl_user_type;
- $bindings{":ce_cpr_id"} = $self->ce_cpr_id;
-
- # ce_incident_datetime is *not* an optional param, but FMS isn't sending it at the moment
- $bindings{":ce_incident_datetime"}=$args->{requested_datetime}
- || $self->ora_dt->format_datetime( DateTime->now );
-
- # especially FMS-specific:
- $bindings{":ce_source"} = "FMS"; # important, and specific to this script!
- $bindings{":ce_doc_reference"} = $attributes->{external_id}; # FMS ID
- $bindings{":ce_enquiry_type"} = $args->{service_code};
-
- # incoming data
- $bindings{":ce_x"} = $attributes->{easting};
- $bindings{":ce_y"} = $attributes->{northing};
- $bindings{":ce_forename"} = uc $self->strip($args->{first_name}, 30); # 'CLIFF'
- $bindings{":ce_surname"} = uc $self->strip($args->{last_name}, 30); # 'STEWART'
- $bindings{":ce_work_phone"} = $self->strip($args->{phone}, 25); # '0117 600 4200'
- $bindings{":ce_email"} = uc $self->strip($args->{email}, 50); # 'info@exor.co.uk'
- $bindings{":ce_description"} = $self->strip($args->{description}, 1970, 1); # 'Large Pothole'
-
- # nearest address guesstimate
- $bindings{":ce_location"} = $self->strip($location, 254);
-
- if ($self->testing) {
- warn Dumper(\%bindings); use Data::Dumper;
- }
-
- my ($pem_id, $error_value, $error_product) = $self->insert_into_db(\%bindings);
-
- # if error, maybe need to look it up:
- # error_value is the index HER_NO in table HIG_ERRORS, which has messages
- # actually err_product not helpful (will always be "DOC")
- die "$error_value $error_product" if $error_value || $error_product;
-
- my $request = $self->new_request(
-
- # NB: possible race condition between next_request_id and _add_request
- # (this is fine for synchronous test-cases)
-
- service => $service,
- service_request_id => $pem_id,
- status => 'open',
- description => $args->{description},
- agency_responsible => '',
- requested_datetime => DateTime->now(),
- updated_datetime => DateTime->now(),
- address => $args->{address_string} // '',
- address_id => $args->{address_id} // '',
- media_url => $args->{media_url} // '',
- zipcode => $args->{zipcode} // '',
- attributes => $attributes,
-
- );
-
- return $request;
-}
-
-sub insert_into_db {
- my ($self, $bindings) = @_;
- my %bindings = %$bindings;
-
- my ($pem_id, $error_value, $error_product);
-
- my $dbh = $self->dbh;
-
- my $sth = $dbh->prepare(q#
- BEGIN
- PEM.create_enquiry(
- ce_cat => :ce_cat,
- ce_class => :ce_class,
- ce_cpr_id => :ce_cpr_id,
- ce_forename => :ce_forename,
- ce_surname => :ce_surname,
- ce_contact_type => :ce_contact_type,
- ce_location => :ce_location,
- ce_work_phone => :ce_work_phone,
- ce_email => :ce_email,
- ce_description => :ce_description,
- ce_enquiry_type => :ce_enquiry_type,
- ce_source => :ce_source,
- ce_incident_datetime => to_Date(:ce_incident_datetime,'YYYY-MM-DD HH24:MI'),
- ce_x => :ce_x,
- ce_y => :ce_y,
- ce_doc_reference => :ce_doc_reference,
- ce_status_code => :ce_status_code,
- ce_compl_user_type => :ce_compl_user_type,
- error_value => :error_value,
- error_product => :error_product,
- ce_doc_id => :ce_doc_id);
- END;
- #);
-
- foreach my $name (sort keys %bindings) {
- next if grep {$name eq $_} (':error_value', ':error_product', ':ce_doc_id'); # return values (see below)
- $sth->bind_param(
- $name,
- $bindings{$name},
- $self->pem_field_type( $name ),
- );
- }
- # return values are bound explicitly here:
- $sth->bind_param_inout(":error_value", \$error_value, 12); #> l_ERROR_VALUE # number
- $sth->bind_param_inout(":error_product", \$error_product, 10); #> l_ERROR_PRODUCT (will always be 'DOC')
- $sth->bind_param_inout(":ce_doc_id", \$pem_id, 12); #> l_ce_doc_id # number
-
- # not used, but from the example docs, for reference
- # $sth->bind_param(":ce_contact_title", $undef); # 'MR'
- # $sth->bind_param(":ce_postcode", $undef); # 'BS11EJ' NB no spaces, upper case
- # $sth->bind_param(":ce_building_no", $undef); # '1'
- # $sth->bind_param(":ce_building_name", $undef); # 'CLIFTON HEIGHTS'
- # $sth->bind_param(":ce_street", $undef); # 'HIGH STREET'
- # $sth->bind_param(":ce_town", $undef); # 'BRSITOL'
- # $sth->bind_param(":ce_rse_he_id", $undef); #> nm3net.get_ne_id('1200D90970/09001','L')
- # $sth->bind_param(":ce_compl_target", $undef); # '08-JAN-2004'
- # $sth->bind_param(":ce_compl_corresp_date",$undef); # '02-JAN-2004'
- # $sth->bind_param(":ce_compl_corresp_deliv_date", $undef); # '02-JAN-2004'
- # $sth->bind_param(":ce_resp_of", $undef); # 'GBOWLER'
- # $sth->bind_param(":ce_hct_vip", $undef); # 'CO'
- # $sth->bind_param(":ce_hct_home_phone", $undef); # '0117 900 6201'
- # $sth->bind_param(":ce_hct_mobile_phone", $undef); # '07111 1111111'
- # $sth->bind_param(":ce_compl_remarks", $undef); # remarks (notes) max 254 char
-
- $sth->execute();
- $dbh->disconnect;
-
- return ($pem_id, $error_value, $error_product);
-}
-
-sub get_service_request_updates {
- my ($self, $args) = @_;
-
- # ignore jurisdiction_id for now
- #
- my $start_date = $self->maybe_inflate_datetime( $args->{start_date} );
- my $end_date = $self->maybe_inflate_datetime( $args->{end_date} );
-
- unless ($self->testing) {
- $start_date = DateTime->now->subtract( days => 1 )
- unless ($start_date or $end_date);
- }
-
- my $w3_dt = $self->w3_dt;
- my $ora_dt = $self->ora_dt;
- my $ORA_DT_FORMAT = $ora_dt->nls_date_format;
-
- my @where;
-
- push @where, sprintf
- 'updated_timedate >= to_date(%s, %s)',
- $ora_dt->format_datetime($start_date), $ORA_DT_FORMAT
- if $start_date;
-
- push @where, sprintf
- 'updated_timedate <= to_date(%s, %s)',
- $ora_dt->format_datetime($end_date), $ORA_DT_FORMAT
- if $end_date;
-
- push @where, "(status='OPEN' OR status='CLOSED')"
- unless $self->testing;
-
- my $WHERE_CLAUSE = @where ?
- 'WHERE ' . join(' AND ', grep {$_} @where)
- : '';
-
- my $sql = qq(
- SELECT
- row_id,
- service_request_id,
- to_char(updated_timedate, '$ORA_DT_FORMAT'),
- status,
- description
- FROM higatlas.fms_update
- $WHERE_CLAUSE
- ORDER BY updated_timedate DESC);
-
- my $limit = $self->max_limit; # also allow testing to modify this?
- $sql = "SELECT * FROM ($sql) WHERE ROWNUM <= $limit" if $limit;
-
- my @data = $self->get_updates_from_sql( $sql );
-
- my @updates = map {
- Open311::Endpoint::Service::Request::Update->new(
- update_id => $_->{row_id},
- service_request_id => $_->{service_request_id},
- updated_datetime => $self->parse_ora_date( $_->{updated_datetime} ),
- status => $_->{status},
- description => $_->{description}
- )
- } @data;
-
- return @updates;
-}
-
-sub get_updates_from_sql {
- my ($self, $sql) = @_;
- my $dbh = $self->dbh;
- my $ary_ref = $dbh->selectall_arrayref($sql, { Slice => {} } );
- return @$ary_ref;
-}
-
-1;
diff --git a/perllib/Open311/Endpoint/Integration/Warwick.pm b/perllib/Open311/Endpoint/Integration/Warwick.pm
deleted file mode 100644
index bc57a8e8c..000000000
--- a/perllib/Open311/Endpoint/Integration/Warwick.pm
+++ /dev/null
@@ -1,47 +0,0 @@
-package Open311::Endpoint::Integration::Warwick;
-use Web::Simple;
-extends 'Open311::Endpoint::Integration::Exor';
-use Open311::Endpoint::Service::Exor;
-
-has '+default_service_notice' => (
- default => 'Warwickshire Open311 Endpoint',
-);
-
-sub services {
- # TODO, get this from ::Exor
- my @services = (
- # [ BR => 'Bridges' ],
- # [ CD => 'Carriageway Defect' ],
- # [ CD => 'Roads/Highways' ],
- # [ DR => 'Drainage' ],
- # [ DS => 'Debris/Spillage' ],
- # [ FE => 'Fences' ],
- # [ 'F D' => 'Pavements' ],
- # [ GC => 'Gully & Catchpits' ],
- # [ IS => 'Ice/Snow' ],
- # [ MD => 'Mud & Debris' ],
- # [ MH => 'Manhole' ],
- # [ OS => 'Oil Spillage' ],
- # [ OT => 'Other' ],
- [ PO => 'Pothole' ],
- # [ PD => 'Property Damage' ],
- # [ RM => 'Road Marking' ],
- # [ SN => 'Road traffic signs' ],
- # [ SP => 'Traffic' ],
- # [ UT => 'Utilities' ],
- # [ VG => 'Vegetation' ],
- );
- return map {
- my ($code, $name) = @$_;
- Open311::Endpoint::Service::Exor->new(
- service_code => $code,
- service_name => $name,
- description => $name,
- type => 'realtime',
- keywords => [qw/ /],
- group => 'highways',
- ),
- } @services;
-}
-
-1;
diff --git a/perllib/Open311/Endpoint/Result.pm b/perllib/Open311/Endpoint/Result.pm
deleted file mode 100644
index 61454e749..000000000
--- a/perllib/Open311/Endpoint/Result.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-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/Role/ConfigFile.pm b/perllib/Open311/Endpoint/Role/ConfigFile.pm
deleted file mode 100644
index 1c4b83355..000000000
--- a/perllib/Open311/Endpoint/Role/ConfigFile.pm
+++ /dev/null
@@ -1,30 +0,0 @@
-package Open311::Endpoint::Role::ConfigFile;
-use Moo::Role;
-use Path::Tiny 'path';
-use Carp 'croak';
-use YAML ();
-use Types::Standard qw( Maybe Str );
-
-has config_file => (
- is => 'ro',
- isa => Maybe[Str],
-);
-
-around BUILDARGS => sub {
- my $next = shift;
- my $class = shift;
-
- my %args = @_;
- if (my $config_file = $args{config_file}) {
- my $cfg = path($config_file);
- croak "$config_file is not a file" unless $cfg->is_file;
-
- my $config = YAML::LoadFile($cfg) or croak "Couldn't load config from $config_file";
- return $class->$next(%$config, %args);
- }
- else {
- return $class->$next(%args);
- }
-};
-
-1;
diff --git a/perllib/Open311/Endpoint/Role/mySociety.pm b/perllib/Open311/Endpoint/Role/mySociety.pm
deleted file mode 100644
index de65baab6..000000000
--- a/perllib/Open311/Endpoint/Role/mySociety.pm
+++ /dev/null
@@ -1,159 +0,0 @@
-package Open311::Endpoint::Role::mySociety;
-
-=head1 NAME
-
-Open311::Endpoint::Role::mySociety - mySociety's proposed Open311 extensions
-
-=head1 SYNOPSIS
-
-See mySociety's
-L<blog post|https://www.mysociety.org/2013/02/20/open311-extended/>
-and
-L<proposal|https://github.com/mysociety/FixMyStreet/wiki/Open311-FMS---Proposed-differences-to-Open311>
-for a full explanation of the spec extension.
-
-You can use the extensions as follows:
-
- package My::Open311::Endpoint;
- use Web::Simple;
- extends 'Open311::Endpoint';
- with 'Open311::Endpoint::Role::mySociety';
-
-You will have to provide implementations of
-
- get_service_request_updates
- post_service_request_update
-
-You will need to return L<Open311::Endpoint::Service::Request::Update>
-objects. However, the root L<Open311::Endpoint::Service::Request> is not
-aware of updates, so you may may find it easier to ensure that the ::Service
-objects you create (with get_service_request etc.) return
-L<Open311::Endpoint::Service::Request::mySociety> objects.
-
-=cut
-
-use Moo::Role;
-no warnings 'illegalproto';
-
-use Open311::Endpoint::Service::Request::mySociety;
-has '+request_class' => (
- is => 'ro',
- default => 'Open311::Endpoint::Service::Request::mySociety',
-);
-
-around dispatch_request => sub {
- my ($orig, $self, @args) = @_;
- my @dispatch = $self->$orig(@args);
- return (
- @dispatch,
-
- sub (GET + /servicerequestupdates + ?*) {
- my ($self, $args) = @_;
- $self->call_api( GET_Service_Request_Updates => $args );
- },
-
- sub (POST + /servicerequestupdates + ?*) {
- my ($self, $args) = @_;
- $self->call_api( POST_Service_Request_Update => $args );
- },
-
- );
-};
-
-sub GET_Service_Request_Updates_input_schema {
- my $self = shift;
- return {
- type => '//rec',
- required => {
- $self->get_jurisdiction_id_required_clause,
- },
- optional => {
- $self->get_jurisdiction_id_optional_clause,
- api_key => $self->get_identifier_type('api_key'),
- start_date => '/open311/datetime',
- end_date => '/open311/datetime',
- }
- };
-}
-
-sub GET_Service_Request_Updates_output_schema {
- my $self = shift;
- return {
- type => '//rec',
- required => {
- service_request_updates => {
- type => '//arr',
- contents => '/open311/service_request_update',
- },
- },
- };
-}
-
-sub GET_Service_Request_Updates {
- my ($self, $args) = @_;
-
- my @updates = $self->get_service_request_updates({
- jurisdiction_id => $args->{jurisdiction_id},
- start_date => $args->{start_date},
- end_date => $args->{end_date},
- });
-
- $self->format_updates(@updates);
-}
-
-sub format_updates {
- my ($self, @updates) = @_;
- return {
- service_request_updates => [
- map {
- my $update = $_;
- +{
- (
- map {
- $_ => $update->$_,
- }
- qw/
- update_id
- service_request_id
- status
- description
- media_url
- /
- ),
- (
- map {
- $_ => $self->w3_dt->format_datetime( $update->$_ ),
- }
- qw/
- updated_datetime
- /
- ),
- }
- } @updates
- ]
- };
-}
-
-sub get_service_request_updates {
- my ($self, $args) = @_;
- die "abstract method get_service_request_updates not overridden";
-}
-
-sub learn_additional_types {
- my ($self, $schema) = @_;
- $schema->learn_type( 'tag:wiki.open311.org,GeoReport_v2:rx/service_request_update',
- {
- type => '//rec',
- required => {
- service_request_id => $self->get_identifier_type('service_request_id'),
- update_id => $self->get_identifier_type('update_id'),
- status => '/open311/status',
- updated_datetime => '/open311/datetime',
- description => '//str',
- media_url => '//str',
- },
- }
- );
-}
-
-1;
diff --git a/perllib/Open311/Endpoint/Schema.pm b/perllib/Open311/Endpoint/Schema.pm
deleted file mode 100644
index 9a2ad81e5..000000000
--- a/perllib/Open311/Endpoint/Schema.pm
+++ /dev/null
@@ -1,177 +0,0 @@
-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
- learn_additional_types
- /],
-);
-
-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',
- },
- }
- );
-
- $self->learn_additional_types($schema);
-
- return $schema;
- },
-);
-
-1;
diff --git a/perllib/Open311/Endpoint/Schema/Comma.pm b/perllib/Open311/Endpoint/Schema/Comma.pm
deleted file mode 100644
index f6ac1bcc7..000000000
--- a/perllib/Open311/Endpoint/Schema/Comma.pm
+++ /dev/null
@@ -1,53 +0,0 @@
-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
deleted file mode 100644
index a79542198..000000000
--- a/perllib/Open311/Endpoint/Schema/Regex.pm
+++ /dev/null
@@ -1,43 +0,0 @@
-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
deleted file mode 100644
index 2c28c6d79..000000000
--- a/perllib/Open311/Endpoint/Service.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-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],
- default => sub { [] },
-);
-
-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'] ],
- default => sub { [] },
- 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
deleted file mode 100644
index f88919408..000000000
--- a/perllib/Open311/Endpoint/Service/Attribute.pm
+++ /dev/null
@@ -1,82 +0,0 @@
-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/Exor.pm b/perllib/Open311/Endpoint/Service/Exor.pm
deleted file mode 100644
index 6261875c1..000000000
--- a/perllib/Open311/Endpoint/Service/Exor.pm
+++ /dev/null
@@ -1,44 +0,0 @@
-package Open311::Endpoint::Service::Exor;
-use Moo;
-extends 'Open311::Endpoint::Service';
-use Open311::Endpoint::Service::Attribute;
-
-has '+attributes' => (
- is => 'ro',
- default => sub { [
- Open311::Endpoint::Service::Attribute->new(
- code => 'easting',
- variable => 0, # set by server
- datatype => 'number',
- required => 1,
- datatype_description => 'a number',
- description => 'easting',
- ),
- Open311::Endpoint::Service::Attribute->new(
- code => 'northing',
- variable => 0, # set by server
- datatype => 'number',
- required => 1,
- datatype_description => 'a number',
- description => 'northing',
- ),
- Open311::Endpoint::Service::Attribute->new(
- code => 'closest_address',
- variable => 0, # set by server
- datatype => 'string',
- required => 1,
- datatype_description => 'an address',
- description => 'closest address',
- ),
- Open311::Endpoint::Service::Attribute->new(
- code => 'external_id',
- variable => 0, # set by server
- datatype => 'string',
- required => 1,
- datatype_description => 'an id',
- description => 'external system ID',
- ),
- ] },
-);
-
-1;
diff --git a/perllib/Open311/Endpoint/Service/Request.pm b/perllib/Open311/Endpoint/Service/Request.pm
deleted file mode 100644
index 8dfa5df3a..000000000
--- a/perllib/Open311/Endpoint/Service/Request.pm
+++ /dev/null
@@ -1,110 +0,0 @@
-package Open311::Endpoint::Service::Request;
-use Moo;
-use MooX::HandlesVia;
-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'] ],
- default => sub { DateTime->now() },
-);
-
-has updated_datetime => (
- is => 'rw',
- isa => Maybe[ InstanceOf['DateTime'] ],
- default => sub { DateTime->now() },
-);
-
-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/Service/Request/Update.pm b/perllib/Open311/Endpoint/Service/Request/Update.pm
deleted file mode 100644
index b881af9ce..000000000
--- a/perllib/Open311/Endpoint/Service/Request/Update.pm
+++ /dev/null
@@ -1,57 +0,0 @@
-package Open311::Endpoint::Service::Request::Update;
-use Moo;
-use Types::Standard ':all';
-use namespace::clean;
-
-sub BUILDARGS {
- my ($class, %args) = @_;
- my $service_request = delete $args{service_request};
-
- if (! $args{status}) {
- $args{status} = $service_request->status;
- }
-
- return \%args;
-}
-
-has update_id => (
- is => 'ro',
- isa => Maybe[Str],
- predicate => 1,
-);
-
-has service_request_id => (
- is => 'ro',
- isa => Maybe[Str],
- predicate => 1,
-);
-
-has token => (
- is => 'ro',
- isa => Maybe[Str],
- predicate => 1,
-);
-
-has status => (
- is => 'ro',
- isa => Enum[qw/ open closed /],
-);
-
-has description => (
- is => 'ro',
- isa => Maybe[Str],
-);
-
-has media_url => (
- is => 'ro',
- isa => Str,
- default => sub { '' },
-);
-
-has updated_datetime => (
- is => 'ro',
- isa => InstanceOf['DateTime'],
- default => sub { DateTime->now() },
-);
-
-1;
diff --git a/perllib/Open311/Endpoint/Service/Request/mySociety.pm b/perllib/Open311/Endpoint/Service/Request/mySociety.pm
deleted file mode 100644
index 85e31b26f..000000000
--- a/perllib/Open311/Endpoint/Service/Request/mySociety.pm
+++ /dev/null
@@ -1,51 +0,0 @@
-package Open311::Endpoint::Service::Request::mySociety;
-use Moo;
-use MooX::HandlesVia;
-extends 'Open311::Endpoint::Service::Request';
-
-use DateTime;
-use Open311::Endpoint::Service::Request::Update;
-use Types::Standard ':all';
-
-has updates => (
- is => 'rw',
- isa => ArrayRef[InstanceOf['Open311::Endpoint::Service::Request::Update']],
- default => sub { [] },
- handles_via => 'Array',
- handles => {
- _add_update => 'push',
- get_updates => 'elements',
- get_update => 'get',
- has_updates => 'count',
- filter_updates => 'grep',
- }
-);
-
-sub add_update {
- my ($self, %args) = @_;
- my $update = Open311::Endpoint::Service::Request::Update->new(
- %args,
- service_request => $self,
- service_request_id => $self->service_request_id,
- );
- $self->_add_update($update);
-}
-
-sub last_update {
- my $self = shift;
- return $self->has_updates ? $self->get_update(-1) : undef;
-}
-
-around updated_datetime => sub {
- my ($orig, $self) = @_;
- my $last_update = $self->last_update or return;
- return $last_update->updated_datetime;
-};
-
-around status => sub {
- my ($orig, $self) = @_;
- my $last_update = $self->last_update or return 'open';
- return $last_update->status;
-};
-
-1;
diff --git a/perllib/Open311/Endpoint/Spark.pm b/perllib/Open311/Endpoint/Spark.pm
deleted file mode 100644
index 292a66996..000000000
--- a/perllib/Open311/Endpoint/Spark.pm
+++ /dev/null
@@ -1,117 +0,0 @@
-package Open311::Endpoint::Spark;
-use Moo;
-
-=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',
- service_request_updates => 'request_update',
-);
-
-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 20:54:05 +0000