From cb49284dc0503b2a05ca2bb98b8a1320431c2616 Mon Sep 17 00:00:00 2001 From: Matthew Somerville Date: Tue, 15 Mar 2016 13:29:42 +0000 Subject: Updates to cpanfile and code for perl 5.20/5.22. The following modules had bugs that have been fixed for working in recent perls: * List::MoreUtils * Guard * PadWalker * aliased * URI * Convert::NLS_DATE_FORMAT The CGI module was removed from core in 5.20, so include it in the snapshot (I don't think it's actually used, but is a dependency). "{" needs to be escaped in regular expressions, and ~~ should not be used. Fix some tests that expect e.g. a certain hash ordering, to use sorted output or better comparisons. --- cpanfile | 10 +- cpanfile.snapshot | 204 ++++++++++++++++++------------ perllib/FixMyStreet/App/Controller/Rss.pm | 12 +- perllib/FixMyStreet/TestMech.pm | 4 +- perllib/Open311/Endpoint.pm | 2 +- t/app/helpers/send_email.t | 26 +++- t/app/helpers/send_email_sample_mime.txt | 10 +- t/cobrand/zurich.t | 18 ++- t/cobrand/zurich_attachments.txt | 8 +- t/open311/endpoint.t | 18 +-- t/open311/endpoint/Endpoint1.pm | 3 +- t/open311/getupdates.t | 22 +++- 12 files changed, 212 insertions(+), 125 deletions(-) diff --git a/cpanfile b/cpanfile index abdd33ca3..28e3d57f9 100644 --- a/cpanfile +++ b/cpanfile @@ -1,5 +1,5 @@ # setenv script -requires 'List::MoreUtils'; +requires 'List::MoreUtils', '0.402'; requires 'local::lib'; requires 'Class::Unload'; @@ -7,6 +7,11 @@ requires 'Class::Unload'; requires 'ExtUtils::MakeMaker', '6.72'; # [1] # requires 'MooseX::NonMoose'; # [2] +# Minimum versions of dependencies to upgrade for bugfixes +requires 'Guard', '1.023'; +requires 'PadWalker', '2.2'; +requires 'aliased', '0.34'; + # Catalyst itself, and modules/plugins used requires 'Catalyst', '5.80031'; requires 'Catalyst::Action::RenderView'; @@ -84,7 +89,7 @@ requires 'Statistics::Distributions'; requires 'Storable'; requires 'Template::Plugin::Number::Format'; requires 'Text::CSV'; -requires 'URI'; +requires 'URI', '1.71'; requires 'URI::Escape'; requires 'URI::QueryParam'; requires 'XML::RSS'; @@ -102,6 +107,7 @@ feature 'open311-endpoint', 'Open311::Endpoint specific requirements' => sub { requires 'MooX::HandlesVia'; requires 'Types::Standard'; requires 'DateTime::Format::Oracle'; # for EXOR + requires 'Convert::NLS_DATE_FORMAT', '0.06'; # Perl 5.22 upgrade }; feature 'zurich', 'Zueri wie neu specific requirements' => sub { diff --git a/cpanfile.snapshot b/cpanfile.snapshot index 973259393..591f3fcbd 100644 --- a/cpanfile.snapshot +++ b/cpanfile.snapshot @@ -63,6 +63,36 @@ DISTRIBUTIONS Sub::Exporter::Progressive 0.001006 Test::More 0.88 Variable::Magic 0.48 + CGI-4.28 + pathname: L/LE/LEEJO/CGI-4.28.tar.gz + provides: + CGI 4.28 + CGI::Carp 4.28 + CGI::Cookie 4.28 + CGI::File::Temp 4.28 + CGI::HTML::Functions undef + CGI::Pretty 4.28 + CGI::Push 4.28 + CGI::Util 4.28 + Fh 4.28 + MultipartBuffer 4.28 + requirements: + Carp 0 + Config 0 + Encode 0 + Exporter 0 + ExtUtils::MakeMaker 0 + File::Spec 0.82 + File::Temp 0 + HTML::Entities 3.69 + base 0 + if 0 + overload 0 + parent 0.225 + perl 5.008001 + strict 0 + utf8 0 + warnings 0 CGI-Simple-1.113 pathname: A/AN/ANDYA/CGI-Simple-1.113.tar.gz provides: @@ -851,12 +881,13 @@ DISTRIBUTIONS Test::Exception 0 Test::More 0 ok 0 - Convert-NLS_DATE_FORMAT-0.05 - pathname: K/KO/KOLIBRIE/Convert-NLS_DATE_FORMAT-0.05.tar.gz + Convert-NLS_DATE_FORMAT-0.06 + pathname: K/KO/KOLIBRIE/Convert-NLS_DATE_FORMAT-0.06.tar.gz provides: - Convert::NLS_DATE_FORMAT 0.05 + Convert::NLS_DATE_FORMAT 0.06 requirements: - ExtUtils::MakeMaker 0 + Module::Build::Tiny 0.035 + perl 5.006001 Cpanel-JSON-XS-3.0210 pathname: R/RU/RURBAN/Cpanel-JSON-XS-3.0210.tar.gz provides: @@ -2699,11 +2730,11 @@ DISTRIBUTIONS Test::More 0.88 Test::Requires 0 Try::Tiny 0 - Exporter-Tiny-0.036 - pathname: T/TO/TOBYINK/Exporter-Tiny-0.036.tar.gz + Exporter-Tiny-0.042 + pathname: T/TO/TOBYINK/Exporter-Tiny-0.042.tar.gz provides: - Exporter::Shiny 0.036 - Exporter::Tiny 0.036 + Exporter::Shiny 0.042 + Exporter::Tiny 0.042 requirements: ExtUtils::MakeMaker 6.17 perl 5.006001 @@ -2978,10 +3009,10 @@ DISTRIBUTIONS overload 0 strict 0 warnings 0 - Guard-1.022 - pathname: M/ML/MLEHMANN/Guard-1.022.tar.gz + Guard-1.023 + pathname: M/ML/MLEHMANN/Guard-1.023.tar.gz provides: - Guard 1.022 + Guard 1.023 requirements: ExtUtils::MakeMaker 0 HTML-Form-6.03 @@ -3500,15 +3531,23 @@ DISTRIBUTIONS Lingua::Stem::Snowball::Da 1.01 requirements: ExtUtils::MakeMaker 0 - List-MoreUtils-0.33 - pathname: A/AD/ADAMK/List-MoreUtils-0.33.tar.gz + List-MoreUtils-0.413 + pathname: R/RE/REHSACK/List-MoreUtils-0.413.tar.gz provides: - List::MoreUtils 0.33 + List::MoreUtils 0.413 + List::MoreUtils::PP 0.413 + List::MoreUtils::XS 0.413 requirements: - ExtUtils::CBuilder 0.27 - ExtUtils::MakeMaker 6.52 - Test::More 0.82 - perl 5.00503 + Carp 0 + Exporter::Tiny 0.038 + ExtUtils::MakeMaker 0 + File::Basename 0 + File::Copy 0 + File::Path 0 + File::Spec 0 + IPC::Cmd 0 + XSLoader 0 + base 0 MIME-Lite-3.030 pathname: R/RJ/RJBS/MIME-Lite-3.030.tar.gz provides: @@ -3681,10 +3720,10 @@ DISTRIBUTIONS Text::ParseWords 0 perl 5.006001 version 0.87 - Module-Build-Tiny-0.037 - pathname: L/LE/LEONT/Module-Build-Tiny-0.037.tar.gz + Module-Build-Tiny-0.039 + pathname: L/LE/LEONT/Module-Build-Tiny-0.039.tar.gz provides: - Module::Build::Tiny 0.037 + Module::Build::Tiny 0.039 requirements: CPAN::Meta 0 DynaLoader 0 @@ -4593,10 +4632,10 @@ DISTRIBUTIONS constant 0 strict 0 warnings 0 - PadWalker-1.96 - pathname: R/RO/ROBIN/PadWalker-1.96.tar.gz + PadWalker-2.2 + pathname: R/RO/ROBIN/PadWalker-2.2.tar.gz provides: - PadWalker 1.96 + PadWalker 2.2 requirements: ExtUtils::MakeMaker 0 perl 5.008001 @@ -6048,67 +6087,70 @@ DISTRIBUTIONS requirements: ExtUtils::MakeMaker 0 Test::More 0.47 - URI-1.60 - pathname: G/GA/GAAS/URI-1.60.tar.gz + URI-1.71 + pathname: E/ET/ETHER/URI-1.71.tar.gz provides: - URI 1.60 + URI 1.71 URI::Escape 3.31 URI::Heuristic 4.20 - URI::IRI undef - URI::QueryParam undef - URI::Split undef + URI::IRI 1.71 + URI::QueryParam 1.71 + URI::Split 1.71 URI::URL 5.04 URI::WithBase 2.20 - URI::_foreign undef - URI::_generic undef - URI::_idna undef - URI::_ldap 1.12 - URI::_login undef - URI::_punycode 0.04 - URI::_query undef - URI::_segment undef - URI::_server undef - URI::_userpass undef - URI::data undef + URI::_foreign 1.71 + URI::_generic 1.71 + URI::_idna 1.71 + URI::_ldap 1.71 + URI::_login 1.71 + URI::_punycode 1.71 + URI::_query 1.71 + URI::_segment 1.71 + URI::_server 1.71 + URI::_userpass 1.71 + URI::data 1.71 URI::file 4.21 - URI::file::Base undef - URI::file::FAT undef - URI::file::Mac undef - URI::file::OS2 undef - URI::file::QNX undef - URI::file::Unix undef - URI::file::Win32 undef - URI::ftp undef - URI::gopher undef - URI::http undef - URI::https undef - URI::ldap 1.12 - URI::ldapi undef - URI::ldaps undef - URI::mailto undef - URI::mms undef - URI::news undef - URI::nntp undef - URI::pop undef - URI::rlogin undef - URI::rsync undef - URI::rtsp undef - URI::rtspu undef - URI::sip 0.11 - URI::sips undef - URI::snews undef - URI::ssh undef - URI::telnet undef - URI::tn3270 undef - URI::urn undef + URI::file::Base 1.71 + URI::file::FAT 1.71 + URI::file::Mac 1.71 + URI::file::OS2 1.71 + URI::file::QNX 1.71 + URI::file::Unix 1.71 + URI::file::Win32 1.71 + URI::ftp 1.71 + URI::gopher 1.71 + URI::http 1.71 + URI::https 1.71 + URI::ldap 1.71 + URI::ldapi 1.71 + URI::ldaps 1.71 + URI::mailto 1.71 + URI::mms 1.71 + URI::news 1.71 + URI::nntp 1.71 + URI::pop 1.71 + URI::rlogin 1.71 + URI::rsync 1.71 + URI::rtsp 1.71 + URI::rtspu 1.71 + URI::sftp 1.71 + URI::sip 1.71 + URI::sips 1.71 + URI::snews 1.71 + URI::ssh 1.71 + URI::telnet 1.71 + URI::tn3270 1.71 + URI::urn 1.71 URI::urn::isbn undef - URI::urn::oid undef + URI::urn::oid 1.71 requirements: + Exporter 5.57 ExtUtils::MakeMaker 0 MIME::Base64 2 - Test 0 - Test::More 0 + Scalar::Util 0 + parent 0 perl 5.008001 + utf8 0 URI-SmartURI-0.032 pathname: R/RK/RKITOVER/URI-SmartURI-0.032.tar.gz provides: @@ -6384,13 +6426,17 @@ DISTRIBUTIONS File::Spec 0.80 Test::More 0.47 perl 5.004 - aliased-0.31 - pathname: O/OV/OVID/aliased-0.31.tar.gz + aliased-0.34 + pathname: E/ET/ETHER/aliased-0.34.tar.gz provides: - aliased 0.31 + aliased 0.34 requirements: - Module::Build 0.40 - Test::More 0 + Carp 0 + Exporter 0 + Module::Build::Tiny 0.039 + perl 5.006 + strict 0 + warnings 0 autodie-2.20 pathname: P/PJ/PJF/autodie-2.20.tar.gz provides: diff --git a/perllib/FixMyStreet/App/Controller/Rss.pm b/perllib/FixMyStreet/App/Controller/Rss.pm index 586d5e7ae..6047f063b 100755 --- a/perllib/FixMyStreet/App/Controller/Rss.pm +++ b/perllib/FixMyStreet/App/Controller/Rss.pm @@ -260,9 +260,9 @@ sub add_row : Private { $row->{confirmed} =~ s/^(\d+)/ordinal($1)/e if $c->stash->{lang_code} eq 'en-gb'; } - (my $title = _($alert_type->item_title)) =~ s/{{(.*?)}}/$row->{$1}/g; - (my $link = $alert_type->item_link) =~ s/{{(.*?)}}/$row->{$1}/g; - (my $desc = _($alert_type->item_description)) =~ s/{{(.*?)}}/$row->{$1}/g; + (my $title = _($alert_type->item_title)) =~ s/\{\{(.*?)}}/$row->{$1}/g; + (my $link = $alert_type->item_link) =~ s/\{\{(.*?)}}/$row->{$1}/g; + (my $desc = _($alert_type->item_description)) =~ s/\{\{(.*?)}}/$row->{$1}/g; my $base_url = $c->cobrand->base_url_for_report($row); my $url = $base_url . $link; @@ -317,9 +317,9 @@ sub add_parameters : Private { $row->{$_} = $c->stash->{title_params}->{$_}; } - (my $title = _($alert_type->head_title)) =~ s/{{(.*?)}}/$row->{$1}/g; - (my $link = $alert_type->head_link) =~ s/{{(.*?)}}/$row->{$1}/g; - (my $desc = _($alert_type->head_description)) =~ s/{{(.*?)}}/$row->{$1}/g; + (my $title = _($alert_type->head_title)) =~ s/\{\{(.*?)}}/$row->{$1}/g; + (my $link = $alert_type->head_link) =~ s/\{\{(.*?)}}/$row->{$1}/g; + (my $desc = _($alert_type->head_description)) =~ s/\{\{(.*?)}}/$row->{$1}/g; $c->stash->{rss}->channel( title => ent($title), diff --git a/perllib/FixMyStreet/TestMech.pm b/perllib/FixMyStreet/TestMech.pm index 9d836ca4d..f3ee7787b 100644 --- a/perllib/FixMyStreet/TestMech.pm +++ b/perllib/FixMyStreet/TestMech.pm @@ -234,8 +234,8 @@ sub get_first_email { my $mech = shift; my $email = shift or do { fail 'No email retrieved'; return }; my $email_as_string = $email->as_string; - ok $email_as_string =~ s{\s+Date:\s+\S.*?$}{}xmsg, "Found and stripped out date"; - ok $email_as_string =~ s{\s+Message-ID:\s+\S.*?$}{}xmsg, "Found and stripped out message ID (contains epoch)"; + ok $email_as_string =~ s{^Date:\s+\S.*?\r?\n}{}xmsg, "Found and stripped out date"; + ok $email_as_string =~ s{^Message-ID:\s+\S.*?\r?\n}{}xmsg, "Found and stripped out message ID (contains epoch)"; return $email_as_string; } diff --git a/perllib/Open311/Endpoint.pm b/perllib/Open311/Endpoint.pm index 2a6ba742a..425a708ef 100644 --- a/perllib/Open311/Endpoint.pm +++ b/perllib/Open311/Endpoint.pm @@ -387,7 +387,7 @@ sub GET_Service_Definition { key => $key, name => $name, } - } $attribute->values_kv + } sort { $a->[0] cmp $b->[0] } $attribute->values_kv ]) : (), map { $_ => $attribute->$_ } qw/ code datatype datatype_description description /, diff --git a/t/app/helpers/send_email.t b/t/app/helpers/send_email.t index c4781ac8f..f60f7fa5a 100644 --- a/t/app/helpers/send_email.t +++ b/t/app/helpers/send_email.t @@ -7,6 +7,7 @@ BEGIN { FixMyStreet->test_mode(1); } +use Email::MIME; use Test::More; use Test::LongString; @@ -36,14 +37,17 @@ is scalar(@emails), 1, "caught one email"; # Get the email, check it has a date and then strip it out my $email_as_string = $mech->get_first_email(@emails); +my $email = Email::MIME->new($email_as_string); my $expected_email_content = path(__FILE__)->parent->child('send_email_sample.txt')->slurp; my $name = FixMyStreet->config('CONTACT_NAME'); $name = "\"$name\"" if $name =~ / /; my $sender = $name . ' <' . FixMyStreet->config('DO_NOT_REPLY_EMAIL') . '>'; $expected_email_content =~ s{CONTACT_EMAIL}{$sender}; +my $expected_email = Email::MIME->new($expected_email_content); -is_string $email_as_string, $expected_email_content, "email is as expected"; +is_deeply { $email->header_pairs }, { $expected_email->header_pairs }, 'MIME email headers ok'; +is_string $email->body, $expected_email->body, 'email is as expected'; subtest 'MIME attachments' => sub { my $data = path(__FILE__)->parent->child('grey.gif')->slurp_raw; @@ -80,15 +84,25 @@ subtest 'MIME attachments' => sub { is scalar(@emails), 1, "caught one email"; my $email_as_string = $mech->get_first_email(@emails); - my ($boundary) = $email_as_string =~ /boundary="([A-Za-z0-9.]*)"/ms; - my $changes = $email_as_string =~ s{$boundary}{}g; - is $changes, 5, '5 boundaries'; # header + 4 around the 3x parts (text + 2 images) + my $email = Email::MIME->new($email_as_string); my $expected_email_content = path(__FILE__)->parent->child('send_email_sample_mime.txt')->slurp; $expected_email_content =~ s{CONTACT_EMAIL}{$sender}g; - - is_string $email_as_string, $expected_email_content, 'MIME email text ok' + $expected_email_content =~ s{BOUNDARY}{$boundary}g; + my $expected_email = Email::MIME->new($expected_email_content); + + my @email_parts; + $email->walk_parts(sub { + my ($part) = @_; + push @email_parts, [ { $part->header_pairs }, $part->body ]; + }); + my @expected_email_parts; + $expected_email->walk_parts(sub { + my ($part) = @_; + push @expected_email_parts, [ { $part->header_pairs }, $part->body ]; + }); + is_deeply \@email_parts, \@expected_email_parts, 'MIME email text ok' or do { (my $test_name = $0) =~ s{/}{_}g; my $path = path("test-output-$test_name.tmp"); diff --git a/t/app/helpers/send_email_sample_mime.txt b/t/app/helpers/send_email_sample_mime.txt index 4ce0f9520..c4ca97bcc 100644 --- a/t/app/helpers/send_email_sample_mime.txt +++ b/t/app/helpers/send_email_sample_mime.txt @@ -1,12 +1,12 @@ MIME-Version: 1.0 Subject: test email =?utf-8?Q?=E2=98=BA?= -Content-Type: multipart/mixed; boundary="" +Content-Type: multipart/mixed; boundary="BOUNDARY" To: test@recipient.com Content-Transfer-Encoding: 7bit From: CONTACT_EMAIL --- +--BOUNDARY MIME-Version: 1.0 Subject: test email =?utf-8?Q?=E2=98=BA?= Content-Type: text/plain; charset="utf-8" @@ -36,7 +36,7 @@ FixMyStreet.=20= --- +--BOUNDARY MIME-Version: 1.0 Content-Type: image/gif; name="foo.gif" Content-Disposition: inline; filename="foo.gif" @@ -45,7 +45,7 @@ Content-Transfer-Encoding: quoted-printable GIF89a=01=00=01=00=80=00=00=00=00=00=CC=CC=CC,=00=00=00=00=01=00=01=00=00= =02=01L=00;= --- +--BOUNDARY MIME-Version: 1.0 Content-Type: image/gif; name="bar.gif" Content-Disposition: inline; filename="bar.gif" @@ -54,4 +54,4 @@ Content-Transfer-Encoding: quoted-printable GIF89a=01=00=01=00=80=00=00=00=00=00=CC=CC=CC,=00=00=00=00=01=00=01=00=00= =02=01L=00;= ----- +--BOUNDARY-- diff --git a/t/cobrand/zurich.t b/t/cobrand/zurich.t index 777e9735f..e130ece87 100644 --- a/t/cobrand/zurich.t +++ b/t/cobrand/zurich.t @@ -4,6 +4,7 @@ use strict; use warnings; use DateTime; +use Email::MIME; use Test::More; use Test::LongString; use Path::Tiny; @@ -884,15 +885,26 @@ subtest 'email images to external partners' => sub { my @emails = $mech->get_email; my $email_as_string = $mech->get_first_email(@emails); my ($boundary) = $email_as_string =~ /boundary="([A-Za-z0-9.]*)"/ms; - my $changes = $email_as_string =~ s{$boundary}{}g; - is $changes, 4, '4 boundaries'; # header + 3 around the 2x parts (text + 1 image) + my $email = Email::MIME->new($email_as_string); my $expected_email_content = path(__FILE__)->parent->child('zurich_attachments.txt')->slurp; my $REPORT_ID = $report->id; $expected_email_content =~ s{REPORT_ID}{$REPORT_ID}g; + $expected_email_content =~ s{BOUNDARY}{$boundary}g; + my $expected_email = Email::MIME->new($expected_email_content); - is_string $email_as_string, $expected_email_content, 'MIME email text ok' + my @email_parts; + $email->walk_parts(sub { + my ($part) = @_; + push @email_parts, [ { $part->header_pairs }, $part->body ]; + }); + my @expected_email_parts; + $expected_email->walk_parts(sub { + my ($part) = @_; + push @expected_email_parts, [ { $part->header_pairs }, $part->body ]; + }); + is_deeply \@email_parts, \@expected_email_parts, 'MIME email text ok' or do { (my $test_name = $0) =~ s{/}{_}g; my $path = path("test-output-$test_name.tmp"); diff --git a/t/cobrand/zurich_attachments.txt b/t/cobrand/zurich_attachments.txt index 1c989c4d9..4ccc90205 100644 --- a/t/cobrand/zurich_attachments.txt +++ b/t/cobrand/zurich_attachments.txt @@ -1,12 +1,12 @@ MIME-Version: 1.0 Subject: =?iso-8859-1?Q?Z=FCri?= wie neu: Weitergeleitete Meldung #REPORT_ID -Content-Type: multipart/mixed; boundary="" +Content-Type: multipart/mixed; boundary="BOUNDARY" To: "External Body" Content-Transfer-Encoding: 7bit From: FixMyStreet --- +--BOUNDARY MIME-Version: 1.0 Subject: =?iso-8859-1?Q?Z=FCri?= wie neu: Weitergeleitete Meldung #REPORT_ID Content-Type: text/plain; charset="iso-8859-1" @@ -23,7 +23,7 @@ gis-zentrum@zuerich.ch.= --- +--BOUNDARY MIME-Version: 1.0 Content-Type: image/jpeg; name="REPORT_ID.0.jpeg" Content-Disposition: inline; filename="REPORT_ID.0.jpeg" @@ -37,4 +37,4 @@ BxcYVVaUpf/EABcBAQEBAQAAAAAAAAAAAAAAAAAFBgT/xAAgEQEAAAQHAQAAAAAAAAAAAAAAAwQV UgECFlNhodGx/9oADAMBAAIRAxEAPwCywAIozyxS5R58tbbujSW33j6zFRj3fGbKbjAGAgAACs9N FCbtUfYg2mO1BM25e/V+lQeW3ISo/9k= ----- +--BOUNDARY-- diff --git a/t/open311/endpoint.t b/t/open311/endpoint.t index 38314f079..a2a4ea83e 100644 --- a/t/open311/endpoint.t +++ b/t/open311/endpoint.t @@ -88,10 +88,6 @@ subtest "GET Service Definition" => sub { 2 false - - Triangle - triangle - Circle circle @@ -100,6 +96,10 @@ subtest "GET Service Definition" => sub { Square square + + Triangle + triangle + true @@ -132,10 +132,6 @@ CONTENT "required" => "false", "datatype" => "singlevaluelist", "values" => [ - { - "name" => "Triangle", - "key" => "triangle" - }, { "name" => "Circle", "key" => "circle" @@ -143,7 +139,11 @@ CONTENT { "name" => "Square", "key" => "square" - } + }, + { + "name" => "Triangle", + "key" => "triangle" + }, ], } ], diff --git a/t/open311/endpoint/Endpoint1.pm b/t/open311/endpoint/Endpoint1.pm index c4119075c..ae12172b8 100644 --- a/t/open311/endpoint/Endpoint1.pm +++ b/t/open311/endpoint/Endpoint1.pm @@ -103,8 +103,7 @@ sub get_service_requests { my ($self, $args) = @_; my $service_code = $args->{service_code} or return $self->get_requests; - # we use ~~ as the service_code arg will be an arrayref like ['POT'] - return $self->filter_requests( sub { shift->service->service_code ~~ $service_code }); + return $self->filter_requests( sub { my $c = shift->service->service_code; grep { $_ eq $c } @$service_code }); } sub get_service_request { diff --git a/t/open311/getupdates.t b/t/open311/getupdates.t index fef51e0e1..0e31db482 100644 --- a/t/open311/getupdates.t +++ b/t/open311/getupdates.t @@ -3,6 +3,7 @@ use strict; use warnings; use Test::More; +use URI::Split qw(uri_split); use FixMyStreet; use FixMyStreet::DB; @@ -103,8 +104,11 @@ for my $test ( my $o = Open311->new( jurisdiction => 'mysociety', endpoint => 'http://example.com', test_mode => 1, test_get_returns => { 'requests.xml' => $local_requests_xml } ); - ok $updates->update_reports( [ 638344 ], $o, $body ); - is $o->test_uri_used, 'http://example.com/requests.xml?jurisdiction_id=mysociety&service_request_id=638344', 'get url'; + ok $updates->update_reports( [ 638344 ], $o, $body ), 'Updated reports'; + my @parts = uri_split($o->test_uri_used); + is $parts[2], '/requests.xml', 'path matches'; + my @qs = sort split '&', $parts[3]; + is_deeply(\@qs, [ 'jurisdiction_id=mysociety', 'service_request_id=638344' ], 'query string matches'); is $problem->comments->count, $test->{comment_count}, 'added a comment'; }; @@ -178,8 +182,11 @@ subtest 'update with two requests' => sub { my $o = Open311->new( jurisdiction => 'mysociety', endpoint => 'http://example.com', test_mode => 1, test_get_returns => { 'requests.xml' => $local_requests_xml } ); - ok $updates->update_reports( [ 638344,638345 ], $o, $body ); - is $o->test_uri_used, 'http://example.com/requests.xml?jurisdiction_id=mysociety&service_request_id=638344%2C638345', 'get url'; + ok $updates->update_reports( [ 638344,638345 ], $o, $body ), 'Updated reports'; + my @parts = uri_split($o->test_uri_used); + is $parts[2], '/requests.xml', 'path matches'; + my @qs = sort split '&', $parts[3]; + is_deeply(\@qs, [ 'jurisdiction_id=mysociety', 'service_request_id=638344%2C638345' ], 'query string matches'); is $problem->comments->count, 1, 'added a comment to first problem'; is $problem2->comments->count, 1, 'added a comment to second problem'; @@ -232,9 +239,12 @@ subtest 'test translation of auto-added comment from old-style Open311 update' = FixMyStreet::override_config { ALLOWED_COBRANDS => [ 'fixamingata' ], }, sub { - ok $updates->update_reports( [ 638346 ], $o, $body ); + ok $updates->update_reports( [ 638346 ], $o, $body ), 'Updated reports'; }; - is $o->test_uri_used, 'http://example.com/requests.xml?jurisdiction_id=mysociety&service_request_id=638346', 'get url'; + my @parts = uri_split($o->test_uri_used); + is $parts[2], '/requests.xml', 'path matches'; + my @qs = sort split '&', $parts[3]; + is_deeply(\@qs, [ 'jurisdiction_id=mysociety', 'service_request_id=638346' ], 'query string matches'); is $problem3->comments->count, 1, 'added a comment'; is $problem3->comments->first->text, "St\xe4ngd av kommunen", 'correct comment text'; -- cgit v1.2.3 From 5fa83565612ca0631e8c57862d39dba26b927cb1 Mon Sep 17 00:00:00 2001 From: Matthew Somerville Date: Wed, 23 Mar 2016 09:26:46 +0000 Subject: Allow zurich tests to run without network. --- t/Mock/MapItZurich.pm | 43 +++++++++++++++++++++++++++++++++++++++++++ t/cobrand/zurich.t | 26 +++++++++++++++----------- 2 files changed, 58 insertions(+), 11 deletions(-) create mode 100644 t/Mock/MapItZurich.pm diff --git a/t/Mock/MapItZurich.pm b/t/Mock/MapItZurich.pm new file mode 100644 index 000000000..ece9a9b22 --- /dev/null +++ b/t/Mock/MapItZurich.pm @@ -0,0 +1,43 @@ +package t::Mock::MapItZurich; + +use JSON::MaybeXS; +use Web::Simple; + +use mySociety::Locale; + +has json => ( + is => 'lazy', + default => sub { + JSON->new->pretty->allow_blessed->convert_blessed; + }, +); + +sub dispatch_request { + my $self = shift; + + sub (GET + /areas/**) { + my ($self, $areas) = @_; + my $response = { + "423017" => {"parent_area" => undef, "generation_high" => 4, "all_names" => {}, "id" => 423017, "codes" => {}, "name" => "Zurich", "country" => "G", "type_name" => "OpenStreetMap Layer 8", "generation_low" => 4, "country_name" => "Global", "type" => "O08"} + }; + my $json = $self->json->encode($response); + return [ 200, [ 'Content-Type' => 'application/json' ], [ $json ] ]; + }, + + sub (GET + /point/**) { + my ($self, $point) = @_; + my $response = { + "423017" => {"parent_area" => undef, "generation_high" => 4, "all_names" => {}, "id" => 423017, "codes" => {}, "name" => "Zurich", "country" => "G", "type_name" => "OpenStreetMap Layer 8", "generation_low" => 4, "country_name" => "Global", "type" => "O08"} + }; + my $json = $self->json->encode($response); + return [ 200, [ 'Content-Type' => 'application/json' ], [ $json ] ]; + }, + + sub (GET + /area/*/example_postcode) { + my ($self, $area) = @_; + my $json = $self->json->encode({}); + return [ 200, [ 'Content-Type' => 'application/json' ], [ $json ] ]; + }, +} + +__PACKAGE__->run_if_script; diff --git a/t/cobrand/zurich.t b/t/cobrand/zurich.t index e130ece87..4734dc837 100644 --- a/t/cobrand/zurich.t +++ b/t/cobrand/zurich.t @@ -5,9 +5,11 @@ use strict; use warnings; use DateTime; use Email::MIME; +use LWP::Protocol::PSGI; use Test::More; use Test::LongString; use Path::Tiny; +use t::Mock::MapItZurich; # Check that you have the required locale installed - the following # should return a line with de_CH.utf8 in. If not install that locale. @@ -72,7 +74,7 @@ $division->parent( $zurich->id ); $division->send_method( 'Zurich' ); $division->endpoint( 'division@example.org' ); $division->update; -$division->body_areas->find_or_create({ area_id => 274456 }); +$division->body_areas->find_or_create({ area_id => 423017 }); my $subdivision = $mech->create_body_ok( 3, 'Subdivision A' ); $subdivision->parent( $division->id ); $subdivision->send_method( 'Zurich' ); @@ -701,10 +703,11 @@ subtest "only superuser can edit bodies" => sub { }; subtest "only superuser can see 'Add body' form" => sub { + LWP::Protocol::PSGI->register(t::Mock::MapItZurich->run_if_script, host => 'mapit.zurich'); $user = $mech->log_in_ok( 'dm1@example.org' ); FixMyStreet::override_config { ALLOWED_COBRANDS => [ 'zurich' ], - MAPIT_URL => 'http://global.mapit.mysociety.org/', + MAPIT_URL => 'http://mapit.zurich/', MAPIT_TYPES => [ 'O08' ], MAPIT_ID_WHITELIST => [ 423017 ], }, sub { @@ -715,12 +718,12 @@ subtest "only superuser can see 'Add body' form" => sub { }; subtest "phone number is mandatory" => sub { + LWP::Protocol::PSGI->register(t::Mock::MapItZurich->run_if_script, host => 'mapit.zurich'); FixMyStreet::override_config { MAPIT_TYPES => [ 'O08' ], - MAPIT_URL => 'http://global.mapit.mysociety.org/', + MAPIT_URL => 'http://mapit.zurich/', ALLOWED_COBRANDS => [ 'zurich' ], - MAPIT_ID_WHITELIST => [ 274456 ], - MAPIT_GENERATION => 2, + MAPIT_ID_WHITELIST => [ 423017 ], MAP_TYPE => 'Zurich,OSM', }, sub { $user = $mech->log_in_ok( 'dm1@example.org' ); @@ -732,12 +735,12 @@ subtest "phone number is mandatory" => sub { }; subtest "phone number is not mandatory for reports from mobile apps" => sub { + LWP::Protocol::PSGI->register(t::Mock::MapItZurich->run_if_script, host => 'mapit.zurich'); FixMyStreet::override_config { MAPIT_TYPES => [ 'O08' ], - MAPIT_URL => 'http://global.mapit.mysociety.org/', + MAPIT_URL => 'http://mapit.zurich/', ALLOWED_COBRANDS => [ 'zurich' ], MAPIT_ID_WHITELIST => [ 423017 ], - MAPIT_GENERATION => 4, MAP_TYPE => 'Zurich,OSM', }, sub { $mech->post_ok( '/report/new/mobile?lat=47.381817&lon=8.529156' , { @@ -759,6 +762,7 @@ subtest "phone number is not mandatory for reports from mobile apps" => sub { }; subtest "problems can't be assigned to deleted bodies" => sub { + LWP::Protocol::PSGI->register(t::Mock::MapItZurich->run_if_script, host => 'mapit.zurich'); $user = $mech->log_in_ok( 'dm1@example.org' ); $user->from_body( $zurich->id ); $user->update; @@ -766,7 +770,7 @@ subtest "problems can't be assigned to deleted bodies" => sub { $report->update; FixMyStreet::override_config { ALLOWED_COBRANDS => [ 'zurich' ], - MAPIT_URL => 'http://global.mapit.mysociety.org/', + MAPIT_URL => 'http://mapit.zurich/', MAPIT_TYPES => [ 'O08' ], MAPIT_ID_WHITELIST => [ 423017 ], MAP_TYPE => 'Zurich,OSM', @@ -787,6 +791,7 @@ subtest "problems can't be assigned to deleted bodies" => sub { }; subtest "photo must be supplied for categories that require it" => sub { + LWP::Protocol::PSGI->register(t::Mock::MapItZurich->run_if_script, host => 'mapit.zurich'); FixMyStreet::App->model('DB::Contact')->find_or_create({ body => $division, category => "Graffiti - photo required", @@ -800,10 +805,9 @@ subtest "photo must be supplied for categories that require it" => sub { }); FixMyStreet::override_config { MAPIT_TYPES => [ 'O08' ], - MAPIT_URL => 'http://global.mapit.mysociety.org/', + MAPIT_URL => 'http://mapit.zurich/', ALLOWED_COBRANDS => [ 'zurich' ], - MAPIT_ID_WHITELIST => [ 274456 ], - MAPIT_GENERATION => 2, + MAPIT_ID_WHITELIST => [ 423017 ], MAP_TYPE => 'Zurich,OSM', }, sub { $mech->post_ok( '/report/new', { -- cgit v1.2.3 From b33eb7d3bd02ece9ff70a215290a233f6e480378 Mon Sep 17 00:00:00 2001 From: Matthew Somerville Date: Fri, 18 Mar 2016 11:45:19 +0000 Subject: [Travis] Test multiple perl versions. --- .gitignore | 1 + .travis.yml | 5 ++++- .travis/after_script | 8 ++------ .travis/install | 7 ++----- .travis/utils.py | 22 ++++++++++++++++++++++ 5 files changed, 31 insertions(+), 12 deletions(-) create mode 100755 .travis/utils.py diff --git a/.gitignore b/.gitignore index 5c77b4b80..ca3180604 100644 --- a/.gitignore +++ b/.gitignore @@ -34,6 +34,7 @@ Makefile blib/ inc/ _Inline/ +*.pyc # International /fixmystreet-international diff --git a/.travis.yml b/.travis.yml index c0191f177..6a2085785 100644 --- a/.travis.yml +++ b/.travis.yml @@ -11,7 +11,10 @@ notifications: language: perl perl: - - "5.14" + - "5.14" # wheezy, precise + - "5.18" # trusty + - "5.20" # jessie, vivid, wily + - "5.22" # stretch, xenial env: global: diff --git a/.travis/after_script b/.travis/after_script index 006ff7849..2a8b2268d 100755 --- a/.travis/after_script +++ b/.travis/after_script @@ -1,16 +1,12 @@ #!/usr/bin/env python -import hashlib import os import site -import subprocess import sys import tarfile +from utils import get_bundle_filename -root = os.path.join(os.path.dirname(__file__), '..') -with open(os.path.join(root, 'cpanfile.snapshot')) as cpanfile: - hash = hashlib.md5(cpanfile.read()).hexdigest() -wanted_filename = 'fixmystreet-local-%s.tgz' % hash +wanted_filename = get_bundle_filename() if os.path.exists(wanted_filename) and os.path.getsize(wanted_filename): print "File was downloaded, no need to upload" diff --git a/.travis/install b/.travis/install index 00ef16bc8..c9d0aef78 100755 --- a/.travis/install +++ b/.travis/install @@ -1,15 +1,12 @@ #!/usr/bin/env python -import hashlib import os import sys import tarfile import urllib +from utils import get_bundle_filename -root = os.path.join(os.path.dirname(__file__), '..') -with open(os.path.join(root, 'cpanfile.snapshot')) as cpanfile: - hash = hashlib.md5(cpanfile.read()).hexdigest() -wanted_filename = 'fixmystreet-local-%s.tgz' % hash +wanted_filename = get_bundle_filename() url = 'https://fixmystreet-bundle-cache.s3.amazonaws.com/%s' % wanted_filename try: diff --git a/.travis/utils.py b/.travis/utils.py new file mode 100755 index 000000000..f56b7d9d4 --- /dev/null +++ b/.travis/utils.py @@ -0,0 +1,22 @@ +import hashlib +import os + + +def get_bundle_filename(): + root = os.path.join(os.path.dirname(__file__), '..') + with open(os.path.join(root, 'cpanfile.snapshot')) as cpanfile: + hash = hashlib.md5(cpanfile.read()).hexdigest() + + try: + version = os.environ['TRAVIS_PERL_VERSION'] + except KeyError: + # Not running on Travis, assume default Travis version + version = '5.14' + + if version == '5.14': + version = '' + else: + version = '-%s' % version + + filename = 'fixmystreet-local-%s%s.tgz' % (hash, version) + return filename -- cgit v1.2.3