start page | rating of books | rating of authors | reviews | copyrights

Perl Cookbook

Perl CookbookSearch this book
Previous: 16.21. Timing Out an Operation Chapter 16
Process Management and Communication
Next: 17. Sockets
 

16.22. Program: sigrand

Description

The following program gives you random signatures by using named pipes. It expects the signatures file to have records in the format of the fortune program - that is, each possible multiline record is terminated with "%%\n" . Here's an example:

Make is like Pascal: everybody likes it, so they go in and change it.                                             --Dennis Ritchie %% I eschew embedded capital letters in names; to my prose-oriented eyes, they are too awkward to read comfortably. They jangle like bad typography.                                             --Rob Pike %% God made the integers; all else is the work of Man.                                               --Kronecker %% I'd rather have :rofix than const.          --Dennis Ritchie %% If you want to program in C, program in C.  It's a nice language. I use it occasionally...   :-)              --Larry Wall %% Twisted cleverness is my only skill as a programmer.                                                    --Elizabeth Zwicky %% Basically, avoid comments. If your code needs a comment to be understood, it would be better to rewrite it so it's easier to understand.                                               --Rob Pike %% Comments on data are usually much more helpful than on algorithms.                                               --Rob Pike %%  Programs that write programs are the happiest programs in the world.                                             --Andrew Hume  %%

We check whether we're already running by using a file with our PID in it. If sending a signal number 0 indicates that PID still exists (or, rarely, that something else has reused it), we just exit. We also look at the current Usenet posting to decide whether to look for a per-newsgroup signature file. That way, you can have different signatures for each newsgroup you post to. For variety, a global signature file is still on occasion used even if a per-newsgroup file exists.

You can even use sigrand on systems without named pipes if you remove the code to create a named pipe and extend the sleep interval before file updates. Then .signature would just be a regular file. Another portability concern is that the program forks itself in the background, which is almost like becoming a daemon. If you have no fork call, just comment it out.

The full program is shown in Example 16.12 .

Example 16.12: sigrand

#!/usr/bin/perl -w # sigrand - supply random fortunes for .signature file  use strict;  # config section variables use vars qw( $NG_IS_DIR $MKNOD $FULLNAME $FIFO $ART $NEWS $SIGS $SEMA             $GLOBRAND $NAME );  # globals use vars qw( $Home $Fortune_Path @Pwd );  ################################################################ # begin configuration section  # should really read from ~/.sigrandrc  gethome();  # for rec/humor/funny instead of rec.humor.funny $NG_IS_DIR      = 1;      $MKNOD          = "/bin/mknod"; $FULLNAME       = "$Home/.fullname"; $FIFO           = "$Home/.signature"; $ART            = "$Home/.article"; $NEWS           = "$Home/News"; $SIGS           = "$NEWS/SIGNATURES"; $SEMA           = "$Home/.sigrandpid"; $GLOBRAND       = 1/4;  # chance to use global sigs anyway  # $NAME should be (1) left undef to have program guess # read address for signature maybe looking in ~/.fullname, # (2) set to an exact address, or (3) set to empty string # to be omitted entirely.  $NAME           = '';           # means no name used ## $NAME        = "me\@home.org\n";       # end configuration section -- HOME and FORTUNE get autoconf'd ################################################################  setup();                # pull in inits justme();               # make sure program not already running fork && exit;           # background ourself and go away  open (SEMA, "> $SEMA")      or die "can't write $SEMA: $!"; print SEMA "$$\n"; close(SEMA)                    or die "can't close $SEMA: $!";  # now loop forever, writing a signature into the  # fifo file.  if you don't have real fifos, change # sleep time at bottom of loop to like 10 to update # only every 10 seconds. for (;;) {     open (FIFO, "> $FIFO")  or die "can't write $FIFO: $!";     my $sig = pick_quote();     for ($sig) {          s/^((:?[^\n]*\n){4}).*$/$1/s;   # trunc to 4 lines         s/^(.{1,80}).*? *$/$1/gm;       # trunc long lines     }     # print sig, with name if present, padded to four lines     if ($NAME) {          print FIFO $NAME, "\n" x (3 - ($sig =~ tr/\n//)), $sig;     } else {         print FIFO $sig;     }     close FIFO;      # Without a microsleep, the reading process doesn't finish before     # the writer tries to open it again, which since the reader exists,     # succeeds.  They end up with multiple signatures.  Sleep a tiny bit     # between opens to give readers a chance to finish reading and close     # our pipe so we can block when opening it the next time.      select(undef, undef, undef, 0.2);   # sleep 1/5 second } die "XXX: NOT REACHED";         # you can't get here from anywhere  ################################################################  # Ignore SIGPIPE in case someone opens us up and then closes the fifo # without reading it; look in a .fullname file for their login name. # Try to determine the fully qualified hostname.  Look our for silly # ampersands in passwd entries.  Make sure we have signatures or fortunes. # Build a fifo if we need to.  sub setup {     $SIG{PIPE} = 'IGNORE';                    unless (defined $NAME) {            # if $NAME undef in config         if (-e $FULLNAME) {             $NAME = `cat $FULLNAME`;             die "$FULLNAME should contain only 1 line, aborting"                  if $NAME =~ tr/\n// > 1;         } else {             my($user, $host);             chop($host = `hostname`);             ($host) = gethostbyname($host) unless $host =~ /\./;             $user = $ENV{USER} || $ENV{LOGNAME} || $Pwd[0]                 or die "intruder alert";             ($NAME = $Pwd[6]) =~ s/,.*//;             $NAME =~ s/&/\u\L$user/g; # can't believe some folks still do this             $NAME = "\t$NAME\t$user\@$host\n";         }      }      check_fortunes() if !-e $SIGS;      unless (-p $FIFO) {         # -p checks whether it's a named pipe         if (!-e _) {              system("$MKNOD $FIFO p") && die "can't mknod $FIFO";              warn "created $FIFO as a named pipe\n";         } else {              die "$0: won't overwrite file .signature\n";         }      } else {         warn "$0: using existing named pipe $FIFO\n";     }       # get a good random number seed.  not needed if 5.004 or better.     srand(time() ^ ($$ + ($$ << 15))); }  # choose a random signature sub pick_quote {     my $sigfile = signame();     if (!-e $sigfile) {         return fortune();     }      open (SIGS, "< $sigfile" ) or die "can't open $sigfile";     local $/  = "%%\n";     local $_;     my $quip;     rand($.) < 1 && ($quip = $_) while <SIGS>;     close SIGS;     chomp $quip;     return $quip || "ENOSIG: This signature file is empty.\n"; }   # See whether ~/.article contains a Newsgroups line.  if so, see the first # group posted to and find out whether it has a dedicated set of fortunes. # otherwise return the global one.  also, return the global one randomly # now and then to spice up the sigs. sub signame {      (rand(1.0) > ($GLOBRAND) && open ART) || return $SIGS;         local $/  = '';      local $_  = <ART>;      my($ng)   = /Newsgroups:\s*([^,\s]*)/;      $ng =~ s!\.!/!g if $NG_IS_DIR;     # if rn -/,  or SAVEDIR=%p/%c      $ng = "$NEWS/$ng/SIGNATURES";      return -f $ng ? $ng : $SIGS; }   # Call the fortune program with -s for short flag until # we get a small enough fortune or ask too much. sub fortune {    local $_;    my $tries = 0;    do {         $_ = `$Fortune_Path -s`;     } until tr/\n// < 5 || $tries++ > 20;    s/^/ /mg;    $_ || " SIGRAND: deliver random signals to all processes.\n"; }   # Make sure there's a fortune program.  Search  # for its full path and set global to that. sub check_fortunes {     return if $Fortune_Path;    # already set     for my $dir (split(/:/, $ENV{PATH}), '/usr/games') {         return if -x ($Fortune_Path = "$dir/fortune");     }      die "Need either $SIGS or a fortune program, bailing out"; }   # figure out our directory sub gethome {     @Pwd = getpwuid($<);     $Home = $ENV{HOME} || $ENV{LOGDIR} || $Pwd[7]        or die "no home directory for user $<"; }  # "There can be only one."  --the Highlander sub justme {     if (open SEMA) {         my $pid;         chop($pid = <SEMA>);         kill(0, $pid) and die "$0 already running (pid $pid), bailing out";         close SEMA;     } 









 } 


Previous: 16.21. Timing Out an Operation Perl Cookbook Next: 17. Sockets
16.21. Timing Out an Operation Book Index 17. Sockets