#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;
require 5.003;

# get rid of nasty warnings
BEGIN { $^W = 0; }

#   bootstrapping private installed modules
use lib "/usr/lib/slice/perl_private/lib";
use lib "/usr/lib/slice/perl_private/lib/i386-linux/5.004";
use lib "/usr/local/lib/site_perl";
use lib "/usr/local/lib/site_perl/i386-linux";


##         _ _          
##     ___| (_) ___ ___ 
##    / __| | |/ __/ _ \
##    \__ \ | | (_|  __/
##    |___/_|_|\___\___|
##                    
##    Slice -- Extract out pre-defined slices of an ASCII file
##
##    The slice program reads an inputfile and divide its prepaired ASCII contents
##    into possibly overlapping slices. These slices are determined by enclosing
##    blocks which are defined by begin and end delimiters which have to be
##    already in the file.   The final output gets calculated by a slice term
##    consisting of slice names, set theory operators and optional round brackets.
##  
##    The latest release can be found on
##    http://www.engelschall.com/sw/slice/
##  
##    Copyright (c) 1997,1998 Ralf S. Engelschall.
##  
##    This program is free software; it may be redistributed and/or modified only
##    under the terms of the GNU General Public License, which may be found in the
##    SLICE source distribution.  Look at the file COPYING.   This program is
##    distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
##    without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
##    PARTICULAR PURPOSE.  See either the GNU General Public License for more
##    details.
##  
##                                Ralf S. Engelschall
##                                rse@engelschall.com
##                                www.engelschall.com


use Getopt::Long 2.13;
use IO::Handle 1.15;
use IO::File 1.07;
use Bit::Vector 5.0;

# !! This file was automatically generated by NEWVERS !!

package Vers;

# for logfiles, etc.
$SLICE_Version =
    "1.3.2 (18-02-1998)";

# interactive 'hello' string to identify us to the user
$SLICE_Hello = 
    "This is SLICE Version 1.3.2 (18-02-1998)";

# a GNU --version output
$SLICE_GNUVersion =
    "SLICE Version 1.3.2";

# a UNIX what(1) id string
$SLICE_WhatID =

# a RCS ident(1) id string
$SLICE_RCSIdentID =
    "\$Id: SLICE 1.3.2 18-02-1998 \$";

# a WWW id string
$SLICE_WebID =
    "SLICE/1.3.2";

# a plain id string
$SLICE_PlainID =
    "1.3.2";

##
##  slice_util.pl -- Utility functions
##  Copyright (c) 1997,1998 Ralf S. Engelschall. 
##

package main;

sub verbose {
    my ($str) = @_;

    if ($main::CFG->{OPT}->{X}) {
        $str =~ s|^|** Slice:Verbose: |mg;
        print STDERR $str;
    }
}

sub printerror {
    my ($str) = @_;

    $str =~ s|^|** Slice:Error: |mg;
    print STDERR $str;
}

sub error {
    my ($str) = @_;

    &printerror($str);
    exit(1);
}

##EOF##

package SliceTermParser;
$SLICE=257;
$YYERRCODE=256;
@yylhs = (                                               -1,
    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
    0,    0,    0,
);
@yylen = (                                                2,
    1,    2,    2,    2,    3,    3,    3,    3,    3,    3,
    3,    3,    3,
);
@yydefred = (                                             0,
    0,    0,    0,    0,    0,    2,    0,    0,    0,    0,
    0,    0,    0,    0,    0,    0,    0,   13,    0,    0,
    0,    0,    0,    0,    0,    0,
);
@yydgoto = (                                              5,
);
@yysindex = (                                           -33,
  -60,  -33,  -33,  -33,  100,    0,  -31,  -31,   44,  -33,
  -33,  -33,  -33,  -33,  -33,  -33,  -33,    0,   36,   36,
  -32,  -32,  -27,  -27,  -31,  100,
);
@yyrindex = (                                             0,
    2,    0,    0,    0,    0,    0,    3,    8,    0,    0,
    0,    0,    0,    0,    0,    0,    0,    0,   29,   35,
   22,   23,    9,   15,   14,    1,
);
@yygindex = (                                           155,
);
$YYTABLESIZE=224;
@yytable = (                                              2,
   10,    1,    3,    6,   17,   17,    4,    4,    5,   17,
    0,    0,    0,    9,    6,    0,    0,    0,    0,    0,
    0,   11,   12,    0,    0,    0,    0,    0,    7,    0,
    0,    0,    0,    0,    8,    0,    0,    0,    1,    0,
    0,   10,    1,    3,    1,    3,    1,    3,    4,    5,
    4,    5,    4,    5,    9,    6,    9,    6,    9,    6,
    0,   15,   11,   12,   11,   12,   11,   12,    0,    7,
    0,    0,   17,    7,    0,    8,    0,   16,   13,    8,
   17,    0,   16,    0,   18,    0,   13,   14,   11,    0,
    0,    0,    3,    1,    3,    1,    3,    0,    0,    4,
    5,    4,    5,    0,    0,    9,    6,    9,    6,    0,
    0,    1,    3,   11,   12,    0,    0,    4,    1,    3,
    7,    1,    3,    9,    4,    5,    8,    4,    5,   15,
    9,    6,    0,    9,    6,   10,   17,   15,   11,   12,
    0,    0,   13,    0,   11,   16,    0,    0,    0,    0,
    0,    0,   12,   16,    0,   14,    7,    8,    9,    0,
   12,    0,    0,   14,   19,   20,   21,   22,   23,   24,
   25,   26,    0,    0,    0,    0,    0,    0,    0,    0,
    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
    0,   10,    0,   15,    0,    0,    0,    0,    0,    0,
    0,    0,    0,    0,    0,    0,    0,    0,    0,   16,
    0,    0,    0,    0,    0,    0,   12,    0,    0,   14,
    0,    0,    0,    1,
);
@yycheck = (                                             33,
    0,    0,    0,   64,   37,   37,   40,    0,    0,   37,
   -1,   -1,   -1,    0,    0,   -1,   -1,   -1,   -1,   -1,
   -1,    0,    0,   -1,   -1,   -1,   -1,   -1,    0,   -1,
   -1,   -1,   -1,   -1,    0,   -1,   -1,   -1,   37,   -1,
   -1,   41,   41,   41,   43,   43,   45,   45,   41,   41,
   43,   43,   45,   45,   41,   41,   43,   43,   45,   45,
   -1,   94,   41,   41,   43,   43,   45,   45,   -1,   41,
   -1,   -1,   37,   45,   -1,   41,   -1,  110,   43,   45,
   37,   -1,  110,   -1,   41,   -1,   43,  120,   45,   -1,
   -1,   -1,  126,   92,   92,   94,   94,   -1,   -1,   92,
   92,   94,   94,   -1,   -1,   92,   92,   94,   94,   -1,
   -1,  110,  110,   92,   92,   -1,   -1,  110,  117,  117,
   92,  120,  120,  110,  117,  117,   92,  120,  120,   94,
  117,  117,   -1,  120,  120,   92,   37,   94,  117,  117,
   -1,   -1,   43,   -1,   45,  110,   -1,   -1,   -1,   -1,
   -1,   -1,  117,  110,   -1,  120,    2,    3,    4,   -1,
  117,   -1,   -1,  120,   10,   11,   12,   13,   14,   15,
   16,   17,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
   -1,   92,   -1,   94,   -1,   -1,   -1,   -1,   -1,   -1,
   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  110,
   -1,   -1,   -1,   -1,   -1,   -1,  117,   -1,   -1,  120,
   -1,   -1,   -1,  257,
);
$YYFINAL=5;
#ifndef YYDEBUG
#define YYDEBUG 0
#endif
$YYMAXTOKEN=257;
#if YYDEBUG
@yyname = (
"end-of-file",'','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','',
"'!'",'','','',"'%'",'','',"'('","')'","'*'","'+'",'',"'-'",'','','','','','','','','','','','','',
'','','','','',"'\@'",'','','','','','','','','','','','','','','','','','','','','','','','','','','',"'\\\\'",
'',"'^'",'','','','','','','','','','','','','','','',"'n'",'','','','','','',"'u'",'','',"'x'",'','','','',
'',"'~'",'','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','',
'','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','',
'','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','',
'','','','','','','','','','','','','','',"SLICE",
);
@yyrule = (
"\$accept : expr",
"expr : SLICE",
"expr : SLICE '\@'",
"expr : '!' expr",
"expr : '~' expr",
"expr : expr 'x' expr",
"expr : expr '^' expr",
"expr : expr '\\\\' expr",
"expr : expr '-' expr",
"expr : expr 'n' expr",
"expr : expr '%' expr",
"expr : expr 'u' expr",
"expr : expr '+' expr",
"expr : '(' expr ')'",
);
#endif
sub yyclearin { $_[0]->{'yychar'} = -1; }
sub yyerrok { $_[0]->{'yyerrflag'} = 0; }
sub new {
  my $p = {'yylex' => $_[1], 'yyerror' => $_[2], 'yydebug' => $_[3]};
  bless $p, $_[0];
}
sub YYERROR { ++$_[0]->{'yynerrs'}; $_[0]->yy_err_recover; }
sub yy_err_recover {
  my ($p) = @_;
  if ($p->{'yyerrflag'} < 3)
  {
    $p->{'yyerrflag'} = 3;
    while (1)
    {
      if (($p->{'yyn'} = $yysindex[$p->{'yyss'}->[$p->{'yyssp'}]]) && 
          ($p->{'yyn'} += $YYERRCODE) >= 0 && 
          $yycheck[$p->{'yyn'}] == $YYERRCODE)
      {
        warn("yydebug: state " . 
                     $p->{'yyss'}->[$p->{'yyssp'}] . 
                     ", error recovery shifting to state" . 
                     $yytable[$p->{'yyn'}] . "\n") 
                       if $p->{'yydebug'};
        $p->{'yyss'}->[++$p->{'yyssp'}] = 
          $p->{'yystate'} = $yytable[$p->{'yyn'}];
        $p->{'yyvs'}->[++$p->{'yyvsp'}] = $p->{'yylval'};
        next yyloop;
      }
      else
      {
        warn("yydebug: error recovery discarding state ".
              $p->{'yyss'}->[$p->{'yyssp'}]. "\n") 
                if $p->{'yydebug'};
        return(undef) if $p->{'yyssp'} <= 0;
        --$p->{'yyssp'};
        --$p->{'yyvsp'};
      }
    }
  }
  else
  {
    return (undef) if $p->{'yychar'} == 0;
    if ($p->{'yydebug'})
    {
      $p->{'yys'} = '';
      if ($p->{'yychar'} <= $YYMAXTOKEN) { $p->{'yys'} = 
        $yyname[$p->{'yychar'}]; }
      if (!$p->{'yys'}) { $p->{'yys'} = 'illegal-symbol'; }
      warn("yydebug: state " . $p->{'yystate'} . 
                   ", error recovery discards " . 
                   "token " . $p->{'yychar'} . "(" . 
                   $p->{'yys'} . ")\n");
    }
    $p->{'yychar'} = -1;
    next yyloop;
  }
0;
} # yy_err_recover

sub yyparse {
  my ($p, $s) = @_;
  if ($p->{'yys'} = $ENV{'YYDEBUG'})
  {
    $p->{'yydebug'} = int($1) if $p->{'yys'} =~ /^(\d)/;
  }

  $p->{'yynerrs'} = 0;
  $p->{'yyerrflag'} = 0;
  $p->{'yychar'} = (-1);

  $p->{'yyssp'} = 0;
  $p->{'yyvsp'} = 0;
  $p->{'yyss'}->[$p->{'yyssp'}] = $p->{'yystate'} = 0;

yyloop: while(1)
  {
    yyreduce: {
      last yyreduce if ($p->{'yyn'} = $yydefred[$p->{'yystate'}]);
      if ($p->{'yychar'} < 0)
      {
        if ((($p->{'yychar'}, $p->{'yylval'}) = 
            &{$p->{'yylex'}}($s)) < 0) { $p->{'yychar'} = 0; }
        if ($p->{'yydebug'})
        {
          $p->{'yys'} = '';
          if ($p->{'yychar'} <= $#yyname) 
             { $p->{'yys'} = $yyname[$p->{'yychar'}]; }
          if (!$p->{'yys'}) { $p->{'yys'} = 'illegal-symbol'; };
          warn("yydebug: state " . $p->{'yystate'} . 
                       ", reading " . $p->{'yychar'} . " (" . 
                       $p->{'yys'} . ")\n");
        }
      }
      if (($p->{'yyn'} = $yysindex[$p->{'yystate'}]) && 
          ($p->{'yyn'} += $p->{'yychar'}) >= 0 && 
          $yycheck[$p->{'yyn'}] == $p->{'yychar'})
      {
        warn("yydebug: state " . $p->{'yystate'} . 
                     ", shifting to state " .
              $yytable[$p->{'yyn'}] . "\n") if $p->{'yydebug'};
        $p->{'yyss'}->[++$p->{'yyssp'}] = $p->{'yystate'} = 
          $yytable[$p->{'yyn'}];
        $p->{'yyvs'}->[++$p->{'yyvsp'}] = $p->{'yylval'};
        $p->{'yychar'} = (-1);
        --$p->{'yyerrflag'} if $p->{'yyerrflag'} > 0;
        next yyloop;
      }
      if (($p->{'yyn'} = $yyrindex[$p->{'yystate'}]) && 
          ($p->{'yyn'} += $p->{'yychar'}) >= 0 &&
          $yycheck[$p->{'yyn'}] == $p->{'yychar'})
      {
        $p->{'yyn'} = $yytable[$p->{'yyn'}];
        last yyreduce;
      }
      if (! $p->{'yyerrflag'}) {
        &{$p->{'yyerror'}}('syntax error', $s);
        ++$p->{'yynerrs'};
      }
      return(undef) if $p->yy_err_recover;
    } # yyreduce
    warn("yydebug: state " . $p->{'yystate'} . 
                 ", reducing by rule " . 
                 $p->{'yyn'} . " (" . $yyrule[$p->{'yyn'}] . 
                 ")\n") if $p->{'yydebug'};
    $p->{'yym'} = $yylen[$p->{'yyn'}];
    $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}+1-$p->{'yym'}];
if ($p->{'yyn'} == 1) {
{ $p->{'yyval'} = &newvar($p->{'yyvs'}->[$p->{'yyvsp'}-0]); push(@OUT, "my ".$p->{'yyval'}." = \$CFG->{SLICE}->{SET}->{OBJ}->{'".$p->{'yyvs'}->[$p->{'yyvsp'}-0]."'}->Clone;"); }
}
if ($p->{'yyn'} == 2) {
{ $p->{'yyval'} = &newvar($p->{'yyvs'}->[$p->{'yyvsp'}-1]); push(@OUT, "my ".$p->{'yyval'}." = \$CFG->{SLICE}->{SET}->{OBJ}->{'NOV_".$p->{'yyvs'}->[$p->{'yyvsp'}-1]."'}->Clone;"); }
}
if ($p->{'yyn'} == 3) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-0]; push(@OUT, $p->{'yyvs'}->[$p->{'yyvsp'}-0]."->Complement(".$p->{'yyvs'}->[$p->{'yyvsp'}-0].");"); }
}
if ($p->{'yyn'} == 4) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-0]; push(@OUT, $p->{'yyvs'}->[$p->{'yyvsp'}-0]."->Complement(".$p->{'yyvs'}->[$p->{'yyvsp'}-0].");"); }
}
if ($p->{'yyn'} == 5) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-2]; push(@OUT, $p->{'yyvs'}->[$p->{'yyvsp'}-2]."->ExclusiveOr(".$p->{'yyvs'}->[$p->{'yyvsp'}-2].",".$p->{'yyvs'}->[$p->{'yyvsp'}-0].");"); }
}
if ($p->{'yyn'} == 6) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-2]; push(@OUT, $p->{'yyvs'}->[$p->{'yyvsp'}-2]."->ExclusiveOr(".$p->{'yyvs'}->[$p->{'yyvsp'}-2].",".$p->{'yyvs'}->[$p->{'yyvsp'}-0].");"); }
}
if ($p->{'yyn'} == 7) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-2]; push(@OUT, $p->{'yyvs'}->[$p->{'yyvsp'}-2]."->Difference(".$p->{'yyvs'}->[$p->{'yyvsp'}-2].",".$p->{'yyvs'}->[$p->{'yyvsp'}-0].");"); }
}
if ($p->{'yyn'} == 8) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-2]; push(@OUT, $p->{'yyvs'}->[$p->{'yyvsp'}-2]."->Difference(".$p->{'yyvs'}->[$p->{'yyvsp'}-2].",".$p->{'yyvs'}->[$p->{'yyvsp'}-0].");"); }
}
if ($p->{'yyn'} == 9) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-2]; push(@OUT, $p->{'yyvs'}->[$p->{'yyvsp'}-2]."->Intersection(".$p->{'yyvs'}->[$p->{'yyvsp'}-2].",".$p->{'yyvs'}->[$p->{'yyvsp'}-0].");"); }
}
if ($p->{'yyn'} == 10) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-2]; push(@OUT, $p->{'yyvs'}->[$p->{'yyvsp'}-2]."->Intersection(".$p->{'yyvs'}->[$p->{'yyvsp'}-2].",".$p->{'yyvs'}->[$p->{'yyvsp'}-0].");"); }
}
if ($p->{'yyn'} == 11) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-2]; push(@OUT, $p->{'yyvs'}->[$p->{'yyvsp'}-2]."->Union(".$p->{'yyvs'}->[$p->{'yyvsp'}-2].",".$p->{'yyvs'}->[$p->{'yyvsp'}-0].");"); }
}
if ($p->{'yyn'} == 12) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-2]; push(@OUT, $p->{'yyvs'}->[$p->{'yyvsp'}-2]."->Union(".$p->{'yyvs'}->[$p->{'yyvsp'}-2].",".$p->{'yyvs'}->[$p->{'yyvsp'}-0].");"); }
}
if ($p->{'yyn'} == 13) {
{ $p->{'yyval'} = $p->{'yyvs'}->[$p->{'yyvsp'}-1]; }
}
    $p->{'yyssp'} -= $p->{'yym'};
    $p->{'yystate'} = $p->{'yyss'}->[$p->{'yyssp'}];
    $p->{'yyvsp'} -= $p->{'yym'};
    $p->{'yym'} = $yylhs[$p->{'yyn'}];
    if ($p->{'yystate'} == 0 && $p->{'yym'} == 0)
    {
      warn("yydebug: after reduction, shifting from state 0 ",
            "to state $YYFINAL\n") if $p->{'yydebug'};
      $p->{'yystate'} = $YYFINAL;
      $p->{'yyss'}->[++$p->{'yyssp'}] = $YYFINAL;
      $p->{'yyvs'}->[++$p->{'yyvsp'}] = $p->{'yyval'};
      if ($p->{'yychar'} < 0)
      {
        if ((($p->{'yychar'}, $p->{'yylval'}) = 
            &{$p->{'yylex'}}($s)) < 0) { $p->{'yychar'} = 0; }
        if ($p->{'yydebug'})
        {
          $p->{'yys'} = '';
          if ($p->{'yychar'} <= $#yyname) 
            { $p->{'yys'} = $yyname[$p->{'yychar'}]; }
          if (!$p->{'yys'}) { $p->{'yys'} = 'illegal-symbol'; }
          warn("yydebug: state $YYFINAL, reading " . 
               $p->{'yychar'} . " (" . $p->{'yys'} . ")\n");
        }
      }
      return ($p->{'yyvs'}->[1]) if $p->{'yychar'} == 0;
      next yyloop;
    }
    if (($p->{'yyn'} = $yygindex[$p->{'yym'}]) && 
        ($p->{'yyn'} += $p->{'yystate'}) >= 0 && 
        $p->{'yyn'} <= $#yycheck && 
        $yycheck[$p->{'yyn'}] == $p->{'yystate'})
    {
        $p->{'yystate'} = $yytable[$p->{'yyn'}];
    } else {
        $p->{'yystate'} = $yydgoto[$p->{'yym'}];
    }
    warn("yydebug: after reduction, shifting from state " . 
        $p->{'yyss'}->[$p->{'yyssp'}] . " to state " . 
        $p->{'yystate'} . "\n") if $p->{'yydebug'};
    $p->{'yyss'}[++$p->{'yyssp'}] = $p->{'yystate'};
    $p->{'yyvs'}[++$p->{'yyvsp'}] = $p->{'yyval'};
  } # yyloop
} # yyparse

#   create new set variable
$tmpcnt = 0;
sub newvar {
    local ($name) = @_;
    my ($tmp);

    if ($main::CFG->{SLICE}->{SET}->{OBJ}->{"$name"} eq '') {
        &main::error("no such slice '$name'\n");
    }
    $tmp = sprintf("\$T%03d", $tmpcnt++);
    return $tmp;
}

#   the lexical scanner
sub yylex {
    local (*s) = @_;
    my ($c, $val);

    #   ignore whitespaces
    $s =~ s|^[ \t\n]+||;

    #   recognize end of string
    return 0 if ($s eq '');

    #   found a token
    if ($s =~ m|^([_A-Z0-9*]+)(.*)|) {
        $val = $1;
        $s = $2;

        #   if its a wildcarded slice name we have
        #   to construct the slice union on-the-fly
        if ($val =~ m|\*|) {
            my $pat = $val;
            $pat =~ s|\*|\.\*|g;
            my $slice;
            my @slices = ();
            foreach $slice (keys(%{$main::CFG->{SLICE}->{SET}->{ASC}})) {
                if ($slice =~ m|^$pat$|) {
                    push(@slices, $slice);
                }
            }
            if ($#slices == 0) {
                $val = $slices[0];
            }
            elsif ($#slices > 0) {
                $s = join('u', @slices).')'.$s;
                return ord('(');
            }
            else {
                &main::error("no existing slice matches `$val'\n");
            }
        }
        return ($SLICE, $val);
    }

    #   else give back one plain character
    $c = substr($s, 0, 1);
    $s = substr($s, 1);
    return ord($c);
}

#   and error function
sub yyerror {
    my ($msg, $s) = @_;
    die "$msg at $s.\n";
}

#
#  The top-level function which gets called by the user
#
#  ($cmds, $var) = SliceTerm::Parse($term);
#

package SliceTerm;

sub Parse {
    local($str) = @_;
    local($p, $var, $cmds);

    @SliceTermParser::OUT = ();
    $p = SliceTermParser->new(\&SliceTermParser::yylex, \&SliceTermParser::yyerror, 0);
    $var = $p->yyparse(*str);
    $cmds = join("\n", @SliceTermParser::OUT) . "\n";

    return ($cmds, $var);
}

package main;

##EOF##
##
##  slice_setup.pl -- Command line parsing and CFG setup
##  Copyright (c) 1997,1998 Ralf S. Engelschall. 
##

package main;

sub usage {
    print STDERR "Usage: slice [options] [file]\n";
    print STDERR "\n";
    print STDERR "Options:\n";
    print STDERR "  -o, --outputfile=FILESPEC  create output file(s)\n";
    print STDERR "  -v, --verbose              enable verbose mode\n";
    print STDERR "  -V, --version              display version string\n";
    print STDERR "  -h, --help                 display usage page\n";
    print STDERR "\n";
    print STDERR "FILESPEC format:\n";
    print STDERR "\n";
    print STDERR "  [SLICETERM:]PATH[\@CHMODOPT]\n";
    print STDERR "\n";
    print STDERR "  SLICETERM ..... a set-theory term describing the slices\n";
    print STDERR "  PATH .......... a filesystem path to the outputfile\n";
    print STDERR "  CHMODOPT ...... permission change options for 'chmod'\n";
    print STDERR "\n";
    exit(1);
}

sub hello {
    print STDERR "$Vers::SLICE_Hello\n";
    print STDERR <<'EOT';
Copyright (c) 1997,1998 Ralf S. Engelschall.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
EOT
    exit(0);
}

sub setup {
    my ($CFG) = @_;

    #   parse command line options
    $opt_h = 0;
    $opt_V = 0;
    $opt_v = 0;
    @opt_o = ();
    $SIG{'__WARN__'} = sub { 
        print STDERR "Slice:Error: $_[0]";
    };
    $Getopt::Long::bundling = 1;
    $Getopt::Long::getopt_compat = 0;
    if (not Getopt::Long::GetOptions("v|verbose",
                                     "V|version",
                                     "h|help",
                                     "o|outputfile=s@")) {
        print STDERR "Try `$0 --help' for more information.\n";
        exit(0);
    }
    $SIG{'__WARN__'} = undef;
    &usage($0) if ($opt_h);
    &hello() if ($opt_V);

    #   process command line arguments and
    #   read input file
    if (($#ARGV == 0 and $ARGV[0] eq '-') or $#ARGV == -1) {
        $fp = new IO::Handle;
        $fp->fdopen(fileno(STDIN), "r");
        local ($/) = undef;
        $INPUT = <$fp>;
        $fp->close;
    }
    elsif ($#ARGV == 0) {
        $fp = new IO::File;
        $fp->open($ARGV[0]);
        local ($/) = undef;
        $INPUT = <$fp>;
        $fp->close;
    }
    else {
        &usage;
    }

    #   add additional options
    $INPUT =~ s|^%!slice\s+(.*?)\n|push(@ARGV, split(' ', $1)), ''|egim;
    if (not Getopt::Long::GetOptions("x|debug",
                                     "v|version",
                                     "o|outputfile=s@")) {
        &usage;
    }
    if ($#opt_o == -1) {
        @opt_o = ( "ALL:-" ); # default is all on stdout
    }

    #   setup the $CFG hash
    $CFG->{INPUT} = {};
    $CFG->{INPUT}->{SRC}   = $INPUT;  # original source
    $CFG->{INPUT}->{PLAIN} = '';      # source without slice delimiters
    $CFG->{OPT} = {};    
    $CFG->{OPT}->{X} = $opt_v;        # option -v
    $CFG->{OPT}->{O} = [ @opt_o ];    # options -o
    $CFG->{SLICE} = {};
    $CFG->{SLICE}->{SET} = {};       
    $CFG->{SLICE}->{SET}->{ASC} = {}; # slice set, represented in ASCII
    $CFG->{SLICE}->{SET}->{OBJ} = {}; # slice set, represented as Bit::Vector object
    $CFG->{SLICE}->{MINLEVELS}  = {}; # slice min levels
    $CFG->{SLICE}->{MAXLEVEL}   = 0;  # maximum slice level
}

##EOF##
##
##  slice_pass1.pl -- Pass 1
##  Copyright (c) 1997,1998 Ralf S. Engelschall. 
##

package main;

##
##
##  Pass 1: Determine delimiters
##
##

sub pass1 {
    my ($CFG) = @_;

    my ($found1, $prolog1, $name1, $epilog1);
    my ($found2, $prolog2, $name2, $epilog2);
    my (@CURRENT_SLICE_NAMES, %CURRENT_LEVEL_BRAIN, $CURRENT_LEVEL_SET);
    my ($INPUT, $pos, $namex, $L, $openseen);

    &verbose("\nPass 1: Determine delimiters\n\n");

    @CURRENT_SLICE_NAMES = ();                  
    %CURRENT_LEVEL_BRAIN = ();                  
    $CURRENT_LEVEL_SET   = new Bit::Vector(512);

    #   allocate the next free level starting from 1
    sub alloclevel {
        my ($i);

        for ($i = 0; $i <= $CURRENT_LEVEL_SET->Max(); $i++) {
            last if (not $CURRENT_LEVEL_SET->bit_test($i));
        }
        $CURRENT_LEVEL_SET->Bit_On($i);
        return $i + 1;
    }

    #   clear the given level  
    sub clearlevel {
        my ($i) = @_;

        $CURRENT_LEVEL_SET->Bit_Off($i - 1);
    }

    $INPUT = $CFG->{INPUT}->{SRC};
    $pos   = 0;
    $open  = 0;
    while (1) {
        # search for begin delimiter
        $found1 = (($prolog1, $name1, $epilog1) = 
                   ($INPUT =~ m|^(.*?)\[([A-Z][_A-Z0-9]*):(.*)$|s));
        # search for end delimiter
        $found2 = (($prolog2, $name2, $epilog2) = 
                   ($INPUT =~ m|^(.*?):([A-Z][_A-Z0-9]*)?\](.*)$|s));

        if (($found1 and not $found2) or ($found1 and $found2 and (length($prolog1) < length($prolog2)))) {
            #
            #   begin delimiter found
            #
            $pos += length($prolog1);           # adjust position
            $CFG->{INPUT}->{PLAIN} .= $prolog1; # move prolog
            $INPUT = $epilog1;                  # and go on with epilog

            $L = &alloclevel();                 # allocate next free level

            push(@CURRENT_SLICE_NAMES, $name1); # remember name  for end delimiter
            $CURRENT_LEVEL_BRAIN{"$name1"} = $L;# remember level for end delimiter
            if ($CFG->{SLICE}->{MINLEVELS}->{"$name1"} eq '' or 
                $CFG->{SLICE}->{MINLEVELS}->{"$name1"} > $L) {
                $CFG->{SLICE}->{MINLEVELS}->{"$name1"} = $L;
            }

            #  now begin entry with LEVEL:START
            $CFG->{SLICE}->{SET}->{ASC}->{"$name1"} .= 
                 ($CFG->{SLICE}->{SET}->{ASC}->{"$name1"} ? ',' : '') . "$L:$pos"; 

            #  adjust notice about highest level
            $CFG->{SLICE}->{MAXLEVEL} = ($CFG->{SLICE}->{MAXLEVEL} < $L ? 
                                         $L : $CFG->{SLICE}->{MAXLEVEL});

            &verbose("    slice `$name1': begin at $pos, level $L\n");

            $open++;
        }
        elsif (($open > 0) and ((not $found1 and $found2) or ($found1 and $found2 and (length($prolog2) < length($prolog1))))) {
            #
            #   end delimiter found
            #
            $pos += length($prolog2)-1;         # adjust position
            $CFG->{INPUT}->{PLAIN} .= $prolog2; # move prolog
            $INPUT = $epilog2;                  # and go on with epilog

            $namex = pop(@CURRENT_SLICE_NAMES);      # take remembered name
            $name2 = $namex if ($name2 eq '');       # fill name because of shortcut syntax
            $L     = $CURRENT_LEVEL_BRAIN{"$name2"}; # take remembered level

            &clearlevel($L);                         # de-allocate level

            # now end entry with :END
            $CFG->{SLICE}->{SET}->{ASC}->{"$name2"} .= ":$pos";

            &verbose("    slice `$name2': end at $pos\n");

            $pos++;
            $open--;
        }
        else { # not $found1 and not $found2 _OR_ bad input stuff
            #
            #   nothing more found
            #
            $CFG->{INPUT}->{PLAIN} .= $INPUT; # add all remaining input
            last;                             # stop loop
        }
    }

    #   check: were all opened slices really closed?
    if ($CURRENT_LEVEL_SET->Norm > 0) {
        my $i;
        my $err = '';
        for ($i = 0; $i <= $CURRENT_LEVEL_SET->Max(); $i++) {
            if ($CURRENT_LEVEL_SET->bit_test($i)) {
                my $name;
                foreach $name (keys(%CURRENT_LEVEL_BRAIN)) {
                    if ($CURRENT_LEVEL_BRAIN{$name} == ($i+1)) {
                        $err .= " `$name'";
                    }
                }
            }
        }
        &error("Some slices were not closed:$err\n");
    }
}

##EOF##
##
##  slice_pass2.pl -- Pass 2
##  Copyright (c) 1997,1998 Ralf S. Engelschall. 
##

package main;

##
##
##  Pass 2: Calculation of slice sets
##
##

sub pass2 {
    my ($CFG) = @_;

    my ($n, $asc, $slice, $set, $setA);

    &verbose("\nPass 2: Calculation of slice sets\n\n");

    #  convert ASCII set representation string into internal set object
    sub asc2set {
        my ($asc, $set, $onlylevel, $notcleared) = @_;
        my ($i, $I, $internal, $from, $to, $level);

        $set->Empty() if (($notcleared eq '') or (not $notcleared));
        return $set if ($asc =~ m|^\d+:0:-1$|); # string represents the empty set

        #   split out the interval substrings 
        @I = ($asc);
        @I = split(',', $asc) if (index($asc, ',') > 0);

        #   iterate over each interval and
        #   set the corresponding elements in the set
        foreach $interval (@I) {
            ($level, $from, $to) = ($interval =~ m|^(\d+):(\d+):(\d+)$|);
            next if (($onlylevel ne '') and ($level != $onlylevel)); 
            next if ($from > $to);
            $set->Interval_Fill($from, $to);
        }
    }

    $n = length($CFG->{INPUT}->{PLAIN})+1;
    $set  = new Bit::Vector($n); # working set
    $setA = new Bit::Vector($n); # "all" set

    #   convert ASCII representation to real internal set objects
    foreach $slice (keys(%{$CFG->{SLICE}->{SET}->{ASC}})) {
        $asc = $CFG->{SLICE}->{SET}->{ASC}->{$slice};
        $set->Empty();
        &asc2set($asc, $set);
        $CFG->{SLICE}->{SET}->{OBJ}->{$slice} = $set->Clone();
    }

    #   define the various (un)defined slice areas
    $set->Fill();
    $CFG->{SLICE}->{SET}->{OBJ}->{'UNDEF0'} = $set->Clone();
    $set->Empty();
    $CFG->{SLICE}->{SET}->{OBJ}->{'DEF0'} = $set->Clone();
    $setA->Empty();
    for ($i = 1; $i <= $CFG->{SLICE}->{MAXLEVEL}; $i++) {
        $set->Empty();
        foreach $slice (keys(%{$CFG->{SLICE}->{SET}->{ASC}})) {
            $asc = $CFG->{SLICE}->{SET}->{ASC}->{$slice};
            &asc2set($asc, $set, $i, 1); # load $set with entries of level $i
            $setA->Union($setA, $set);   # add to $setA these entries
        }
        $CFG->{SLICE}->{SET}->{OBJ}->{"DEF$i"} = $set->Clone();
        $set->Complement($set);
        $CFG->{SLICE}->{SET}->{OBJ}->{"UNDEF$i"} = $set->Clone();
    }
    $CFG->{SLICE}->{SET}->{OBJ}->{'DEF'} = $setA->Clone();
    $setA->Complement($setA);
    $CFG->{SLICE}->{SET}->{OBJ}->{'UNDEF'} = $setA->Clone();
    $CFG->{SLICE}->{SET}->{OBJ}->{'ALL'} = $CFG->{SLICE}->{SET}->{OBJ}->{'UNDEF0'};

    #   define the various slice areas which are not overwritten
    foreach $slice (keys(%{$CFG->{SLICE}->{SET}->{ASC}})) {
        $asc = $CFG->{SLICE}->{SET}->{ASC}->{$slice};
        $set->Empty();
        &asc2set($asc, $set);
        $L = $CFG->{SLICE}->{MINLEVELS}->{$slice};
        for ($i = $L+1; $i <= $CFG->{SLICE}->{MAXLEVEL}; $i++) {
            $set->Difference($set, $CFG->{SLICE}->{SET}->{OBJ}->{"DEF$i"});
        }
        $CFG->{SLICE}->{SET}->{OBJ}->{"NOV_$slice"} = $set->Clone();
    }

    if ($CFG->{OPT}->{X}) {
        foreach $slice (sort(keys(%{$CFG->{SLICE}->{SET}->{OBJ}}))) {
            $set = $CFG->{SLICE}->{SET}->{OBJ}->{$slice};
            if ($set->Norm > 0) {
                &verbose("    slice `$slice': " . $set->to_ASCII() . "\n");
            }
            else {
                &verbose("    slice `$slice': -Empty-\n");
            }
        }
    }
}

##EOF##
##
##  slice_pass3.pl -- Pass 3
##  Copyright (c) 1997,1998 Ralf S. Engelschall. 
##

package main;

##
##
##  Pass 3: Output generation
##
##

sub pass3 {
    my ($CFG) = @_;

    my ($slice, $outfile, $chmod, $out);
    my ($set, $cmds, $var);
    my ($start, $min, $max);
    my ($entry);

    &verbose("\nPass 3: Output generation\n\n");

    foreach $entry (@{$CFG->{OPT}->{O}}) {

        #   determine parameters
        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");

        #   open output file
        if ($outfile eq '-') {
            $out = new IO::Handle;
            $out->fdopen(fileno(STDOUT), 'w');
        }
        else {
            $out = new IO::File;
            $out->open(">$outfile");
        }

        #   now when there is plain data cut out the slices
        if (length($CFG->{INPUT}->{PLAIN}) > 0) {
            #   parse the sliceterm and create corresponding
            #   Perl 5 statement containing Bit::Vector calls
            ($cmds, $var) = SliceTerm::Parse($slice);
    
            #   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;
            while (($start < $set->Size()) &&
                   (($min, $max) = $set->Interval_Scan_inc($start))) {
                $out->print(substr($CFG->{INPUT}->{PLAIN}, $min, ($max-$min+1)));
                $start = $max + 2;
            }
        }

        #   close outputfile
        $out->close;

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


$CFG = {};
&setup($CFG);
&pass1($CFG);
&pass2($CFG);
&pass3($CFG);

exit(0);


##EOF##
