Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
perl script for Windoze changed to linux
- Thread starter elentz
- Start date
Using a perl script on a Linux box should be no problem, just change the path to perl line to match the Linux environment, typically:
#!/usr/bin/perl
Now if your Windows perl script has lots of windows specific modules it uses that all has to be changed.
------------------------------------------
- Kevin, perl coder unexceptional!![[wiggle]](/data/assets/smilies/wiggle.gif "[wiggle] [wiggle]")
#!/usr/bin/perl
Now if your Windows perl script has lots of windows specific modules it uses that all has to be changed.
------------------------------------------
- Kevin, perl coder unexceptional!
- Thread starter
- #3
OK. Well obviously nobody can help with code we can't see, so post the code if it's not too much, and try and point out areas of the code that need changing if you can. Hopefully someone will be able to let you know what you need to change.
------------------------------------------
- Kevin, perl coder unexceptional!
------------------------------------------
- Kevin, perl coder unexceptional!
- Thread starter
- #5
Here's what I got. The script saves the information from a phone system. The first two lines will always have the same information when it first connects. I want to only get the date from the first line and then the rest of the file when the script exits I want it to be saved in a csv file so I can import it to a mySql table. A timeout for lack of activity would be good too. Here's the code:
#
# This program is designed to run as a service, so we include the PerlSvc package to allow us to
# install and remove the package via command line options.
package PerlSvc;
# The "strict" directive turns on tighter syntax control that helps catch typos early.
use strict;
# Create a local hash for working with with service.
our %Config = (ServiceName => "SMDRBridge");
# Include various modules that we'll make use of throughout the program.
require File::Find;
require File:
ath;
require Getopt::Long;
require Win32::ChangeNotify;
use IO::Socket;
use IO::Select;
# The version number should be updated each time this is modified.
our $Version = "0.6";
# Declare local variables for the parameters.
my($remote_host, $remote_port, $smdr_password, $comport, $logdir);
# Set the default values for the parameters.
$remote_port = "4000";
$comport = "COM1";
$logdir = "c:\\temp";
# Check to see if we're rurnning as a service.
unless (defined &ContinueRun) {
*ContinueRun = sub { return 1 };
*RunningAsService = sub { return 0 };
Interactive();
}
# The installation procedure is used to install the program to run as a service. This procedure
# gathers the parameters from the command line. If we're running as a service, we'll take the
# parameters and use them in the service creation.
sub Install {
Disclaimer();
Getopt::Long::GetOptions(
'remote_host=s' => \$remote_host,
'remote_port=s' => \$remote_port,
'smdr_password=s' => \$smdr_password,
'comport=s' => \$comport,
'logdir=s' => \$logdir
);
die "--remote_host is mandatory\n"
unless RunningAsService() or $remote_host;
$Config{DisplayName} = "$Config{ServiceName} SMDR Bridge";
$Config{Description} = "This is the description";
$Config{Parameters} = "--remote_host $remote_host --smdr_password $smdr_password";
$Config{Interactive} = 1;
$Config{StartNow} = 0;
$Config{StartType} = "auto";
}
# The remove procedure is used to remove the service.
# TPB This doesn't look to be complete yet.
sub Remove {
our %Config = (ServiceName => "SMDRBridge");
}
# If we're running interactively, we need to grab the command line options and run.
sub Interactive {
# Eventlog
Install();
Startup();
}
sub Startup {
$remote_port = "4000";
$comport = "COM1";
Disclaimer();
# do we need this here? Aren't we doing it in install?
Getopt::Long::GetOptions(
'remote_host=s' => \$remote_host,
'remote_port=s' => \$remote_port,
'smdr_password=s' => \$smdr_password,
'comport=s' => \$comport,
'logdir=s' => \$logdir
);
report("Info: $Config{ServiceName} starting $remote_host");
my $socket;
# This is where we build the magic string for logging in.
my $command_length = length($smdr_password) + 2;
my $length_string = sprintf "%#x", $command_length;
my $print_string = sprintf "%c\x00\x00\x00\x84$smdr_password\x00", $command_length;
# If we can't open the com port, it might be in use for other purposes. There's not much we
# can do other than to log it.
open( PORT, "+>$comport" ) or report("Can't open $comport: $!");
print PORT "\n\n";
# In the loop below, we're going to attempt to open the socket. If we get an error, we'll keep
# trying once a minute. We loop here because we want to recover if there is a transient
# network problem. The downside is that if we're failing because of bad parameters, etc., we
# won't exit after the error. The user will be forced to either ^C if interactive or stop the
# service.
SESSION: while (ContinueRun(60)) {
until ($socket = IO::Socket::INET->new(PeerAddr => $remote_host,
PeerPort => $remote_port,
Proto => "tcp",
Timeout => 1,
Type => SOCK_STREAM))
{
report ("Couldn't connect to $remote_host:$remote_port : $@, Retrying");
sleep 60; # this means that we wait for one minute before trying again.
}
# Next we set the socket to be non-blocking. It's not clear whether this does any good.
# The idea is that we don't want to be stuck waiting for input because we would require
# input before we can quit.
$socket->blocking(0);
# Create a the selection of sockets that we'll monitor for input. There is only one.
# Theoretically, this same program could monitor other sockets like message print.
my $read_set = new IO::Select;
$read_set->add($socket);
my $sel = new IO::Select( $socket );
# Send the "login" string that we built above to the socket.
print $socket $print_string;
# Set up some local variables for the loop below.
my $input;
my $inputqueue = "";
my $line;
my $exitflag;
my $counter = 0; # just for debugging purposes
my $result;
my @ready;
my @error;
my $fh;
# In the loop below, we are processing input from the socket. The tricky part is that
# we need to be careful to not block for input, and we also want to try to recover if
# we encounter a network error. In this outer while, we're processing until there's no
# more input. When that happens, we sleep for a little while and check again.
while (ContinueRun(5)) {
$counter = $counter + 1;
# The inner while loop executes only when there is input. The "1" in the can_read
# property of the while loop condition is a timeout. In other words, we check to see
# if there's anything to read, but if there isn't we time out after 1 second.
while(@ready = $sel->can_read(1)) {
# We know there's only one socket, so we don't bother even looking for others; we
# just use the first (and only) one in the array.
$fh = @ready[0];
# Get the line (up to 1000 characters).
$result = sysread $fh, $input, 1000;
# It turns out that a network error results in some strange behavior. It looks like
# we "can_read", but we get no data. If that happens, we'll jump out of this
# inner while loop out to where the socket is opened.
next SESSION if ($result == 0);
# append new input to the inputqueue
$inputqueue = $inputqueue . $input;
$exitflag = 0;
# loop until no complete call log lines are found
do {
# look for a match from the beginning of the string up to the carriage return/line feed characters
if ($inputqueue =~ m/^[^\n]*\n/) {
# remove the R nul nul nul and carriage return/line feed characters off the matched call log line
$line = substr($&, 4, -2);
# put the remaining segment of the string into inputqueue
$inputqueue = $';
# Next we check to see if we're logging to a file. If we are, we open the log file,
# named according to the date, write the line, and close it. This is pretty
# inefficient, but it helps ensure the integrity of the log file by not leaving
# it open.
if ($logdir ne "") {
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
# my $datestamp = sprintf "%4d%2.2d%2.2d", $year+1900, $mon+1, $mday;
my $datestamp = sprintf "%4d%2.2d", $year+1900, $mon+1;
my $logfilename = "$logdir\\smdr$datestamp.log";
open (LOGFILE, ">> $logfilename")
or die "Couldn't open $logfilename for writing: $!\n";
print LOGFILE $line, "\n";
close (LOGFILE);
} # of if logging
# Send the output to the serial port. This is the "bridge".
print PORT $line . "\n";
# if we're running in a window, we'll go ahead and echo the output there as well
print $line . "\n";
} else {
$exitflag = 1;
}
} while ($exitflag == 0);
} # of while there's input.
# When we get here, there's no more input waiting for us, so let's go to sleep for a while.
# The tradeoff on this delay is responsiveness vs. CPU time. The responsiveness is mostly
# noticed as a delay before printing and a delay in shutting down.
sleep 10;
} # infinite loop
# The only time we'll fall out of this loop if the service is "stopped". We do what little
# cleanup we can.
report("lost connection, retrying in 1 minute");
close($socket);
}
# Again, the only time we'll fall out of this loop if the service is "stopped". We do what
# little cleanup we can.
report("Info: $Config{ServiceName} stopping");
close(PORT);
}
# The following subroutine is used to log things to the event log if we're running as a service. If
# we're running interactively, we'll just log to stdout.
sub report {
my($msg) = @_;
if (!RunningAsService()) {
print $msg, "\n";
return;
}
return unless $msg =~ /^\S+:/;
require Win32::EventLog;
my $EventType = Win32::EventLog::EVENTLOG_INFORMATION_TYPE();
$EventType = Win32::EventLog::EVENTLOG_WARNING_TYPE() if $msg =~ /^w\S+:/i;
$EventType = Win32::EventLog::EVENTLOG_ERROR_TYPE() if $msg =~ /^e\S+:/i;
$msg =~ s/^\S+:\s*//;
my $EventLog = Win32::EventLog->new("PerlMsg", "");
$EventLog->Report({
EventType => $EventType,
Category => undef,
EventID => 0xC0000004,
Strings => $msg,
Data => "",
});
}
There is a "Install as a service" that can be "lost" as far as I am concerned, that is only for a windows box. I want to be able to run this with a cron script at various times.
Thanks for any help!
#
# This program is designed to run as a service, so we include the PerlSvc package to allow us to
# install and remove the package via command line options.
package PerlSvc;
# The "strict" directive turns on tighter syntax control that helps catch typos early.
use strict;
# Create a local hash for working with with service.
our %Config = (ServiceName => "SMDRBridge");
# Include various modules that we'll make use of throughout the program.
require File::Find;
require File:
ath;require Getopt::Long;
require Win32::ChangeNotify;
use IO::Socket;
use IO::Select;
# The version number should be updated each time this is modified.
our $Version = "0.6";
# Declare local variables for the parameters.
my($remote_host, $remote_port, $smdr_password, $comport, $logdir);
# Set the default values for the parameters.
$remote_port = "4000";
$comport = "COM1";
$logdir = "c:\\temp";
# Check to see if we're rurnning as a service.
unless (defined &ContinueRun) {
*ContinueRun = sub { return 1 };
*RunningAsService = sub { return 0 };
Interactive();
}
# The installation procedure is used to install the program to run as a service. This procedure
# gathers the parameters from the command line. If we're running as a service, we'll take the
# parameters and use them in the service creation.
sub Install {
Disclaimer();
Getopt::Long::GetOptions(
'remote_host=s' => \$remote_host,
'remote_port=s' => \$remote_port,
'smdr_password=s' => \$smdr_password,
'comport=s' => \$comport,
'logdir=s' => \$logdir
);
die "--remote_host is mandatory\n"
unless RunningAsService() or $remote_host;
$Config{DisplayName} = "$Config{ServiceName} SMDR Bridge";
$Config{Description} = "This is the description";
$Config{Parameters} = "--remote_host $remote_host --smdr_password $smdr_password";
$Config{Interactive} = 1;
$Config{StartNow} = 0;
$Config{StartType} = "auto";
}
# The remove procedure is used to remove the service.
# TPB This doesn't look to be complete yet.
sub Remove {
our %Config = (ServiceName => "SMDRBridge");
}
# If we're running interactively, we need to grab the command line options and run.
sub Interactive {
# Eventlog
Install();
Startup();
}
sub Startup {
$remote_port = "4000";
$comport = "COM1";
Disclaimer();
# do we need this here? Aren't we doing it in install?
Getopt::Long::GetOptions(
'remote_host=s' => \$remote_host,
'remote_port=s' => \$remote_port,
'smdr_password=s' => \$smdr_password,
'comport=s' => \$comport,
'logdir=s' => \$logdir
);
report("Info: $Config{ServiceName} starting $remote_host");
my $socket;
# This is where we build the magic string for logging in.
my $command_length = length($smdr_password) + 2;
my $length_string = sprintf "%#x", $command_length;
my $print_string = sprintf "%c\x00\x00\x00\x84$smdr_password\x00", $command_length;
# If we can't open the com port, it might be in use for other purposes. There's not much we
# can do other than to log it.
open( PORT, "+>$comport" ) or report("Can't open $comport: $!");
print PORT "\n\n";
# In the loop below, we're going to attempt to open the socket. If we get an error, we'll keep
# trying once a minute. We loop here because we want to recover if there is a transient
# network problem. The downside is that if we're failing because of bad parameters, etc., we
# won't exit after the error. The user will be forced to either ^C if interactive or stop the
# service.
SESSION: while (ContinueRun(60)) {
until ($socket = IO::Socket::INET->new(PeerAddr => $remote_host,
PeerPort => $remote_port,
Proto => "tcp",
Timeout => 1,
Type => SOCK_STREAM))
{
report ("Couldn't connect to $remote_host:$remote_port : $@, Retrying");
sleep 60; # this means that we wait for one minute before trying again.
}
# Next we set the socket to be non-blocking. It's not clear whether this does any good.
# The idea is that we don't want to be stuck waiting for input because we would require
# input before we can quit.
$socket->blocking(0);
# Create a the selection of sockets that we'll monitor for input. There is only one.
# Theoretically, this same program could monitor other sockets like message print.
my $read_set = new IO::Select;
$read_set->add($socket);
my $sel = new IO::Select( $socket );
# Send the "login" string that we built above to the socket.
print $socket $print_string;
# Set up some local variables for the loop below.
my $input;
my $inputqueue = "";
my $line;
my $exitflag;
my $counter = 0; # just for debugging purposes
my $result;
my @ready;
my @error;
my $fh;
# In the loop below, we are processing input from the socket. The tricky part is that
# we need to be careful to not block for input, and we also want to try to recover if
# we encounter a network error. In this outer while, we're processing until there's no
# more input. When that happens, we sleep for a little while and check again.
while (ContinueRun(5)) {
$counter = $counter + 1;
# The inner while loop executes only when there is input. The "1" in the can_read
# property of the while loop condition is a timeout. In other words, we check to see
# if there's anything to read, but if there isn't we time out after 1 second.
while(@ready = $sel->can_read(1)) {
# We know there's only one socket, so we don't bother even looking for others; we
# just use the first (and only) one in the array.
$fh = @ready[0];
# Get the line (up to 1000 characters).
$result = sysread $fh, $input, 1000;
# It turns out that a network error results in some strange behavior. It looks like
# we "can_read", but we get no data. If that happens, we'll jump out of this
# inner while loop out to where the socket is opened.
next SESSION if ($result == 0);
# append new input to the inputqueue
$inputqueue = $inputqueue . $input;
$exitflag = 0;
# loop until no complete call log lines are found
do {
# look for a match from the beginning of the string up to the carriage return/line feed characters
if ($inputqueue =~ m/^[^\n]*\n/) {
# remove the R nul nul nul and carriage return/line feed characters off the matched call log line
$line = substr($&, 4, -2);
# put the remaining segment of the string into inputqueue
$inputqueue = $';
# Next we check to see if we're logging to a file. If we are, we open the log file,
# named according to the date, write the line, and close it. This is pretty
# inefficient, but it helps ensure the integrity of the log file by not leaving
# it open.
if ($logdir ne "") {
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
# my $datestamp = sprintf "%4d%2.2d%2.2d", $year+1900, $mon+1, $mday;
my $datestamp = sprintf "%4d%2.2d", $year+1900, $mon+1;
my $logfilename = "$logdir\\smdr$datestamp.log";
open (LOGFILE, ">> $logfilename")
or die "Couldn't open $logfilename for writing: $!\n";
print LOGFILE $line, "\n";
close (LOGFILE);
} # of if logging
# Send the output to the serial port. This is the "bridge".
print PORT $line . "\n";
# if we're running in a window, we'll go ahead and echo the output there as well
print $line . "\n";
} else {
$exitflag = 1;
}
} while ($exitflag == 0);
} # of while there's input.
# When we get here, there's no more input waiting for us, so let's go to sleep for a while.
# The tradeoff on this delay is responsiveness vs. CPU time. The responsiveness is mostly
# noticed as a delay before printing and a delay in shutting down.
sleep 10;
} # infinite loop
# The only time we'll fall out of this loop if the service is "stopped". We do what little
# cleanup we can.
report("lost connection, retrying in 1 minute");
close($socket);
}
# Again, the only time we'll fall out of this loop if the service is "stopped". We do what
# little cleanup we can.
report("Info: $Config{ServiceName} stopping");
close(PORT);
}
# The following subroutine is used to log things to the event log if we're running as a service. If
# we're running interactively, we'll just log to stdout.
sub report {
my($msg) = @_;
if (!RunningAsService()) {
print $msg, "\n";
return;
}
return unless $msg =~ /^\S+:/;
require Win32::EventLog;
my $EventType = Win32::EventLog::EVENTLOG_INFORMATION_TYPE();
$EventType = Win32::EventLog::EVENTLOG_WARNING_TYPE() if $msg =~ /^w\S+:/i;
$EventType = Win32::EventLog::EVENTLOG_ERROR_TYPE() if $msg =~ /^e\S+:/i;
$msg =~ s/^\S+:\s*//;
my $EventLog = Win32::EventLog->new("PerlMsg", "");
$EventLog->Report({
EventType => $EventType,
Category => undef,
EventID => 0xC0000004,
Strings => $msg,
Data => "",
});
}
There is a "Install as a service" that can be "lost" as far as I am concerned, that is only for a windows box. I want to be able to run this with a cron script at various times.
Thanks for any help!
![[noevil]](/data/assets/smilies/noevil.gif "[noevil] [noevil]")
Hi there,
It may not be as bad a task as it first seems.
At first sight I see two areas you'll need to change:
1 - It's running as a service so you'll need to change it to run as a UNIX (sorry, LINUX) daemon process. As a start you can get rid of the code that runs it as a service and just run from the command line - once you've finished debugging come back and ask how to create a system or daemon process in Perl.
2 - The report sub - just writes to the event log, change this so that it writes to your own log file somewhere. The script already uses a log file elsewhere so you can steal that code.
This should give you a start.
Mike
It may not be as bad a task as it first seems.
At first sight I see two areas you'll need to change:
1 - It's running as a service so you'll need to change it to run as a UNIX (sorry, LINUX) daemon process. As a start you can get rid of the code that runs it as a service and just run from the command line - once you've finished debugging come back and ask how to create a system or daemon process in Perl.
2 - The report sub - just writes to the event log, change this so that it writes to your own log file somewhere. The script already uses a log file elsewhere so you can steal that code.
This should give you a start.
Mike
- Status
Similar threads
