--- nfo/perl/libs/shortcuts.pm	2003/06/23 15:59:16	1.10
+++ nfo/perl/libs/shortcuts.pm	2003/06/23 20:58:31	1.13
@@ -1,7 +1,17 @@
 ## ---------------------------------------------------------------------------
-##  $Id: shortcuts.pm,v 1.10 2003/06/23 15:59:16 joko Exp $
+##  $Id: shortcuts.pm,v 1.13 2003/06/23 20:58:31 joko Exp $
 ## ---------------------------------------------------------------------------
 ##  $Log: shortcuts.pm,v $
+##  Revision 1.13  2003/06/23 20:58:31  joko
+##  restructured, hopefully makes Linux and Windows (and *BSD) more compatible...  what about IPC::Cmd???
+##
+##  Revision 1.12  2003/06/23 19:43:19  joko
+##  minor cleanup
+##  now using IPC::Session::NoShell
+##
+##  Revision 1.11  2003/06/23 17:41:50  jonen
+##  + NEW - used IPC::Session instead of IPC::Run to get better results at linux
+##
 ##  Revision 1.10  2003/06/23 15:59:16  joko
 ##  major/minor fixes?
 ##
@@ -60,6 +70,8 @@
 use IPC::Run qw( start pump finish timeout run ) ;
 use Carp;
 
+# NEW - 2003-06-23 for Linux (what about *BSD?)
+use IPC::Session;
 
 
 # $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
@@ -76,6 +88,9 @@
   return strftime("%Y-%m-%d", localtime);
 }
 
+sub RUNNING_IN_HELL () { $^O eq 'MSWin32' }
+
+
 sub get_executable {
   my $cmd = shift;
   # FIXME: detect type of program and run with proper application/interpreter
@@ -83,22 +98,39 @@
   # => better use absolute path-names only?!
   my $application = '';
   if ($cmd =~ m/\w+\.pl\s*.*/) {
-    $application = 'perl ';
+      $application = get_interpreter_wrapper($cmd, 'perl');
+      #$cmd = "$application $cmd" if $application;
+      $application .= ' ';
+    
   } else {
     $application = './';
   }
   return $application;
 }
 
-sub get_executable_wrapper {
+sub get_interpreter_wrapper {
   my $cmd = shift;
-  my $application = '';
-  # Required to adapt to IPC::Run on win32.
-  if (RUNNING_IN_HELL()) {
-    #$application = 'cmd.exe /C';
-    $application = 'cmd.exe /C';
+  my $language = shift;
+  $language ||= '';
+
+  my $wrapper = '';
+
+  if ($language eq 'perl') {
+  
+    if (RUNNING_IN_HELL()) {
+      # Required to adapt to IPC::Run on win32.
+      $wrapper = 'cmd.exe /C perl';
+    } else {
+      # NEW 2003-06-23 - needed if used with IPC::Session (at Linux)
+      #  whats about Win32?
+      $wrapper = 'perl';
+    }
+    
+  } else {
+    die("No wrapper for language '$language'.");
   }
-  return $application;
+  
+  return $wrapper;
 }
 
 
@@ -106,19 +138,15 @@
   my $cmd = shift;
   my $caption = shift;
   my $options = shift;
-  #$cmd = 'perl ' . $cmd;
   
   #print Dumper($options);
   
   # report - header
   my $sep = "-" x 60;
-  print $sep, "\n";
-  #print "  ", $cmd, "\n";
-  #print "  ", "  $caption", "\n" if $caption;
-  print "  ", $cmd;
-  print " - ", $caption if $caption;
-  print "\n";
-  print $sep, "\n";
+  print STDERR $sep, "\n";
+  print STDERR "  ", $cmd;
+  print STDERR " - ", $caption if $caption;
+  print STDERR "\n", $sep, "\n";
   
   # strip name of executable from full command string
   $cmd =~ m/(.+?)\s/;
@@ -147,6 +175,7 @@
     -e $executable or die("$executable does not exist.");
     #$basedir = ".";
     #$basedir .= './';
+    $basedir = "";
   }
   $cmd = "$basedir$cmd";
 
@@ -162,30 +191,66 @@
     $cmd = "$application$cmd" if $application;
   }
 
-  # V3 - using IPC::Run (optional)
+  # V3 - using IPC (optional)
   if ($options->{async}) {
-    my $application = get_executable_wrapper($cmd);
-    $cmd = "$application $cmd" if $application;
-    
-    print "run_cmd: IPC::Run: $cmd", "\n";
+
     #run \@cmd, \$in, \$out, \$err, timeout( 10 ) or die "cat: $?";
-    
     my @cmd = split(' ', $cmd);
     
-    my $in; my $out; my $err;
-    #print "IPC::Run: $cmd", "\n";
-    #start \@cmd, timeout(0) or croak("run_cmd: IPC::Run could not start '$cmd'.");
-    run(\@cmd, timeout(2)) or croak("run_cmd: IPC::Run could not start '$cmd'.");
     
-    #$IPC::Run::Timer::timeout = 2000;
-    #start $cmd or die("IPC::Run could not start '$cmd'.");
+    # V3.1 - using IPC::Run
+    #
+    # tests:
+    
+    if (RUNNING_IN_HELL()) {
+    
+      #my $in; my $out; my $err;
+      print STDERR "run_cmd: IPC::Run: $cmd", "\n";
+      
+      # no success!
+      #start \@cmd, timeout(0) or croak("run_cmd: IPC::Run could not start '$cmd'.");
+      #
+      # success on Win32, but seems broken at 'timeout' on linux:
+      run(\@cmd, timeout(4)) or croak("run_cmd: IPC::Run could not start '$cmd'.");
+          
+      # other tests ;)
+      #$IPC::Run::Timer::timeout = 2000;
+      #start $cmd or die("IPC::Run could not start '$cmd'.");
+      
+    } else {
+
+      print STDERR "run_cmd: IPC::Session: $cmd", "\n";
+
+      # V3.2 - using IPC::Session
+      #  success on Linux AND Win32 ??
+      #
+      # set timeout:
+      #  (don't really know why we needs 2 secconds
+      #   to wait for init of process !?!)
+      my $session_timeout = 3;
+      # set session name (default: cmd as string):
+      my $session_name = $cmd;
+      # create session:
+      my $session = IPC::Session->new($session_name, $session_timeout);
+      
+      # send 'cmd' to session - not required since complete command is sent via constructor above
+      $session->send(\@cmd);
+      
+      #print $session->stdout(), "\n";
+      
+      # optional switch case:
+      #for ($session->stdout()) {
+      #}
+      # optional get error:
+      #my $err = session->stderr();
+    }
     
   } else {
-    print "run_cmd: system('$cmd').", "\n";
+    print STDERR "run_cmd: system('$cmd').", "\n";
     system($cmd);
   }
   
-  print "run_cmd: ready.", "\n";
+  print STDERR "run_cmd: ready.", "\n";
   
 }
 
@@ -211,8 +276,6 @@
   return ($bool ? 'ok' : 'failed');
 }
 
-sub RUNNING_IN_HELL () { $^O eq 'MSWin32' }
-
 # create global unique identifers using Data::UUID
 # if updating this code, please also modify Tangram::Storage::make_guid
 sub make_guid 
@@ -241,3 +304,4 @@
   }
 
 1;
+__END__