/[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.1 by joko, Sun Feb 9 04:49:45 2003 UTC revision 1.6 by joko, Fri Mar 28 06:58:06 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.6  2003/03/28 06:58:06  joko
6    ##  new: 'run_cmd' now asynchronous! (via IPC::Run...)
7    ##
8    ##  Revision 1.5  2003/02/22 17:26:13  joko
9    ##  + enhanced unix compatibility fix
10    ##
11    ##  Revision 1.4  2003/02/22 17:19:36  joko
12    ##  + unix compatibility fix
13    ##
14    ##  Revision 1.3  2003/02/14 14:17:04  joko
15    ##  - shortened seperator
16    ##
17    ##  Revision 1.2  2003/02/11 05:14:28  joko
18    ##  + refactored code from libp.pm
19    ##
20  ##  Revision 1.1  2003/02/09 04:49:45  joko  ##  Revision 1.1  2003/02/09 04:49:45  joko
21  ##  + shortcuts now refactored to this file  ##  + shortcuts now refactored to this file
22  ##  ##
# Line 20  our @EXPORT_OK = qw( Line 35  our @EXPORT_OK = qw(
35    now today    now today
36    run_cmd run_cmds    run_cmd run_cmds
37    get_chomped    get_chomped
38      bool2status
39  );  );
40    
41    
42  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -   main  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -   main
43    
44  use Data::Dumper;  use Data::Dumper;
45  use POSIX qw(strftime);  use POSIX qw( strftime );
46    #use IPC::Run qw( run timeout );
47    use IPC::Run qw( start pump finish timeout ) ;
48    
49  # $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;  # $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
50  # see "perldoc -f localtime"  # see "perldoc -f localtime"
# Line 46  sub today { Line 64  sub today {
64  sub run_cmd {  sub run_cmd {
65    my $cmd = shift;    my $cmd = shift;
66    my $caption = shift;    my $caption = shift;
67      my $options = shift;
68    #$cmd = 'perl ' . $cmd;    #$cmd = 'perl ' . $cmd;
69    my $sep = "-" x 90;    
70      # report - header
71      my $sep = "-" x 60;
72    print $sep, "\n";    print $sep, "\n";
73    print "  ", $cmd, "\n";    #print "  ", $cmd, "\n";
74    print "  ", $caption, "\n" if $caption;    #print "  ", "  $caption", "\n" if $caption;
75      print "  ", $cmd;
76      print " - ", $caption if $caption;
77      print "\n";
78    print $sep, "\n";    print $sep, "\n";
79    system($cmd);    
80      # strip name of executable from full command string
81      $cmd =~ m/(.+?)\s/;
82      my $executable = $1;
83      
84      # for unix: check if executable is in local directory, if so - prefix with './'
85      if (!RUNNING_IN_HELL()) {
86        #if ($cmd !~ m/\//) {
87        if (-e $executable) {
88          $cmd = "./$cmd";
89        }
90      }
91      
92      # V1 - backticks or qq{}
93    #`$cmd`;    #`$cmd`;
94      #qq{$cmd};
95      
96      # V2 - via 'system'
97      #system($cmd);
98    
99      # V3 - using IPC::Run (optional)
100      if ($options->{async}) {
101        # FIXME: detect type of program and run with proper application/interpreter
102        # using IPC::Run we have to dispatch this on our own! *no* os-interaction or interpolation here!
103        # => better use absolute path-names only?!
104        $cmd = "perl $cmd";
105        print "IPC::Run: $cmd", "\n";
106        #run \@cmd, \$in, \$out, \$err, timeout( 10 ) or die "cat: $?";
107        
108        my @cmd = split(' ', $cmd);
109        
110        my $in; my $out; my $err;
111        start \@cmd, timeout(0) or die("IPC::Run could not start '$cmd'.");
112        
113        #$IPC::Run::Timer::timeout = 2000;
114        #start $cmd or die("IPC::Run could not start '$cmd'.");
115        
116      } else {
117        system($cmd);
118      }
119      
120    print "ready.", "\n";    print "ready.", "\n";
121      
122  }  }
123    
124  sub run_cmds {  sub run_cmds {
# Line 69  sub get_chomped { Line 133  sub get_chomped {
133    return $str;    return $str;
134  }  }
135    
136    sub bool2status {
137      my $bool = shift;
138      return ($bool ? 'ok' : 'failed');
139    }
140    
141    sub RUNNING_IN_HELL () { $^O eq 'MSWin32' }
142    
143    
144  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed