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