in reply to Date Array Convolution

BrowserUK and Choroba,

This is the solution I've finally ended up with that works exactly as it should. I think structurally I borrowed more from Browser, but I wanted to thank you both for the help and code examples. Here are the two input files I am using as examples:

number1.mrg
DTG/291505ZDEC11// XXX/XXX/XXX/301200ZDEC11/021200ZJAN12// /301226/301227/2/2/001.4/ /302350/310005/2f2f2f2f/g4g4g4g4g4g4g4g4g4g4g4g4g4g4g4g/012.4/ /312357/010003/2f2f2f2f/g4g4g4g4g4g4g4g4g4g4g4g4g4g4g4g/012.7/ // /
number1.dat
DTG/291500ZDEC11// XXX/XXX/XXX/301200ZDEC11/031200ZJAN12// /301222/301232/234/4234/011.0/ /301240/301250/asdf/fdsa/011.3/ /302340/302355/9j9js9j9j9jf9sjfd/9j9sfj9df9323/010.0/ /302359/310002/kfjakdjfakdfasdf/salkdjfaklsdjflkasjd/008.1/ /312359/010001/f333333/f3333333333/002.2/ // /
And then the code for the project:
# # this assumes the time span on input docs will be 27 days or less # this assumes that the current year is less than 2100 # this asssumes that no single closure will cover more than 24 hour +s # this assumes that the date validity range between two input fi +les always match # use strict; use warnings; use Time::Local; sub fmon { if ($_[0] =~ /^\d{6}\wJAN\d{2}$/i) {return "00";} if ($_[0] =~ /^\d{6}\wFEB\d{2}$/i) {return "01";} if ($_[0] =~ /^\d{6}\wMAR\d{2}$/i) {return "02";} if ($_[0] =~ /^\d{6}\wAPR\d{2}$/i) {return "03";} if ($_[0] =~ /^\d{6}\wMAY\d{2}$/i) {return "04";} if ($_[0] =~ /^\d{6}\wJUN\d{2}$/i) {return "05";} if ($_[0] =~ /^\d{6}\wJUL\d{2}$/i) {return "06";} if ($_[0] =~ /^\d{6}\wAUG\d{2}$/i) {return "07";} if ($_[0] =~ /^\d{6}\wSEP\d{2}$/i) {return "08";} if ($_[0] =~ /^\d{6}\wOCT\d{2}$/i) {return "09";} if ($_[0] =~ /^\d{6}\wNOV\d{2}$/i) {return "10";} if ($_[0] =~ /^\d{6}\wDEC\d{2}$/i) {return "11";} } sub m2d { my @t = localtime($_[0]*60); return sprintf "%02d%02d%02d", $t[3], $t[2], $t[1]; } my ($d,$t); foreach (<*>) { $d = $_ if (/\.dat$/i); $t = $_ if (/\.mrg$/i); } my (@dl,@tl); if (open(D, $d)) {@dl = <D>; close(D); print "Found $d\n";} else {prin +t "Error: missing XXX.\n";} if (open(T, $t)) {@tl = <T>; close(T); print "Found $t\n";} else {prin +t "Error: missing YYY.\n";} my (@big,@n,@m); for (@dl,@tl) { chomp($_); if (/\w{4}\d{2}\/\d{6}\w{4}\d{2}\/\/$/) {@n = split(/\//);} if (/^\/\d{6}\/\d{6}\//) { @m = split(/\//); my ($t1,$t2); if (substr($m[1],0,2) < substr($n[3],0,2)) { if (fmon($n[3]) eq 11) { $t1 = timelocal(0,substr($m[1],4,2),substr($m[1],2,2), +substr($m[1],0,2),fmon($n[4]),"20".substr($n[4],10,2))/60; } else { $t1 = timelocal(0,substr($m[1],4,2),substr($m[1],2,2), +substr($m[1],0,2),fmon($n[4]),"20".substr($n[3],10,2))/60; } } else { $t1 = timelocal(0,substr($m[1],4,2),substr($m[1],2,2),subs +tr($m[1],0,2),fmon($n[3]),"20".substr($n[3],10,2))/60; } if (substr($m[2],0,2) < substr($n[3],0,2)) { if (fmon($n[3]) eq 11) { $t2 = timelocal(0,substr($m[2],4,2),substr($m[2],2,2), +substr($m[2],0,2),fmon($n[4]),"20".substr($n[4],10,2))/60; } else { $t2 = timelocal(0,substr($m[2],4,2),substr($m[2],2,2), +substr($m[2],0,2),fmon($n[4]),"20".substr($n[3],10,2))/60; } } else { $t2 = timelocal(0,substr($m[2],4,2),substr($m[2],2,2),subs +tr($m[2],0,2),fmon($n[3]),"20".substr($n[3],10,2))/60; } push @big,[$t1,$t2,$m[5]]; } } my %values = (); for my $e (0 .. $#big) { my $l = $big[$e]; for my $min ($l->[0] .. $l->[1]) { if ((!exists $values{$min}) or ($values{$min} > $l->[2])) { $values{$min} = $l->[2]; } } } print "...processing...\n"; my @res1; my $s = timelocal(0,substr($n[3],4,0),substr($n[3],2,0),substr($n[3],0 +,2),fmon($n[3]),"20".substr($n[3],10,2))/60; my $e = timelocal(0,substr($n[4],4,0),substr($n[4],2,0),substr($n[4],0 +,2),fmon($n[4]),"20".substr($n[4],10,2))/60; while ($s < $e) { ++$s until exists $values{$s} or $s == $e; my ($val,$start,$end); if ($s != $e) { $val = $values{$s}; $start = $s; ++$s while exists $values{$s} and $values{$s} == $val; $end = $s - 1; push @res1,[m2d($start),m2d($end),$val]; } } my @res2; foreach (@res1) { if (substr(@$_[0],0,2) == substr(@$_[1],0,2) ) { push @res2,[@$_[0],@$_[1],@$_[2]]; } else { push @res2,[@$_[0],substr(@$_[0],0,2)."2359",@$_[2]]; push @res2,[substr(@$_[1],0,2)."0000",@$_[1],@$_[2]]; } } open (C,'>CDA.txt'); my @last = ("","",""); print C "To do later: ... a lot of specific formatting work(easy)\n"; foreach (@res2) { if (substr($last[0],0,2) ne substr(@$_[0],0,2)) { print C "\n"; } print C @$_[0]," ",@$_[1]," ",@$_[2],"\n"; $last[0] = @$_[0]; } close(C); print "Complete.\n"; print "\nPress Enter to exit.\n"; my $end = <STDIN>;
The way I see this being used is thrown in a directory with the mrg and dat files (with LOTS and LOTS of times listed), run, and the resulting CDA file has the correct data. Do you guys see any glaring errors? In testing it, I can't find any errors yet... I think it should work for leap years, all month and year rollovers, etc. I tried to be conniving in my input test!

I will say though, that through this, I've learned a ton (and my regex look better!).

Thanks!!

-Alan