--- nfo/perl/libs/shortcuts.pm 2003/02/14 14:17:04 1.3 +++ nfo/perl/libs/shortcuts.pm 2003/04/04 17:31:59 1.8 @@ -1,7 +1,22 @@ ## --------------------------------------------------------------------------- -## $Id: shortcuts.pm,v 1.3 2003/02/14 14:17:04 joko Exp $ +## $Id: shortcuts.pm,v 1.8 2003/04/04 17:31:59 joko Exp $ ## --------------------------------------------------------------------------- ## $Log: shortcuts.pm,v $ +## Revision 1.8 2003/04/04 17:31:59 joko +## + sub make_guid +## +## Revision 1.7 2003/03/29 07:24:10 joko +## enhanced 'run_cmd': now tries to execute program with appropriate application (e.g. 'cmd.exe' or 'perl') +## +## 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 ## @@ -27,17 +42,20 @@ run_cmd run_cmds get_chomped bool2status + make_guid ); -# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - main - use Data::Dumper; -use POSIX qw(strftime); +use POSIX qw( strftime ); +#use IPC::Run qw( run timeout ); +use IPC::Run qw( start pump finish timeout ) ; +use Carp; + + # $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"; @@ -53,15 +71,71 @@ 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, "\n"; + #print " ", " $caption", "\n" if $caption; + print " ", $cmd; + print " - ", $caption if $caption; + print "\n"; print $sep, "\n"; - system($cmd); + + # 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 { @@ -81,4 +155,33 @@ 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 + { + my $self = shift; + + my $guid; + + # try to use Data::UUID first ... + eval("use Data::UUID;"); + if (!$@) { + my $ug = Data::UUID->new(); + $guid = $ug->create_str(); + + # ... if this fails, try to fallback to Data::UUID::PurePerl instead ... + } else { + eval("use Data::UUID::PurePerl;"); + if (!$@) { + $guid = Data::UUID::PurePerl::generate_id(); + } else { + croak "couldn't create globally unique identifier"; + } + } + + return $guid; + } + 1;