1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
|
##
## slice_pass3.pl -- Pass 3
## Copyright (c) 1997-2002 Ralf S. Engelschall.
## Copyright (c) 1999-2002 Denis Barbier.
##
package main;
##
##
## Pass 3: Output generation
##
##
sub pass3 {
my ($CFG) = @_;
my ($slice, $outfile, $chmod, $status, $modifier, $out);
my ($set, $cmds, $var);
my ($start, $min, $max);
my ($entry);
verbose("\nPass 3: Output generation\n\n");
foreach $entry (@{$CFG->{OPT}->{O}}) {
# determine skip options:
# u: a set is undefined
# w: a wildcard set does not match
# z: result is empty
# s: result is only composed of whitespaces
$status = $CFG->{OPT}->{Y};
if ($entry =~ s|\#([suwz\d]+)$||) {
$modifier = $1;
foreach (qw(u w z s)) {
($modifier =~ m/$_(\d+)/) and $status->{$_} = $1;
}
}
if ($entry =~ m|^([_A-Z0-9~!+u%n\-\\^x*{}()@]+):(.+)@(.+)$|) {
# full syntax
($slice, $outfile, $chmod) = ($1, $2, $3);
}
elsif ($entry =~ m|^([_A-Z0-9~!+u%n\-\\^x*{}()@]+):(.+)$|) {
# only slice and file
($slice, $outfile, $chmod) = ($1, $2, '');
}
elsif ($entry =~ m|^([^@]+)@(.+)$|) {
# only file and chmod
($slice, $outfile, $chmod) = ('ALL', $1, $2);
}
else {
# only file
($slice, $outfile, $chmod) = ('ALL', $entry, '');
}
verbose(" file `$outfile': sliceterm='$slice', chmodopts='$chmod'\n");
# parse the sliceterm and create corresponding
# Perl 5 statement containing Bit::Vector calls
($cmds, $var) = SliceTerm::Parse($slice, $status);
# skip file if requested by options
if ($status->{u} > 0 and !defined($cmds)) {
printwarning("Undefined set: skip generation of $outfile\n");
next if $status->{u} > 1;
}
# just debugging...
if ($CFG->{OPT}->{X}) {
verbose(" calculated Perl 5 set term:\n");
verbose(" ----\n");
my $x = $cmds;
$x =~ s|\n+$||;
$x =~ s|\n|\n |g;
verbose(" $x\n");
verbose(" ----\n");
}
# now evaluate the Bit::Vector statements
# and move result to $set
eval "$cmds; \$set = $var";
# now scan the set and write out characters
# which have a corresponding bit set.
$start = 0;
$out = '';
while (($start < $set->Size()) &&
(($min, $max) = $set->Interval_Scan_inc($start))) {
$out .= substr($CFG->{INPUT}->{PLAIN},
$min, ($max-$min+1));
$start = $max + 2;
}
# skip file if requested by options
if ($status->{z} > 0 and $out eq '') {
printwarning("Empty output: skip generation of $outfile\n");
next if $status->{z} > 1;
}
if ($status->{s} > 0 and ($out eq '' or $out !~ m/\S/)) {
printwarning("Whitespace only: skip generation of $outfile\n");
next if $status->{s} > 1;
}
# open output file
if ($outfile eq '-') {
print $out;
}
else {
open(OUT, ">$outfile");
print OUT $out;
close(OUT);
}
# additionally run chmod on the output file
if ($outfile ne '-' and $chmod ne '' and -f $outfile) {
system("chmod $chmod $outfile");
}
}
}
1;
|