# # 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 hours # this assumes that the date validity range between two input files 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 = ; close(D); print "Found $d\n";} else {print "Error: missing XXX.\n";} if (open(T, $t)) {@tl = ; close(T); print "Found $t\n";} else {print "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),substr($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),substr($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 = ;