http://qs1969.pair.com?node_id=58913
ryan's user image
User since: Feb 16, 2001 at 22:08 UTC (23 years ago)
Last here: Sep 10, 2020 at 07:29 UTC (4 years ago)
Experience: 702
Level:Pilgrim (8)
Writeups: 53
Location:<-- Perth, Western Australia (see picture)
User's localtime: Mar 29, 2024 at 17:17 +08
Scratchpad: View
For this user:Search nodes
Watch for posts by this user


-----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.