 |
| User since: |
Feb 16, 2001 at 22:08 UTC
(24 years ago) |
| Last here: |
Sep 10, 2020 at 07:29 UTC
(5 years ago) |
| Experience: |
702
|
| Level: | Pilgrim (8) |
| Writeups: |
53
|
| Location: | <-- Perth, Western Australia (see picture) |
| User's localtime: |
Jun 20, 2025 at 06:45 +08
|
| Scratchpad: |
View
|
| For this user: | Search nodes |
|
-----BEGIN GEEK CODE BLOCK-----
Version: 3.12
CAN'T BE ARSED+++++$
------END GEEK CODE BLOCK------
| |
I attempt to write Perl programs, mostly assorted servers and CGI. I'm crap at it though, that's why I come here.
Feel free to email me if you can think of a good reason to: ryan at slowest dot net
Useful bits of code:
Get all file names recursively in a directory from this node:
use File::Find;
my @files;
sub eachFile {
if (-e $_) { push @files, $File::Find::name; }
}
find (\&eachFile, "/some/directory/");
|
Generate every IP between two ranges from this node:
my @range = map { unpack "N", pack "C4", split /\./ } qw(0.0.0.0 255.2
+55.255.255); #yes i know these aren't 'real'
$hostcount = $range[1]-$range[0]+1; #number of IPs
for (0..$hostcount-1) { #done this way to avoid problems
#with large numbers in some
#environments
print join(".", unpack "C4", pack "N", $_+$range[0]);
}
|
Simple server template from this node
use IO::Socket;
# optional stuff to make init.d calling work
my $pidFile = '/var/run/something.pid';
my $pid = fork;
if ($pid) # parent: save PID
{
open PIDFILE, ">$pidFile" or die "Can't open PID file: $!\n";
print PIDFILE $pid;
close PIDFILE;
exit 0;
}
# end of optional init.d stuff
my $port = 8000;
my $proto = 'tcp';
my %kids = ();
# do stuff when we are forced to exit
$SIG{"TERM"} = "cleanup_and_exit";
sub cleanup_and_exit {
my $sig = @_;
foreach my $kid (keys %kids) {
# attempt to reap the kiddies
warn ("Failed to reap child pid: $kid") unless kill 9, $kid;
}
# it's a good idea to exit when you are told to
exit(0);
}
# set up a socket
my $listen_socket = IO::Socket::INET->new(LocalPort => $port,
Listen => 10,
Proto => $proto,
Reuse => 1);
while (my $connection = $listen_socket->accept)
{
my $child;
# perform the fork or exit
die "Can't fork: $!" unless defined ($child = fork());
if ($child == 0) { # i'm the child!
# close the child's listen socket, we dont need it.
$listen_socket->close;
# call the main child rountine
&some_routine($connection);
# if the child returns, then record and exit;
undef $kids{$child};
exit 0;
} else { # i'm the parent!
# remember the pid of any children for later reaping
$kids{$child} = 1;
# close the connection, the parent has already passed
# it off to a child.
$connection->close();
}
# go back and listen for the next connection!
}
sub some_routine {
my $socket = shift;
# go for it here ...
# but don't forget to exit
exit(0);
}
|
If NT is the answer, you haven't understood the question.
|
