Your problem starts here
my @arr_b = grep { $_ % 3600 == 0 } ($start_b .. $end_b);
my @arr_a = grep { $_ % 3600 == 0 } ($start_a .. $end_a);
Sure, I hate to do math too, esp the fuzzy date math, but DateTime::Span already does the math for us :) no need to generate ranges like some ruby programmer :)
With my modification I get 5 second speedup
$ perl -s timeoverlap.961234.pl
Start: Sun Mar 25 06:53:28 2012
Start: 0
unit6;449
unit2;1014
End: Sun Mar 25 06:53:34 2012
End: 6
$ perl -s timeoverlap.961234.pl -withDateTime
Start: Sun Mar 25 06:53:37 2012
Start: 1
unit6;447
unit2;1013
End: Sun Mar 25 06:53:37 2012
End: 1
Sure my numbers don't exactly match yours but they're close enough :) maybe even more correct; here is my modification, add it to your program after split
use vars qw/ $withDateTime /;
if( $withDateTime ){
use if $withDateTime,qw/ DateTime::Span /;
use if $withDateTime,qw/ DateTime::Format::Strptime /;
#~ use DateTime::Span;
#~ use DateTime::Format::Strptime;
my $strp = DateTime::Format::Strptime->new(
#~ 29.10.2008 13:00:00
#~ %d.%m.%Y %T
pattern => '%d.%m.%Y %T',
);
my $span_a = DateTime::Span->from_datetimes(
start => $strp->parse_datetime($start_a_str),
end => $strp->parse_datetime($end_a_str),
);
my $span_b = DateTime::Span->from_datetimes(
start => $strp->parse_datetime($start_b_str),
end => $strp->parse_datetime($end_b_str),
);
my $set = $span_a->intersection( $span_b );
my $dur = $set->duration;
my $thours = 0;
$thours += $dur ->years *365*24;
$thours += $dur ->months *30*24;
$thours += $dur ->weeks *7*24;
$thours += $dur ->days *24;
$thours += $dur ->hours ;
$thours += $dur ->minutes / 60 ;
$thours += $dur ->seconds / 60 / 60 ; # irrelevant
$thours = sprintf '%.f', $thours; # round
$hash{$wds} += $thours if $thours;
next STRING;
}
And sure, DateTime::Duration is annoying and could have used some kind of total_as_hours but it sure beats ranges :)