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. --- 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 ++++++++++++++++------ 7 files changed, 70 insertions(+), 35 deletions(-) (limited to 't') 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