[6477] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 101 Volume: 8

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Mar 12 12:38:03 1997

Date: Wed, 12 Mar 97 09:00:23 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Wed, 12 Mar 1997     Volume: 8 Number: 101

Today's topics:
     3 Easy questions. - PLEASE HELP <nick@batfink.demon.co.uk>
     Re: All I want to do is subtract 180 days from a given  (Steffen Beyer)
     Re: DFD's for perl5 <tchrist@mox.perl.com>
     Re: Efficient multiple regexp searching <tchrist@mox.perl.com>
     Example of monitoring TCP services with Perl <P.Gillingwater@iaea.org>
     faq for perl compiler? (The next Pele)
     Re: filehandles: better way to test existence of? <tchrist@mox.perl.com>
     Re: How to overwrite a file? <tchrist@mox.perl.com>
     HTML Programmer alliance- Earn big $$$ <sales@planetek.com>
     Re: ISBN/Checkdigit calculator <mriggsby@sybex.com>
     Making ror to really Rotate Right <sbekman@iil.intel.com>
     Re: matching whitespace? <tchrist@mox.perl.com>
     Re: matching whitespace? <tchrist@mox.perl.com>
     Re: On implementing tie (Gregory Tucker-Kellogg)
     Open file works under DOS, not under server dsmith6@sct.edu
     Re: Open file works under DOS, not under server (Nathan V. Patwardhan)
     Re: Perl "strict" usage (Ken Williams)
     Re: porting script from unix to nt (The next Pele)
     Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Wed, 12 Mar 1997 16:27:22 +0000
From: Nick Curtis <nick@batfink.demon.co.uk>
Subject: 3 Easy questions. - PLEASE HELP
Message-Id: <3326D969.3E11@batfink.demon.co.uk>

OK, I have three little posers that I need to ask. 

1. How do you change a string to be either all caps or all non-caps?

2. How do you truncate a string, or get a substring?

3. How do I get a list of all environment variables sent from a web
browser???

I tried 

foreach $key (sort keys(%ENV)) {print "$key = $ENV($key)\n};

but with perlIS.dll it only shows    PERLXS = PERLIS.DLL

Help much appreciated.

NickC (told you it was quick and easy!!!!).


------------------------------

Date: 12 Mar 1997 06:42:18 GMT
From: sb@en.muc.de (Steffen Beyer)
Subject: Re: All I want to do is subtract 180 days from a given date!
Message-Id: <5g5j8a$ao5$1@en1.engelschall.com>

Tom Phoenix <rootbeer@teleport.com> wrote:
> On Tue, 11 Mar 1997, Blake Swensen wrote:

> > Subject: All I want to do is subtract 180 days from a given date!
> > 
> > Really... thats all.  User inputs a date, and gets a date 180..0 days
> > earlier.

> > I have surfed, searched, read FAQs, downloaded, copied, hacked.  Can
> > some kind soul give me the necessary nudge.

> Sure. First, convert the date to standard format (which is often the
> number of seconds since a certain time and date). Then, use the fact that
> there are 24 * 60 * 60 seconds per day and subtract. Finally, you can
> convert from the standard format to your local time format, or another
> format if that's what you'd prefer.

Much too complicated!

> In order to convert time formats, check out the Date modules on CPAN,
> which are found in the modules/by-module/Date subdirectory.

>     http://www.perl.org/CPAN/
>     http://www.perl.com/CPAN/

Yes, definitely get yourself the Date::DateCalc module!

http://www.perl.com/CPAN/authors/id/STBEY/DateCalc-3.0.tar.gz

or from the author's site:

http://www.engelschall.com/u/sb/download/DateCalc-3.0.tar.gz

Your problem is addressed by the function "calc_new_date" in the above
module:

($year,$mm,$dd) = calc_new_date($year,$mm,$dd,$offset);

"$offset" can be any offset in days you like.

Hope this helps.

Yours,
-- 
    |s  |d &|m  |    Steffen Beyer <sb@sdm.de> (+49 89) 63812-244 fax -150
    |   |   |   |    software design & management GmbH & Co. KG
    |   |   |   |    Thomas-Dehler-Str. 27, 81737 Munich, Germany.
                     "There is enough for the need of everyone in this world,
                     but not for the greed of everyone." - Mahatma Gandhi


------------------------------

Date: 12 Mar 1997 14:59:37 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: DFD's for perl5
Message-Id: <5g6gcp$1ro$4@csnews.cs.colorado.edu>

 [courtesy cc of this posting sent to cited author via email]

In comp.lang.perl.misc, 
    vkomandu@mnemosyne.cs.du.edu (Ind study) writes:
: Really appreciate your help!!

What'a DFD?  It's like BNF?  If so, there's just do such thing.

--tom
-- 
	Tom Christiansen	tchrist@jhereg.perl.com


    "For it, that's now" --Larry Wall


------------------------------

Date: 12 Mar 1997 16:39:07 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Efficient multiple regexp searching
Message-Id: <5g6m7b$71s$2@csnews.cs.colorado.edu>

You may be able to use an approach related to this one:

=head2 How do I efficiently match many regular expressions at once?

    The following is super-inefficient:

	while (<FH>) {
	    foreach $pat (@patterns) {
		if ( /$pat/ ) {
		    # do something
		}
	    }
	}

    Instead, you either need to use one of the experimental Regexp extension
    modules from CPAN (which might well be overkill for your purposes),
    or else put together something like this, inspired from a routine
    in Jeffrey Friedl's book:

	sub _bm_build {
	    my $condition = shift;
	    my @regexp = @_;  # this MUST not be local(); need my()
	    my $expr = join $condition => map { "m/\$regexp[$_]/o" } (0..$#regexp);
	    my $match_func = eval "sub { $expr }";
	    die if $@;  # propagate $@; this shouldn't happen!
	    return $match_func;
	}

	sub bm_and { _bm_build('&&', @_) }
	sub bm_or  { _bm_build('||', @_) }

	$f1 = bm_and qw{
		xterm
		(?i)window
	};

	$f2 = bm_or qw{
		\b[Ff]ree\b
		\bBSD\B
		(?i)sys(tem)?\s*[V5]\b
	};

	# feed me /etc/termcap, prolly
	while ( <> ) {
	    print "1: $_" if &$f1;
	    print "2: $_" if &$f2;
	}


-- 
	Tom Christiansen	tchrist@jhereg.perl.com

#ifdef USE_STD_STDIO    /* Here is some breathtakingly efficient cheating */
    --Larry Wall, from sv.c in the v5.0 perl distribution


------------------------------

Date: Wed, 12 Mar 1997 17:29:56 +0100
From: Paul Gillingwater <P.Gillingwater@iaea.org>
Subject: Example of monitoring TCP services with Perl
Message-Id: <3326DA03.5546@iaea.org>

This is a multi-part message in MIME format.
------------254923846A7F0
Content-Transfer-Encoding: 7bit
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Type: text/plain; charset=us-ascii

I wrote a Perl script that runs out of cron every 2 minutes,
to monitor over 60 TCP-based services (defined by
hostname and port).  The information is used to update
an SQL database (using Sybperl), as well as sending
e-mail alerts and pager notifications (using an e-mail
interface to "qpage".)

I'm very lazy, so this isn't a module, but it is sufficiently
useful that others may care to adopt it.  I was motivated
to build this because most Network Management systems
I've seen don't go above layer 3 or 4 to monitor
services rather than servers.  Go figure.  Later, this
will be extended to generate SNMP traps for our NMS.

Enjoy.

------------254923846A7F0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="mc.pl"
Content-Type: application/x-perl; name="mc.pl"

#!perl5

# mc.pl -- Mission Control central process

# Author: Paul Gillingwater <P.Gillingwater@iaea.org>
# Created: 29 January 1997
# Version: 1.4
# Updated: 12 March 1997
 
# This process will connect to an SQL database, and use it to
# read a set of tests which must be performed every minute.

# This process should be activated at startup, and will
# run continuously. 

# Signals should be intercepted to avoid accidental termination.
# The HUP signal will cause the parameters to be re-read.

# Note that if this script is executed on the firewall
# system, which has implicit packet forwarding between
# interfaces disabled, then we have to establish the 
# local end on one or the other interface according to
# whether it is an internal or an external service.

# Changes:

# 03 Feb 1997: Changed database to add column specifying
#              whether the target service is inside or 
#              outside the firewall, so we can use the
#              internal or external interface.
# 06 Feb 1997: Added priority, if 1 then pager notified
#              when a service has failed.  Delay is the 
#              number of cycles we wait after failure 
#              before changing state in database.
# 04 Mar 1997: Use arrays instead of SQL database for
#              temporary storage of information.  Read
#              SQL database only when starting, or after
#              receiving signal HUP.  Write database when
#              any change of status occurs.
# 06 Mar 1997: Reduced sensitivity by delaying failure
#              detection for selected hosts.  Added a
#              calculation for cumulative downtime.
# 08 Mar 1997: Send page when this program starts
#              and when it terminates.
# 12 Mar 1997: Added signal handling.


# Future Plans:

# If the SQL database is unreachable, page someone and e-mail.
# Only needed when reloading, because this is a normal test.

# Escalation time (in minutes) is how long we wait after a
# service has gone down, and remains down, before an additional
# pager message is sent out (and e-mail messages.)

# Porting note: IBM probably doesn't have /usr/bin/elm.  Find
# something similar, e.g., mailx, which doesn't do strange
# things when sending plain text to MS Exchange.  For now, 
# this program will remain on HP-UX however.

# Add new table in database for monthly downtime accumulation
# for each service.  When we reach a new month, we should
# move current downtime into the database, and clear it.
# Each row will also contain number of failures.

#----------------------------------------------------------------

# Database structures:

# SQL server name: XXXXX
# Database name:   XXXXX
# Table name:      Services
# Columns:
#  id		- unique numerical key, increasing from 1
#  host		- DNS name of host
#  port		- Port number for service
#  status	- Is this service available presently
#                 A means active, F means fail, N means testing disabled
#  hits		- Number of failures noted
#  lastfailed   - Date & time of last failure
#  inside	- I means inside firewall, E means external
#  description  - Description of service
#  priority	- Level 1 is urgent (use pager), level 2 is e-mail, 
#		  0 is ignore
#  inform	- E-mail addresses (space delimited) to inform in case 
#		  of failure
#  delay        - Number of cycles to delay before alarm generated
#  downtime     - Cumulative downtime in minutes
#  escalation   - Minutes something has to be down before escalation


use Sybase::DBlib;  # Sybase database library routines
use Date::Manip;    # Date manipulation routines

# require 'sybutil.pl';
# require 'getopts.pl';
require 'ctime.pl';

@Months = ("Jan","Feb","Mar","Apr","May","Jun",
           "Jul","Aug","Sep","Oct","Nov","Dec");

$mailer = "/usr/bin/elm"; 

# List of persons to notify (later to store in SQL database)
$notify = "I.Kurtev\@iaea.org P.Gillingwater\@iaea.org W.Opoku\@iaea.org";
$pager  = "J.Winkels.Pager\@intranet.iaea.or.at";

# Here are some parameters which may vary for other systems
# for example, HP-UX uses SOCK_STREAM = 1, while
# Solaris uses SOCK_STREAM=2

$AF_INET = 2;
$SOCK_STREAM = 1;
$sockaddr = 'S n a4 x8';

@nul = ('not null','null');
select(STDOUT); $| = 1;         # make unbuffered
select(STDERR); $| = 1; 

$dbname = "XXX";
$server = "XXXXX";
$table  = "Services";
$login  = "xxxxx";
$password  = "xxxxx";
$cycle  = 2;  # minutes duration for sleep cycle

$LogFile = "/root/mc.log";
open(LOG,">>$LogFile") || die "Unable to open log file $LogFile : $!\n";
select(LOG); $| = 1; # make log file unbuffered

if (! -r $mailer) {
  print LOG "Fatal Error: Can't find the mail program $mailer.\n";
  print STDERR "Fatal Error: Can't find the mail program $mailer.\n";
  close(LOG);
  exit(1);
}

$firsttime = 1;  # this is 1 only first time through
&initdb;

# Open a second connection for updates
($dbproc = new Sybase::DBlib $login, $password, $server);

if ($dbproc eq "") {
  print LOG "$DateStamp: Server $server: Login failed.\n";
  print STDERR "$DateStamp: Server $server: Login failed.\n";
  exit(1);
}

# The login was successful.  Let's get some data

restart:  # come here after a HUP signal

# Note that this outer loop will operate all the time.
while (1) {
  foreach $id (keys %active) {
    $host = $host[$id];
    $port = $port[$id];
    $status = $status[$id];
    $inside = $inside[$id];
    $description = $description[$id];
    &testservice($host,$port,$status,$inside,$description,$id);
  }
  print STDERR "Sleeping $cycle minutes.\n";
  sleep $cycle * 60;  # wait $cycle minutes for the next round
}

exit 0;

######################################

# initdb()
# This routine will log on to the database, collect all
# of the information, and log off from the database.
# This routine is called at initialization, and also
# upon receipt of signal HUP.
# Note that although we can guarantee that our IDs are
# numeric, and probably > 0, we can't guarantee that
# there won't be any gaps, therefore we should keep
# track of the functioning IDs in an associative array,
# called %active.

sub initdb {

  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  $year = $year + 1900;
  $DateStamp = sprintf("%04d/%02d/%02d %02d:%02d:%02d",
  $year, $mon+1, $mday, $hour, $min, $sec);

  print LOG "$DateStamp: Logging on to $server\n";

  ($dbinit = new Sybase::DBlib $login, $password, $server);

  if ($dbinit eq "") {
    print LOG "$DateStamp: Database Login failed.\n";
    print STDERR "$DateStamp: Database Login failed.\n";
    if ($firsttime) {
      print LOG "$DateStamp: Alert: Cannot proceed without data.\n";
      print STDERR "$DateStamp: Alert: Cannot proceed without data.\n";
      close(LOG);
      exit;
    }
  }
  if ($firsttime) {
    $message = "Mission Control Restart";
    open(PAGER,
      "|$mailer -s \"$message\" $pager");
    print PAGER " ";
    close(PAGER);
    print LOG "DateStamp: Mission Control Restart\n";
    # Establish signal handlers
    $SIG{'INT'} = 'handler';
    $SIG{'QUIT'} = 'handler';
    $SIG{'HUP'} = 'handler';
    $SIG{'KILL'} = 'handler';
    $firsttime = 0;
  }

  # Forget everything we know for this reload -- but only
  # AFTER we have successfully logged-on to the database.
  undef @host;
  undef @port;
  undef @status;
  undef @hits;
  undef @lastfailed;
  undef @inside;
  undef @description;
  undef @priority;
  undef @inform;
  undef @delay;
  undef @count;
  undef @downtime;
  undef @escalation;
  undef %active;
  $dbinit->dbuse("$dbname");  # use this database
  $dbinit->dbcmd("select * from $table where status <> 'N'");
  $dbinit->dbsucceed(TRUE);   
  $counter = 0;
  while (($id,$host,$port,$status,$hits,$lastfailed,
          $inside,$description,$priority,$inform,$delay,
          $downtime,$escalation) = 
    $dbinit->dbnextrow()) {
    $host[$id] 		= $host;
    $port[$id] 		= $port;
    $status[$id] 	= $status;
    $hits[$id] 		= $hits;
    $lastfailed[$id]	= $lastfailed;
    $inside[$id]	= $inside;
    $description[$id]	= $description;
    $priority[$id]	= $priority;
    $inform[$id]	= $inform;
    $delay[$id]		= $delay;
    $count[$id]		= $delay;  # used to countdown
    $downtime[$id]	= $downtime;
    $escalation[$id]	= $escalation;
    # Track which ids are active in this assoc. array:
    # Note this doesn't mean Active, it means that these
    # entities are monitored.  
    # => We ignore ones with status "N".
    $active{$id}	= "$host:$port";
    $counter++;
  }
  if ($counter == 0) {
    print LOG "$DateStamp: No active hosts found to monitor\n";
    print STDERR "$DateStamp: No active hosts found to monitor\n";
    exit(1);
  }
  print LOG "$DateStamp: Found $counter hosts to monitor.\n";
}

# mailalarm() 
# This subroutine will send an alarm message via mail to the
# list of addresses specified in $notify, plus any addresses
# specified in the database in the column "inform".  

sub mailalarm {
  local($host,$port,$description,$alarm,$reason) = @_;

  open(MAIL,
    "|$mailer -s \"$alarm: $description\" \"$notify $inform[$id]\"");
  print MAIL <<"EOM";

A change in status has occurred with the $description.

Connecting to port $port on $host 
$alarm 
$reason
EOM
  close(MAIL);
  print LOG "$DateStamp $description: $alarm $reason ($host:$port)\n";
  print STDERR "$DateStamp $description: $alarm ($host:$port)\n";

}

######
#
# testservice(host,port,status,inside,description,id)
#
# This routine will use TCP to connect to a port on a host.
# If the connection cannot be made, an alarm will be logged.
# If the alarm has changed state, someone will be notified.

sub testservice {
  local($testhost,$testport,$teststatus,$testinside,$testdesc,$testid) = @_;

  print STDERR "Testing $testhost on port $testport ($testdesc)...\n";

  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

  $year = $year + 1900;  # Yes, this is year 2000 safe

  $DateStamp = sprintf("%04d/%02d/%02d %02d:%02d:%02d",
  $year, $mon+1, $mday, $hour, $min, $sec);

  $month = $Months[$mon];
  $now = "$month $mday $year " . sprintf("%02d:%02d:%02d",
         $hour, $min, $sec);

  chop($hostname = `hostname`);
  # If we're the Bastion, then we need special treatment
  if ($hostname eq "bastion" || $hostname eq "festung") {
    if ($testinside eq "I" || $testinside eq "i") { # Internal target
      $hostname = "festung";
    } else {
      $hostname = "bastion";
    }
  }
  
  ($name,$aliases,$proto) = getprotobyname('tcp');
  ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
  $this = pack($sockaddr, $AF_INET, 0, $thisaddr); 

  ($name,$aliases,$testport) = getservbyname($testport,'tcp')
    unless $testport =~ /^\d+$/;;
  ($name, $aliases, $type, $len, $thataddr) = gethostbyname($testhost);
  $that = pack($sockaddr, $AF_INET, $testport, $thataddr); 

  # Create a handle to the socket
  if (!socket(S, $AF_INET, $SOCK_STREAM, $proto)) {
    $reason = $!;
    print STDERR "socket failed: $reason\n";
    print LOG "$DateStamp $testhost:$testport -- socket failed: $reason\n";
    &report($testid,"F","Socket failed: $reason");  # report failure
    next;
  }
  
  # Assign the socket an address
  if (!bind(S, $this)) {
    $reason = $!;
    print STDERR "bind failed: $reason\n";
    print LOG "$DateStamp $testhost:$testport -- bind failed: $reason\n";
    &report($testid,"F","Bind failed: $reason");  # report failure
    next;
  }
  
  # Connect to the server
  if (!connect(S,$that)) { 
    $reason = $!;
    print STDERR "connect failed: $reason\n"; 
    print LOG "$DateStamp $testhost:$testport -- connect failed: $reason\n"; 
    shutdown(S,2);
    close(S);
    &report($testid,"F","Connect failed: $reason");  # report failure
    next;
  }

  print STDERR "Connected successfully.\n";

  &report($testid,"A","");   # report activity 

  # Eliminate buffering on this socket
  select(S);      $| = 1; 

  # If it's a Web service, use the GET method

#  if ($testport == 80) {
#    print S "GET / HTTP/1.0\n\n";
#
#    $LineCount = 0;
#    while (<S>) { # read line by line
#      $LineCount++;
#    }
#    print STDERR "http: Received $LineCount lines.\n";
#  }

  shutdown(S,2);
  close(S);
}

# report() -- report success ("A") or failure ("F")
#
# This procedure will take the id of the connection, and will
# update the database with the results of the test, either
# success or failure, as well as the datestamp of the test
# and the attempt number.  If there is a change in status,
# then an alarm will be generated.

sub report {

local ($reportid,$reportstatus,$reportreason) = @_;

# Assume the variables are still around from the current row
# in the Services table.
# Note that we update the SQL only if there has been a
# change in status.

  # Status N means no testing will be performed.
  if ($status[$id] eq "N") {  # should never get here...
    return 0;
  } elsif ($status[$id] eq "A") {  # should be Active
    if ($reportstatus eq "F") { # but now has failed
      # determine whether we should delay reporting...
      if ($count[$id] > 0) {
        $count[$id]--;   # start count-down
        print STDERR "Countdown: $count[$id] on $host[$id]:$port[$id]\n";
        print LOG "Countdown: $count[$id] on $host[$id]:$port[$id]\n";
        return 0;  # do nothing
      }
      $count[$id] = $delay[$id];  # restore for next time
      $status[$id] = "F";
      # Generate an alarm, the Service has failed.
      $alarm = "Failed";
      # Update the hits only for failure transitions
      $hits[$id]++;
      &mailalarm($host[$id],$port[$id],$description[$id],
        $alarm,$reportreason);

      # Prepare the SQL update
      $lastfailed[$id] = $now;
      $sql = "update $table set hits = $hits[$id], lastfailed = '$now',
        status = 'F' where id = $id";
      if ($priority[$id] eq "1") {  # failed, so send pager message
        $message = substr("FAIL: $description",0,37);
        open(PAGER,
          "|$mailer -s \"$message\" $pager");
        print PAGER " ";
        close(PAGER);
      }
    } else {
      return 0;
    }
  } elsif ($status[$id] eq "F") {  # had failed
    if ($reportstatus eq "A") { # but now is active
      $status[$id] = "A";
      $count[$id] = $delay[$id];  # restore countdown for next time
      print LOG "Countdown for $host[$id]:$port[$id] restored.\n";
      # Let's find out how long it was down, by looking at
      # the last datefailed, and the current time, and compare.
      # Use this to update the downtime.
      $lastfailed = $lastfailed[$id];
      if ($lastfailed ne "") {
        $lastfailed=&ParseDate($lastfailed[$id]);
        $upagain=&ParseDate($now);
        $delta=&DateCalc($lastfailed,$upagain,$err);
        ($dy,$dm,$ddays,$dhours,$dmins,$dsecs) = split(/:/,$delta);
        # Correct for the delay in detecting an error (underestimated)
        # Note that delay 2 is actually between 4 & 6 minutes,
        # but we will take the lower value to be generous.
        $downtime = ($ddays * 24 + $dhours) * 60 + $dmins 
          + ($delay[$id] * $cycle);
        $downtime[$id] = $downtime[$id] + $downtime;
        print LOG "Up again, delta was $delta, Downtime is $downtime minutes, Err is $err\n";
      }

      # Generate an alarm, the Service is restored.
      $alarm = "Active";
      $reportreason = "Downtime was $downtime minutes.";
      &mailalarm($host[$id],$port[$id],$description[$id],
        $alarm,$reportreason);

      # Prepare the SQL update
      $sql = "update $table set status = 'A', 
        downtime = $downtime[$id]
        where id = $id";
      if ($priority[$id] eq "1") {  # OK, so send pager message
        $message = substr("OK: $description",0,37);
        open(PAGER,
          "|$mailer -s \"$message\" $pager");
        print PAGER " ";
        close(PAGER);
      }
    } else {
      # Here is where we check for escalation, i.e., it is
      # still down.  Note we only wish to escalate once per day.
      return 0;
    }
  } else {
    print LOG "$DateStamp Unknown status: $status[$id]\n";
    print STDERR "$DateStamp Unknown status: $status[$id]\n";
    return 1;
  }
  # We only get here if there has been a transition.
  # Update the row with the new status
  $dbproc->dbcmd($sql);
  $dbproc->dbsucceed(TRUE);   
  while (@results = $dbproc->dbnextrow()) {
    print LOG "$DateStamp @results\n";
    print STDERR "$DateStamp @results\n";
  }
}

# signal handling here
# Try to ignore most signals, except KILL which we use to clean up,
# and HUP which we use to reload the database.

sub handler {
  local($sig) = @_;
  print LOG "$DateStamp: Caught a SIG$sig\n";
  print "$DateStamp: Caught a SIG$sig\n";
  if ($sig eq "KILL" || $sig eq "QUIT" || $sig eq "INT") { 
    # OK Gov, I'll go quietly...
    $message = "Mission Control Exit";
    print LOG "$DateStamp: $message\n";
    close(LOG);
    open(PAGER,
      "|$mailer -s \"$message\" $pager");
    print PAGER " ";
    close(PAGER);
    exit(1);
  } elsif ($sig eq "HUP") { # reload database
    print LOG "$DateStamp: Reloading Database\n";
    print "$DateStamp: Reloading Database\n";
    &initdb;
    goto restart;
  } else {
    print LOG "$DateStamp: Why am I here? [Strange signal trapped]\n";
  }
}


######################## END of PROGRAM ##########################



------------254923846A7F0--



------------------------------

Date: 12 Mar 1997 16:28:47 GMT
From: gt1535b@acmey.gatech.edu (The next Pele)
Subject: faq for perl compiler?
Message-Id: <5g6ljv$rmp@catapult.gatech.edu>

Is there a faq for the perl compiler?
Also, has anyone tried to compile on Win95, and not UNIX?

thanks,
Daryl

--
<>< Daryl Bowen	<><
Georgia Institute of Technology
E-mail: gt1535b@prism.gatech.edu
Siemens Stromberg-Carlson Co-op


------------------------------

Date: 12 Mar 1997 15:15:08 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: filehandles: better way to test existence of?
Message-Id: <5g6h9s$3ic$2@csnews.cs.colorado.edu>

 [courtesy cc of this posting sent to cited author via email]

In comp.lang.perl.misc, 
    "Cal..." <jewell@halcyon.com> writes:
:Is fileno(fH) the best way to test the existence of a filehandle?

No, defined(fileno(FH)) is, because fileno(STDIN) == 0.

--tom
-- 
	Tom Christiansen	tchrist@jhereg.perl.com
    It won't be covered in the book.  The source code has to be useful for
    something, after all...  :-)
            --Larry Wall in <10160@jpl-devvax.JPL.NASA.GOV>


------------------------------

Date: 12 Mar 1997 15:09:59 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: How to overwrite a file?
Message-Id: <5g6h07$3ic$1@csnews.cs.colorado.edu>

 [courtesy cc of this posting sent to cited author via email]

In comp.lang.perl.misc, 
    maclaudi@cps.msu.edu (Claudia  Ma) writes:
:I'm working on a cgi right now: when someone fill a form online, the data
:are saved to a file. But the problem is when the same person wants to
:change the data, it can't be done.

This is not a perl question.  It is a CGI question.  It is the 
absolutely number one most frequently asked such question.  What
resources did you consult?

Here's one.  In part 9 of the (new) Perl FAQ, the first question
reads:

    =head2 My CGI script runs from the command line but not the browser.
	   Can you help me fix it?

    Sure, but you probably can't afford our contracting rates :-)

    Seriously, if you can demonstrate that you've read the following
    FAQs and that your problem isn't something simple that can be easily
    answered, you'll probably receive a courteous and useful reply to
    your question if you post it on comp.infosystems.www.authoring.cgi
    (if it's something to do with HTTP, HTML, or the CGI protocols).
    Questions that appear to be Perl questions but are really CGI ones
    that are posted to comp.lang.perl.misc may not be so well received.

    The useful FAQs are:

	http://www.perl.com/perl/faq/idiots-guide.html
	http://www3.pair.com/webthing/docs/cgi/faqs/cgifaq.shtml
	http://www.perl.com/perl/faq/perl-cgi-faq.html
	http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html
	http://www.boutell.com/faq/

--tom
-- 
	Tom Christiansen	tchrist@jhereg.perl.com


    "It's okay to be wrong temporarily." --Larry Wall


------------------------------

Date: 12 Mar 1997 14:45:20 GMT
From: "Planetek" <sales@planetek.com>
Subject: HTML Programmer alliance- Earn big $$$
Message-Id: <01bc2ef3$619beab0$7e055ac2@musach>

LOWEST WEB HOSTING PRICES ON EARTH!
Host your customers site on our fast T1 servers and earn 50% commission
for every referral!

Each time the Customer signs up for a further six months you get another
commission check!

The PLANETEK (http://www.planetek.com) Alliance Program was designed to
enable HTML Programmers to participate in the fast-growing and lucrative
Internet marketplace as value-added resellers. PLANETEK is committed to
providing the highest level of Internet access and support services to its
Alliance Partners. 

The Internet provides your organizations with outstanding sales and
business development opportunities. You can lead with the Internet with new
prospects and customers and use it as a door opener for consulting and
design business. 

Companies who are interested in this program may participate as an
Authorized PLANETEK Reseller. One of the steps in the process of creating
your customers web sites is finding an affordable, inexpensive place to
host their sites. With our reseller agreement we allow you to make an
additional profit while providing your customers with a dependable server
to host their web sites. We can offer advanced custom programming and can
help when you land a large project. Our staff has knowledge of all the
cutting edge solutions. Let us make you more money by providing you with
higher margin solutions, including shockwave, Java, and Database
Integration. 

Here are two simple steps to follow so you may begin earning more money
while providing a valuable service to your customers. 

First, e-mail us at sales@planetek.com or call us at: 818-7641274 (or fax
818-7646340) for a Reseller Agreement form, so you will know the wholesale
per-months costs of hosting a web site on our servers.

Second, using our Order Form (which will be sent to you via e-mail or fax
in 24 hours), start earning commissions by registering your customers.



------------------------------

Date: Wed, 12 Mar 1997 08:31:00 -0800
From: Matt Riggsby <mriggsby@sybex.com>
Subject: Re: ISBN/Checkdigit calculator
Message-Id: <3326DA44.5C51@sybex.com>

David Syer wrote:
> 
> brian d foy wrote:
[script and ammendations snipped]
> 
> Incidentally, all the ISBN numbers on my bookshelf are 10-digits (not 11
> as specified in the original posting).  The example program posted by
> brian foy however corrected that error.

Once again, I display my inability to count.  Thanks to everybody for
the surprisingly rapid assistance.


------------------------------

Date: Wed, 12 Mar 1997 16:59:28 +0200
From: Bekman Stanislav <sbekman@iil.intel.com>
Subject: Making ror to really Rotate Right
Message-Id: <3326C4D0.41C6@iil.intel.com>

Hi,
I need to do a simple ror (Rotate Right) function
But not the way perl implement it. ror throws out the shifted bits
and I need to push them from the left side. That's why it's called
rotate and no shift. 

Is there any ready implementation.
I'm trying to do it my self

But first I'm in trouble to count the number of bits my code:
	# count the lenth of the number 
  $bits=log($sum)/log(2);                 
	# Upper rounding
  ($bits/int($bits) != 1) && ($bits=int($bits)+1);    

But sometimes this code mistakes in 1 bit ???

The function to rotate one bit right:
sub rotr(){
  local($num)=@_;
  local($left,$right);

# Handle the zero case
  ($num==0 || $num==1) && (return $num);      
                
  $left = $num << ($bits-1);    # Rotate the number to the left
  $right = $num >> 1;           # Rotate the number to the right
   
    $num = $right+$left;	# Add the 2 parts
    $num = $num & (2**$bits-1) ;# Take the original number of bits

return $num;
}

So it works for some numbers and doesn't for the other

Any ideas?
Thanks


-------------------------------------------------------------------------------
Stas Bekman 	sbekman@iil.intel.com.il  [ WebMaster at Intel Corp. ]
Address:	Aba Silver 12/29, Haifa, 32694, Israel
Phones:		[w]  972-(0)4-865-5188, [h]  972-(0)4-828-2264/3020 
Home Page:	http://techunix.technion.ac.il/~ofelix
Linux Page: 	http://www.mardanit.co.il/stas/linux.html
Linux-il Home:	http://www.linux.org.il/


------------------------------

Date: 12 Mar 1997 15:06:01 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: matching whitespace?
Message-Id: <5g6gop$1ro$5@csnews.cs.colorado.edu>

 [courtesy cc of this posting not sent to cited author via email
  because his newsreader is screwed up

In comp.lang.perl.misc, 
    astroweb@astron (alex filippenko) writes:
:i know i could look it up but i am 20min away from any perl book....sorry

It's really verging on the edge of of unacceptable behaviour to send
off a request like this.  You waste thousands of people's time 
just because you're to lazy to use the man pages or their moral
equivalents.

You're online -- hence you can look it up.  Perl is shipped with 
about 600 pages of documentation, which you can grep through.
Or you can access the web version at 
    http://www.perl.com/perl/nmanual/perl.html
    http://www.perl.com/perl/nmanual/perlre.html

:how do I match an intederminate amount of whitespace... 
:
:i thought... /' '.*/... but doesn't work.. 

That's right.  See the URLs above, or read the fine perlre manpage.

--tom
-- 
	Tom Christiansen	tchrist@jhereg.perl.com
clueless> $SOCK_STREAM = 2  
    Huh?  use Socket or die!
	    --Tom Christiansen <tchrist@mox.perl.com>


------------------------------

Date: 12 Mar 1997 16:30:54 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: matching whitespace?
Message-Id: <5g6lnu$71s$1@csnews.cs.colorado.edu>

 [courtesy cc of this posting sent to cited author via email]

In comp.lang.perl.misc, 
    Olivier Dehon <dehon_olivier@jpmorgan.com> writes:
:BTW, to match an amount of whitespce, I would use: /\s*/ or / */ to
:match only the 0x20 character

No.  That's not any amount, unless you consider not getting it to be an
amount of 0 and thus valid.  Usually you want /\s+/ instead.

--tom
-- 
	Tom Christiansen	tchrist@jhereg.perl.com

    I know it's weird, but it does make it easier to write poetry in perl.    :-)
                    --Larry Wall in <7865@jpl-devvax.JPL.NASA.GOV>


------------------------------

Date: 12 Mar 1997 16:12:05 GMT
From: gtk@walsh.med.harvard.edu (Gregory Tucker-Kellogg)
Subject: Re: On implementing tie
Message-Id: <5g6kkl$e2h@mufasa.harvard.edu>

Roderick Schertler (roderick@argon.org) wrote:
: On 10 Mar 1997 23:20:33 GMT, gtk@walsh.med.harvard.edu (Gregory Tucker-Kellogg) said:
: > 
: > I'm trying to tie a hash.  I won't bore you with the whole
: > implementation, but the parts I'm having trouble with look like this:

: Please, do your best to post self-contained code fragments.  Posting
: self contained code is more important than posting a small amount of
: code (though doing both is best).

: At the least post code which you've actually tried to run.  There are
: basic errors in the code you posted, you must not have run it.  I could
: fix the errors and then move on to trying to figure out what you're
: doing wrong, but from this end it's not an inviting task.

Sorry about that.  I realized after I posted that, since I didn't know
what the problem was, I shouldn't have excised the code the way I did.

: >     # Lots of code deleted, hauling data into a %list
: >     print $list{HEADER}[0];
: >     return bless $list,$self;

: you're trying to bless $list, but $list isn't a reference so this fails
: (even without using -w).

This was definitely the problem.  Implementing this tie has been for
me an object lesson (no pun intended) in Perl references.  I had
earlier put "$list={};", so "bless $list,$self" worked, but $list did
not refer to the %list I had created.

Thanks,

--
Gregory Tucker-Kellogg
Department of Biological Chemistry and Molecular Pharmacology
Harvard Medical School, Boston MA 02115
"Mojo Dobro"    Finger for PGP info



------------------------------

Date: Wed, 12 Mar 1997 10:01:54 -0600
From: dsmith6@sct.edu
Subject: Open file works under DOS, not under server
Message-Id: <858181778.25376@dejanews.com>

Why does the following code work fine under DOS, but doesn't appear
to work under the O'Reilly Web Server.  From the server, the file
doesn't appear to read in any data. Other CGI's seem to work OK.

#!/usr/bin/perl

$file = "ratedata/comments.txt";
$newval1 = "NULL";
$newval2 = "NULL";

open(FILE,"<" . $file);
@lines = <FILE>;
close(FILE);

$newval1 = $lines[0];
$newval2 = $lines[1];

print "Content-type: text/html \n\n";
print "Contents of ",$file,"\n";
print "Line 1:",$newval1,"\n";
print "Line 2:",$newval2,"\n";
print @lines;
exit(0);

Thanks,
David L. Smith
Tech. Info. Sp.
CDC/NCID/CISSS/TRW

-------------------==== Posted via Deja News ====-----------------------
      http://www.dejanews.com/     Search, Read, Post to Usenet


------------------------------

Date: 12 Mar 1997 16:21:57 GMT
From: nvp@shore.net (Nathan V. Patwardhan)
Subject: Re: Open file works under DOS, not under server
Message-Id: <5g6l75$n4e@fridge-nf0.shore.net>

dsmith6@sct.edu wrote:
: Why does the following code work fine under DOS, but doesn't appear
: to work under the O'Reilly Web Server.  From the server, the file
: doesn't appear to read in any data. Other CGI's seem to work OK.

: $file = "ratedata/comments.txt";

Use the absolute path to the file.  CGI doesn't know where it is.

--
Nathan V. Patwardhan
nvp@shore.net



------------------------------

Date: Wed, 12 Mar 1997 11:13:52 -0500
From: ken@forum.swarthmore.edu (Ken Williams)
Subject: Re: Perl "strict" usage
Message-Id: <ken-1203971113520001@news.swarthmore.edu>

In article <5g1pi3$55i@svna0001.clipper.ssb.com>, mattera@ssga.ssb.com
(Luigi Mattera) wrote:

> Tom Christiansen (tchrist@mox.perl.com) wrote:
> 
> : That's quite odd.  lexicals are 10% faster than globals.
> : You've done something else here.
> 
>   I was surprised by the slowdown myself.  I had timed my script for
> each execution list and it went from around 50 seconds to execute to
> around 2 minutes 20 seconds.  Does using "my" multiple times on a
> single variable cause slowdown?  I combined them all to be certain,
> but perhaps my slowdown was indicated by a poor test run of my
> program.

It's possible that your program execution time increased in real seconds,
but decreased in CPU seconds.  This could happen for many reasons, the
most common of which would be that your computer was busy doing other
things and couldn't devote as much time to your program.

To get a more accurate picture of how the program efficiency changed, use
the "time" command (if you're on a unix machine), something like this:

time my_program.pl
<your program's output>
0.003u 0.008s 0:00.01 0.0% 0+0k 0+0io 0pf+0w

-Ken Williams
 ken@forum.swarthmore.edu


------------------------------

Date: 12 Mar 1997 15:31:58 GMT
From: gt1535b@acmex.gatech.edu (The next Pele)
Subject: Re: porting script from unix to nt
Message-Id: <5g6i9e$q6r@catapult.gatech.edu>

I'm kind of doing the same thing right now - porting from UNIX system V
to Win 95.  The biggest tip I'd give is to use as few shell commands as
possible.  Chances are, your scripts already use things like ls, rm, cp
and such.  If you try to convert those to perl commands or subroutines
then you'll have scripts that will work on either platform.  Using things
like File::Copy, unlink, and readdir will help greatly.  You might even want
to make your own &ls, &rm, etc. subroutines and put them in a module.  I
have a few that I can e-mail you if you want them.  They won't do everything
that the orignals can, but you can modify them to do whatever you want.

Daryl

James A. Tucker (james@timetrend.com) wrote:
: Are they any basic tips when porting from Perl 5.003 built on BSDI to Perl
: 5.003 for NT?  How do you adjust for the difference in paths, etc. I didn't
: see any proting information in the FAQ.

: TIA

: James A. Tucker
: Internet Administrator
: Centuryinter.net - Region 1

--
<>< Daryl Bowen	<><
Georgia Institute of Technology
E-mail: gt1535b@prism.gatech.edu
Siemens Stromberg-Carlson Co-op


------------------------------

Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 8 Mar 97)
Message-Id: <null>


Administrivia:

The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc.  For subscription or unsubscription requests, send
the single line:

	subscribe perl-users
or:
	unsubscribe perl-users

to almanac@ruby.oce.orst.edu.  

To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.

To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.

To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.

The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.

The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.

For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.


------------------------------
End of Perl-Users Digest V8 Issue 101
*************************************

home help back first fref pref prev next nref lref last post