#!/usr/bin/env perl use strict; use warnings; use Test::MockTime qw( :all ); use Test::Most; use DateTime; subtest 'NumberStyler' => sub { { package NumberRoleTester; use Moo; with 'DDG::GoodieRole::NumberStyler'; 1; } subtest 'Initialization' => sub { new_ok('NumberRoleTester', [], 'Applied to a class'); isa_ok(NumberRoleTester::number_style_regex(), 'Regexp', 'number_style_regex()'); }; subtest 'Valid numbers' => sub { my @valid_test_cases = ( [['0,013'] => 'euro'], [['4,431', '4.321'] => 'perl'], [['4,431', '4,32'] => 'euro'], [['4534,345.0', '1'] => 'perl'], # Unenforced commas. [['4,431', '4,32', '5,42'] => 'euro'], [['4,431', '4.32', '5.42'] => 'perl'], ); foreach my $tc (@valid_test_cases) { my @numbers = @{$tc->[0]}; my $expected_style_id = $tc->[1]; is(NumberRoleTester::number_style_for(@numbers)->id, $expected_style_id, '"' . join(' ', @numbers) . '" yields a style of ' . $expected_style_id); } }; subtest 'Invalid numbers' => sub { my @invalid_test_cases = ( [['5234534.34.54', '1'] => 'has a mal-formed number'], [['4,431', '4,32', '4.32'] => 'is confusingly ambiguous'], [['4,431', '4.32.10', '5.42'] => 'is hard to figure'], [['4,431', '4,32,100', '5.42'] => 'has a mal-formed number'], [['4,431', '4,32,100', '5,42'] => 'is too crazy to work out'], ); foreach my $tc (@invalid_test_cases) { my @numbers = @{$tc->[0]}; my $why_not = $tc->[1]; is(NumberRoleTester::number_style_for(@numbers), undef, '"' . join(' ', @numbers) . '" fails because it ' . $why_not); } }; }; subtest 'Dates' => sub { { package DatesRoleTester; use Moo; with 'DDG::GoodieRole::Dates'; 1; } my $test_datestring_regex; my $test_formatted_datestring_regex; my $test_descriptive_datestring_regex; subtest 'Initialization' => sub { new_ok('DatesRoleTester', [], 'Applied to a class'); $test_datestring_regex = DatesRoleTester::datestring_regex(); isa_ok($test_datestring_regex, 'Regexp', 'datestring_regex()'); $test_formatted_datestring_regex = DatesRoleTester::formatted_datestring_regex(); isa_ok($test_formatted_datestring_regex, 'Regexp', 'formatted_datestring_regex()'); $test_descriptive_datestring_regex = DatesRoleTester::descriptive_datestring_regex(); isa_ok($test_descriptive_datestring_regex, 'Regexp', 'descriptive_datestring_regex()'); }; subtest 'Working single dates' => sub { my %dates_to_match = ( # Defined formats: #ISO8601 '2014-11-27' => 1417046400, '1994-02-03 14:15:29 -0100' => 760288529, '1994-02-03 14:15:29' => 760284929, '1994-02-03T14:15:29' => 760284929, '19940203T141529Z' => 760284929, '19940203' => 760233600, #HTTP 'Sat, 09 Aug 2014 18:20:00' => 1407608400, # RFC850 '08-Feb-94 14:15:29 GMT' => 760716929, # date(1) default 'Sun Sep 7 15:57:56 EDT 2014' => 1410119876, 'Sun Sep 14 15:57:56 UTC 2014' => 1410710276, 'Sun Sep 7 20:11:44 BST 2014' => 1410117104, # RFC 2822 'Sat, 13 Mar 2010 11:29:05 -0800' => 1268508545, #Undefined/Natural formats: '13/12/2011' => 1323734400, #DMY '01/01/2001' => 978307200, #Ambiguous, but valid '29 June 2014' => 1404000000, #DMY '05 Mar 1990' => 636595200, #DMY (short) 'June 01 2012' => 1338508800, #MDY 'May 05 2011' => 1304553600, #MDY 'may 01 2010' => 1272672000, '1st june 1994' => 770428800, '5 th january 1993' => 726192000, 'JULY 4TH 1976' => 205286400, '07/13/1984' => 458524800, '7/13/1984' => 458524800, '13/07/1984' => 458524800, '13.07.1984' => 458524800, '7.13.1984' => 458524800, 'june-01-2012' => 1338508800, 'feb/01/2010' => 1264982400, '01-jun-2012' => 1338508800, '01/june/2012' => 1338508800, 'JUN-1-2012' => 1338508800, '4-jUL-1976' => 205286400, '2001-1-1' => 978307200, 'jan 6, 2014' => 1388966400, '6, jan 2014' => 1388966400, '6 jan, 2014' => 1388966400, '29 feb, 2012' => 1330473600, '2038-01-20' => 2147558400, # 32-bit signed int UNIX epoch ends 2038-01-19 '1780-01-20' => -5994172800, # Way before 32-bit signed int epoch ); foreach my $test_date (sort keys %dates_to_match) { like($test_date, qr/^$test_datestring_regex$/, "$test_date matches the datestring_regex"); like($test_date, qr/^$test_formatted_datestring_regex$/, "$test_date matches the formatted_datestring_regex"); # test_regex should not contain any submatches $test_date =~ qr/^$test_datestring_regex$/; ok(scalar @- == 1 && scalar @+ == 1, ' with no sub-captures.'); $test_formatted_datestring_regex =~ qr/^$test_datestring_regex$/; ok(scalar @- == 1 && scalar @+ == 1, ' with no sub-captures.'); my $date_object = DatesRoleTester::parse_formatted_datestring_to_date($test_date); isa_ok($date_object, 'DateTime', $test_date); is($date_object->epoch, $dates_to_match{$test_date}, '... which represents the correct time.'); } }; subtest 'Working multi-dates' => sub { my @date_sets = ({ src => ['01/10/2014', '01/06/2014'], output => [1389312000, 1388966400], # 10 jan; 6 jan }, { src => ['01/13/2014', '01/06/2014'], output => [1389571200, 1388966400], # 13 jan; 6 jan }, { src => ['05/06/2014', '20/06/2014'], output => [1401926400, 1403222400], # 5 jun; 20 jun }, { src => ['20/06/2014', '05/06/2014'], output => [1403222400, 1401926400], # 20 jun; 5 jun }, { src => ['5/06/2014', '20/06/2014'], output => [1401926400, 1403222400], # 5 jun; 20 jun }, { src => ['20/06/2014', '5/06/2014'], output => [1403222400, 1401926400], # 20 jun; 5 jun }, { src => ['20-06-2014', '5-06-2014'], output => [1403222400, 1401926400], # 20 jun; 5 jun }, { src => ['5-06-2014', '20-06-2014'], output => [1401926400, 1403222400], # 5 jun; 20 jun }, { src => ['5-June-2014', '20-06-2014'], output => [1401926400, 1403222400], # 5 jun; 20 jun }, { src => ['5-06-2014', '4th January 2013', '20-06-2014'], output => [1401926400, 1357257600, 1403222400], # 5 jun; 4 jan, 20 jun }, ); foreach my $set (@date_sets) { my @source = @{$set->{src}}; eq_or_diff([map { $_->epoch } (DatesRoleTester::parse_all_datestrings_to_date(@source))], $set->{output}, '"' . join(', ', @source) . '": dates parsed correctly'); } }; subtest 'Invalid single dates' => sub { my %bad_strings_match = ( '24/8' => 0, '123' => 0, '123-84-1' => 0, '1st january' => 0, '1/1/1' => 0, '2014-13-13' => 1, 'Feb 38th 2015' => 1, '2014-02-29' => 1, ); foreach my $test_string (sort keys %bad_strings_match) { if ($bad_strings_match{$test_string}) { like($test_string, qr/^$test_formatted_datestring_regex$/, "$test_string matches formatted_datestring_regex"); } else { unlike($test_string, qr/^$test_formatted_datestring_regex$/, "$test_string does not match formatted_datestring_regex"); } my $result; lives_ok { $result = DatesRoleTester::parse_formatted_datestring_to_date($test_string) } '... and does not kill the parser.'; is($result, undef, '... and returns undef to signal failure.'); } }; subtest 'Invalid multi-format' => sub { my @invalid_date_sets = ( ['01/13/2014', '13/06/2014'], ['13/01/2014', '01/31/2014'], ['38/06/2014', '13/06/2014'], ['01/13/2014', '01/85/2014'], ['13/01/2014', '01/31/2014', '13/06/2014'], ['13/01/2014', '2001-01-01', '14/01/2014', '01/31/2014'], ); foreach my $set (@invalid_date_sets) { my @source = @$set; my @date_results = DatesRoleTester::parse_all_datestrings_to_date(@source); is(@date_results, 0, '"' . join(', ', @source) . '": cannot be parsed in combination.'); } }; subtest 'Valid standard string format' => sub { my %date_strings = ( '01 Jan 2001' => ['2001-1-1', 'January 1st, 2001', '1st January, 2001'], '13 Jan 2014' => ['13/01/2014', '01/13/2014', '13th Jan 2014'], ); foreach my $result (sort keys %date_strings) { foreach my $test_string (@{$date_strings{$result}}) { is(DatesRoleTester::date_output_string($test_string), $result, $test_string . ' normalizes for output as ' . $result); } } }; subtest 'Invalid standard string format' => sub { my %bad_stuff = ( 'Empty string' => '', 'Hashref' => {}, 'Object' => DatesRoleTester->new, ); foreach my $description (sort keys %bad_stuff) { my $result; lives_ok { $result = DatesRoleTester::date_output_string($bad_stuff{$description}) } $description . ' does not kill the string output'; is($result, '', '... and yields an empty string as a result'); } }; subtest 'Vague strings' => sub { my %time_strings = ( '2000-08-01T00:00:00Z' => { 'next december' => '01 Dec 2000', 'last january' => '01 Jan 2000', 'this year' => '01 Aug 2000', 'june' => '01 Jun 2001', 'december 2015' => '01 Dec 2015', 'june 2000' => '01 Jun 2000', 'jan' => '01 Jan 2001', 'next jan' => '01 Jan 2001', 'last jan' => '01 Jan 2000', 'feb 2038' => '01 Feb 2038', 'next day' => '02 Aug 2000', }, '2015-12-01T00:00:00Z' => { 'next december' => '01 Dec 2016', 'last january' => '01 Jan 2015', 'june' => '01 Jun 2016', 'december 2015' => '01 Dec 2015', 'june 2000' => '01 Jun 2000', 'jan' => '01 Jan 2016', 'next jan' => '01 Jan 2016', 'last jan' => '01 Jan 2015', 'feb 2038' => '01 Feb 2038', 'now' => '01 Dec 2015', 'today' => '01 Dec 2015', 'current day' => '01 Dec 2015', 'next month' => '01 Jan 2016', 'this week' => '01 Dec 2015', }, '2000-01-01T00:00:00Z' => { 'feb 21st' => '21 Feb 2000', '11th feb' => '11 Feb 2000', 'march 13' => '13 Mar 2000', '12 march' => '12 Mar 2000', 'next week' => '08 Jan 2000', 'last week' => '25 Dec 1999', 'tomorrow' => '02 Jan 2000', 'yesterday' => '31 Dec 1999', 'last year' => '01 Jan 1999', 'next year' => '01 Jan 2001', 'in a weeks time' => '08 Jan 2000', 'a month ago' => '01 Dec 1999', 'in a day' => '02 Jan 2000', '2 months ago' => '01 Mar 2000', 'in 2 years' => '01 Jan 2002', }, '2014-10-08T00:00:00Z' => { 'next week' => '15 Oct 2014', 'this week' => '08 Oct 2014', 'last week' => '01 Oct 2014', 'next month' => '08 Nov 2014', 'this month' => '08 Oct 2014', 'last month' => '08 Sep 2014', 'next year' => '08 Oct 2015', 'this year' => '08 Oct 2014', 'last year' => '08 Oct 2013', 'december 2015' => '01 Dec 2015', 'march 13' => '13 Mar 2014', }, ); foreach my $query_time (sort keys %time_strings) { set_fixed_time($query_time); my %strings = %{$time_strings{$query_time}}; foreach my $test_date (sort keys %strings) { my $result = DatesRoleTester::parse_descriptive_datestring_to_date($test_date); isa_ok($result, 'DateTime', $test_date); is(DatesRoleTester::date_output_string($result), $strings{$test_date}, $test_date . ' relative to ' . $query_time); } } restore_time(); }; subtest 'Valid mixture of formatted and descriptive dates' => sub { set_fixed_time('2000-01-01T00:00:00Z'); my %mixed_dates_to_test = ( '2014-11-27' => 1417046400, '1994-02-03T14:15:29' => 760284929, 'Sat, 09 Aug 2014 18:20:00' => 1407608400, '08-Feb-94 14:15:29 GMT' => 760716929, '13/12/2011' => 1323734400, '01/01/2001' => 978307200, '29 June 2014' => 1404000000, '05 Mar 1990' => 636595200, 'June 01 2012' => 1338508800, 'May 05 2011' => 1304553600, 'February 21st' => 951091200, '11th feb' => 950227200, '11 march' => 952732800, '11 mar' => 952732800, 'jun 21' => 961545600, 'next january' => 978307200, 'december' => 975628800, ); foreach my $test_mixed_date (sort keys %mixed_dates_to_test) { my $parsed_date_object = DatesRoleTester::parse_datestring_to_date($test_mixed_date); isa_ok($parsed_date_object, 'DateTime', $test_mixed_date); is($parsed_date_object->epoch, $mixed_dates_to_test{$test_mixed_date}, ' ... represents the correct time.'); } restore_time(); } }; subtest 'ImageLoader' => sub { subtest 'object with no share' => sub { # We have to wrap the function in a method in order to get the call-stack correct. { package ImgRoleTester; use Moo; with 'DDG::GoodieRole::ImageLoader'; sub img_wrap { shift; goodie_img_tag(@_); } 1; } my $no_share; subtest 'Initialization' => sub { $no_share = new_ok('ImgRoleTester', [], 'Applied to class'); }; subtest 'non-share enabled object attempts' => sub { my %no_deaths = ( 'undef' => undef, 'array ref' => [], 'killer code ref' => sub { die }, 'with itself' => $no_share, 'empty hash ref' => +{}, 'nonsense hash ref' => {ding => 'dong'}, 'proper' => {filename => 'hi.jpg'}, ); foreach my $desc (sort keys %no_deaths) { lives_ok { $no_share->goodie_img_tag($no_deaths{$desc}) } $desc . ': does not die.'; } }; }; subtest 'object with a share' => sub { our $b64_gif = 'R0lGODlhEAAOALMAAOazToeHh0tLS/7LZv/0jvb29t/f3//Ub//ge8WSLf/rhf/3kdbW1mxsbP//mf///yH5BAAAAAAALAAAAAAQAA4AAARe8L1Ekyky67QZ1hLnjM5UUde0ECwLJoExKcppV0aCcGCmTIHEIUEqjgaORCMxIC6e0CcguWw6aFjsVMkkIr7g77ZKPJjPZqIyd7sJAgVGoEGv2xsBxqNgYPj/gAwXEQA7'; our $final_src = 'src="data:image/gif;base64,' . $b64_gif; { package DDG::Goodie::ImgShareTester; use Moo; use HTML::Entities; use Path::Class; # Hopefully the real share stays implemented this way. use MIME::Base64; with 'DDG::GoodieRole::ImageLoader'; our $tmp_dir = Path::Class::tempdir(CLEANUP => 1); our $tmp_file = file(($tmp_dir->tempfile(TEMPLATE => 'img_XXXXXX', suffix => '.gif'))[1]); # Always return the same file for our purposes here. sub share { $tmp_file } sub html_enc { encode_entities(@_) } # Deal with silly symbol table twiddling. sub fill_temp { $tmp_file->spew(iomode => '>:bytes', decode_base64($b64_gif)) } sub kill_temp { undef $tmp_file } sub img_wrap { shift; goodie_img_tag(@_); } 1; } my $with_share; subtest 'Initialization' => sub { $with_share = new_ok('DDG::Goodie::ImgShareTester', [], 'Applied to class'); }; subtest 'tag creation' => sub { my $filename = $with_share->share()->stringify; my $tag_content; lives_ok { $tag_content = $with_share->img_wrap({filename => $filename}) } 'Empty file does not die'; is($tag_content, '', '... but returns empty tag.'); $with_share->fill_temp; lives_ok { $tag_content = $with_share->img_wrap({filename => $filename}) } 'Newly filled file does not die'; like($tag_content, qr/$final_src/, '... contains proper data'); lives_ok { $tag_content = $with_share->img_wrap({filename => $filename, alt => 'Yo!'}) } 'With alt'; like($tag_content, qr/$final_src/, '... contains proper data'); like($tag_content, qr/alt=\"Yo!\"/, '... and proper alt attribute'); lives_ok { $tag_content = $with_share->img_wrap({filename => $filename, alt => 'Yo!', height => 12}) } 'Plus height'; like($tag_content, qr/$final_src/, '... contains proper data'); like($tag_content, qr/alt="Yo!"/, '... and proper alt attribute'); like($tag_content, qr/height="12"/, '... and proper height attribute'); lives_ok { $tag_content = $with_share->img_wrap({filename => $filename, alt => 'Yo!', height => 12, width => 10}) } 'Plus width'; like($tag_content, qr/$final_src/, '... contains proper data'); like($tag_content, qr/alt="Yo!"/, '... and proper alt attribute'); like($tag_content, qr/height="12"/, '... and proper height attribute'); like($tag_content, qr/width="10"/, '... and proper width attribute'); lives_ok { $tag_content = $with_share->img_wrap({filename => $filename, alt => 'hello"there!', height => 12, width => 10, class => 'smooth' }); } 'Plus class'; like($tag_content, qr/$final_src/, '... contains proper data'); like($tag_content, qr/alt="hello"there!"/, '... and proper alt attribute'); like($tag_content, qr/height="12"/, '... and proper height attribute'); like($tag_content, qr/width="10"/, '... and proper width attribute'); like($tag_content, qr/class="smooth"/, '... and proper class attribute'); lives_ok { $tag_content = $with_share->img_wrap({filename => $filename, atl => 'Yo!', height => 12, width => 10, class => 'smooth'}) } 'Any mispelled does not die'; is($tag_content, '', '... but yields an empty tag'); $with_share->kill_temp; lives_ok { $tag_content = $with_share->img_wrap({filename => $filename, alt => 'Yo!', height => 12, width => 10, class => 'smooth'}) } 'File disappeared does not die'; is($tag_content, '', '... but yields an empty tag'); }; }; }; done_testing;