API tools faq
paste
Guest User

Untitled

a guest
Aug 22nd, 2018
186
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 9.15 KB | None | 0 0
raw download clone embed print report
  1. Why does my Perl script produce corrupted output with large files on Windows?
  2. #!/usr/bin/perl
  3.  
  4. use DBI;
  5. use DBD::Oracle;
  6.  
  7. # Constants:
  8. use constant field0 => 0;
  9. use constant field1 => 1;
  10. use constant field2 => 2;
  11. use constant field3 => 3;
  12. use constant field4 => 4;
  13. use constant field5 => 5;
  14. use constant field6 => 6;
  15. use constant field7 => 7;
  16. use constant field8 => 8;
  17. use constant field9 => 9;
  18. use constant field10 => 10;
  19. use constant field11 => 11;
  20. use constant field12 => 12;
  21. use constant field13 => 13;
  22. use constant field14 => 14;
  23. use constant field15 => 15;
  24. use constant field16 => 16;
  25. use constant field17 => 17;
  26. use constant field18 => 18;
  27. use constant field19 => 19;
  28. use constant field20 => 20;
  29. use constant field21 => 21;
  30. use constant field22 => 22;
  31. use constant field23 => 23;
  32. use constant field24 => 24;
  33. use constant field25 => 25;
  34. use constant field26 => 26;
  35. use constant field27 => 27;
  36. use constant field28 => 28;
  37. use constant field29 => 29;
  38. use constant field30 => 30;
  39. use constant field31 => 31;
  40. use constant field32 => 32;
  41. use constant field33 => 33;
  42. use constant field34 => 34;
  43. use constant field35 => 35;
  44. use constant field36 => 36;
  45. use constant field37 => 37;
  46. use constant field38 => 38;
  47. use constant field39 => 39;
  48. use constant field40 => 40;
  49. use constant field41 => 41;
  50.  
  51. # Capture Directory Path from Environment Variable:
  52. my $DIRECTORY = $ENV{DATADIR};
  53.  
  54. # Process Counters:
  55. my %fileCntr = (
  56. ccr1 => 0,
  57. ccr2 => 0,
  58. ccr3 => 0,
  59. ccr4 => 0,
  60. ccr5 => 0
  61. );
  62.  
  63. # Process Control Hashes:
  64. my %xref = ();
  65.  
  66. # Process Control Variables:
  67. my $diag = 0;
  68. my $proc = 0;
  69. my $ndcc = 0;
  70. my $previous = "";
  71.  
  72. # Claims Extract array:
  73. my @arr = ();
  74. my $hdr = "";
  75.  
  76. # Accept/Parse DSS Connection String:
  77. $ENV{PSWD} =~ /(.+)/(.+)@(.+)/;
  78. my $USER = $1;
  79. my $PASS = $2;
  80. my $CONN = 'DBI:Oracle:' . $3;
  81.  
  82. # ALTER Date format:
  83. my $ATL = qq(ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD');
  84.  
  85. # Database Connection:
  86. my $dbh = DBI->connect( $CONN, $USER, $PASS, { RaiseError => 1, AutoCommit => 0 } );
  87. $dbh->do($ATL); # Execute ALTER session.
  88.  
  89. my $SQL = qq(
  90. SELECT ... here is a big sql query
  91. );
  92.  
  93. # Open OUTPUT file for CCR processing:
  94. open OUT1, ">$DIRECTORY/ccr1.dat" or die "Unable to open OUT1 file: $!n";
  95. open OUT2, ">$DIRECTORY/ccr2.dat" or die "Unable to open OUT2 file: $!n";
  96. open OUT3, ">$DIRECTORY/ccr3.dat" or die "Unable to open OUT3 file: $!n";
  97. open OUT4, ">$DIRECTORY/ccr4.dat" or die "Unable to open OUT4 file: $!n";
  98. open OUT5, ">$DIRECTORY/ccr5.dat" or die "Unable to open OUT5 file: $!n";
  99.  
  100. # Redirect STDOUT to log file:
  101. open STDOUT, ">$DIRECTORY/ccr.log" or die "Unable to open LOG file: $!n";
  102.  
  103. # Prepare $SQL for execution:
  104. my $sth = $dbh->prepare($SQL);
  105. $sth->execute();
  106.  
  107. # Produce out files:
  108. {
  109. local $, = "|";
  110. local $ = "n";
  111.  
  112. while (@arr = $sth->fetchrow_array)
  113. {
  114. # Direct Write of CCR1&2 records:
  115. &BuildCCR12();
  116.  
  117. # Write and Wipe CCR3 HASH Table:
  118. &WriteCCR3() unless ($arr[field0] == $previous);
  119. &BuildCCR3();
  120.  
  121. # Loop processing for CCR4:
  122. &BuildCCR4();
  123.  
  124. # Loop processing for CCR5:
  125. &BuildCCR5();
  126. }
  127. }
  128.  
  129. # Print Record Counts for OUTPUT files:
  130. foreach my $key (keys %fileCntr) { print "$key: " . $fileCntr{$key} . "n"; }
  131.  
  132. # Terminate DB connection:
  133. $sth->finish();
  134. $dbh->disconnect();
  135.  
  136. # Close all output files:
  137. close(OUT1); close(OUT2); close(OUT3);
  138. close(OUT4); close(OUT5);
  139.  
  140. {
  141. # Reassign Output End-of-record across subroutine block:
  142. local $ = "n";
  143.  
  144. sub BuildCCR12
  145. {
  146. # Write CCR1 Table:
  147. print OUT1 $arr[field6] . '|' . $arr[field7] . '|' . $arr[field5] . '|' .
  148. $arr[field0] . '|' . $arr[field8] . '|' . $arr[field9] . '|' .
  149. $arr[field10] . '|' . $arr[field11] . '|' . $arr[field12] . '|' .
  150. $arr[field13] . '|' . $arr[field2] . '|' . $arr[field3] . '|' .
  151. $arr[field40] . '|' . $arr[field16];
  152.  
  153. $fileCntr{ccr1}++;
  154.  
  155. # Write CCR2 Table:
  156. unless ($arr[field17] eq '###########') {
  157. print OUT2 ++$ndcc . "|" . $arr[field0] . "|" .
  158. $arr[field6] . '|' . $arr[field7] . '|' .
  159. $arr[field17] . '|' . $arr[field19] . '|' . $arr[field18] . '|' .
  160. $arr[field2] . '|' . $arr[field3] . '|' . $arr[field39];
  161. $fileCntr{ccr2}++;
  162. }
  163. }
  164.  
  165. sub WriteCCR3
  166. {
  167. unless ($previous == "")
  168. {
  169. # Produce ccr3 from DISTINCT combo listing:
  170. foreach $key (keys %xref) { print OUT3 $xref{$key}; $fileCntr{ccr3}++; }
  171. %xref = ();
  172. }
  173. }
  174.  
  175. sub BuildCCR3
  176. {
  177. # Spin off relationship:
  178. for (my $i = field8; $i <= field13; $i++)
  179. {
  180. unless ($arr[$i] == -1)
  181. {
  182. $xref{$arr[field0] . "|" . $arr[$i]} = $arr[field0] . "|" . $arr[$i];
  183. }
  184. }
  185. $previous = $arr[field0];
  186. }
  187.  
  188. sub BuildCCR4
  189. {
  190. # Spin off relationship:
  191. for (my $i = field26; $i <= field37; $i++)
  192. {
  193. my $sak = $arr[field0] . $arr[field6] . $arr[field7] . $arr[$i];
  194. unless (($arr[$i] eq '#######') or ($arr[$i] eq '######')) {
  195. print OUT4 ++$diag . '|' . $arr[field0] . '|' .
  196. $arr[field6] . '|' .
  197. $arr[field7] . '|' . $arr[$i];
  198. $fileCntr{ccr4}++;
  199. }
  200. }
  201. }
  202.  
  203. sub BuildCCR5
  204. {
  205. # Spin off field0/Procedure relationship:
  206. for (my $i = field20; $i <= field23; $i++)
  207. {
  208. my $sak = $arr[field0] . $arr[field6] . $arr[field7] . $arr[$i];
  209. unless ($arr[$i] eq '######' or $arr[$i] eq '####') {
  210. print OUT5 ++$proc . '|' . $arr[field0] . '|' . $arr[field6] . '|' .
  211. $arr[field7] . '|' . $arr[$i];
  212. $fileCntr{ccr5}++;
  213. }
  214. }
  215. }
  216. }
  217.  
  218. 3260183|147845
  219. 3260183|78246
  220. 3260183|13898
  221. 3260183|184783
  222. 3260183|116315
  223. 3260183|184483262216|105843262217|1461703262217|175593262217|1360303262217
  224.  
  225. use constant LICENSE_NO => 42;
  226.  
  227. #!/usr/bin/perl
  228.  
  229. use warnings; use strict;
  230. use DBI;
  231. use File::Spec::Functions qw( catfile );
  232.  
  233. my @proc = qw(ccr1 ccr2 ccr3 ccr4 ccr5);
  234.  
  235. # Capture Directory Path from Environment Variable:
  236. my $DIRECTORY = $ENV{DATADIR};
  237.  
  238. # Process Counters:
  239. my %fileCntr = map { $_ => 0 } @proc;
  240.  
  241. # Process Control Hashes:
  242. my %xref = ();
  243.  
  244. # Process Control Variables:
  245. my $diag = 0;
  246. my $proc = 0;
  247. my $ndcc = 0;
  248. my $previous = "";
  249.  
  250. # Claims Extract array:
  251. my @arr = ();
  252. my $hdr = "";
  253.  
  254. # Accept/Parse DSS Connection String:
  255. my ($USER, $PASS, $CONN) = ($ENV{PSWD} =~ m{^(.+)/(.+)@(.+)});
  256.  
  257. # ALTER Date format:
  258. my $ATL = qq(ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD');
  259.  
  260. # Database Connection:
  261. my $dbh = DBI->connect(
  262. "DBI::Oracle:$CONN", $USER, $PASS,
  263. { RaiseError => 1, AutoCommit => 0 },
  264. );
  265.  
  266. $dbh->do($ATL); # Execute ALTER session.
  267.  
  268. my $SQL = qq(
  269. SELECT ... here is a big sql query
  270. );
  271.  
  272. my %outh;
  273.  
  274. for my $proc ( @proc ) {
  275. my $fn = catfile $DIRECTORY, "$proc.dat";
  276. open $outh{ $proc }, '>', $fn
  277. or die "Cannot open '$fn' for writing: $!";
  278. }
  279.  
  280. # Redirect STDOUT to log file:
  281. open STDOUT, '>', catfile($DIRECTORY, 'ccr.log')
  282. or die "Unable to open LOG file: $!";
  283.  
  284. # Prepare $SQL for execution:
  285. my $sth = $dbh->prepare($SQL);
  286. $sth->execute();
  287.  
  288. # Produce out files:
  289.  
  290. while (my @arr = $sth->fetchrow_array) {
  291. # Direct Write of CCR1&2 records:
  292. BuildCCR12(@arr);
  293.  
  294. # Write and Wipe CCR3 HASH Table:
  295. WriteCCR3(@arr) unless ($arr[0] == $previous);
  296. BuildCCR3(@arr);
  297.  
  298. # Loop processing for CCR4:
  299. BuildCCR4(@arr);
  300.  
  301. # Loop processing for CCR5:
  302. BuildCCR5(@arr);
  303. }
  304.  
  305. # Print Record Counts for OUTPUT files:
  306. foreach my $key (keys %fileCntr) {
  307. printf "%s: %sn", $key, $fileCntr{$key};
  308. }
  309.  
  310. # Terminate DB connection:
  311. $sth->finish();
  312. $dbh->disconnect();
  313.  
  314. for my $proc (keys %outh) {
  315. close $outh{ $proc } or die "Cannot close filehandle for '$proc': $!";
  316. }
  317.  
  318. sub print_to {
  319. my ($dest, $data) = @_;
  320.  
  321. my $fh = $outh{$dest};
  322.  
  323. print $fh join('|', @$data), "n"
  324. or die "Error writing to '$dest' file: $!";
  325.  
  326. $fileCntr{$dest}++;
  327. return;
  328. }
  329.  
  330. sub BuildCCR12 {
  331. my ($arr) = @_;
  332.  
  333. print_to(ccr1 =>
  334. [@{$arr}[6, 7, 5, 0, 8, 9, 10, 13, 2, 3, 40, 16]]);
  335.  
  336. if ($arr->[17] ne '###########') {
  337. print_to(ccr2 =>
  338. [++$ndcc, @{ $arr }[0, 6, 7, 17, 19, 18, 2, 3, 39]]);
  339. }
  340. return;
  341. }
  342.  
  343. sub WriteCCR3 {
  344. my ($arr) = @_;
  345.  
  346. unless ($previous) {
  347. # Produce ccr3 from DISTINCT combo listing:
  348.  
  349. print_to(ccr3 => [ keys %xref ]);
  350. %xref = ();
  351. }
  352.  
  353. return;
  354. }
  355.  
  356. sub BuildCCR3 {
  357. my ($arr) = @_;
  358.  
  359. # Spin off relationship:
  360.  
  361. for my $i (8 .. 13) {
  362. unless ($arr->[$i] == -1) {
  363. my $k = join '|', @{ $arr }[0, $i];
  364. $xref{ $k } = $k;
  365. }
  366. }
  367. $previous = $arr->[0];
  368.  
  369. return;
  370. }
  371.  
  372. sub BuildCCR4 {
  373. my ($arr) = @_;
  374.  
  375. # Spin off relationship:
  376.  
  377. for my $i (26 .. 37) {
  378. my $sak = join '|', @{ $arr }[0, 6, 7, $i];
  379.  
  380. my $v = $arr->[$i];
  381.  
  382. unless ( $v =~ /^#{6,7}z/ ) {
  383. print_to(ccr4 => [++$diag, @{ $arr }[0, 6, 7, $v]]);
  384. }
  385. }
  386. return;
  387. }
  388.  
  389. sub BuildCCR5 {
  390. my ($arr) = @_;
  391.  
  392. # Spin off field0/Procedure relationship:
  393.  
  394. for my $i (20 .. 23) {
  395. my $v = $arr[$i];
  396. my $sak = join('', @{ $arr }[0, 6, 7], $v);
  397.  
  398. unless ($v eq '######' or $v eq '####') {
  399. print_to(ccr5 => [++$proc, @{ $arr }[0, 6, 7], $v]);
  400. }
  401. }
  402.  
  403. return;
  404. }
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!