/[cvs]/nfo/perl/libs/shortcuts.pm
ViewVC logotype

Diff of /nfo/perl/libs/shortcuts.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by joko, Mon Jun 23 15:59:16 2003 UTC revision 1.11 by jonen, Mon Jun 23 17:41:50 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.11  2003/06/23 17:41:50  jonen
6    ##  + NEW - used IPC::Session instead of IPC::Run to get better results at linux
7    ##
8  ##  Revision 1.10  2003/06/23 15:59:16  joko  ##  Revision 1.10  2003/06/23 15:59:16  joko
9  ##  major/minor fixes?  ##  major/minor fixes?
10  ##  ##
# Line 60  use POSIX qw( strftime ); Line 63  use POSIX qw( strftime );
63  use IPC::Run qw( start pump finish timeout run ) ;  use IPC::Run qw( start pump finish timeout run ) ;
64  use Carp;  use Carp;
65    
66    # NEW - 2003-06-23
67    use IPC::Session;
68    
69    
70  # $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;  # $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
# Line 83  sub get_executable { Line 88  sub get_executable {
88    # => better use absolute path-names only?!    # => better use absolute path-names only?!
89    my $application = '';    my $application = '';
90    if ($cmd =~ m/\w+\.pl\s*.*/) {    if ($cmd =~ m/\w+\.pl\s*.*/) {
91        # NEW 2003-06-23 - needed if used with IPC::Session (at Linux)
92        #  whats about Win32?
93      $application = 'perl ';      $application = 'perl ';
94    } else {    } else {
95      $application = './';      $application = './';
# Line 94  sub get_executable_wrapper { Line 101  sub get_executable_wrapper {
101    my $cmd = shift;    my $cmd = shift;
102    my $application = '';    my $application = '';
103    # Required to adapt to IPC::Run on win32.    # Required to adapt to IPC::Run on win32.
104    if (RUNNING_IN_HELL()) {    #if (RUNNING_IN_HELL()) {
105      #$application = 'cmd.exe /C';      #$application = 'cmd.exe /C';
106      $application = 'cmd.exe /C';    #}
   }  
107    return $application;    return $application;
108  }  }
109    
# Line 162  sub run_cmd { Line 168  sub run_cmd {
168      $cmd = "$application$cmd" if $application;      $cmd = "$application$cmd" if $application;
169    }    }
170    
171    # V3 - using IPC::Run (optional)    # V3 - using IPC (optional)
172    if ($options->{async}) {    if ($options->{async}) {
173      my $application = get_executable_wrapper($cmd);  
174      $cmd = "$application $cmd" if $application;      #$cmd = "$application $cmd" if $application;
175        #my $application = get_executable_wrapper($cmd);
176            
177      print "run_cmd: IPC::Run: $cmd", "\n";      print "run_cmd: IPC::Run: $cmd", "\n";
178      #run \@cmd, \$in, \$out, \$err, timeout( 10 ) or die "cat: $?";      #run \@cmd, \$in, \$out, \$err, timeout( 10 ) or die "cat: $?";
179                
180      my @cmd = split(' ', $cmd);      my @cmd = split(' ', $cmd);
181            
182      my $in; my $out; my $err;      
183        # V3.1 - using IPC::Run
184        #
185        # tests:
186        #my $in; my $out; my $err;
187      #print "IPC::Run: $cmd", "\n";      #print "IPC::Run: $cmd", "\n";
188      #start \@cmd, timeout(0) or croak("run_cmd: IPC::Run could not start '$cmd'.");      #start \@cmd, timeout(0) or croak("run_cmd: IPC::Run could not start '$cmd'.");
189      run(\@cmd, timeout(2)) or croak("run_cmd: IPC::Run could not start '$cmd'.");      #
190            # success on Win32, but seems broken at 'timeout' on linux:
191        #run(\@cmd, timeout(2)) or croak("run_cmd: IPC::Run could not start '$cmd'.");
192            
193        # other tests ;)
194      #$IPC::Run::Timer::timeout = 2000;      #$IPC::Run::Timer::timeout = 2000;
195      #start $cmd or die("IPC::Run could not start '$cmd'.");      #start $cmd or die("IPC::Run could not start '$cmd'.");
196    
197    
198        # V3.2 - using IPC::Session
199        #  success on Linux AND Win32 ??
200        #
201        # set timeout:
202        #  (don't really know why we needs 2 secconds
203        #   to wait for init of process !?!)
204        my $session_timeout = 2;
205        # set session name (default: cmd as string):
206        my $session_name = $cmd;
207        # create session:
208        my $session = new IPC::Session($session_name, $session_timeout);
209        # send 'cmd' to session:
210        $session->send(\@cmd);
211        # optional switch case:
212        #for ($session->stdout()) {
213        #}
214        # optional get error:
215        #my $err = session->stderr();
216    
217            
218    } else {    } else {
219      print "run_cmd: system('$cmd').", "\n";      print "run_cmd: system('$cmd').", "\n";
# Line 240  sub make_guid Line 275  sub make_guid
275      return $guid;      return $guid;
276    }    }
277    
278    
279    
280  1;  1;
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed