Acme-PM-Berlin-Meetings

 view release on metacpan or  search on metacpan

META.json  view on Meta::CPAN

            "ExtUtils::MakeMaker" : "0"
         }
      },
      "configure" : {
         "requires" : {
            "ExtUtils::MakeMaker" : "0"
         }
      },
      "runtime" : {
         "requires" : {
            "DateTime" : "0",
            "Exporter" : "5.57"
         }
      }
   },
   "release_status" : "stable",
   "resources" : {
      "repository" : {
         "type" : "git",
         "url" : "git://github.com/eserte/acme-pm-berlin-meetings.git"
      }

META.yml  view on Meta::CPAN

license: unknown
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: '1.4'
name: Acme-PM-Berlin-Meetings
no_index:
  directory:
    - t
    - inc
requires:
  DateTime: '0'
  Exporter: '5.57'
resources:
  repository: git://github.com/eserte/acme-pm-berlin-meetings.git
version: '202402.28'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

Makefile.PL  view on Meta::CPAN


EOF
    };
}

WriteMakefile(NAME =>         'Acme::PM::Berlin::Meetings',
	      VERSION_FROM => 'lib/Acme/PM/Berlin/Meetings.pm',
	      ($eumm_recent_enough ?
	       (META_ADD => { resources => { repository => 'git://github.com/eserte/acme-pm-berlin-meetings.git' },
			    }) : ()),
	      PREREQ_PM => { 'DateTime' => 0,
			     'Exporter' => 5.57,
			   },
	      EXE_FILES => ['script/berlin-pm'],
	     );

sub MY::postamble {
    my $postamble = "";

    if ($is_devel_host) {
	$postamble .= <<'EOF';

lib/Acme/PM/Berlin/Meetings.pm  view on Meta::CPAN

#

package Acme::PM::Berlin::Meetings;

use strict;
our $VERSION = '202402.28';

use Exporter 'import'; # needs Exporter 5.57
our @EXPORT = qw(next_meeting);

use DateTime;

sub next_meeting {
    my $count = shift || 1;
    my $dt = DateTime->now(time_zone => 'local');
    map { $dt = next_meeting_dt($dt) } (1 .. $count);
}

sub next_meeting_dt {
    my $dt = shift;
    my $dt_berlin = $dt->clone->set_time_zone('Europe/Berlin');

    # Regular exception: December meeting is in January
    if ($dt_berlin->month == 1 && $dt_berlin->day < 10) {
	my $dec_meeting = _get_dec_meeting($dt_berlin);
	if ($dec_meeting > $dt_berlin) {
	    return $dec_meeting;
	}
    }

    # Exceptions
    {
	# August 2020 (last Wed -> last Tue)
	my $dt_aug_2020       = DateTime->new(year=>2020, month=>8, day=>25, hour=>19, time_zone=>"Europe/Berlin");
	my $dt_aug_2020_from  = DateTime->new(year=>2020, month=>7, day=>29, hour=>19, time_zone=>"Europe/Berlin");
	my $dt_aug_2020_until = DateTime->new(year=>2020, month=>8, day=>26, hour=>19, time_zone=>"Europe/Berlin");
	if ($dt_berlin > $dt_aug_2020_from && $dt_berlin < $dt_aug_2020) {
	    return $dt_aug_2020;
	} elsif ($dt_berlin >= $dt_aug_2020 && $dt_berlin < $dt_aug_2020_until) {
	    $dt_berlin = $dt_aug_2020_until;
	}
    }
    {
	# September 2020 (last Wed, 19h -> pre-last Wed, 18h)
	my $dt_sep_2020       = DateTime->new(year=>2020, month=>9, day=>23, hour=>18, time_zone=>"Europe/Berlin");
	my $dt_sep_2020_from  = DateTime->new(year=>2020, month=>8, day=>25, hour=>19, time_zone=>"Europe/Berlin");
	my $dt_sep_2020_until = DateTime->new(year=>2020, month=>9, day=>30, hour=>19, time_zone=>"Europe/Berlin");
	if ($dt_berlin > $dt_sep_2020_from && $dt_berlin < $dt_sep_2020) {
	    return $dt_sep_2020;
	} elsif ($dt_berlin >= $dt_sep_2020 && $dt_berlin < $dt_sep_2020_until) {
	    $dt_berlin = $dt_sep_2020_until;
	}
    }

    # Regular meetings
    my $last_wed_of_month = _get_last_wed_of_month($dt_berlin);
    if ($last_wed_of_month <= $dt_berlin) {

lib/Acme/PM/Berlin/Meetings.pm  view on Meta::CPAN

	$last_wed_of_month = _get_last_wed_of_month($dt_berlin);
    }
    if ($last_wed_of_month->month == 12) {
	return _get_dec_meeting($last_wed_of_month);
    }
    $last_wed_of_month;    
}

sub _get_last_wed_of_month {
    my $dt_berlin = shift;
    my $last_day_of_month = DateTime->last_day_of_month(year => $dt_berlin->year, month => $dt_berlin->month, time_zone => 'Europe/Berlin');
    my $dow = $last_day_of_month->day_of_week;
    my $last_wed_of_month = $last_day_of_month->add(days => $dow < 3 ? -$dow-4 : -$dow+3);
    _adjust_hour($last_wed_of_month);
    $last_wed_of_month;
}

sub _get_dec_meeting {
    my $dt = shift;
    $dt = $dt->clone;
    if ($dt->month == 12) {

t/next_meeting.t  view on Meta::CPAN

use strict;
use Test::More 'no_plan';

use Acme::PM::Berlin::Meetings;

{
    my @dts = next_meeting(1);
    is scalar(@dts), 1;
    isa_ok $dts[0], 'DateTime';
}

{
    my $now = DateTime->new(day => 31, month => 3, year => 2010, hour => 20, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2010-04-28T20:00:00';
}

{
    my $now = DateTime->new(day => 1, month => 12, year => 2014, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2015-01-07T20:00:00';
}

{
    my $now = DateTime->new(day => 29, month => 12, year => 2014, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2015-01-07T20:00:00';
}

{
    my $now = DateTime->new(day => 7, month => 1, year => 2015, hour => 21, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2015-01-28T20:00:00';
}

{
    my $now = DateTime->new(day => 8, month => 1, year => 2013, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2013-01-09T20:00:00', 'RT #61077';
}

{
    my $now = DateTime->new(day => 1, month => 2, year => 2016, hour => 21, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2016-02-24T19:00:00';
}

{
    my $now = DateTime->new(day => 27, month => 10, year => 2016, hour => 21, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2016-11-30T19:00:00';
}

{
    my $now = DateTime->new(day => 20, month => 11, year => 2016, hour => 21, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2016-11-30T19:00:00';
}

# Exception Aug 2020
{
    my $now = DateTime->new(day => 24, month => 8, year => 2020, hour => 21, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2020-08-25T19:00:00';
}

{
    my $now = DateTime->new(day => 25, month => 8, year => 2020, hour => 19, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    # is $dt, '2020-09-30T19:00:00'; --- another exception
    is $dt, '2020-09-23T18:00:00';
}

# Exception Sep 2020
{
    my $now = DateTime->new(day => 22, month => 9, year => 2020, hour => 21, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2020-09-23T18:00:00';
}

{
    my $now = DateTime->new(day => 24, month => 9, year => 2020, hour => 21, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2020-10-28T19:00:00';
}

# Switch from 19h -> 18h

{
    my $now = DateTime->new(day => 24, month => 3, year => 2023, hour => 21, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2023-03-29T19:00:00';
}

{
    my $now = DateTime->new(day => 24, month => 5, year => 2023, hour => 21, time_zone => 'Europe/Berlin');
    my $dt = Acme::PM::Berlin::Meetings::next_meeting_dt($now);
    is $dt, '2023-05-31T18:00:00';
}

__END__



( run in 0.296 second using v1.01-cache-2.11-cpan-05444aca049 )