diff options
Diffstat (limited to 'perllib/FixMyStreet/SendReport/Barnet.pm')
| -rw-r--r-- | perllib/FixMyStreet/SendReport/Barnet.pm | 222 |
1 files changed, 222 insertions, 0 deletions
diff --git a/perllib/FixMyStreet/SendReport/Barnet.pm b/perllib/FixMyStreet/SendReport/Barnet.pm new file mode 100644 index 000000000..9a54dd91d --- /dev/null +++ b/perllib/FixMyStreet/SendReport/Barnet.pm @@ -0,0 +1,222 @@ +package FixMyStreet::SendReport::Barnet; + +use Moose; + +BEGIN { extends 'FixMyStreet::SendReport'; } + +use BarnetInterfaces::service::ZLBB_SERVICE_ORDER; +use Encode; +use Utils; +use mySociety::Config; +use mySociety::Web qw(ent); + +# maximum number of webservice attempts to send before not trying any more (XXX may be better in config?) +use constant SEND_FAIL_RETRIES_CUTOFF => 3; + +# specific council numbers +use constant COUNCIL_ID_BARNET => 2489; +use constant MAX_LINE_LENGTH => 132; + +sub should_skip { + my $self = shift; + my $problem = shift; + + my $council_name = 'Barnet'; + my $err_msg = ""; + + if ($problem->send_fail_count >= SEND_FAIL_RETRIES_CUTOFF) { + $council_name &&= " to $council_name"; + $err_msg = "skipped: problem id=" . $problem->id . " send$council_name has failed " + . $problem->send_fail_count . " times, cutoff is " . SEND_FAIL_RETRIES_CUTOFF; + + $self->skipped( $err_msg ); + + return 1; + } +} + +sub construct_message { + my %h = @_; + my $message = <<EOF; +Subject: $h{title} + +Details: $h{detail} + +$h{fuzzy}, or to provide an update on the problem, please visit the following link: + +$h{url} + +$h{closest_address} +EOF +} + + +sub send { + my ( $self, $problem, $h, $to, $template, $recips, $nomail ) = @_; + + my %h = %$h; + + $h{message} = construct_message(%h); + + my $return = 1; + my $err_msg = ""; + + my $default_kbid = 14; # This is the default, "Street Scene" + my $kbid = sprintf( "%050d", Utils::barnet_categories()->{$h{category}} || $default_kbid); + + my $geo_code = "$h{easting} $h{northing}"; + + my $interface = BarnetInterfaces::service::ZLBB_SERVICE_ORDER->new(); + + my ($nearest_postcode, $nearest_street) = ('', ''); + for ($h{closest_address}) { + $nearest_postcode = sprintf("%-10s", $1) if /Nearest postcode [^:]+: ((\w{1,4}\s?\w+|\w+))/; + # use partial postcode or comma as delimiter, strip leading number (possible letter 221B) off too + # "99 Foo Street, London N11 1XX" becomes Foo Street + # "99 Foo Street N11 1XX" becomes Foo Street + $nearest_street = $1 if /Nearest road [^:]+: (?:\d+\w? )?(.*?)(\b[A-Z]+\d|,|$)/m; + } + my $postcode = mySociety::PostcodeUtil::is_valid_postcode($h{query}) + ? $h{query} : $nearest_postcode; # use given postcode if available + + # note: endpoint can be of form 'https://username:password@url' + my $council_config = FixMyStreet::App->model("DB::Open311conf")->search( { area_id => COUNCIL_ID_BARNET} )->first; + if ($council_config and $council_config->endpoint) { + $interface->set_proxy($council_config->endpoint); + # Barnet web service doesn't like namespaces in the elements so use a prefix + $interface->set_prefix('urn'); + # uncomment these lines to print XML that will be sent rather + # than connecting to the endpoint + #$interface->outputxml(1); + #$interface->no_dispatch(1); + } else { + die "Barnet webservice FAIL: looks like you're missing some config data: no endpoint (URL) found for area_id=" . COUNCIL_ID_BARNET; + } + + eval { + my $result = $interface->Z_CRM_SERVICE_ORDER_CREATE( { + ET_RETURN => { # ignored by server + item => { + TYPE => "", ID => "", NUMBER => "", MESSAGE => "", LOG_NO => "", LOG_MSG_NO => "", + MESSAGE_V1 => "", MESSAGE_V2 => "", MESSAGE_V3 => "", MESSAGE_V4 => "", PARAMETER => "", + ROW => "", FIELD => "", SYSTEM => "", + }, + }, + IT_PROBLEM_DESC => { # MyTypes::TABLE_OF_CRMT_SERVICE_REQUEST_TEXT + item => [ # MyTypes::CRMT_SERVICE_REQUEST_TEXT + map { { TEXT_LINE => $_ } } split_text_with_entities(ent(encode_utf8($h{message})), 132) # char132 + ], + }, + IV_CUST_EMAIL => truncate_string_with_entities(ent(encode_utf8($h{email})), 241), # char241 + IV_CUST_NAME => truncate_string_with_entities(ent(encode_utf8($h{name})), 50), # char50 + IV_KBID => $kbid, # char50 + IV_PROBLEM_ID => $h{id}, # char35 + IV_PROBLEM_LOC => { # MyTypes::BAPI_TTET_ADDRESS_COM + COUNTRY2 => 'GB', # char2 + REGION => "", # char3 + COUNTY => "", # char30 + CITY => "", # char30 + POSTALCODE => $postcode, # char10 + STREET => truncate_string_with_entities(ent(encode_utf8($nearest_street)), 30), # char30 + STREETNUMBER => "", # char5 + GEOCODE => $geo_code, # char32 + }, + IV_PROBLEM_SUB => truncate_string_with_entities(ent(encode_utf8($h{title})), 40), # char40 + }, + ); + if ($result) { + # currently not using this: get_EV_ORDER_GUID (maybe that's the customer number in the CRM) + if (my $barnet_id = $result->get_EV_ORDER_NO()) { + $problem->external_id( $barnet_id ); + $problem->external_body( 'Barnet Borough Council' ); # better to use $problem->body()? + $problem->send_method_used('barnet'); + $return = 0; + } else { + my @returned_items = split /<item[^>]*>/, $result->get_ET_RETURN; + my @messages = (); + foreach my $item (@returned_items) { + if ($item=~/<MESSAGE [^>]*>\s*(\S.*?)<\/MESSAGE>/) { # if there's a non-null MESSAGE in there, grab it + push @messages, $1; # best stab at extracting useful error message back from convoluted response + } + } + push @messages, "service returned no external id" unless @messages; + $err_msg = "Failed (problem id $h{id}): " . join(" \n ", @messages); + } + } else { + my %fault = ( + 'code' => $result->get_faultcode(), + 'actor' => $result->get_faultactor(), + 'string' => $result->get_faultstring(), + 'detail' => $result->get_detail(), # possibly only contains debug info + ); + $fault{$_}=~s/^\s*|\s*$//g foreach keys %fault; + $fault{actor}&&=" (actor: $fault{actor})"; + $fault{'detail'} &&= "\n" . $fault{'detail'}; + $err_msg = "Failed (problem id $h{id}): Fault $fault{code}$fault{actor}\n$fault{string}$fault{detail}"; + } + + }; + print "$err_msg\n" if $err_msg; + if ($@) { + my $e = shift; + print "Caught an error: $@\n"; + } + if ( $return ) { + $self->error( "Error sending to Barnet: $err_msg" ); + } + $self->success( !$return ); + return $return; +} + +# for barnet webservice: max-length fields require truncate and split + +# truncate_string_with_entities +# args: text to truncate +# max number of chars +# returns: string truncated +# Note: must not partially truncate an entity (e.g., &) +sub truncate_string_with_entities { + my ($str, $max_len) = @_; + my $retVal = ""; + foreach my $chunk (split /(\&(?:\#\d+|\w+);)/, $str) { + if ($chunk=~/^\&(\#\d+|\w+);$/){ + my $next = $retVal.$chunk; + last if length $next > $max_len; + $retVal=$next + } else { + $retVal.=$chunk; + if (length $retVal > $max_len) { + $retVal = substr($retVal, 0, $max_len); + last + } + } + } + return $retVal +} + +# split_text_with_entities into lines +# args: text to be broken into lines +# max length (option: uses constant MAX_LINE_LENGTH) +# returns: array of lines +# Must not to split an entity (e.g., &) +# Not worrying about hyphenating here, since a word is only ever split if +# it's longer than the whole line, which is uncommon in genuine problem reports +sub split_text_with_entities { + my ($text, $max_line_length) = @_; + $max_line_length ||= MAX_LINE_LENGTH; + my @lines; + foreach my $line (split "\n", $text) { + while (length $line > $max_line_length) { + if (! ($line =~ s/^(.{1,$max_line_length})\s// # break on a space + or $line =~ s/^(.{1,$max_line_length})(\&(\#\d+|\w+);)/$2/ # break before an entity + or $line =~ s/(.{$max_line_length})//)) { # break the word ruthlessly + $line =~ s/(.*)//; # otherwise gobble whole line (which is now shorter than max length) + } + push @lines, $1; + } + push @lines, $line; + } + return @lines; +} + +1; |