/[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.9 by joko, Tue May 13 05:36:24 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
9    ##  major/minor fixes?
10    ##
11  ##  Revision 1.9  2003/05/13 05:36:24  joko  ##  Revision 1.9  2003/05/13 05:36:24  joko
12  ##  heavy modifications to run_cmd  ##  heavy modifications to run_cmd
13  ##  + sub get_executable  ##  + sub get_executable
# Line 57  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 80  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      $application = 'perl';      # NEW 2003-06-23 - needed if used with IPC::Session (at Linux)
92        #  whats about Win32?
93        $application = 'perl ';
94      } else {
95        $application = './';
96    }    }
97    return $application;    return $application;
98  }  }
# Line 89  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 141  sub run_cmd { Line 152  sub run_cmd {
152    } else {    } else {
153      -e $executable or die("$executable does not exist.");      -e $executable or die("$executable does not exist.");
154      #$basedir = ".";      #$basedir = ".";
155      $basedir .= './';      #$basedir .= './';
156    }    }
157    $cmd = "$basedir$cmd";    $cmd = "$basedir$cmd";
158    
# Line 152  sub run_cmd { Line 163  sub run_cmd {
163    # V2 - via 'system'    # V2 - via 'system'
164    #system($cmd);    #system($cmd);
165    
166    # V3 - using IPC::Run (optional)    if (not $use_path) {
167        my $application = get_executable($cmd);
168        $cmd = "$application$cmd" if $application;
169      }
170    
171      # 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 {
     if (!$use_path) {  
       my $application = get_executable($cmd);  
       $cmd = "$application $cmd" if $application;  
     }  
219      print "run_cmd: system('$cmd').", "\n";      print "run_cmd: system('$cmd').", "\n";
220      system($cmd);      system($cmd);
221    }    }
# Line 234  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.9  
changed lines
  Added in v.1.11
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed