number1.datDTG/291505ZDEC11// XXX/XXX/XXX/301200ZDEC11/021200ZJAN12// /301226/301227/2/2/001.4/ /302350/310005/2f2f2f2f/g4g4g4g4g4g4g4g4g4g4g4g4g4g4g4g/012.4/ /312357/010003/2f2f2f2f/g4g4g4g4g4g4g4g4g4g4g4g4g4g4g4g/012.7/ // /
And then the code for the project: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/ // /
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!# # 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>;
In reply to Re: Date Array Convolution
by alanonymous
in thread Date Array Convolution
by alanonymous
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |