The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

BEGIN {

  use Test::More tests => 59;
  use Test::Deep;
  use Test::NoWarnings;

  use_ok( 'DateTime' );
  use_ok( 'DateTimeX::Duration::SkipDays' );
  use_ok( 'DateTime::Event::Holiday::US' );

}

my ( $skip_days, $sd, $span, $skipped, %skipped_days, $iter, $expected_end );

# Make sure empty new() returns valid object.
$sd = DateTimeX::Duration::SkipDays->new();
isa_ok( $sd, 'DateTimeX::Duration::SkipDays', 'empty new returns valid object' );

# Make sure invalid references cause death.
eval { $sd = DateTimeX::Duration::SkipDays->new( [] ) };
like( $@, qr/Must pass nothing or a reference to a hash to new/, 'array ref dies correctly' );

eval { $sd = DateTimeX::Duration::SkipDays->new( \$skipped ) };
like( $@, qr/Must pass nothing or a reference to a hash to new/, 'scalar ref dies correctly' );

eval {
  $sd = DateTimeX::Duration::SkipDays->new( sub { } );
};
like( $@, qr/Must pass nothing or a reference to a hash to new/, 'code ref dies correctly' );

# Make sure 'add' included in call to new is ignored.
$sd = DateTimeX::Duration::SkipDays->new( { 'add' => '1' } );
isa_ok( $sd, 'DateTimeX::Duration::SkipDays', 'hash with add returns valid object' );

# Make sure unkown key is ignored.
$sd = DateTimeX::Duration::SkipDays->new( { 'badkey' => '1' } );
isa_ok( $sd, 'DateTimeX::Duration::SkipDays', 'hash with bad key returns valid object' );

# Make sure start_date doesn't work with anything but a DateTime object.
eval { $sd->start_date( 'monkey' ) };
like( $@, qr/Must pass a DateTime object to start/, 'start_date dies correctly' );

# Make sure parse_dates dies with anything but a scalar.
eval { $sd->parse_dates( {} ) };
like( $@, qr/Expected scalar/, 'parse_dates dies correctly' );

# Make sure parse dates bad formats correctly.
my %bad_format = (
  'one bad line' => { dates => q{one bad line}, check_array => ['one bad line'], },

  'all good but one' => {
    dates => q{
one bad line
1/1/1
2/2/2
Thanksgiving
},

    check_array => ['one bad line'],
  },

  'multiple bad lines' => {
    dates => q{
multiple
bad lines
1/1/1
2/2/2
},

    check_array => [ 'multiple', 'bad lines' ],
  },

  'all bad lines' => {
    dates => q{
I'm
such a
stinker
},

    check_array => [ "I'm", 'such a', 'stinker' ],
  },
);

for my $key ( keys %bad_format ) {

  %{ $bad_format{ $key }{ check_hash } } = map { ( $_, "Invalid date format: $_" ) } @{ $bad_format{ $key }{ check_array } };

  my $bf = DateTimeX::Duration::SkipDays->new();

  #  $DB::single = 1;
  $bf->parse_dates( $bad_format{ $key }{ dates } );
  my @array = sort $bf->bad_format;
  my @check = sort @{ $bad_format{ $key }{ check_array } };
  cmp_deeply( \@array, \@check, "$key, check bad array" );

  my $hash_ref = $bf->bad_format;
  cmp_deeply( $hash_ref, $bad_format{ $key }{ check_hash }, "$key, check bad hash" );

}

my $skip_weekends = q(RRULE:FREQ=WEEKLY;BYDAY=SA,SU);

#       July 2011             August 2011
# Su Mo Tu We Th Fr Sa  Su Mo Tu We Th Fr Sa
#                 1  2      1  2  3  4  5  6
#  3  4  5  6  7  8  9   7  8  9 10 11 12 13
# 10 11 12 13 14 15 16  14 15 16 17 18 19 20
# 17 18 19 20 21 22 23  21 22 23 24 25 26 27
# 24 25 26 27 28 29 30  28 29 30 31
# 31

my $skip_x_days    = 30;
my $start_date     = DateTime->new( 'year' => 2011, 'month' => 7, 'day' => 1 );
my $start_date_ymd = $start_date->ymd;

# Skip Nothing
my $temp = $skip_x_days;
$skip_x_days = 0;

$sd = DateTimeX::Duration::SkipDays->new( { 'start_date' => $start_date } );

if ( keys %{ $sd->bad_format } ) {

  fail( 'This should never happen! Problem parsing format(s)' );
  my %bf = %{ $sd->bad_format };
  diag( $_ ) for map { "Bad format: $_ ($bf{ $_ })" } keys %bf;

}

# Both DateTime::Duration::SkipDays and DateTime should return the same date
# when adding 0 days and skipping nothing.

my $dt = $start_date->clone;
$dt->add( 'days' => $skip_x_days );

( $span, $skipped ) = $sd->add( $skip_x_days );

check_date( $span->start->ymd, $start_date_ymd, 'Skip Nothing - Start' );
check_date( $span->end->ymd,   $start_date_ymd, "Skip Nothing (Skip $skip_x_days Days) - End" );

$skip_x_days = $temp;

# Both DateTime::Duration::SkipDays and DateTime should return the same date
# when adding days and skipping nothing.

$dt = $start_date->clone;
$dt->add( 'days' => $skip_x_days );
my $dt_ymd = $dt->ymd;

( $span, $skipped ) = $sd->add( $skip_x_days );

check_date( $span->start->ymd, $start_date_ymd, 'Skip Nothing - Start' );
check_date( $span->end->ymd,   $dt_ymd,         "Skip Nothing (Skip $skip_x_days Days) - End" );

# Skip Independence Day
$skip_days = q(Independence Day);

$sd = make_sd( $start_date, $skip_days );

( $span, $skipped ) = $sd->add( $skip_x_days );

#       July 2011             August 2011
# Su Mo Tu We Th Fr Sa  Su Mo Tu We Th Fr Sa
#                 1. 2    . 1  2  3  4  5  6
#. 3  4. 5. 6. 7. 8. 9   7  8  9 10 11 12 13
#.10.11.12.13.14.15.16  14 15 16 17 18 19 20
#.17.18.19.20.21.22.23  21 22 23 24 25 26 27
#.24.25.26.27.28.29.30  28 29 30 31
#.31
#
check_date( $span->start->ymd, $start_date_ymd, 'Skip Independence Day - Start' );
check_date( $span->end->ymd,   '2011-08-01',    "Skip Independence Day - (Skip $skip_x_days Days) - End" );

%skipped_days = ( '2011-07-04' => 1 );

check_skipped_days( $skipped->iterator, \%skipped_days );

# Skip weekends

$sd = make_sd( $start_date, $skip_weekends );

( $span, $skipped ) = $sd->add( $skip_x_days );

check_date( $span->start->ymd, $start_date_ymd, 'Skip weekends - Start' );
check_date( $span->end->ymd,   '2011-08-12',    "Skip weekends - (Skip $skip_x_days Days) - End" );

#       July 2011             August 2011
# Su Mo Tu We Th Fr Sa  Su Mo Tu We Th Fr Sa
#                 1  2    . 1. 2. 3. 4. 5  6
#  3. 4. 5. 6. 7. 8  9   7. 8. 9.10.11.12 13
# 10.11.12.13.14.15 16  14 15 16 17 18 19 20
# 17.18.19.20.21.22 23  21 22 23 24 25 26 27
# 24.25.26.27.28.29 30  28 29 30 31
# 31

%skipped_days = (
  '2011-07-02' => 1,
  '2011-07-03' => 1,
  '2011-07-09' => 1,
  '2011-07-10' => 1,
  '2011-07-16' => 1,
  '2011-07-17' => 1,
  '2011-07-23' => 1,
  '2011-07-24' => 1,
  '2011-07-30' => 1,
  '2011-07-31' => 1,
  '2011-08-06' => 1,
  '2011-08-07' => 1,
);

check_skipped_days( $skipped->iterator, \%skipped_days );

# Skip Independence Day, weekends and an arbitrary day.

$skip_days = qq(

Independence Day
$skip_weekends
7/22

);

$sd = make_sd( $start_date, $skip_days );

( $span, $skipped ) = $sd->add( $skip_x_days );

check_date( $span->start->ymd, $start_date_ymd, 'Skip combo - Start' );

TODO: {
  local $TODO = 'chasing this bug';
  check_date( $span->end->ymd, '2011-08-16', "Skip combo - (Skip $skip_x_days Days) - End" );
}

#       July 2011             August 2011
# Su Mo Tu We Th Fr Sa  Su Mo Tu We Th Fr Sa
#                 1  2    . 1. 2. 3. 4. 5  6
#  3  4. 5. 6. 7. 8  9   7. 8. 9.10.11.12 13
# 10.11.12.13.14.15 16  14.15.16 17 18 19 20
# 17.18.19.20.21 22 23  21 22 23 24 25 26 27
# 24.25.26.27.28.29 30  28 29 30 31
# 31

%skipped_days = (
  '2011-07-02' => 1,
  '2011-07-03' => 1,
  '2011-07-04' => 1,
  '2011-07-09' => 1,
  '2011-07-10' => 1,
  '2011-07-16' => 1,
  '2011-07-17' => 1,
  '2011-07-22' => 1,
  '2011-07-23' => 1,
  '2011-07-24' => 1,
  '2011-07-30' => 1,
  '2011-07-31' => 1,
  '2011-08-06' => 1,
  '2011-08-07' => 1,
  '2011-08-13' => 1,
  '2011-08-14' => 1,
);

check_skipped_days( $skipped->iterator, \%skipped_days );

sub make_sd {

  my ( $start_date, $parse_dates ) = @_;

  $sd = DateTimeX::Duration::SkipDays->new( { 'start_date' => $start_date, 'parse_dates' => $parse_dates, } );

  if ( keys %{ $sd->bad_format } ) {

    fail( 'Problem parsing format(s)' );
    my %bf = %{ $sd->bad_format };
    diag( $_ ) for map { "Bad format: $_ ($bf{ $_ })" } keys %bf;

  }

  return $sd;

}

sub check_date { ## no strict qw( Subroutines::RequireFinalReturn )

  my ( $got, $expected, $note ) = @_;

  ok( $got eq $expected, $note )
    or diag( "Got $got; expected $expected" );

}

sub check_skipped_days { ## no strict qw( Subroutines::RequireFinalReturn )

  my ( $iter, $skipped_days ) = @_;

  while ( my $dt = $iter->next ) {

    ## no critic qw( ValuesAndExpressions::ProhibitAccessOfPrivateData )
    my $dt_ymd = $dt->min->ymd;
    ok( exists $skipped_days->{ $dt_ymd }, "Skipped $dt_ymd" );
    delete $skipped_days->{ $dt_ymd };

  }

  if ( keys %$skipped_days ) {

    TODO: {
      local $TODO = 'chasing this bug';
      fail( 'Not all expected days skipped' );
      diag( $_ ) for keys %$skipped_days;
    }

  } else {

    pass( 'All expected days skipped' );

  }
} ## end sub check_skipped_days