--- nfo/perl/libs/shortcuts.pm 2003/06/23 17:41:50 1.11 +++ nfo/perl/libs/shortcuts.pm 2003/06/23 20:58:31 1.13 @@ -1,7 +1,14 @@ ## --------------------------------------------------------------------------- -## $Id: shortcuts.pm,v 1.11 2003/06/23 17:41:50 jonen 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 ## @@ -63,7 +70,7 @@ use IPC::Run qw( start pump finish timeout run ) ; use Carp; -# NEW - 2003-06-23 +# NEW - 2003-06-23 for Linux (what about *BSD?) use IPC::Session; @@ -81,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 @@ -88,23 +98,39 @@ # => better use absolute path-names only?! my $application = ''; if ($cmd =~ m/\w+\.pl\s*.*/) { - # NEW 2003-06-23 - needed if used with IPC::Session (at Linux) - # whats about Win32? - $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'; - #} - return $application; + 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 $wrapper; } @@ -112,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/; @@ -153,6 +175,7 @@ -e $executable or die("$executable does not exist."); #$basedir = "."; #$basedir .= './'; + $basedir = ""; } $cmd = "$basedir$cmd"; @@ -171,56 +194,63 @@ # V3 - using IPC (optional) if ($options->{async}) { - #$cmd = "$application $cmd" if $application; - #my $application = get_executable_wrapper($cmd); - - print "run_cmd: IPC::Run: $cmd", "\n"; #run \@cmd, \$in, \$out, \$err, timeout( 10 ) or die "cat: $?"; - my @cmd = split(' ', $cmd); # V3.1 - using IPC::Run # # tests: - #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'."); - # - # success on Win32, but seems broken at 'timeout' on linux: - #run(\@cmd, timeout(2)) 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'."); - + + 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 { - # 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 = 2; - # set session name (default: cmd as string): - my $session_name = $cmd; - # create session: - my $session = new IPC::Session($session_name, $session_timeout); - # send 'cmd' to session: - $session->send(\@cmd); - # optional switch case: - #for ($session->stdout()) { - #} - # optional get error: - #my $err = session->stderr(); + 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"; } @@ -246,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 @@ -275,6 +303,5 @@ return $guid; } - - 1; +__END__