Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

ryan

by ryan (Pilgrim)
on Feb 16, 2001 at 22:08 UTC ( [id://58913]=user: print w/replies, xml ) Need Help??


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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others musing on the Monastery: (5)
As of 2024-10-09 01:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The PerlMonks site front end has:





    Results (44 votes). Check out past polls.

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.