#!/usr/bin/perl

use Data::Dump qw/dump/;

use warnings;
use strict;

my $d = My::ConvoluteDate->new;
while (<>) {
    my ($from, $to, $value) = split;
    $d->populate([$from, $to, $value]);
}

print dump $d->combine;

package My::ConvoluteDate;

use Data::Dump qw/dump/;
use List::Util qw/min/;

sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;
} # new

sub populate {
    my $self = shift;
    while (my $triple = shift) {
        my ($start, $end, $value) = @$triple;
        push @{ $self->{times}{$start}{push} }, $value;
        push @{ $self->{times}{$end}{pop}    }, $value;
    }
} # populate

sub combine {
    my $self = shift;
    my @result;
    my @stack;
    for my $time_string (sort keys %{ $self->{times} }) {
        my $time = $self->{times}{$time_string};
        my $old_value = min @stack;

        for my $push (@{ $time->{push} }) {
            push @stack, $push;
        }
        for my $pop (@{ $time->{pop} }) {
            my $value = $pop;
            @stack = grep {
                not defined $value or $_ != $value or undef $value
            } @stack;
        }

        my $new_value = min @stack;

        if (not defined $old_value) {
            push @result, [$time_string];

        } elsif (not defined $new_value) {
            push @{ $result[-1] }, $time_string, $old_value;

        } elsif ($new_value != $old_value) {
            my $end_string = $time_string;
            my $start_string = $time_string;
            if ($new_value < $old_value) {
                $end_string = _dec($end_string);
            } else {
                $start_string = _inc($start_string);
            }
            # avoid zero length intervals
            if ($result[-1][0] le $end_string) { 
                push @{ $result[-1] }, $end_string, $old_value;
            } else {
                pop @result;
            }

            push @result, [$start_string];
        }
    }
    return _day_split(@result);
} # combine

sub _day_split {
    return map {
        my ($start, $end, $value) = @$_;
        my $from  = 0 + substr $start, 0, 2;
        my $to    = 0 + substr $end,   0, 2;

        if ($from < $to) {
            my $split;
            my $newfrom = sprintf('%02d', $from) . '2359';
            $split = [[$start, $newfrom, $value]];
            push @$split,
              map { [sprintf('%02d', $_) . '0000',
                     sprintf('%02d', $_) . '2359',
                     $value] } $from + 1 .. $to - 1;
            my $newto = sprintf('%02d', $to) . '0000';
            push @$split, [$newto, $end, $value];
            @$split;

        } elsif ($from == $to) {
            $_;

        } else {
            die "Start later then end\n";
        }
    } @_;
} # _day_split

sub _dec {
    my $time = shift;
    my ($day, $hour, $min) = $time =~ /(..)(..)(..)/;
    $min--;
    if ($min < 0) {
        $min = 59;
        $hour--;
        if ($hour < 0) {
            $hour = 23;
            $day--;
            die "Cannot go before 010000\n" if $day < 1;
        }
    }
    return sprintf '%02d' x 3, $day, $hour, $min;
} # _dec

sub _inc {
    my $time = shift;
    my ($day, $hour, $min) = $time =~ /(..)(..)(..)/;
    $min++;
    if ($min > 59) {
        $min = 00;
        $hour++;
        if ($hour > 23) {
            $hour = 00;
            $day++;
        }
    }
    return sprintf '%02d' x 3, $day, $hour, $min;

} # _inc
[download]