#! perl -slw use strict; use Data::Dump qw[ pp ]; sub dt2int { my( $d, $h, $m ) = unpack '(A2)*', $_[0]; return ( ( $d - 1 ) * 24 + $h ) * 60 + $m; } sub int2dt { sprintf "%02d%02d%02d", int($_[0]/1440)+1, int($_[0]/60)%24, $_[0]%60; } sub adjacentPairs (&@) { my $code = shift; map { $code->( shift(), $_[0] ); } 1 .. @_; } my @listone = (['010000','010010',2],['010200','010210',5],['012359','020001',3]); my @listtwo = (['010005','010015',1],['010207','010211',4]); my @res = adjacentPairs{ defined( $_[1] ) && $_[0][4] > $_[1][3] ? [ $_[0][0], int2dt( $_[1][3] - 1 ), $_[0][2] ] : [ @{ $_[0] }[ 0 .. 2 ] ] } sort { $a->[ 3 ] <=> $b->[ 3 ] } map { my $s = dt2int( $_->[ 0 ] ); my $e = dt2int( $_->[ 1 ] ); my @out; while( int( $s / 1440 ) != int( $e / 1440 ) ) { my $newe = ( $s + 1440 ) % 1440; push @out, [ int2dt( $s ), int2dt( $newe ), $_->[2], $s, $newe ]; $s = $newe +1; } ( @out, [ int2dt( $s ), $_->[1], $_->[2], $s, $e ] ); } @listone, @listtwo; pp \@res; __END__ c:\test>junk33 [ ["010000", "010004", 2], ["010005", "010015", 1], ["010200", "010206", 5], ["010207", "010211", 4], ["012359", "012359", 3], ["020000", "020001", 3], ]