$| = 1;

use IO::File;

%builtin = (cd => sub { chdir $_[0] 
                          || warn "Couldn't chdir to $_[0]: $!\n"; },
            exit => sub { exit $_[0] || 0 },
            );

while (1) {
  print "perl% ";
  my $command = <STDIN>;
  last if $command eq '';
  chomp $command;
  my (%command) = parse($command);
  print STDERR "$$ parser returned ", join(" ", %command), "\n";
  next unless %command;

  if (defined $builtin{$command{program}}) {
    $builtin{$command{program}}->(@{$command{args}});
    next;
  }

  my $pid = $command{nofork} ? 0 : fork;
  printf STDERR "$$ after %s is %s...\n", 
    $command{nofork} ? 'pseudofork' : 'fork',
      $pid == 0 ? 'child' : 'parent';
  if (! defined $pid) { print STDERR "Couldn't fork: $!\n" }
  elsif ($pid != 0) { print STDERR "$$ waiting\n"; my $p = waitpid $pid, 0; 
                      print STDERR "$$ finished waiting on $p\n"; }
  else { 
    if (defined $command{stdin}) {
      open STDIN, "<$command{stdin}"
        or die "$$ Couldn't redirect stdin from $command{stdin}: $!\n";
      print STDERR "$$ Redirected STDIN from $command{stdin}\n";
    }
    if (defined $command{stdout}) {
      open STDOUT, "$command{append}$command{stdout}"
        or die "Couldn't redirect stdout to $command{stdout}: $!\n";
      print STDERR "$$ Redirected STDOUT to $command{stdout}\n";
    }
    print STDERR "$$ Execing $command{program}\n";
    exec $command{program}, @{$command{args}};
    die "Couldn't exec: $!\n";
  }
}


sub parse {
  my @words = grep $_ =~ /\S/, split /(\s+|<|>>|>|\|)/, $_[0];
  my %d;
  $d{program} = shift @words;
  while (@words) {
    local $_ = shift @words;
    if ($_ eq '<') {
      $d{stdin} = shift @words;
    } elsif ($_ eq '>' || $_ eq '>>') {
      $d{stdout} = shift @words;
      $d{append} = $_;
    } elsif ($_ eq '|') {
      pipe "R", "W" or warn("Couldn't create pipe: $!\n"), return;
      my $pid = fork;
      if (! defined $pid) { warn "Couldn't fork: $!\n"; return; }
      elsif ($pid != 0) {       # parent
        close "W";
        %d = (program =>  shift(@words), stdin => "&R");
      } else {
        close "R";
        print STDERR "$$ Closed R\n";
        return %d, stdout => "&W", append => '>', nofork => 1;
      }
    } else {
      push @{$d{args}}, $_;
    }
  }
  %d;
}