=head1 NAME

CFX5::Win32::Commands - Functions for spawning tasks under Windows NT

=head1 SYNOPSIS

This module provides functions for spawning tasks in various exotic
ways under Windows NT.

It should never be included under UNIX. Most users will not want it
under NT either, as it is used by all the functions in
L<CFX5::Commands> anyway.

=cut

package CFX5::Win32::Commands;

use strict;

use vars qw($CVSVersion);
$CVSVersion='$Id$ ';

use Exporter;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);

use File::Temp qw(tempfile);

@ISA=qw(Exporter);
@EXPORT_OK=qw();


use vars qw($UseAPIFile);

eval { require Win32API::File; };
if (not $@) {
  # got it, we can use the calls from here to access OS file handles
  $UseAPIFile=1;
}
# otherwise we better hope we're using an older perl which still has
# Win32::GetOSFHandle built in ...

use CFX5::Output qw(:all);

require CFX5::PathManip;
require CFX5::Config;

sub GetOSFHandle {
  if ($UseAPIFile) {
    return Win32API::File::GetOsFHandle(@_);
  } else {
    return Win32::GetOSFHandle(fileno($_[0]));
  }
}

=head1 DESCRIPTION

=head2 run_minimized

We "emulate" the system() function using the Win32 call CreateProcess,
as loaded via Win32::API (to avoid having lots of DLLs, and also
because Win32::Process::Create is horrid).

Return value is the emulated exit status if we had a go at running, or
undef if we couldn't even load the DLLs we needed.

=cut 

sub run_minimized {
  my ($cmd, @args) = @_;

  use Win32::Job;
  my $ok;
  my $job = Win32::Job->new();
  my %opts;
  $opts{window_attr}="minimized";
  # Modified Win32::Job module
  # Don't create a new job object if we are already part of a job
  $opts{nojob}=Win32::Job::hasparentjob();
  $ok=$job->spawn($cmd,			# the command to run
             join(" ",$cmd,             # the arguments
               map { $_ =~ m!\s! ? qq("$_") : $_ } @args),
             \%opts);
  
  return CFX5::Commands::Result->new_not_run("Unable to execute $cmd: $^E", $cmd) unless defined $ok;

  $job->run();
  
  require CFX5::Commands::Result;

  my %stat=$job->status();

  my $prv=CFX5::Commands::Result->new($stat{exitcode}, $cmd);

  # in case $retval happens to trigger the "nope" clause
  $prv->set_ran(1);

  $?=$stat{exitcode};

  return $prv;
}

=head2 get_cmd_output_min

We "emulate" the C<qx{}> (backticks) function using the Win32 call
CreateProcess, as loaded via Win32::API (to avoid having lots of DLLs,
and also because Win32::Process::Create is horrid).

Return value is the command output (list of lines if C<wantarray>,
concatenated otherwise) if we had a go at running, or undef if we
failed.

=cut

sub get_cmd_output_min {
  return get_cmd_output_(undef, 1, @_);
}

sub get_cmd_output_ {
  my ($input, $min, $cmd, @args) = @_;

  # need to quote commands or arguments containing spaces.  We also
  # include $cmd here, so it gets quoted too if necessary
  @args = map { m! ! ? qq("$_") : $_ } ($cmd, @args);

  # we make a pair of pipes
  local (*KIDOUT, *PARIN);
  pipe(PARIN, KIDOUT)
    or die "Error opening pipe: $!";

  use Win32::Job;
  my $pid;
  my $job = Win32::Job->new();
  my %opts;
  if($min){
    $opts{window_attr}="minimized";
  }
  if(defined $input){
    my($fh, $filename)=tempfile();
    for my $l (@$input) {
      print $fh $l;
    }
    close($fh);
    $opts{stdin}=$filename;
  } else {
    $opts{stdin}='NUL';
  }
  $opts{stdout}=\*KIDOUT;
  $opts{stderr}=\*KIDOUT;
  $opts{nojob}=Win32::Job::hasparentjob();
  
  $pid=$job->spawn($cmd,			# the command to run
             join(" ",@args),             # the arguments
             \%opts);
  unless (defined $pid) {
    # XP has a "bug" where NULL appname doesn't seem to work, so let's
    # try doing it ourselves!
    my $ncmd=get_module_path($cmd);
    $^E=0;
    _debug("Calling CreateProcess with appname $ncmd");
    $pid=$job->spawn($ncmd, join(" ", @args), \%opts);
    _debug("return $pid (non-zero => success), error is $^E");
  }
  close(*KIDOUT);
  
  return CFX5::Commands::Result->new_not_run("Unable to execute $cmd: $^E", $cmd) unless defined $pid;

  local ($CFX5::Win32::Commands::_tmptxt) ="";
  local ($CFX5::Win32::Commands::_tmpfno) = "";
  vec($CFX5::Win32::Commands::_tmpfno, fileno(PARIN),1)=1;
  $job->watch(\&_mywatch
	       , 0.3);
  
  require CFX5::Commands::Result;

  my %stat=%{$job->status()};
  %stat=%{$stat{$pid}};

  my $done=0;

  # now the process has finished, flush the buffer and return
  #my $t;
  #while(!$done) {
  #  if (defined ($t=<PARIN>)) {
  #    $CFX5::Win32::Commands::_tmptxt .= $t;
  #  } else {
  #    $done=1;
  #  }
  #}

  require CFX5::Commands::Result;
  my $prv=CFX5::Commands::Result->new($stat{exitcode}, $cmd);

  # in case $retval happens to trigger the "nope" clause
  $prv->set_ran(1);

  $prv->set_cmd_output(split("\r*\n",$CFX5::Win32::Commands::_tmptxt));

  unlink($opts{stdin}) if defined $input;

  return $prv;
}

sub _mywatch {
  my ($eout, $buf);
  die unless defined $CFX5::Win32::Commands::_tmpfno;
  while(select($eout = $CFX5::Win32::Commands::_tmpfno, undef, undef, 0.01)) {
         if(sysread(PARIN,$buf,16384)) {
           $CFX5::Win32::Commands::_tmptxt .= $buf;
         }
         else {
           last;
         }
  }
  return 0;
}

=head3 get_module_path

This call is used to handle the command lines to pass to
C<CreateProcess>.  It is needed because of an apparrent difference in
behaviour on Windows XP, where CreateProcess no longer looks along the
PATH, and needs to have the binary ("module name") supplied.

It does two things.  Firstly, it endeavours to split off the command
from its arguments, if there is only one argument; we need do no more
than this, as Windows concatenates them later anyway, so we avoid all
that complexity.

Secondly, it then attempts to locate the command on the PATH, and
fills in the full pathname to it.

Greetz to Steve for the debugging!

=cut

sub get_module_path {
  my ($cmd,@args)=shift;

  if (!@args and $cmd =~ m! ! and ! -f $cmd) {
    # $cmd might also include the arguments.  How do we know?  Assume
    # that the final command name (without the path) will never
    # include spaces.  Then it is either of the form q(word arg1 arg2)
    # or q("full path maybe containing spaces" arg1 arg2)
    _debug("Attempting to split command \"$cmd\"");
    if ($cmd =~ m!^\"([^\"]+\")\s+(.*)$!) {
      # got a quoted path
      $cmd=$1;
      unshift @args, $2;
    } else {
      my ($ncmd,$nargs)=split(' ',$cmd,2);
      $cmd=$ncmd;
      unshift @args, $nargs;
    }
    _debug("got \"$cmd\" and \"$args[0]\"");
  }

  # step two: find the binary if possible.

  # need a version of the same with .exe appended for the file test,
  # unless it already has it.
  my $cmdexe=$cmd;
  $cmdexe .= '.exe' unless $cmdexe =~ m!(^|[\\/]).*\..*!;

  unless (-f $cmd or -f $cmdexe) {
    # doesn't exist as a filename, we may need to look along the PATH,
    # but only if it doesn't contain a slash already
    if ($cmd =~ m![\\/]!) {
      _debug("Not looking for path $cmd on PATH");
    } else {
      my @dirs=CFX5::PathManip::path_to_list(CFX5::Config::getconf('PATH'));
      for my $d (@dirs) {
        if (-f "$d\\$cmd") {
          $cmd="$d\\$cmd";
          last;
        }
        if (-f "$d\\$cmd.exe") {
          $cmd="$d\\$cmd.exe";
          last;
        }
      }
      _debug("Finally command is $cmd");
    }
  }
  # return ($cmd,@args);
  return $cmd;
}

1;
