1# ==== Purpose ====
2#
3# Read the contents of a file, filter it through a perl script, and
4# write it back.
5#
6# This is useful in conjunction with include/write_result_to_file.inc
7# and cat_file or include/read_file_to_var.inc.  See
8# e.g. include/show_events.inc for an example.
9#
10# ==== Usage ====
11#
12# --let $input_file= <FILE_NAME>
13# [--let $output_file= <FILE_NAME>]
14# --let $script= <PERL_SCRIPT>
15# [--let $select_columns= <LIST OF NUMBERS>]
16# [--let $pre_script= <PERL_SCRIPT>]
17# [--let $rpl_debug= 1]
18# --source include/filter_file.inc
19#
20# Parameters:
21#
22#   $input_file
23#     File to read from.
24#
25#   $output_file
26#     File to write to. If omitted, writes to $input_file.
27#
28#   $script
29#     This script will be executed once for each line in $input_file.
30#
31#     When the script starts, the perl variable $_ will be set to the
32#     current row (including the terminating newline).  The script can
33#     modify $_ in any way it likes, and the result will be appended
34#     to $output_file.  It is even possible to remove a row by setting
35#     $_ to '', or to generate extra rows by appending "\n" to $_.
36#
37#     Since mysqltest is incapable of properly escaping dollar
38#     characters, you have to replace any '$' in your script by
39#     'DOLLAR' (otherwise mysqltest would try to interpolate parts of
40#     your script).  filter_file.inc will replace 'DOLLAR' by '$'
41#     before evaluating your script.
42#
43#   $select_columns
44#     For convenience, if you set this to a space-separated list of
45#     numbers, it will print only the numbered columns, in the given
46#     order.
47#
48#   $pre_script
49#     This script will be evaluated before starting to iterate over
50#     the lines of $input_file.  It can be useful if you need some
51#     sort of initialization; for example, you can define a subroutine
52#     here and call it from $script.
53#
54#   $rpl_debug
55#     If set, verbose debug info is printed.
56#
57#   $filter_script
58#     If set, rows matching this regexp will be filtered out
59
60--let $include_filename= filter_file.inc
61--source include/begin_include_file.inc
62
63if ($rpl_debug)
64{
65  --echo pre_script='$pre_script'
66  --echo script='$script'
67  --echo select_columns='$select_columns'
68  --echo input_file='$input_file' output_file='$output_file'
69}
70
71--let _FF_PRE_SCRIPT= $pre_script
72--let _FF_SCRIPT= $script
73--let _FF_FILTER_SCRIPT= $filter_script
74--let _FF_INPUT_FILE= $input_file
75--let _FF_OUTPUT_FILE= $output_file
76--let _FF_SELECT_COLUMNS= $select_columns
77--let _FF_DEBUG= $rpl_debug
78
79if (!$output_file)
80{
81  --let _FF_OUTPUT_FILE= $input_file
82}
83perl;
84  my $pre_script = $ENV{'_FF_PRE_SCRIPT'};
85  $pre_script =~ s/DOLLAR/\$/g;
86  my $script = $ENV{'_FF_SCRIPT'};
87  my $filter_script = $ENV{'_FF_FILTER_SCRIPT'};
88  $script =~ s/DOLLAR/\$/g;
89  my $input_file = $ENV{'_FF_INPUT_FILE'};
90  my $output_file = $ENV{'_FF_OUTPUT_FILE'};
91  my $select_columns = $ENV{'_FF_SELECT_COLUMNS'};
92  my $debug = $ENV{'_FF_DEBUG'};
93  if ($select_columns)
94  {
95    chomp($select_columns);
96    $select_columns =~ s/[, ]+/,/g;
97    $script = '
98    chomp;
99    my @cols = split(/\t/, $_);
100    $_ = join("\t", map { $cols[$_ - 1] } ('.$select_columns.'))."\n";
101    ' . $script;
102  }
103  unless ($keep_quotes)
104  {
105    $pre_script = 'my %unquote = ("n"=>"\n","t"=>"\t","\\\\"=>"\\\\");' . $pre_script;
106    $script .= 's{\\\\(.)}{$unquote{$1}}ge;';
107  }
108  if ($debug)
109  {
110    $script = 'print "BEFORE:\'$_\'";' . $script . 'print "AFTER:\'$_\'";'
111  }
112  # Generate a script (perl is faster if we avoid many calls to eval).
113  my $full_script =
114'
115  open FILE, "< $input_file" or die "Error opening $input_file: $!";
116  my $filtered_contents = "";
117  my %column_names = ();
118  '.$pre_script.';
119  while (<FILE>)
120  {
121    chomp;
122    s/\r//g;
123    if (!%column_names)
124    {
125      my $n = 1;
126      %column_names = map { $_ => $n++ } split(/\t/, $_);
127    }
128    else
129    {
130      ' . $script . '
131    }
132    if (!$filter_script || ! m/$filter_script/)
133    {
134      $filtered_contents .= $_."\n";
135    }
136  }
137  close FILE or die "Error closing $input_file: $!";
138  open FILE, "> $output_file" or die "Error opening $output_file: $!";
139  binmode FILE;
140  print FILE $filtered_contents or die "Error writing filtered contents to $output_file: $!";
141  close FILE or die "Error closing $output_file: $!";
142  return 0;
143';
144  if ($debug)
145  {
146    print STDOUT "full_script=<<END_OF_SCRIPT\n${full_script}END_OF_SCRIPT\n"
147  }
148  my $eval_ret = eval($full_script);
149  defined($eval_ret) or die "Parse error or 'die' invoked when evaluating perl script '$full_script': $@";
150  $eval_ret == 0 or die "Non-zero exit value $eval_ret from script '$script'";
151EOF
152
153--let $include_filename= filter_file.inc
154--source include/end_include_file.inc
155