File: slice_pass3.pl

package info (click to toggle)
slice 1.3.8-14
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 872 kB
  • sloc: ansic: 3,310; perl: 2,263; sh: 869; makefile: 296; yacc: 127
file content (130 lines) | stat: -rw-r--r-- 4,305 bytes parent folder | download | duplicates (6)
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
120
121
122
123
124
125
126
127
128
129
130
##
##  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");
                main::error("Execution stopped\n") if $status->{z} > 2;
                next if $status->{z} == 2;
        }
        if ($status->{s} > 0 and ($out eq '' or $out !~ m/\S/)) {
                printwarning("Whitespace only: skip generation of $outfile\n");
                main::error("Execution stopped\n") if $status->{s} > 2;
                next if $status->{s} == 2;
        }

        #   open output file
        if ($outfile eq '-') {
            $fp = new IO::Handle;
            $fp->fdopen(fileno(STDOUT), "w")
                or main::error("Unable to write into STDOUT: $!\n");
            print $fp $out;
            $fp->close()
                or main::error("Unable to close STDOUT: $!\n");
        }
        else {
            $fp = new IO::File;
            $fp->open("> $outfile")
                or main::error("Unable to write into $outfile: $!\n");
            print $fp $out
                or main::fileerror($outfile, "Unable to write into $outfile: $!\n");
            $fp->close()
                or main::fileerror($outfile, "Unable to close $outfile: $!\n");
        }

        #   additionally run chmod on the output file
        if ($outfile ne '-' and $chmod ne '' and -f $outfile) {
            system("chmod $chmod $outfile");
        }
    }
}

1;