perl/libs/shortcuts.pm

## ---------------------------------------------------------------------------
##  $Id: shortcuts.pm,v 1.6 2003/03/28 06:58:06 joko Exp $
## ---------------------------------------------------------------------------
##  $Log: shortcuts.pm,v $
##  Revision 1.6  2003/03/28 06:58:06  joko
##  new: 'run_cmd' now asynchronous! (via IPC::Run...)
##
##  Revision 1.5  2003/02/22 17:26:13  joko
##  + enhanced unix compatibility fix
##
##  Revision 1.4  2003/02/22 17:19:36  joko
##  + unix compatibility fix
##
##  Revision 1.3  2003/02/14 14:17:04  joko
##  - shortened seperator
##
##  Revision 1.2  2003/02/11 05:14:28  joko
##  + refactored code from libp.pm
##
##  Revision 1.1  2003/02/09 04:49:45  joko
##  + shortcuts now refactored to this file
##
## ---------------------------------------------------------------------------


package shortcuts;

use strict;
use warnings;

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( 
  strftime
  now today
  run_cmd run_cmds
  get_chomped
  bool2status
);


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -   main

use Data::Dumper;
use POSIX qw( strftime );
#use IPC::Run qw( run timeout );
use IPC::Run qw( start pump finish timeout ) ;

# $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
# see "perldoc -f localtime"

sub now {
  my $options = shift;
  my $pattern = "%Y-%m-%d %H:%M:%S";
  $pattern = "%Y-%m-%d_%H-%M-%S" if $options->{fs};
  my $result = strftime($pattern, localtime);
  return $result;
}

sub today {
  return strftime("%Y-%m-%d", localtime);
}

sub run_cmd {
  my $cmd = shift;
  my $caption = shift;
  my $options = shift;
  #$cmd = 'perl ' . $cmd;
  
  # 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";
  
  # strip name of executable from full command string
  $cmd =~ m/(.+?)\s/;
  my $executable = $1;
  
  # for unix: check if executable is in local directory, if so - prefix with './'
  if (!RUNNING_IN_HELL()) {
    #if ($cmd !~ m/\//) {
    if (-e $executable) {
      $cmd = "./$cmd";
    }
  }
  
  # V1 - backticks or qq{}
  #`$cmd`;
  #qq{$cmd};
  
  # V2 - via 'system'
  #system($cmd);

  # V3 - using IPC::Run (optional)
  if ($options->{async}) {
    # FIXME: detect type of program and run with proper application/interpreter
    # using IPC::Run we have to dispatch this on our own! *no* os-interaction or interpolation here!
    # => better use absolute path-names only?!
    my $application = '';
    if (RUNNING_IN_HELL()) {
      $application = 'cmd.exe /C';
    }
    
    if ($cmd =~ m/\w+\.pl\s*.*/) {
      $application = 'perl';
    }
    
    $cmd = "$application $cmd" if $application;
    
    print "IPC::Run: $cmd", "\n";
    #run \@cmd, \$in, \$out, \$err, timeout( 10 ) or die "cat: $?";
    
    my @cmd = split(' ', $cmd);
    
    my $in; my $out; my $err;
    start \@cmd, timeout(0) or die("IPC::Run could not start '$cmd'.");
    
    #$IPC::Run::Timer::timeout = 2000;
    #start $cmd or die("IPC::Run could not start '$cmd'.");
    
  } else {
    system($cmd);
  }
  
  print "ready.", "\n";
  
}

sub run_cmds {
  foreach (@_) {
    run_cmd($_);
  }
}

sub get_chomped {
  my $str = shift;
  chomp($str);
  return $str;
}

sub bool2status {
  my $bool = shift;
  return ($bool ? 'ok' : 'failed');
}

sub RUNNING_IN_HELL () { $^O eq 'MSWin32' }


1;
1	joko	1.1	## ---------------------------------------------------------------------------
2	joko	1.7	## $Id: shortcuts.pm,v 1.6 2003/03/28 06:58:06 joko Exp $
3	joko	1.1	## ---------------------------------------------------------------------------
4			## $Log: shortcuts.pm,v $
5	joko	1.7	## Revision 1.6 2003/03/28 06:58:06 joko
6			## new: 'run_cmd' now asynchronous! (via IPC::Run...)
7			##
8	joko	1.6	## Revision 1.5 2003/02/22 17:26:13 joko
9			## + enhanced unix compatibility fix
10			##
11	joko	1.5	## Revision 1.4 2003/02/22 17:19:36 joko
12			## + unix compatibility fix
13			##
14	joko	1.4	## Revision 1.3 2003/02/14 14:17:04 joko
15			## - shortened seperator
16			##
17	joko	1.3	## Revision 1.2 2003/02/11 05:14:28 joko
18			## + refactored code from libp.pm
19			##
20	joko	1.2	## Revision 1.1 2003/02/09 04:49:45 joko
21			## + shortcuts now refactored to this file
22			##
23	joko	1.1	## ---------------------------------------------------------------------------
24
25
26			package shortcuts;
27
28			use strict;
29			use warnings;
30
31			require Exporter;
32			our @ISA = qw( Exporter );
33			our @EXPORT_OK = qw(
34			strftime
35			now today
36			run_cmd run_cmds
37			get_chomped
38	joko	1.2	bool2status
39	joko	1.1	);
40
41
42			# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - main
43
44			use Data::Dumper;
45	joko	1.6	use POSIX qw( strftime );
46			#use IPC::Run qw( run timeout );
47			use IPC::Run qw( start pump finish timeout ) ;
48	joko	1.1
49			# $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
50			# see "perldoc -f localtime"
51
52			sub now {
53			my $options = shift;
54			my $pattern = "%Y-%m-%d %H:%M:%S";
55			$pattern = "%Y-%m-%d_%H-%M-%S" if $options->{fs};
56			my $result = strftime($pattern, localtime);
57			return $result;
58			}
59
60			sub today {
61			return strftime("%Y-%m-%d", localtime);
62			}
63
64			sub run_cmd {
65			my $cmd = shift;
66			my $caption = shift;
67	joko	1.6	my $options = shift;
68	joko	1.1	#$cmd = 'perl ' . $cmd;
69	joko	1.6
70			# report - header
71	joko	1.3	my $sep = "-" x 60;
72	joko	1.1	print $sep, "\n";
73	joko	1.6	#print " ", $cmd, "\n";
74			#print " ", " $caption", "\n" if $caption;
75			print " ", $cmd;
76			print " - ", $caption if $caption;
77			print "\n";
78	joko	1.1	print $sep, "\n";
79	joko	1.4
80	joko	1.5	# 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	joko	1.4	if (!RUNNING_IN_HELL()) {
86	joko	1.5	#if ($cmd !~ m/\//) {
87			if (-e $executable) {
88	joko	1.4	$cmd = "./$cmd";
89			}
90			}
91
92	joko	1.6	# V1 - backticks or qq{}
93	joko	1.1	#`$cmd`;
94	joko	1.6	#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	joko	1.7	my $application = '';
105			if (RUNNING_IN_HELL()) {
106			$application = 'cmd.exe /C';
107			}
108
109			if ($cmd =~ m/\w+\.pl\s./) {
110			$application = 'perl';
111			}
112
113			$cmd = "$application $cmd" if $application;
114
115	joko	1.6	print "IPC::Run: $cmd", "\n";
116			#run \@cmd, \$in, \$out, \$err, timeout( 10 ) or die "cat: $?";
117
118			my @cmd = split(' ', $cmd);
119
120			my $in; my $out; my $err;
121			start \@cmd, timeout(0) or die("IPC::Run could not start '$cmd'.");
122
123			#$IPC::Run::Timer::timeout = 2000;
124			#start $cmd or die("IPC::Run could not start '$cmd'.");
125
126			} else {
127			system($cmd);
128			}
129
130	joko	1.1	print "ready.", "\n";
131	joko	1.6
132	joko	1.1	}
133
134			sub run_cmds {
135			foreach (@_) {
136			run_cmd($_);
137			}
138			}
139
140			sub get_chomped {
141			my $str = shift;
142			chomp($str);
143			return $str;
144	joko	1.2	}
145
146			sub bool2status {
147			my $bool = shift;
148			return ($bool ? 'ok' : 'failed');
149	joko	1.1	}
150	joko	1.4
151			sub RUNNING_IN_HELL () { $^O eq 'MSWin32' }
152
153	joko	1.1
154			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26