1## -*- mode: Perl -*- 2## 3## Copyright (c) 2012, 2013, 2015, 2016 The University of Utah 4## All rights reserved. 5## 6## This file is distributed under the University of Illinois Open Source 7## License. See the file COPYING for details. 8 9############################################################################### 10 11package pass_lines; 12 13use strict; 14use warnings; 15 16use POSIX; 17 18use Cwd 'abs_path'; 19use File::Compare; 20 21use creduce_config qw(bindir libexecdir); 22use creduce_utils; 23 24my $topformflat; 25 26sub check_prereqs () { 27 my $path; 28 my $abs_bindir = abs_path(bindir); 29 if ((defined $abs_bindir) && ($FindBin::RealBin eq $abs_bindir)) { 30 # This script is in the installation directory. 31 # Use the installed `topformflat'. 32 $path = libexecdir . "/topformflat"; 33 } else { 34 # Assume that this script is in the C-Reduce build tree. 35 # Use the `topformflat' that is also in the build tree. 36 $path = "$FindBin::Bin/../delta/topformflat"; 37 } 38 if ((-e $path) && (-x $path)) { 39 $topformflat = $path; 40 return 1; 41 } 42 # Check Windows 43 $path = $path . ".exe"; 44 if (($^O eq "MSWin32") && (-e $path) && (-x $path)) { 45 $topformflat = $path; 46 return 1; 47 } 48 return 0; 49} 50 51# unlike the previous version of pass_lines, this one always 52# progresses from the back of the file to the front 53 54sub new ($$) { 55 (my $cfile, my $arg) = @_; 56 my %sh; 57 $sh{"start"} = 1; 58 return \%sh; 59} 60 61sub advance ($$$) { 62 (my $cfile, my $which, my $state) = @_; 63 my %sh = %{$state}; 64 die if (defined($sh{"start"})); 65 my $pos = $sh{"index"}; 66 $sh{"index"} -= $sh{"chunk"}; 67 my $i = $sh{"index"}; 68 my $c = $sh{"chunk"}; 69 print "***ADVANCE*** from $pos to $i with chunk $c\n" if $DEBUG; 70 return \%sh; 71} 72 73sub transform ($$$) { 74 (my $cfile, my $arg, my $state) = @_; 75 my %sh = %{$state}; 76 77 if (defined($sh{"start"})) { 78 print "***TRANSFORM START***\n" if $DEBUG; 79 delete $sh{"start"}; 80 my $outfile = File::Temp::tmpnam(); 81 my $cmd = qq{"$topformflat" $arg < $cfile > $outfile}; 82 print $cmd if $DEBUG; 83 runit ($cmd); 84 85 my $tmpfile = File::Temp::tmpnam(); 86 open INF_BLANK, "<$outfile" or die; 87 open OUTF_BLANK, ">$tmpfile" or die; 88 while (my $line = <INF_BLANK>) { 89 if($line !~ /^\s*$/) { 90 print OUTF_BLANK $line; 91 } 92 } 93 close INF_BLANK; 94 close OUTF_BLANK; 95 96 if (compare($cfile, $tmpfile) == 0) { 97 # this is a gross hack to avoid tripping the 98 # pass-didn't-modify-file check in the C-Reduce core, in 99 # the (generally unlikely) case where topformflat didn't 100 # change the file at all 101 print "gross blank line hack!\n" if $DEBUG; 102 open OF, ">>$tmpfile" or die; 103 print OF "\n"; 104 close OF; 105 } 106 File::Copy::move($tmpfile, $cfile); 107 open INF, "<$cfile" or die; 108 my @data = (); 109 while (my $line = <INF>) { 110 push @data, $line; 111 } 112 close INF; 113 my $l = scalar(@data); 114 $sh{"index"} = $l; 115 $sh{"chunk"} = $l; 116 return ($OK, \%sh); 117 } 118 119 if ($DEBUG) { 120 my $c = $sh{"chunk"}; 121 my $i = $sh{"index"}; 122 print "***TRANSFORM REGULAR chunk $c at $i***\n"; 123 } 124 125 open INF, "<$cfile" or die; 126 my @data = (); 127 while (my $line = <INF>) { 128 push @data, $line; 129 if ($DEBUG && 0) { 130 chomp $line; 131 print "LINE PASS FILE DATA: '$line'\n"; 132 } 133 } 134 close INF; 135 136 AGAIN: 137 $sh{"index"} = scalar(@data) if ($sh{"index"} > scalar(@data)); 138 if ($sh{"index"} >= 0 && scalar(@data) > 0 && $sh{"chunk"} > 0) { 139 my $start = $sh{"index"} - $sh{"chunk"}; 140 $start = 0 if ($start < 0); 141 my $lines = scalar(@data); 142 splice @data, $start, $sh{"chunk"}; 143 my $newlines = scalar(@data); 144 my $c = $sh{"chunk"}; 145 print "went from $lines lines to $newlines with chunk $c\n" if $DEBUG; 146 my $tmpfile = File::Temp::tmpnam(); 147 open OUTF, ">$tmpfile" or die; 148 foreach my $line (@data) { 149 print OUTF $line; 150 } 151 close OUTF; 152 if (compare($cfile, $tmpfile) == 0) { 153 print "did not change file\n" if $DEBUG; 154 unlink $tmpfile; 155 $sh{"index"} -= $sh{"chunk"}; 156 goto AGAIN; 157 } 158 File::Copy::move($tmpfile, $cfile); 159 } else { 160 return ($STOP, \%sh) if ($sh{"chunk"} <= 1); 161 my $newchunk = int ($sh{"chunk"} / 2.0); 162 $sh{"chunk"} = $newchunk; 163 print "granularity reduced to $newchunk\n" if $DEBUG; 164 $sh{"index"} = scalar(@data); 165 goto AGAIN; 166 } 167 168 return ($OK, \%sh); 169} 170 1711; 172