diff options
Diffstat (limited to 'perllib')
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/FixMyStreet.pm | 11 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/TfL.pm | 92 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/UKCouncils.pm | 30 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/Westminster.pm | 4 |
4 files changed, 125 insertions, 12 deletions
diff --git a/perllib/FixMyStreet/Cobrand/FixMyStreet.pm b/perllib/FixMyStreet/Cobrand/FixMyStreet.pm index a6161b570..6e0a0e2a5 100644 --- a/perllib/FixMyStreet/Cobrand/FixMyStreet.pm +++ b/perllib/FixMyStreet/Cobrand/FixMyStreet.pm @@ -86,11 +86,7 @@ sub munge_reports_categories_list { sub munge_report_new_category_list { my ($self, $options, $contacts, $extras) = @_; - # No TfL Traffic Lights category in Hounslow my %bodies = map { $_->body->name => $_->body } @$contacts; - if ( $bodies{'Hounslow Borough Council'} ) { - @$options = grep { ($_->{category} || $_->category) !~ /^Traffic lights$/i } @$options; - } if ( $bodies{'Isle of Wight Council'} ) { my $user = $self->{c}->user; @@ -105,6 +101,13 @@ sub munge_report_new_category_list { my $seen = { map { $_->category => 1 } @$contacts }; @$options = grep { my $c = ($_->{category} || $_->category); $c =~ 'Pick a category' || $seen->{ $c } } @$options; } + + if ( $bodies{'TfL'} ) { + # Presented categories vary if we're on/off a red route + my $tfl = FixMyStreet::Cobrand->get_class_for_moniker( 'tfl' )->new({ c => $self->{c} }); + $tfl->munge_red_route_categories($options, $contacts); + } + } sub munge_load_and_group_problems { diff --git a/perllib/FixMyStreet/Cobrand/TfL.pm b/perllib/FixMyStreet/Cobrand/TfL.pm index c91b8a79c..b8c03c7a9 100644 --- a/perllib/FixMyStreet/Cobrand/TfL.pm +++ b/perllib/FixMyStreet/Cobrand/TfL.pm @@ -7,6 +7,8 @@ use warnings; use POSIX qw(strcoll); use FixMyStreet::MapIt; +use mySociety::ArrayUtils; +use Utils; sub council_area_id { return [ 2511, 2489, 2494, 2488, 2482, 2505, 2512, 2481, 2484, 2495, @@ -362,4 +364,94 @@ sub munge_sendreport_params { $params->{To} = \@munged_to; } +sub report_new_is_on_tlrn { + my ( $self ) = @_; + + my ($x, $y) = Utils::convert_latlon_to_en( + $self->{c}->stash->{latitude}, + $self->{c}->stash->{longitude}, + 'G' + ); + + my $cfg = { + url => "https://tilma.mysociety.org/mapserver/tfl", + srsname => "urn:ogc:def:crs:EPSG::27700", + typename => "RedRoutes", + filter => "<Filter><Contains><PropertyName>geom</PropertyName><gml:Point><gml:coordinates>$x,$y</gml:coordinates></gml:Point></Contains></Filter>", + }; + + my $features = $self->_fetch_features($cfg, $x, $y); + return scalar @$features ? 1 : 0; +} + +sub munge_report_new_category_list { } + +sub munge_red_route_categories { + my ($self, $options, $contacts) = @_; + if ( $self->report_new_is_on_tlrn ) { + # We're on a red route - only send TfL categories (except the disabled + # one that directs the user to borough for street cleaning XXX TODO: make sure this is included when on the TfL cobrand) and borough + # street cleaning categories. + my %cleaning_cats = map { $_ => 1 } @{ $self->_cleaning_categories }; + @$contacts = grep { + ( $_->body->name eq 'TfL' && $_->category ne $self->_tfl_council_category ) + || $cleaning_cats{$_->category} + || @{ mySociety::ArrayUtils::intersection( $self->_cleaning_groups, $_->groups ) } + } @$contacts; + } else { + # We're not on a red route - send all categories except + # TfL red-route-only. + my %tlrn_cats = map { $_ => 1 } @{ $self->_tlrn_categories }; + @$contacts = grep { !( $_->body->name eq 'TfL' && $tlrn_cats{$_->category } ) } @$contacts; + } + my $seen = { map { $_->category => 1 } @$contacts }; + @$options = grep { my $c = ($_->{category} || $_->category); $c =~ 'Pick a category' || $seen->{ $c } } @$options; +} + +# Reports in these categories can only be made on a red route +sub _tlrn_categories { [ + "All out - three or more street lights in a row", + "Blocked drain", + "Damage - general (Trees)", + "Dead animal in the carriageway or footway", + "Debris in the carriageway", + "Fallen Tree", + "Flooding", + "Flytipping (TfL)", + "Graffiti / Flyposting (non-offensive)", + "Graffiti / Flyposting (offensive)", + "Graffiti / Flyposting on street light (non-offensive)", + "Graffiti / Flyposting on street light (offensive)", + "Grass Cutting and Hedges", + "Hoardings blocking carriageway or footway", + "Light on during daylight hours", + "Lights out in Pedestrian Subway", + "Low hanging branches and general maintenance", + "Manhole Cover - Damaged (rocking or noisy)", + "Manhole Cover - Missing", + "Mobile Crane Operation", + "Other (TfL)", + "Pavement Defect (uneven surface / cracked paving slab)", + "Pothole", + "Roadworks", + "Scaffolding blocking carriageway or footway", + "Single Light out (street light)", + "Standing water", + "Unstable hoardings", + "Unstable scaffolding", + "Worn out road markings", +] } + +sub _cleaning_categories { [ + 'Street cleaning', + 'Street Cleaning', + 'Accumulated Litter', + 'Street Cleaning Enquiry', + 'Street Cleansing', +] } + +sub _cleaning_groups { [ 'Street cleaning' ] } + +sub _tfl_council_category { 'General Litter / Rubbish Collection' } + 1; diff --git a/perllib/FixMyStreet/Cobrand/UKCouncils.pm b/perllib/FixMyStreet/Cobrand/UKCouncils.pm index ef0bcf4fb..97c8b6c81 100644 --- a/perllib/FixMyStreet/Cobrand/UKCouncils.pm +++ b/perllib/FixMyStreet/Cobrand/UKCouncils.pm @@ -289,6 +289,18 @@ sub prefill_report_fields_for_inspector { 1 } sub social_auth_disabled { 1 } +sub munge_report_new_category_list { + my ($self, $options, $contacts, $extras) = @_; + + my %bodies = map { $_->body->name => $_->body } @$contacts; + if ( $bodies{'TfL'} ) { + # Presented categories vary if we're on/off a red route + my $tfl = FixMyStreet::Cobrand->get_class_for_moniker( 'tfl' )->new({ c => $self->{c} }); + $tfl->munge_red_route_categories($options, $contacts); + } +} + + =head2 lookup_site_code Reports made via FMS.com or the app probably won't have a site code @@ -317,10 +329,16 @@ sub lookup_site_code { sub _fetch_features { my ($self, $cfg, $x, $y) = @_; - my $buffer = $cfg->{buffer}; - my ($w, $s, $e, $n) = ($x-$buffer, $y-$buffer, $x+$buffer, $y+$buffer); - my $uri = $self->_fetch_features_url($cfg, $w, $s, $e,$n); + # default to a buffered bounding box around the given point unless + # a custom filter parameter has been specified. + unless ( $cfg->{filter} ) { + my $buffer = $cfg->{buffer}; + my ($w, $s, $e, $n) = ($x-$buffer, $y-$buffer, $x+$buffer, $y+$buffer); + $cfg->{bbox} = "$w,$s,$e,$n"; + } + + my $uri = $self->_fetch_features_url($cfg); my $response = get($uri) or return; my $j = JSON->new->utf8->allow_nonref; @@ -336,7 +354,7 @@ sub _fetch_features { } sub _fetch_features_url { - my ($self, $cfg, $w, $s, $e, $n) = @_; + my ($self, $cfg) = @_; my $uri = URI->new($cfg->{url}); $uri->query_form( @@ -346,7 +364,7 @@ sub _fetch_features_url { TYPENAME => $cfg->{typename}, VERSION => "1.1.0", outputformat => "geojson", - BBOX => "$w,$s,$e,$n" + $cfg->{filter} ? ( Filter => $cfg->{filter} ) : ( BBOX => $cfg->{bbox} ), ); return $uri; @@ -372,7 +390,7 @@ sub _nearest_feature { next unless $accept_types->{$feature->{geometry}->{type}}; my @linestrings = @{ $feature->{geometry}->{coordinates} }; - if ( $feature->{geometry}->{type} eq 'LineString') { + if ( $feature->{geometry}->{type} eq 'LineString' ) { @linestrings = ([ @linestrings ]); } # If it is a point, upgrade it to a one-segment zero-length diff --git a/perllib/FixMyStreet/Cobrand/Westminster.pm b/perllib/FixMyStreet/Cobrand/Westminster.pm index 8adb7eb2c..7a3d7bbcd 100644 --- a/perllib/FixMyStreet/Cobrand/Westminster.pm +++ b/perllib/FixMyStreet/Cobrand/Westminster.pm @@ -122,7 +122,7 @@ sub lookup_site_code_config { } sub _fetch_features_url { - my ($self, $cfg, $w, $s, $e, $n) = @_; + my ($self, $cfg) = @_; # Westminster's asset proxy has a slightly different calling style to # a standard WFS server. @@ -132,7 +132,7 @@ sub _fetch_features_url { outSR => "27700", f => "geojson", outFields => $cfg->{property}, - geometry => "$w,$s,$e,$n", + geometry => $cfg->{bbox}, ); return $cfg->{proxy_url} . "?" . $uri->as_string; |