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