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

# Copyright (c) 2003-2007 Vincent Lefevre <vincent@vinc17.org>.
# Latest version on <http://www.vinc17.org/unix/>.

# This program is free software; you may redistribute it
# and/or modify it under the same terms as Perl itself.

require 5.001;
use strict;
use Getopt::Long;
use IO::Handle;

my ($proc,$vers) = '$Id: eet 20145 2007-12-03 16:28:56Z lefevre $'
  =~ /^.Id: (\S+) \d+ (\d{4}-\d\d-\d\d \d\d:\d\d:\d\d)Z/ or die;

my $Usage = <<EOF;
Usage: $proc [options] [command ...]
  -a, --append=FILE     append to file FILE
  -d, --directory=DIR   directory containing the filters
  -f, --filter=STRING   use filter STRING
  -l, --library=STRING  use library STRING
  -m, --mode=STRING     output mode (behavior depends on the filter/libs)
  -n, --nostdout        write to the given files only (nothing to stdout)
  -o, --output=FILE     output to file FILE
      --off             turn off filter when writing to files
      --on              turn on filter when writing to files (default)
  -p, --pipe=COMMAND    pipe to command COMMAND
  -s, --stderr          catch the command stderr (wrapper mode only)
  -?, --help            display this help and exit
      --version         output version information and exit

The directories given by the -d option and the value of the environment
variable \$EETPATH (in that order) form the filter path, where filters
and libraries are searched for. If the filter path is empty, the following
default path is used:

  \$HOME/.eet
  /usr/local/share/eet
  /usr/share/eet

The order of the -a, -f, -m, -o, -p, --off and --on options is important.
It determines when the filter is on or off and which filter/mode is used.

If a command is given (wrapper mode), it is started with:
  * standard input: standard input of $proc
  * standard output: caught by $proc (to be filtered)
  * standard error: standard error of $proc, unless option -s is given
Otherwise (filter mode), the standard input is caught by $proc to be
filtered.

Copyright (c) 2003-2007 Vincent Lefevre <vincent\@vinc17.org>.
Latest version on <http://www.vinc17.org/unix/>.

This program is free software; you may redistribute it
and/or modify it under the same terms as Perl itself.
EOF

my ($filter,$mode,$nostdout,$stderr,@fpath,@libs,%out);
my $on = 1;

Getopt::Long::Configure("require_order");
GetOptions(
    'append|a=s'    => sub { &conf(">>$_[1]") },
    'directory|d=s' => sub { push @fpath, split /:+/, $_[1] },
    'filter|f=s'    => \$filter,
    'library|l=s'   => sub { push @libs, $_[1] },
    'mode|m=s'      => \$mode,
    'nostdout|n'    => \$nostdout,
    'output|o=s'    => sub { &conf(">$_[1]") },
    'off'           => sub { $on = 0 },
    'on'            => sub { $on = 1 },
    'pipe|p=s'      => sub { &conf("|$_[1]") },
    'stderr|s'      => \$stderr,
    'help|h'        => sub { print $Usage; exit },
    'version'       => \&version)
  or die <<EOF;
Try '$proc --help' for more information.
EOF

$out{'STDOUT'} = [ $filter, $mode, *STDOUT ] unless $nostdout;

push @fpath, split /:+/, $ENV{'EETPATH'};
@fpath = @fpath ? grep { $_ ne '' } @fpath :
  ("$ENV{HOME}/.eet", "/usr/local/share/eet", "/usr/share/eet");

if (@ARGV)
  {
    if ($stderr)
      {
        require IPC::Open3;
        import IPC::Open3;
        open3("<&STDIN", \*INPUT, \*INPUT, @ARGV);
      }
    else
      {
        require IPC::Open2;
        import IPC::Open2;
        open2(\*INPUT, "<&STDIN", @ARGV);
      }
    open STDIN, "<&=INPUT" or die;
  }

my $nullfilter =
  { 'begin' => sub { '' },
    'end'   => sub { '' },
    'loop'  => sub { $_ } };

my %fsub;
$fsub{''} = sub { $nullfilter };

foreach my $file (keys %out)
  {
    my $ref = $out{$file};
    my $f = $ref->[0];
    defined $fsub{$f} or $fsub{$f} = &dofile('filter', $f);
    my $fobj = &{$fsub{$f}};
    my $libsref = $fobj->{'libs'};
    defined $libsref and push @libs, @$libsref;
    foreach (qw/begin end loop/)
      { defined $fobj->{$_} or $fobj->{$_} = $nullfilter->{$_} }
    $ref->[0] = $fobj;
    $file eq 'STDOUT' and next;
    local *FH;
    open FH, $file or die "$proc: error when opening '$file'\n$!\n";
    FH->autoflush(1);
    push @$ref, *FH;
  }

my %libs;
foreach my $lib (@libs)
  {
    $libs{$lib} and next;
    $libs{$lib} = 1;
    &dofile('library', $lib);
  }

foreach my $ref (values %out)
  {
    my $fh = $ref->[2];
    print $fh $ref->[0]->{'begin'}->($ref->[1]);
  }

while (defined (my $line = <STDIN>))
  {
    foreach my $ref (values %out)
      {
        $_ = $line;
        my $fh = $ref->[2];
        print $fh $ref->[0]->{'loop'}->($ref->[1]);
      }
  }

foreach my $ref (values %out)
  {
    my $fh = $ref->[2];
    print $fh $ref->[0]->{'end'}->($ref->[1]);
  }

sub conf
  {
    my $key = $_[0];
    $out{$key} = $on ? [ $filter, $mode ] : [ '', '' ];
  }

sub dofile
  {
    my ($type,$file) = @_;
    foreach (@fpath)
      {
        -f "$_/$file" or next;
        $file = "$_/$file";
        my $ret = do $file;
        unless (defined $ret)
          {
            $! and die "$proc: error when reading $file\n$!\n";
            $@ and die "$proc: error when compiling $file\n$@";
          }
        return $ret;
      }
    die "$proc: can't find $type $file\n";
  }

sub version
  {
    print "$proc $vers, written by Vincent Lefevre.\n";
    exit;
  }

# Note about the filters
# ======================
#
# A filter is a reference to a subroutine that takes a mode in argument
# and returns a reference to a hash. This subroutine is evaluated each
# time the filter is defined, so that it can act as a closure. The hash
# contains, for the following keys (when defined):
#   * 'libs'
#       A reference to an array containing the names of the required
#       libraries. Default: [ ] (no required libraries).
#   * 'begin'
#       A reference to a subroutine that takes a mode in argument and
#       returns a string to print out. This subroutine is called before
#       the first line of the file is read. Default: sub { } (print out
#       nothing).
#   * 'end'
#       A reference to a subroutine that takes a mode in argument and
#       returns a string to print out. This subroutine is called after
#       the last line of the file is read. Default: sub { } (print out
#       nothing).
#   * 'loop'
#       A reference to a subroutine that takes a mode in argument and
#       returns a string to print out. This subroutine is called each
#       time a line of the file is read, and $_ contains this line (to
#       be filtered). Default: sub { $_ } (do not change the line).