diff options
| -rw-r--r-- | challenge-132/dave-jacoby/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-132/dave-jacoby/perl/ch-1.pl | 67 | ||||
| -rw-r--r-- | challenge-132/dave-jacoby/perl/ch-2.pl | 52 |
3 files changed, 120 insertions, 0 deletions
diff --git a/challenge-132/dave-jacoby/blog.txt b/challenge-132/dave-jacoby/blog.txt new file mode 100644 index 0000000000..1b4bd1b6f8 --- /dev/null +++ b/challenge-132/dave-jacoby/blog.txt @@ -0,0 +1 @@ +https://jacoby.github.io/2021/09/27/dates-and-hashes-and-names-oh-my-the-weekly-challenge-132.html diff --git a/challenge-132/dave-jacoby/perl/ch-1.pl b/challenge-132/dave-jacoby/perl/ch-1.pl new file mode 100644 index 0000000000..7b45e60ded --- /dev/null +++ b/challenge-132/dave-jacoby/perl/ch-1.pl @@ -0,0 +1,67 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw{ say postderef signatures }; +no warnings qw{ experimental }; + +# Do Not Write Your Own Date and Time Manipulation Code! +# Do Not Write Your Own Date and Time Manipulation Code! +# Do Not Write Your Own Date and Time Manipulation Code! +# Do Not Write Your Own Date and Time Manipulation Code! +# Do Not Write Your Own Date and Time Manipulation Code! +use DateTime; + +my @examples; +push @examples, '2021/09/18'; +push @examples, '1975/10/10'; +push @examples, '1967/07/08'; +push @examples, '1970/01/01'; + +for my $input (@examples) { +my $output= mirror_dates($input); + say <<"END"; + Input: $input + Output: $output +END +} + +# takes the date as a string, in the ONE TRUE FORMAT: YYYY/MM/DD +# That makes the epoch 1970/01/01 +# The program CAN handle non-padded days and months, but when you're +# dealling with a LOT of dates, non-zero,padding makes you wonder if +# 1970123 is Jan 23 or Dec 3. +sub mirror_dates ( $date_str ) { + + # The default time zone for new DateTime objects, except where stated + # otherwise, is the "floating" time zone. This concept comes from the + # iCal standard. A floating datetime is one which is not anchored to + # any particular time zone. In addition, floating datetimes do not + # include leap seconds, since we cannot apply them without knowing the + # datetime's time zone. + my $now = DateTime->now()->set_time_zone('floating'); + + my ( $y, $m, $d ) = split m{/}, $date_str; + my $then = DateTime->new( + year => $y, + month => $m, + day => $d, + time_zone => 'floating' + ); + + # the time difference between now and then, expressed in days + my $diff = $now->delta_days($then)->in_units('days'); + + # add and subtract in a DateTime context act on the object, which + # isn't the result I would expect from $semi_numerical_thing->add(number) + # so we clone it and modify the clone. + # I mean, we COULD, but for testing, I was printing now and then as well + # as past and future, just to be sure I was right. + my $past = $then->clone; + $past->subtract( days => $diff ); + + my $future = $now->clone; + $future->add( days => $diff ); + + return join ', ', $future->ymd, $past->ymd; +} diff --git a/challenge-132/dave-jacoby/perl/ch-2.pl b/challenge-132/dave-jacoby/perl/ch-2.pl new file mode 100644 index 0000000000..c2e85ea059 --- /dev/null +++ b/challenge-132/dave-jacoby/perl/ch-2.pl @@ -0,0 +1,52 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw{ say postderef signatures }; +no warnings qw{ experimental }; + +my @player_ages = ( + [ 20, "Alex" ], + [ 28, "Joe" ], + [ 38, "Mike" ], + [ 18, "Alex" ], + [ 25, "David" ], + [ 18, "Simon" ], +); + +my @player_names = ( + [ "Alex", "Stewart" ], + [ "Joe", "Root" ], + [ "Mike", "Gatting" ], + [ "Joe", "Blog" ], + [ "Alex", "Jones" ], + [ "Simon", "Duane" ], +); + +say join "\n", hash_join( \@player_ages, \@player_names ); + +sub hash_join ( $array1, $array2 ) { + my @output; + my $hash = {}; + for my $e ( $array1->@* ) { + my ( $age, $firstname ) = $e->@*; + push $hash->{$firstname}->{age}->@*, $age; + } + for my $e ( $array2->@* ) { + my ( $firstname, $lastname ) = $e->@*; + push $hash->{$firstname}->{lastname}->@*, $lastname; + } + for my $firstname ( sort keys $hash->%* ) { + next unless defined $hash->{$firstname}{age}; + next unless defined $hash->{$firstname}{lastname}; + my @ages = $hash->{$firstname}{age}->@*; + my @lastnames = $hash->{$firstname}{lastname}->@*; + + for my $age ( reverse sort @ages ) { + for my $lastname ( reverse sort @lastnames ) { + push @output, join ",\t", ' ' . $age, $firstname, $lastname; + } + } + } + return join "\n", @output; +} |