Mail Archives: cygwin/2002/11/18/07:05:54
I made some kind of patch to use ActivePerl within a cygwin console. The
problem was that ActivePerl doesn't dupport posix paths so I made the
following:
1) A readlink recursive that returns the real file:
#!/bin/perl
# script that does recursive readlink
# exit with error status if no arg or arg doesn't exist or is not a symlink
if($ARGV[0] eq "" or ! -e $ARGV[0] or ! -l $ARGV[0]){ exit 1; }
$file=$ARGV[0];
$realfile=""; # this will store each dir in $file for each iteration in do-while
$restofpath=$file; # the rest of the path that is to be checked
$nextdir=$file; # the next dir to check
do{
$nextdir=~s/^(\/{1}[^\/]*)\/{1}.*$/$1/;
$realfile=$realfile.$nextdir;
$restofpath=~s/^\/{1}[^\/]*//;
#print "\nnextdir: $nextdir\n";
#print "realfile: $realfile";
if(-l $realfile){
$realfile=readlink "$realfile"; $realfile=~s/\/{1}$//;
#print " -> link to $realfile";
if ($restofpath eq ""){ $restofpath=$realfile; $realfile=""; $nextdir=$realfile; }
}
#print "\nrestofpath: $restofpath\n";
# update variables for next iteration
$nextdir=$restofpath;
}until($restofpath eq "");
# return the real file
print "$realfile\n";
2) a "interpreter" to make a workaround:
#!/bin/bash
# script that tricks ActivePerl for Windows to work on Perl scripts under cygwin
# (a workaround for posix-windows paths)
# TODO: eventhough this is a workaround, perl doesn't support symlinks, so I need
# a function that does(ie): getrealfile /usr/local/bin/xnet, returns
# /dit/DIT/scripts/cygwin-scripts/xnet
# `-> done: function is readlink, although it doesn't support the -f option
# as in linux, it's not recursive.
# I made a script that implements this (rreadlink)
#
# $ActivePerl is a symbolic link to wherever the real ActivePerl perl.exe resides
ActivePerl=/usr/local/bin/perl
file=`rreadlink "$1"`
shift
args="$@"
path=`expr $file ':' '\(.*\)\/\.*' '|' $file`
script=`expr $file ':' '.*\/\(.*\)' '|' $file`
cd $path
$ActivePerl $script $args
cd $OLDPWD
3) Now this can be used for executing ActivePerl scripts:
#!/usr/local/bin/activeperl_trick
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
See the interpreter here
use Win32::Service;
use Sys::Hostname;
use Win32;
use strict;
#
my %service_states =
(
"stopped" => 0x00000001,
"start pending" => 0x00000002,
"stop pending" => 0x00000003,
"running" => 0x00000004,
"continue pending" => 0x00000005,
"pause pending" => 0x00000006,
"paused" => 0x00000007,
);
my %service_codes = reverse (%service_states);
#
my $HOSTNAME = hostname;
my $op = lc shift;
my ($server, $service);
$server = '' unless $server = shift;
$service = '' unless $service = shift;
if ($server ne '' and $server !~ /^\\/){
$service = $server;
$server = '';
}
if ($op eq 'status'){
if ($server ne ''){
print "\t\t\t\\$server status:\n-------------------------------------------------------------------\n";
&status ("\\$server", $service);
exit;
}else{
print "\t\t\t\\\\$HOSTNAME status:\n-------------------------------------------------------------------\n";
&status ($server, $service) unless $server ne '';
exit;
}
}
if ($op =~ /^(?:start|stop|pause|resume)$/){
if ($service eq ''){
print "You must specify a service for this option.\n";
exit 1
}
&process ($op, $server, $service);
sleep 1;
&status ($server, $service);
exit;
}
if ($op eq 'restart'){
if ($service eq ''){
print "You must specify a service for this option.\n";
exit 1
}
#print "Restarting $service...\n";
#&process ('stop', $server, $service);
#sleep 1;
#&status ($server, $service);
&process ('restart', $server, $service);
#sleep 1;
#&status ($server, $service);
exit;
}
#
print STDERR "Usage: $0 status|start|stop|restart|pause|resume [\\\\server] [service_short_name]\n";
exit;
#
sub status{
my ($server, $service) = @_;
my ($err, %status, %services, %rservices);
if ($service) {
$err = Win32::Service::GetStatus($server,$service,\%status);
if (!$err) {&display_error; return};
print "$service is $service_codes{$status{CurrentState}}\n";
}
else {
$err = Win32::Service::GetServices($server,\%services);
if (!$err) {&display_error; return};
%rservices = reverse %services;
foreach $service (sort {lc $a cmp lc $b} keys %rservices){
$err = Win32::Service::GetStatus($server,$service,\%status);
if (!$err) {print "$service: "; &display_error; next};
print "$service_codes{$status{CurrentState}}: $service [$rservices{$service}]\n";
}
}
}
#
sub process{
my ($process,$server, $service) = @_;
my $err;
if ($process eq 'start') {
print "Starting $service... ";
{$err = Win32::Service::StartService($server,$service) and return}
}
if ($process eq 'stop') {
print "Stopping $service... ";
{$err = Win32::Service::StopService($server,$service) and return}
}
if ($process eq 'restart') {
print "Restarting $service...\n\n";
print "Stopping $service... ";
{$err = Win32::Service::StopService($server,$service)}
sleep 1;
&status ($server, $service);
print "Starting $service... ";
{$err = Win32::Service::StartService($server,$service)}
sleep 1;
&status ($server, $service);
}
if ($process eq 'pause') {
print "Pausing $service... ";
{$err = Win32::Service::PauseService($server,$service) and return}
}
if ($process eq 'resume') {
print "Resuming $service... ";
{$err = Win32::Service::ResumeService($server,$service) and return}
}
if (!$err) {&display_error}
}
#
sub display_error{
my $err = Win32::GetLastError();
print STDERR Win32::FormatMessage($err);
}
This latest script is for checking status/starting/stoping services via
ActivePerl. The advantage is that this can check other computers services
(within our domain and if we have the required privileges).
I hope this helps anyone.
Cheers,
m4c.
--
##########################################################################
"And the next time you consider complaining that running Lucid Emacs
19.05 via NFS from a remote Linux machine in Paraguay doesn't seem to
get the background colors right, you'll know who to thank."
(By Matt Welsh)
...
_________ Marcos Lorenzo de Santiago (Labs Technician) /` `\
|~~ @| Departament of Telematic Engineering / \
| ==== | |\~~~~~~~/|
| ==== | E-mail: marcos AT it DOT uc3m DOT es | \=====/ |
|_________| Telephone: (+34)91-624-8757 | /`...'\ |
Homepage: http://www.it.uc3m.es/marcos |/_______\|
##########################################################################
--
Unsubscribe info: http://cygwin.com/ml/#unsubscribe-simple
Bug reporting: http://cygwin.com/bugs.html
Documentation: http://cygwin.com/docs.html
FAQ: http://cygwin.com/faq/
- Raw text -