schedules.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Data::Dumper;

main();
##############################################################################
sub main {
    my @schedules = _init();

    ## Search for '$size' contiguous slots
    my $i = 0;
    my @slots;
    my $size = $ARGV[0] || 2;
    my ( $start, $end );
    do {
        if ( $schedules[$i]{available} ) {
            $start = $i;
            do {
                $end = $i;
                $i++;
            } while ( $i < @schedules && $schedules[$i]{available} );

            if ( 1 + $end - $start >= $size ) {
                push @slots,
                  {
                    start => $start,
                    end   => $end,
                  };
            }
        }
        else {
            $i++;
        }
    } while ( $i < @schedules );

    ## Discard end slots
    $_->{end} -= ( $size - 1 ) foreach @slots;

    ## copy schedules data set
    my @firsts = _copy(@schedules);

    ## set all copy as unavailable
    $_->{available} = 0 foreach @firsts;

    ## set available as needed
    foreach my $slice (@slots) {
        for my $i ( $slice->{start} .. $slice->{end} ) {
            $firsts[$i]{available} = 1;
        }
    }

    ## just print
    print 'First appointments size: ' . $size . $/;
    _print_label(@schedules);
    _print_avail(@schedules);
    _print_avail(@firsts);
}

sub _init {
    my @schedules = ();
    my $i         = 0;
    my $r         = $ARGV[1] || 2;
    foreach my $hour ( 8 .. 13 ) {
        foreach my $min ( map { 20 * $_ } 0 .. 2 ) {
            push @schedules,
              {
                i         => $i++,
                start     => sprintf( '%02d:%02d', $hour, $min ),
                available => ( ( 1000 * rand ) % $r ) ? 1 : 0,
              };
        }
    }

    return @schedules;
}

sub _copy {
    return map {
        { %$_ }
    } @_;
}

sub _print_label {
    my $mask = join ' - ', map { '%5s' } @_;
    print sprintf( $mask, map { $_->{start} } @_ ) . $/;
}

sub _print_avail {
    my $mask = join ' - ', map { '[ %s ]' } @_;
    print sprintf( $mask, map { $_->{available} ? ' ' : 'X' } @_ ) . $/;
}