[Angus] SOAP interface/send method for Angus CRM

8 files changed, 479 insertions, 5 deletions

diff --git a/cpanfile b/cpanfile
index 28e3d57f9..5df6cb0dc 100644
--- a/cpanfile
+++ b/cpanfile
@@ -97,7 +97,7 @@ requires 'XML::Simple';
 requires 'YAML';
 
 feature 'uk', 'FixMyStreet.com specific requirements' => sub {
-    # East Hampshire
+    # East Hampshire & Angus
     requires 'SOAP::Lite';
 };
 
diff --git a/perllib/FixMyStreet/Cobrand/Angus.pm b/perllib/FixMyStreet/Cobrand/Angus.pm
index 36d888744..a41d46205 100644
--- a/perllib/FixMyStreet/Cobrand/Angus.pm
+++ b/perllib/FixMyStreet/Cobrand/Angus.pm
@@ -46,4 +46,77 @@ sub contact_email {
     return join( '@', 'accessline', 'angus.gov.uk' );
 }
 
+=head2 temp_email_to_update, temp_update_contacts
+
+Temporary helper routines to update the extra for potholes (temporary setup
+hack, cargo-culted from Harrogate, may in future be superseded either by
+Open311/integration or a better mechanism for manually creating rich contacts).
+
+Can run with a script or command line like:
+
+ bin/cron-wrapper perl -MFixMyStreet::App -MFixMyStreet::Cobrand::Angus -e \
+ 'FixMyStreet::Cobrand::Angus->new({c => FixMyStreet::App->new})->temp_update_contacts'
+
+=cut
+
+sub temp_update_contacts {
+    my $self = shift;
+
+    my $contact_rs = $self->{c}->model('DB::Contact');
+
+    my $_update = sub {
+        my ($category, $field, $category_details) = @_;
+        # NB: we're accepting just 1 field, but supply as array [ $field ]
+
+        my $contact = $contact_rs->find_or_create(
+            {
+                body_id => $self->council_id,
+                category => $category,
+                %{ $category_details || {} },
+            },
+            {
+                key => 'contacts_body_id_category_idx'
+            }
+        );
+
+        my %default = (
+            variable => 'true',
+            order => '1',
+            required => 'no',
+            datatype => 'string',
+            datatype_description => 'a string',
+        );
+
+        if ($field->{datatype} || '' eq 'boolean') {
+            my $description = $field->{description};
+            %default = (
+                %default,
+                datatype => 'singlevaluelist',
+                datatype_description => 'Yes or No',
+                values => { value => [
+                        { key => ['No'],  name => ['No'] },
+                        { key => ['Yes'], name => ['Yes'] },
+                ] },
+            );
+        }
+
+        $contact->update({
+            # XXX: we're just setting extra with the expected layout,
+            # this could be encapsulated more nicely
+            extra => { _fields => [ { %default, %$field } ] },
+            confirmed => 1,
+            deleted => 0,
+            editor => 'automated script',
+            whenedited => \'NOW()',
+            note => 'Edited by script as per requirements Jan 2016',
+        });
+    };
+
+    $_update->( 'Street lighting', {
+            code => 'column_id',
+            description => 'Column number',
+        });
+
+}
+
 1;
diff --git a/perllib/FixMyStreet/DB/Result/Problem.pm b/perllib/FixMyStreet/DB/Result/Problem.pm
index 2a90d0bec..705c6d284 100644
--- a/perllib/FixMyStreet/DB/Result/Problem.pm
+++ b/perllib/FixMyStreet/DB/Result/Problem.pm
@@ -654,7 +654,7 @@ sub response_templates {
 #     Note:   this only makes sense when called on a problem that has been sent!
 sub can_display_external_id {
     my $self = shift;
-    if ($self->external_id && $self->send_method_used && $self->bodies_str =~ /2237/) {
+    if ($self->external_id && $self->send_method_used && $self->bodies_str =~ /(2237|2550)/) {
         return 1;
     }
     return 0;    
diff --git a/perllib/FixMyStreet/SendReport/Angus.pm b/perllib/FixMyStreet/SendReport/Angus.pm
new file mode 100644
index 000000000..4373c3c37
--- /dev/null
+++ b/perllib/FixMyStreet/SendReport/Angus.pm
@@ -0,0 +1,172 @@
+package FixMyStreet::SendReport::Angus;
+
+use Moo;
+
+BEGIN { extends 'FixMyStreet::SendReport'; }
+
+use Try::Tiny;
+use Encode;
+use XML::Simple;
+use mySociety::Web qw(ent);
+
+sub get_auth_token {
+    my ($self, $authxml) = @_;
+
+    my $xml = new XML::Simple;
+    my $obj;
+
+    eval {
+        $obj = $xml->parse_string( $authxml );
+    };
+
+    my $success = $obj->{success};
+    $success =~ s/^\s+|\s+$//g if defined $success;
+    my $token = $obj->{AuthenticateResult};
+    $token =~ s/^\s+|\s+$//g if defined $token;
+
+    if (defined $success && $success eq 'True' && defined $token) {
+        return $token;
+    } else {
+        $self->error("Couldn't authenticate against Angus endpoint.");
+    }
+}
+
+sub get_external_id {
+    my ($self, $resultxml) = @_;
+
+    my $xml = new XML::Simple;
+    my $obj;
+
+    eval {
+        $obj = $xml->parse_string( $resultxml );
+    };
+
+    my $success = $obj->{success};
+    $success =~ s/^\s+|\s+$//g if defined $success;
+    my $external_id = $obj->{CreateRequestResult}->{RequestId};
+
+    if (defined $success && $success eq 'True' && defined $external_id) {
+        return $external_id;
+    } else {
+        $self->error("Couldn't find external id in response from Angus endpoint.");
+        return undef;
+    }
+}
+
+sub crm_request_type {
+    my ($self, $row, $h) = @_;
+    return 'StLight'; # TODO: Set this according to report category
+}
+
+sub jadu_form_fields {
+    my ($self, $row, $h) = @_;
+    my $xml = XML::Simple->new(
+        NoAttr=> 1,
+        KeepRoot => 1,
+        SuppressEmpty => 0,
+    );
+    my $metas = $row->get_extra_fields();
+    my %extras;
+    foreach my $field (@$metas) {
+        $extras{$field->{name}} = $field->{value};
+    }
+    my $cobrand = FixMyStreet::Cobrand->get_class_for_moniker($row->cobrand)->new();
+    my $output = $xml->XMLout({
+        formfields => {
+            formfield => [
+                {
+                    name => 'RequestTitle',
+                    value => $h->{title}
+                },
+                {
+                    name => 'RequestDetails',
+                    value => $h->{detail}
+                },
+                {
+                    name => 'ReporterName',
+                    value => $h->{name}
+                },
+                {
+                    name => 'ReporterEmail',
+                    value => $h->{email}
+                },
+                {
+                    name => 'ReporterAnonymity',
+                    value => $row->anonymous ? 'True' : 'False'
+                },
+                {
+                    name => 'ReportedDateTime',
+                    value => $h->{confirmed}
+                },
+                {
+                    name => 'ColumnId',
+                    value => $extras{'column_id'} || ''
+                },
+                {
+                    name => 'ReportId',
+                    value => $h->{id}
+                },
+                {
+                    name => 'ReportedNorthing',
+                    value => $h->{northing}
+                },
+                {
+                    name => 'ReportedEasting',
+                    value => $h->{easting}
+                },
+                {
+                    name => 'Imageurl1',
+                    value => $row->photos->[0] ? ($cobrand->base_url . $row->photos->[0]->{url_full}) : ''
+                },
+                {
+                    name => 'Imageurl2',
+                    value => $row->photos->[1] ? ($cobrand->base_url . $row->photos->[1]->{url_full}) : ''
+                },
+                {
+                    name => 'Imageurl3',
+                    value => $row->photos->[2] ? ($cobrand->base_url . $row->photos->[2]->{url_full}) : ''
+                }
+            ]
+        }
+    });
+    # The endpoint crashes if the JADUFormFields string has whitespace between XML elements, so strip it out...
+    $output =~ s/>[\s\n]+</></g;
+    return $output;
+}
+
+sub send {
+    my ( $self, $row, $h ) = @_;
+
+    # FIXME: should not recreate this each time
+    my $angus_service;
+
+    require Integrations::AngusSOAP;
+
+    my $return = 1;
+    $angus_service ||= Integrations::AngusSOAP->on_fault(sub { my($soap, $res) = @_; die ref $res ? $res->faultstring : $soap->transport->status, "\n"; });
+    try {
+        my $authresult = $angus_service->AuthenticateJADU();
+        my $authtoken = $self->get_auth_token( $authresult );
+        # authenticationtoken, CallerId, CallerAddressId, DeliveryId, DeliveryAddressId, CRMRequestType, JADUXFormRef, PaymentRef, JADUFormFields
+        my $message = ent(encode_utf8($h->{message}));
+        my $name = ent(encode_utf8($h->{name}));
+        my $result = $angus_service->CreateServiceRequest(
+            $authtoken, '1', '1', '1', '1', $self->crm_request_type($row, $h),
+            'FMS', '', $self->jadu_form_fields($row, $h)
+        );
+        my $external_id = $self->get_external_id( $result );
+        if ( $external_id ) {
+            $row->external_id( $external_id );
+            $row->send_method_used('Angus');
+            $return = 0;
+        }
+    } catch {
+        my $e = $_;
+        print "Caught an error: $e\n";
+        $self->error( "Error sending to Angus: $e" );
+    };
+    $self->success( !$return );
+    return $return;
+}
+
+1;
diff --git a/perllib/FixMyStreet/SendReport/EastHants.pm b/perllib/FixMyStreet/SendReport/EastHants.pm
index 3eb8ffcfa..cc302b8b3 100644
--- a/perllib/FixMyStreet/SendReport/EastHants.pm
+++ b/perllib/FixMyStreet/SendReport/EastHants.pm
@@ -35,12 +35,12 @@ sub send {
     # FIXME: should not recreate this each time
     my $eh_service;
 
-    require EastHantsWSDL;
+    require Integrations::EastHantsWSDL;
 
     $h->{category} = 'Customer Services' if $h->{category} eq 'Other';
     $h->{message} = construct_message( %$h );
     my $return = 1;
-    $eh_service ||= EastHantsWSDL->on_fault(sub { my($soap, $res) = @_; die ref $res ? $res->faultstring : $soap->transport->status, "\n"; });
+    $eh_service ||= Integrations::EastHantsWSDL->on_fault(sub { my($soap, $res) = @_; die ref $res ? $res->faultstring : $soap->transport->status, "\n"; });
     try {
         # ServiceName, RemoteCreatedBy, Salutation, FirstName, Name, Email, Telephone, HouseNoName, Street, Town, County, Country, Postcode, Comments, FurtherInfo, ImageURL
         my $message = ent(encode_utf8($h->{message}));
diff --git a/perllib/Integrations/AngusSOAP.pm b/perllib/Integrations/AngusSOAP.pm
new file mode 100644
index 000000000..5f100993b
--- /dev/null
+++ b/perllib/Integrations/AngusSOAP.pm
@@ -0,0 +1,168 @@
+package Integrations::AngusSOAP;
+
+# Generated by SOAP::Lite (v0.715) for Perl -- soaplite.com
+# Copyright (C) 2000-2006 Paul Kulchenko, Byrne Reese
+# -- generated at [Thu Dec 17 15:16:47 2015]
+# -- generated from https://webserviceslive.angus.gov.uk/acwebservices.cfc?wsdl
+# -- generated with the stubmaker.pl script from SOAP::Lite
+
+# Angus provide endpoints for testing and production, make sure we're using the right one.
+use FixMyStreet;
+my $TEST_ENDPOINT = 'https://webservicestest.angus.gov.uk/acwebservices.cfc';
+my $LIVE_ENDPOINT = 'https://webserviceslive.angus.gov.uk/acwebservices.cfc';
+my $ENDPOINT = FixMyStreet->config('STAGING_SITE') ? $TEST_ENDPOINT : $LIVE_ENDPOINT;
+
+# It can be helpful to override the endpoint URL e.g. for dev or testing
+$ENDPOINT = FixMyStreet->config('ANGUS_ENDPOINT') ? FixMyStreet->config('ANGUS_ENDPOINT') : $ENDPOINT;
+
+my %methods = (
+'GetLocaleInfo' => {
+    endpoint => $ENDPOINT,
+    soapaction => '',
+    namespace => 'http://DefaultNamespace',
+    parameters => [
+      SOAP::Data->new(name => 'authenticationtoken', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'uprn', type => 'xsd:string', attr => {}),
+    ], # end parameters
+  }, # end GetLocaleInfo
+'AuthenticateJADU' => {
+    endpoint => $ENDPOINT,
+    soapaction => '',
+    namespace => 'http://DefaultNamespace',
+    parameters => [
+    ], # end parameters
+  }, # end AuthenticateJADU
+'CreateServiceRequest' => {
+    endpoint => $ENDPOINT,
+    soapaction => '',
+    namespace => 'http://DefaultNamespace',
+    parameters => [
+      SOAP::Data->new(name => 'authenticationtoken', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'CallerId', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'CallerAddressId', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'DeliveryId', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'DeliveryAddressId', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'CRMRequestType', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'JADUXFormRef', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'PaymentRef', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'JADUFormFields', type => 'xsd:string', attr => {}),
+    ], # end parameters
+  }, # end CreateServiceRequest
+'PropertySearch' => {
+    endpoint => $ENDPOINT,
+    soapaction => '',
+    namespace => 'http://DefaultNamespace',
+    parameters => [
+      SOAP::Data->new(name => 'authenticationtoken', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'postcode', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'streetname', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'town', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'UPRN', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'USRN', type => 'xsd:string', attr => {}),
+    ], # end parameters
+  }, # end PropertySearch
+'CreateCustomer' => {
+    endpoint => $ENDPOINT,
+    soapaction => '',
+    namespace => 'http://DefaultNamespace',
+    parameters => [
+      SOAP::Data->new(name => 'authenticationtoken', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'title', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'forename', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'surname', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'uprn', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'HouseNo', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'HouseName', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'StreetName', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'Locale', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'Town', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'County', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'Northing', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'Easting', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'postcode', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'email', type => 'xsd:string', attr => {}),
+      SOAP::Data->new(name => 'telephone', type => 'xsd:string', attr => {}),
+    ], # end parameters
+  }, # end CreateCustomer
+); # end my %methods
+
+use SOAP::Lite;
+use Exporter;
+use Carp ();
+
+use vars qw(@ISA $AUTOLOAD @EXPORT_OK %EXPORT_TAGS);
+@ISA = qw(Exporter SOAP::Lite);
+@EXPORT_OK = (keys %methods);
+%EXPORT_TAGS = ('all' => [@EXPORT_OK]);
+
+sub _call {
+    my ($self, $method) = (shift, shift);
+    my $name = UNIVERSAL::isa($method => 'SOAP::Data') ? $method->name : $method;
+    my %method = %{$methods{$name}};
+    $self->proxy($method{endpoint} || Carp::croak "No server address (proxy) specified")
+        unless $self->proxy;
+    my @templates = @{$method{parameters}};
+    my @parameters = ();
+    foreach my $param (@_) {
+        if (@templates) {
+            my $template = shift @templates;
+            my ($prefix,$typename) = SOAP::Utils::splitqname($template->type);
+            my $method = 'as_'.$typename;
+            # TODO - if can('as_'.$typename) {...}
+            my $result = $self->serializer->$method($param, $template->name, $template->type, $template->attr);
+            push(@parameters, $template->value($result->[2]));
+        }
+        else {
+            push(@parameters, $param);
+        }
+    }
+    $self->endpoint($method{endpoint})
+       ->ns($method{namespace})
+       ->on_action(sub{qq!"$method{soapaction}"!});
+  $self->serializer->register_ns("http://schemas.xmlsoap.org/wsdl/soap/","wsdlsoap");
+  $self->serializer->register_ns("http://DefaultNamespace","intf");
+  $self->serializer->register_ns("http://xml.apache.org/xml-soap","apachesoap");
+  $self->serializer->register_ns("http://rpc.xml.coldfusion","tns1");
+  $self->serializer->register_ns("http://DefaultNamespace","impl");
+  $self->serializer->register_ns("http://schemas.xmlsoap.org/wsdl/","wsdl");
+  $self->serializer->register_ns("http://schemas.xmlsoap.org/soap/encoding/","soapenc");
+  $self->serializer->register_ns("http://www.w3.org/2001/XMLSchema","xsd");
+    my $som = $self->SUPER::call($method => @parameters);
+    if ($self->want_som) {
+        return $som;
+    }
+    UNIVERSAL::isa($som => 'SOAP::SOM') ? wantarray ? $som->paramsall : $som->result : $som;
+}
+
+sub BEGIN {
+    no strict 'refs';
+    for my $method (qw(want_som)) {
+        my $field = '_' . $method;
+        *$method = sub {
+            my $self = shift->new;
+            @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
+        }
+    }
+}
+no strict 'refs';
+for my $method (@EXPORT_OK) {
+    my %method = %{$methods{$method}};
+    *$method = sub {
+        my $self = UNIVERSAL::isa($_[0] => __PACKAGE__)
+            ? ref $_[0]
+                ? shift # OBJECT
+                # CLASS, either get self or create new and assign to self
+                : (shift->self || __PACKAGE__->self(__PACKAGE__->new))
+            # function call, either get self or create new and assign to self
+            : (__PACKAGE__->self || __PACKAGE__->self(__PACKAGE__->new));
+        $self->_call($method, @_);
+    }
+}
+
+sub AUTOLOAD {
+    my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
+    return if $method eq 'DESTROY' || $method eq 'want_som';
+    die "Unrecognized method '$method'. List of available method(s): @EXPORT_OK\n";
+}
+
+1;
diff --git a/perllib/EastHantsWSDL.pm b/perllib/Integrations/EastHantsWSDL.pm
index 181cc93a1..b35309c3d 100644
--- a/perllib/EastHantsWSDL.pm
+++ b/perllib/Integrations/EastHantsWSDL.pm
@@ -1,4 +1,4 @@
-package EastHantsWSDL;
+package Integrations::EastHantsWSDL;
 
 # -- generated by SOAP::Lite (v0.60) for Perl -- soaplite.com -- Copyright (C) 2000-2001 Paul Kulchenko --
 # -- generated from http://www.easthants.gov.uk/forms.nsf/InputFeedback?WSDL [Thu Oct 16 12:31:57 2008]
diff --git a/t/app/sendreport/angus.t b/t/app/sendreport/angus.t
new file mode 100644
index 000000000..a19ee483a
--- /dev/null
+++ b/t/app/sendreport/angus.t
@@ -0,0 +1,61 @@
+use strict;
+use warnings;
+
+use FixMyStreet::DB;
+
+use Test::More;
+
+use_ok("FixMyStreet::SendReport::Angus");
+
+my $u = FixMyStreet::DB->resultset('User')->new( { email => 'test@example.org', name => 'A User' } );
+
+my $p = FixMyStreet::DB->resultset('Problem')->new( {
+    latitude => 1,
+    longitude => 1,
+    title => 'title',
+    detail => 'detail',
+    user => $u,
+    id => 1,
+    name => 'A User',
+    cobrand => 'fixmystreet',
+} );
+
+my $angus = FixMyStreet::SendReport::Angus->new();
+
+subtest 'parses authentication token correctly' => sub {
+    my $authxml = <<EOT;
+    <AuthenticateResponse>
+
+            <AuthenticateResult>
+                TVRreUxqRTJPQzR5TlRVdU1qSjhNakF4Tmpvd01Ub3lNam94TlRvME16b3pPUT09VGhvdVNoYWx0Tm90UGFzcw==
+            </AuthenticateResult>
+            <success>
+                    True
+            </success>
+            <message></message>
+
+    </AuthenticateResponse>
+EOT
+;
+    is $angus->get_auth_token($authxml), 'TVRreUxqRTJPQzR5TlRVdU1qSjhNakF4Tmpvd01Ub3lNam94TlRvME16b3pPUT09VGhvdVNoYWx0Tm90UGFzcw==', 'token correct';
+};
+
+subtest 'parses report external id correctly' => sub {
+    my $respxml = <<EOT;
+<CreateRequestResponse>
+
+    <CreateRequestResult>
+        <RequestId>7245</RequestId>
+    </CreateRequestResult>
+
+    <success>True</success>
+    <message></message>
+
+</CreateRequestResponse>
+EOT
+;
+    is $angus->get_external_id($respxml), '7245', 'external id correct';
+};
+
+
+done_testing();