[10535] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 4127 Volume: 8

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Nov 2 04:07:33 1998

Date: Mon, 2 Nov 98 01:01:36 -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           Mon, 2 Nov 1998     Volume: 8 Number: 4127

Today's topics:
    Re: Help debugging a Perl script. [LONG] (Ronald J Kimball)
    Re: Help debugging a Perl script. (Ethan H. Poole)
    Re: How to pipe a file (Alastair)
        Interesting challenge:  Reformatting text to 80 chars. <trevorh@curtco.com>
    Re: It works , but why <gellyfish@btinternet.com>
    Re: It works , but why (Matthew Bafford)
        modification of gcos field (Barry K Freeman)
        Need help with encryption & passwords... (Mikefurr)
    Re: Need help with encryption & passwords... <Tony.Curtis+usenet@vcpc.univie.ac.at>
    Re: Not to start a language war but.. (Reimer Behrends)
    Re: parsing email address problem <gellyfish@btinternet.com>
        Passing $Variables from script to script (John Hardy)
    Re: Passing $Variables from script to script (Ethan H. Poole)
        Perl Cookbook code on web? <aravind@genome.wi.mit.edu>
    Re: Perl Cookbook code on web? (Stefaan A Eeckels)
    Re: Perl Cookbook code on web? <che@debian.org>
    Re: Perl Cookbook code on web? dturley@pobox.com
    Re: Perl, DBI and Apache <ask@netcetera.dk>
    Re: Testing Perlscript at home (Rob Watson)
        VARIABLES DE ENTORNO CGI (Nicolas Rodrmguez)
        What is gd.pm? <kris@fit2print.com>
    Re: What is gd.pm? <trevorh@curtco.com>
    Re: What is the "correct" location of perl under Solari <eashton@bbnplanet.com>
        Special: Digest Administrivia (Last modified: 12 Mar 98 (Perl-Users-Digest Admin)

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

Date: Mon, 2 Nov 1998 01:50:14 -0500
From: rjk@coos.dartmouth.edu (Ronald J Kimball)
Subject: Re: Help debugging a Perl script. [LONG]
Message-Id: <1dhua3f.13kw6us1fvqarkN@bos-ip-1-115.ziplink.net>

Kris <kris@fit2print.com> wrote:

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

Please don't send MIME-encoded messages to clpm.

> Could someone help debug a script for me.  I don't have access to a Unix
> machine in house, I use an ISP, so the only way I know if there is a
> problem with a script is the Internal Server Error message (which I have
> grown to hate).  I've attached the file, and if someone could run it
> through the debugger, I would greatly appreciate it.  Thanks.

I understand your frustration, but this does not seem to be a good
solution to your problem.  Will you post your script to clpm every time
you have an error?

I would propose a few alternative solutions:

1) Ask your ISP for the error messages generated by your script from the
server's error log.

2) use CGI::Carp qw(fatalsToBrowser);

3) Get access to a machine with Perl installed on it.  This does not
necessarily mean Unix.



These comments should by no means be considered exhaustive...

> #!/usr/bin/perl
> 
> ###################################################################
> ## HitLog Version 1.0 - Released 8/1/98                          ##
> ## ------------------------------------------------------------- ##
> ## * hlstats.pl: Hitlog statistics script file                   ##
> ## ------------------------------------------------------------- ##
> ## Copyright (C) 1998 Dimension's CGI Workshop                   ##
> ## http://www.thenetnow.com/dimension                            ##
> ## dimension@cybered.net                                         ##
> ## ------------------------------------------------------------- ##
> ## This script is freeware and may not be sold in any way.  If   ##
> ## you would like to make changes to this script, please EMail   ##
> ## me and ask for my permission before doing so.  Once recieving ##
> ## my permission, this notice must remain in place.              ##
> ###################################################################

You spelled 'receiving' wrong.  :-)

> ##################################################################
> ### *** NO VARIABLES NEED TO BE CUSTOMIZED IN THIS SCRIPT **** ###
> ##################################################################
> 
> use GD;
> 
> print "Content-type:text/html\n\n";
                     ^^^

There should be a space after the colon.  I'm afraid that mistake does
not inspire confidence.

> 
> ### PARSE FORM ###
> read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
> @pairs = split(/&/, $buffer);
> foreach $pair (@pairs)
> {
>     ($name, $value) = split(/=/, $pair);
>     $value =~ tr/+/ /;
>     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
>     $value =~ s/~!/ ~!/g;    $FORM{$name} = $value;
> }

I would recommend using the CGI module to handle this.

use CGI;

$query = new CGI;

> ### READ HIDDEN VARIABLES FROM SUBMITTED FORM ###
> $logfile = $FORM{logfile};
> $tempgif = $FORM{tempgif};
> $date = $FORM{date};
> $tgifurl = $FORM{tgifurl};
> $bargraph = $FORM{bargraph};
> ($tmonth, $tday, $tyear) = split(/\|/, $date);

$logfile = $query->param('logfile');
etc.

> print "$tempgifurl\n";

Hmm...  I don't think this will be a valid HTML document...

> ### DAYS IN EACH MONTH OF YEAR.  DETERMINE IF LEAP YEAR ###
> @daysinmonth = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
> if (($tyear / 4) eq int($tyear / 4)) { $daysinmonth[2] = 29; }

Your check for leap years is not technically correct.

You're using string comparison on numbers.

But, you should use modulus instead of dividing and comparing anyway.

if ((not $tyear % 4) and ($tyear % 100 or not $tyear % 400)) {
  $daysinmonth[2] = 29;
}

> ### DETERMINE TODAY'S DATE & TIME
> @normal = ("0","31","28","31","30","31","30","31","31","30","31","30","31");
> @leap = ("0","31","29","31","30","31","30","31","31","30","31","30","31");

Just how many of these 'days in month' arrays do you need, anyway?

> ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
> if ($sec < 10) { $sec = "0$sec"; }
> if ($min < 10) { $min = "0$min"; }

$sec = sprintf "%02d", $sec;
$min = sprintf "%02d", $min;

> $mon++;

First you add one to the month...

> @months = (January, February, March, April, May, June,
>            July, August, September, October, November, December);

Those are unquoted literal strings.  Tsk tsk.

@months = qw(January February March April May June
             July August September October November December);

> $month = $months[$mon - 1];

 ...And then you subtract one from the month.  Make up your mind.

By the way, in your @daysinmonth array January is 1, but in your @months
array, January is 0.  That's likely to cause confusion later on.

> if ($year <= 97) { $yr = "20$year"; }
> if ($year >= 98) { $yr = "19$year"; }

Bzzzzt!   Instead of avoiding a Y2K problem, you have created one.  RTFM
on localtime, please.

The value of $year is year - 1900, not year % 100.

Thus, in 2000, you will have set $yr to be "19100".

As it happens, you never actually use $yr in the script anyway, using
$year instead.

$year += 1900;

> $ampm = "A.M.";
> $hr = $hour;
> if ($hour >= 12) { $hr = $hour - 12; $ampm = "P.M."; }

When using AM/PM notation, noon and midnight are usually written as 12pm
and 12am instead of 0pm and 0am, but, okay.

Oh, not that you actually use $hr anywhere in the script.
(See above, for $yr.)

> 
> ### OPEN & READ LOG FILE ###
> open(FILE, "$logfile");

Always check the return value of open.

open(FILE, $logfile) or die "Could not open $logfile: $!\n";

> @infile = <FILE>;

If you change that to

chomp(@infile = <FILE>);

then you'll save some work later on.

> close(FILE);


> ### DETERMINE IF THE USER SELECTED TO MAKE A GRAPH OR VIEW A CHART OF HITS ###
> foreach $key (keys(%FORM))
> {   
>   chop($key);
>   $c = chop($key);
>   if ($c eq '.') { $q = $key; }
> }

That looks rather odd.  What exactly are you trying to accomplish?
Whatever it is, there are undoubtedly much better ways to do it.

> if ($q eq "Today" || $q eq "Yesterday" || $q eq "Specific" ||
>     $q eq "24hours" || $q eq "7days" || $q eq "60minutes" ||
>     $q eq "2dates" || $q eq "sphits") { $option = "chart"; }
> elsif ($q eq "10days" || $q eq "20days" || $q eq "50days" ||
>     $q eq "100days" || $q eq "hour" || $q eq "dayofweek") {
>   $option = "graph"; }
> else { $option = "bars"; }
> 
> print "<html><head><title>HitLog 1.0 - Statistics</title>
>        </head><body bgcolor=black text=white link=yellow
>        vlink=yellow alink=cyan>\n";
> print "<center><table width=620 border=0 bgcolor=black><tr>
>        <td bgcolor=black width=100%>\n";
> print "<center><font color=cyan size=6 face=\"arial\">
>        <b>HitLog 1.0 Statistics</b></font><br>\n";
> print "<font color=white size=4 face=\"arial\"><b>\n";

I had to rewrap these lines so that I could post this reply.  Try to
keep your lines of code within a reasonable length.

Even better, use here-docs instead of multiple print statements.

print <<EOHTML;
<html>
<head>
<title>HitLog 1.0 - Statistics</title>
</head>
<body bgcolor=black text=white link=yellow vlink=yellow alink=cyan>
<center>
<table width=620 border=0 bgcolor=black>
<tr><td bgcolor=black width=100%>
<center>
<font color=cyan size=6 face="arial">
<b>HitLog 1.0 Statistics</b>
</font><br>
<font color=white size=4 face="arial">
<b>
EOHTML

> ### IF CHART ###
> if ($option eq "chart") {
>   $credit = 0;
>   $bad = "yes";
>   if ($q eq "Today") {
>     $bad = "no";

Wouldn't it make more sense to use actual true and false values rather
than "yes" and "no"?

$bad = 1;
$bad = 0;

>     $styear = $year;
>     $stmonth = $mon;
>     $stday = $mday;
>     $sthour = 0;
>     $stminute = 0;
>     $endyear = $year;
>     $endmonth = $mon;
>     $endday = $mday;
>     $endhour = 24;
>     $endminute = 00;  
>     print "Today's Hits\n";
>   }
>   elsif ($q eq "Yesterday")
>   {
>     $bad = "no";
>     $stday = $mday - 1;
>     $styear = $year;
>     $stmonth = $mon;
>     $sthour = 0;
>     $stminute = 0;
>     $endyear = $year;
>     $endmonth = $mon;
>     $endday = $mday;
>     $endhour = 0;
>     $endminute = 0; 
>     if ($stday eq 0) {
>       $stmonth--;
>       if ($stmonth eq 0) {
>         $styear--;
>         $stmonth=12;
>       }
>       $stday = $daysinmonth[$stmonth];
>     }

You're using string comparison to compare numbers again.
You want == to test the equality of numbers.

>     print "Yesterday's Hits\n";
>   }
>   elsif ($q eq "Specific")
>   {
>     if ($FORM{spmonth} >= 1 && $FORM{spmonth} <= 12 &&
>         $FORM{spday} >= 1 && $FORM{spday} <= $daysinmonth[$FORM{spmonth}] &&
>         $FORM{spyear} < 100 & $FORM{spyear} >= 0) {
>       $bad = "no";
>       while (length($FORM{spday}) > 2) { chop($FORM{spday}); }
>       while (length($FORM{spyear}) > 2) { chop($FORM{spyear}); }

That's a rather silly way to truncate a string.

substr($FORM{spday}, 2) = '';

>       $yy = $FORM{spyear};
>       if ($yy >= 98) { $yy = "19$yy"; }
>       else { $yy = "20$yy"; }

I hope you know what you're doing here...

>       print "Hits for $months[$FORM{spmonth}-1] $FORM{spday}, $yy\n";
>       $stday=$endday=$FORM{spday};
>       $stmonth=$endmonth=$FORM{spmonth};
>       $styear=$endyear=$FORM{spyear};
>       $sthour=0; $stminute=0;
>       $endhour=24; $endminute=00;
>     }
>     else { print "Bad Data"; }
>   }
>   elsif ($q eq "24hours")
>   {
>     $bad = "no";
>     $stday = $mday - 1;
>     $styear = $year;
>     $stmonth = $mon;
>     $sthour = $hour;
>     $stminute = $min;
>     $endyear = $year;
>     $endmonth = $mon;
>     $endday = $mday;
>     $endhour = $hour;
>     $endminute = $min;  
>     if ($stday eq 0) {
>       $stmonth--;
>       if ($stmonth eq 0) {
>         $styear--;
>         $stmonth=12;
>       }
>       $stday = $daysinmonth[$stmonth];
>     }
>     print "Hits within last 24 hours\n";
>   }
>   elsif ($q eq "7days")
>   {
>     $bad = "no";
>     $stday = $mday;
>     $styear = $year;
>     $stmonth = $mon;
>     $sthour = 0;
>     $stminute = 0;
>     $endyear = $year;
>     $endmonth = $mon;
>     $endday = $mday;
>     $endhour = 24;
>     $endminute = 0;
>     for ($x=7; $x>=1; $x--) {
>       $stday--;
>       if ($stday eq 0) {
>         $stmonth--;
>         if ($stmonth eq 0) {
>           $styear--;
>           $stmonth=12;
>         }
>         $stday = $daysinmonth[$stmonth];
>       }
>     }
>     print "Hits within last 7 days\n";
>   }
>   elsif ($q eq "60minutes")
>   {
>     $bad = "no";
>     $stday = $mday;
>     $styear = $year;
>     $stmonth = $mon;
>     $sthour = $hour - 1;
>     $stminute = $min;
>     $endyear = $year;
>     $endmonth = $mon;
>     $endday = $mday;
>     $endhour = $hour;
>     $endminute = $min;  
>     if ($hour < 0) {
>       $stday--;
>       if ($stday eq 0) {
>         $stmonth--;
>         if ($stmonth eq 0) {
>           $styear--;
>           $stmonth=12;
>         }
>         $stday = $daysinmonth[$stmonth];
>       }
>       $hour = 23;
>     }
>     print "Hits within last 60 minutes\n";
>   }
>   elsif ($q eq "2dates")
>   {
>     if ($FORM{bmonth} >= 1 && $FORM{bmonth} <= 12 && $FORM{bday} >= 1 &&
>         $FORM{bday} <= $daysinmonth[$FORM{bmonth}] && $FORM{byear} < 100 &
>         $FORM{byear} >= 0 && $FORM{emonth} >= 1 && $FORM{emonth} <= 12 &&
>         $FORM{eday} >= 1 &&
>         $FORM{eday} <= $daysinmonth[$FORM{emonth}] && $FORM{eyear} < 100 &
>         $FORM{eyear} >= 0) {

[rewrapped, of course]

I don't think you want bitwise-and (i.e. &) in that conditional...

>       $bad="no";
>       while (length($FORM{spday}) > 2) { chop($FORM{spday}); }
>       while (length($FORM{spyear}) > 2) { chop($FORM{spyear}); }

There's that silly string truncation again.

>       $yy = $FORM{byear};
>       if ($yy >= 98) { $yy = "19$yy"; }
>       else { $yy = "20$yy"; }
>       $zz = $FORM{eyear};
>       if ($zz >= 98) { $zz = "19$zz"; }
>       else { $zz = "20$zz"; }

And I hope you know what you're doing here too.
(What if someone enters, say, '1999' as the year?

>       $stday = $FORM{bday};
>       $stmonth = $FORM{bmonth};
>       $styear = $FORM{byear};
>       $endday = $FORM{eday};
>       $endmonth = $FORM{emonth};
>       $endyear = $FORM{eyear};
>       $sthour = 0; $stminute = 0;
>       $endhour = 24; $endminute = 0;
>     }
> 
>     print "Hits between $months[$FORM{bmonth}-1] $FORM{bday},
>            $yy and $months[$FORM{emonth}-1] $FORM{eday}, $zz\n";
>   }
>   elsif ($q eq "sphits")
>   {
>     $bad = "no";
>     $credit = $FORM{lhits};
>     print "Last $FORM{lhits} hits\n";
>   }
>   print "</b></font></center><hr size=5>\n";
> 
> 
> ### GENERATE CHART HERE ###
> if ($bad eq "no") {
>   $count = 0;
>   $combstartdate = ($styear * 100000000) + ($stmonth * 1000000) +
>                    ($stday * 10000) + ($sthour * 100) + $endminute;
>   $combenddate = ($endyear * 100000000) + ($endmonth * 1000000) +
>                  ($endday * 10000) + ($endhour * 100) + $endminute;

$combstartdate = sprintf
                   "%d%02d%02d%02d%02d",
                   $styear, $stmonth, $stday, $sthour, $endminute;

By the way, shouldn't that be $stminute?

$combenddate = sprintf
                   "%d%02d%02d%02d%02d",
                   $endyear, $endmonth, $endday, $endhour, $endminute;

>   print "<table border=0>\n";
>   $cnt=0;
>   foreach $lineofdata (@infile)
>   {
>     $cnt++;
>   }

That's a pretty silly way to count the number of elements in @infile.
$cnt = @infile;

>   for ($x = $cnt; $x>=1; $x--) {

Especially when you're just using it once anyway.

for ($x = @infile; $x > 0; $x--) {

>     $lineofdata = $infile[$x];
>     ($mon,$mday,$year,$hour,$min,$sec,$documenturi,$remoteaddr,
>      $httpreferer,$remotehost) = split(/\|/, $lineofdata);

Any reason for the $lineofdata variable?

($mon,$mday,$year,$hour,$min,$sec,$documenturi,$remoteaddr,
 $httpreferer, $remotehost) = split(/\|/, $infile[$x]);

By the way, I hope you're aware that you're clobbering the values of the
date variables you used above.  As long as that's what you meant to do,
okay.

>     $httprefererlink = $httpreferer;
>     chop($remotehost);

Use chomp() instead of chop(), it's safer.

>     $onoff = "off";
>     while (length($httprefererlink) >= 60)
>     { chop($httprefererlink); $onoff = "on";}

Once again, what's wrong with actual true and false values?

And there's that silly way to truncate a variable again.

>     if ($onoff eq "on") { $httprefererlink = "$httprefererlink..."; }

if (length $httprefererlink > 59) {
  substr($httprefererlink, 59) = '...';
}

>     $recorddate = ($year * 100000000) + ($mon * 1000000) +
>                   ($mday * 10000) + ($hour * 100) + $min;

$recorddate = sprintf "%d%02d%02d%02d%02d",
                      $year, $mon, $mday, $hour, $min;

>     if ($x eq $cnt && $credit > 0) { $i = "bad"; }

==, not eq.  :-(

> 
>     if (($recorddate <= $combenddate && $recorddate >= $combstartdate) &&
>         $q ne "sphits") {
>       $count++;
>       $color="000088";
>       if (($count/2) eq int($count/2)) { $color="006666"; }

if (not $count % 2) {

*or*

if (not $count & 1) {

>       print "<tr><td bgcolor=black valign=top align=right>$count)</td>
>              <td bgcolor=#$color>\n";
>       if ($year < 98) { $year = "20$year"; }
>         else { $year = "19$year"; }

See above.

>       $ampm = "PM";
>       if ($hour < 12) { $ampm = "AM"; }

Before you used "P.M." and "A.M.", with periods.  Consistency is
important.

Oh, but you never actually use the value of $ampm that you set at the
beginning of the script anyway.
(See above for $yr and $hr.)

>         else { $hour = $hour - 12; }
>       if ($hour eq 0) { $hour = 12; }

Ah, you did remember noon and midnight this time, anyway.

>       print "On $months[$mon-1] $mday, $year at $hour:$min $ampm,
>              a visitor from $remotehost ($remoteaddr)\n";
>       print "visited <b><font color=#40FF40><i>$documenturi</i></font></b>.\n";
>       if ($httpreferer ne "") {
>           print "The visitor arrived from
>                  <a href=\"$httpreferer\">$httprefererlink</a>.\n";
>       }
>       else { print "The visitor arrived without a referring URL.\n"; }
>       print "</td></tr>\n";
>     }
>     elsif ($q eq "sphits" && $credit >= 1) {
>       if ($x ne $cnt) {

!=, not ne.  (See above for == and eq.)

>         $credit--;
>         $count++;
>         $color="000088";
>         if (($count/2) eq int($count/2)) { $color="006666"; }

See above.

>         print "<tr><td bgcolor=black valign=top
>                align=right>$count)</td><td bgcolor=#$color>\n";
>         if ($year < 98) { $year = "20$year"; }
>           else { $year = "19$year"; }

See above.

>         $ampm = "PM";
>         if ($hour < 12) { $ampm = "AM"; }
>           else { $hour = $hour - 12; }
>         if ($hour eq 0) { $hour = 12; }

See above.

>         print "On $months[$mon-1] $mday, $year at $hour:$min $ampm,
>                a visitor from $remotehost ($remoteaddr)\n";
>         print "visited <b><font color=#40FF40><i>$documenturi</i></font></b>.\n";
>         if ($httpreferer ne "") {
>             print "The visitor arrived from
>                    <a href=\"$httpreferer\">$httprefererlink</a>.\n";
>         }
>         else { print "The visitor arrived without a referring URL.\n"; }
>         print "</td></tr>\n";
>       }
>     }
>   }
>   if ($count eq 0) {
>     print "There were no hits within the selected time period.\n";
>    }

See above.

>   print "</table>\n";
> }
> else {
>   print "<font color=white size=2 face=\"arial\">
>          <b>Sorry, you did not enter valid information.
>          Please click the back button, recheck your information,
>          and retry.</b></font>\n";

But don't tell the use why the information entered was not valid.

> }
> }

That suggests poor indenting...

> ### END CHART GENERATION ###
> 
> 
> ### IF GRAPH ###
> elsif ($option eq "graph") {
> 
>   if ($q eq "10days") {
>     $numdata = 10;
>     $type = "lastxdays";
>   }
>   if ($q eq "20days") {
>     $numdata = 20;
>     $type = "lastxdays";
>   }
>   if ($q eq "50days") {
>     $numdata = 50;
>     $type = "lastxdays";
>   }
>   if ($q eq "100days") {
>     $numdata = 100;
>     $type = "lastxdays";
>   }
> 
>   if ($type eq "lastxdays") {
>     $title = "Hits: Last $numdata Days";
>     $stday = $mday;
>     $styear = $year;
>     $stmonth = $mon;
>     $combenddate = $styear * 10000 + $stmonth * 100 + $stday;

$combenddate = sprint "%d%02d%02d", $styear, $stmonth, $stday;

>     $xlabels[$numdata] = "$stmonth/$stday";
>     for ($x=($numdata-1); $x>=1; $x--) {
>       $stday--;
>       if ($stday eq 0) {
>         $stmonth--;
>         if ($stmonth eq 0) {
>           $styear--;
>           $stmonth=12;
>         }
>         $stday = $daysinmonth[$stmonth];

Note that if you ever allow a graph of the past ~365 days, @daysinmonth
will contain the number of days in February for the current year, not
the previous year.

>       }
>       $xlabels[$x] = "$stmonth/$stday";
>     }
>     $combstartdate = $styear * 10000 + $stmonth * 100 + $stday;

See above.

>     print "Hits: Last $numdata Days\n";
> 
>   }
> 
>   if ($q eq "hour") {
>     $title = "Average hits by hour";
>     $numdata = 23;
>     for ($x = 0; $x <= 23; $x++) {
>       if ($x eq 0) { $xlabels[$x+1] = "12 AM"; }

See above.

>       elsif ($x <= 11) { $xlabels[$x+1] = " $x "; }
>       if ($x eq 12) { $xlabels[$x+1] = "12 PM"; }     
>       elsif ($x >= 13) { $y = $x - 12; $xlabels[$x+1] = " $y "; }
>     }
>     $days = 0;
>     foreach $lineofdata (@infile)
>     {
>       ($mon,$mday,$year,$hour,$min,$sec,$documenturi,$remoteaddr,
>        $httpreferer,$remotehost) = split(/\|/, $lineofdata);
>       if ($mday ne $lastday) { $days++; $lastday = $mday; }

See above.

>       $xvalues[$hour+1]++;
>     }
>     for ($x=1; $x<=24; $x++) {
>       $xvalues[$x] = $xvalues[$x] / $days;
>     }

Before you iterated from 0 to 23.  Here you iterate from 1 to 24.  Just
want to make sure that's what you intended.

>     print "Average hits by hour\n";
>     print "</b></font></center><hr size=5>\n";
>     $count = 0;
>   }
> 
>   if ($q eq "dayofweek") {
>     $title = "Avg. hits by day of week";
>     $numdata = 7;
>     @xlabels = ("", "Sun.", "Mon.", "Tues.", "Wed.", "Thurs.", "Fri.", "Sat.");
>     $low = 1000000;
>     foreach $lineofdata (@infile)
>     {
>       ($mon,$mday,$year,$hour,$min,$sec,$documenturi,$remoteaddr,
>        $httpreferer,$remotehost) = split(/\|/, $lineofdata);
>       $comb = $year * 10000 + $mon * 100 + $mday;

See above.

>       if ($comb < $low && $mday ne "") { $low = $comb; }
>       if ($comb > $high && $mday ne "") { $high = $comb; }
>       if ($year <= 94) { $year = "20$year"; }
>       else { $year = "19$year"; }

See above.

>       if ($done{$mon/$mday/$year} ne "yes") {
>         $done{$mon/$mday/$year} = "yes";

I don't think that does what you think it does...

(Hint: division.)

>         $m = $mon;
>         $d = $mday;
>         $y = $year;

>         $leapyear = "no";

See above.

>         if (($y/4) eq int($y/4)) {
>           if ((($y/100) ne int($y/100)) || (($y/400) eq int($y/400)))
>           {
>             $leapyear = "yes";
>           }
>         }

See above.  But least you got check for leap year right this time.

>         for ($x = 1; $x < $m; $x++) {
>           if ($leapyear eq "yes") { $d = $d + $leap[$x]; }
>           else { $d = $d + $normal[$x]; }
>         }
>         while ($d > 7) { $d = $d - 7; }

$d %= 7;
$d = 7 if $d == 0;

>         $count = 0;
>         for ($x = 1995; $x < $y; $x++) {

Why do you start at 1995, exactly?

>           if (($x/4) eq int($x/4) && (($x/100) ne int($x/100) ||
>                    ($x/400) eq int($x/400))) {

See above.

You know, if you're going to do this leap year check so many times, one
would think you'd have made a subroutine to do it, instead of repeating
the same code over and over.

>             $count = $count+2;

$count += 2;

>           }
>           else { $count++; }
>         }
>         $d = $count + $d;

$d += $count;

>         while ($d > 7) { $d = $d - 7; } 

See above.

>         $dd{$mon/$mday/$year} = $d;
>       }
>       else { $d = $dd{$mon/$mday/$year}; }

See above.

>       $xvalues[$d]++;
>     }
>     $difference = 0;
> 
>     $styear = int($low/10000);
>     $stmonth = int(($low - ($styear*10000))/100);
>     $stday = int($low - ($styear*10000) - ($stmonth*100));
> 
>     while ($newcomb <= $high) {
>       $stday++;
>       if ($stday > $daysinmonth[$stmonth]) {
>         $stmonth++;
>         if ($stmonth eq 13) {
>           $styear++;
>           $stmonth=1;
>         }
>         $stday = 1;
>       }
>       $difference++;
>       $newcomb = $styear*10000 + $stmonth*100 + $stday;

See above.

>     }
>     $count = 1;
>     while ($difference > 7) { $count++; $difference = $difference - 7; }

$count = int(($difference+6)/7) || 1;
$difference %= 7;
$difference = 7 if $difference == 0;

:-)

>     for ($x=1; $x<=7; $x++) {
>       $xvalues[$x] = $xvalues[$x] / $count;
>     }
>     print "Average hits by day of week\n";
>     print "</b></font></center><hr size=5>\n";
>   }
> 
>   if ($type eq "lastxdays") {
>     print "</b></font></center><hr size=5>\n";
>     $count = 0;
>     $value = 0;
>     foreach $lineofdata (@infile)
>     {
>       ($mon,$mday,$year,$hour,$min,$sec,$documenturi,$remoteaddr,
>        $httpreferer,$remotehost) = split(/\|/, $lineofdata);
>       $recorddate = $year * 10000 + $mon * 100 + $mday;

See above.

>       if ($recorddate >= $combstartdate && $recorddate <= $combenddate)
>       {
>         for ($x = 1; $x <= $numdata; $x++) {
>           if ($xlabels[$x] eq "$mon/$mday") { $numb = $x; } }
>         $count++;
>         $xvalues[$numb]++;
>       }
>     }
>   }
> 
>   $miny = 1000000; $maxy=0;
>   for ($x = 1; $x <= $numdata; $x++)
>   {
>     if ($xvalues[$x] eq "") { $xvalues[$x] = 0; }
>     if ($xvalues[$x] > $maxy) { $maxy = $xvalues[$x]; }
>     if ($xvalues[$x] < $miny) { $miny = $xvalues[$x]; }
>   }
>   if ($miny eq 1000000) { $miny = 0; $maxy=10; }
>   if ($maxy eq 0) { $maxy = 10; $miny=0; }
> 
> 
> 
> ### !!! GRAPH CREATOR !!! ###      
>   $maxy++;
>   if ($miny ne int($miny)) { $miny = int($miny); }
>   $labelinterval=int($numdata/8+.5);
>   $yinterval=int(($maxy-$miny)/12+.5);
>   $im = new GD::Image(440,250);
> 
>         # allocate some colors
>         $white = $im->colorAllocate(255,255,255);
>   $gray = $im->colorAllocate(127,127,127);
>   $dkgray = $im->colorAllocate(64,64,64);
>   $green = $im->colorAllocate(0,255,0);
>         $black = $im->colorAllocate(0,0,0);       
>         $red = $im->colorAllocate(255,0,0);      
>         $blue = $im->colorAllocate(0,0,255);
>   $cyan = $im->colorAllocate(0,255,255);
> 
>         # make the background transparent and interlaced
>         $im->interlaced('true');
>   $im->fill(50,50,$black);
>         $im->rectangle(0,0,439,249,$white);
>   $im->string(gdMediumBoldFont, 5, 5, "$title", $green);
>   $im->string(gdSmallFont, 214, 7,
>               "HitLog 1.0 - Dimension's CGI Workshop", $cyan);
>   $im->line(1,20,439,20,$white);
>   $im->line(40,232,438,232,$gray);

Consistent indenting, please.

>   $step = int(400/$numdata);
>   for ($x = 40; $x<=439; $x=$x+$step) {
>     if ($x >= 40 && $x < 439) {
>       $im->line($x,230,$x,234,$gray);
>     }
>   }
> 
>   $count = $miny;
> 
>   if ($yinterval eq 0) { $yinterval = 1; }

See above.

>   $sub = int(204/(($maxy-$miny)/$yinterval)+.5);
>   for ($y = 226; $y >= 21; $y=$y-$sub) {
>     $l = length("$count");
>     if ($y >= 26) { $im->string(gdSmallFont, 37-(6*$l), $y, "$count", $white); }
>     if ($y < 222 && $y > 25) { $im->line(40,$y+6,438,$y+6,$dkgray); }
>     $count = $count + $yinterval;
>   }
>   $labelnum = 1;
>   for ($x = 40; $x <=438; $x=$x+($step*$labelinterval)) {
>     while (length("$xlabels[$labelnum]") > 6) { chop($xlabels[$labelnum]); }

See above.

>     $l = length("$xlabels[$labelnum]");
>     $l = int(($l*6)/2);
>     if ($x + $l < 437) { $im->string(gdSmallFont, $x-$l+1, 235,
>                                      "$xlabels[$labelnum]", $white); }
>     $labelnum=$labelnum+$labelinterval;
>   }
> 
> 
>   $count = 1;
>   for ($x = 40; $x<=438; $x=$x+int(400/$numdata)) {
> 
>     $y = $xvalues[$count] - $miny;
>     $y = 232 - ($y * ($sub / $yinterval));
>     if ($count ne 1) { $im->line($oldx, $oldy, $x, $y, $white); }

See above.

>     $oldx = $x; $oldy = $y;
>     $count++;
>   }
>   open (FILE, ">$tempgif");

See above.

>         print FILE $im->gif;
>   close (FILE);
> 
>   print "<center><img src=\"$tgifurl\"></center>\n";
> }
> 
> elsif ($option eq "bars") {
>   if ($q eq "domains") {
>     print "Domains of Referring URLs\n";
>     $thisaddr = $ENV{HTTP_HOST};

>     $len = length($thisaddr);
>     for ($x = 1; $x <= $len; $x++) {
>       $c = chop($thisaddr);
>       $backwords = "$backwords" . "$c";
>     }

That's a rather silly way to reverse a string.

$backwards = reverse $thisaddr;  # note spelling of 'backwards' :-)

>     ($one,$two,$a) = split(/\./, $backwords);
>     $backwords = "$one" . "." . "$two";

>     $len = length($backwords);
>     $forwards = "";
>     for ($x = 1; $x <= $len; $x++) {
>       $c = chop($backwords);
>       $forwards = "$forwards" . "$c";
>     }

That's still a rather silly way to reverse a string.

>     $thisaddr=$forwards;

Er...  All that trouble just to get the last two pieces of $thisaddr?
That's extremely silly.

$thisaddr = join '.', (split /\./, $thisaddr)[-2,-1];

>     foreach $lineofdata (@infile)
>     {
>       ($mon,$mday,$year,$hour,$min,$sec,$documenturi,$remoteaddr,
>        $httpreferer,$remotehost) = split(/\|/, $lineofdata);
>       $backwords = "";
>       ($a, $a, $httpreferer, $a) = split(/\//, $httpreferer);

>       $len = length($httpreferer);
>       for ($x = 1; $x <= $len; $x++) {
>         $c = chop($httpreferer);
>         $backwords = "$backwords" . "$c";
>       }
>       ($one,$two,$a) = split(/\./, $backwords);
>       $backwords = "$one" . "." . "$two";
>       $len = length($backwords);
>       $forwards = "";
>       for ($x = 1; $x <= $len; $x++) {
>         $c = chop($backwords);
>         $forwards = "$forwards" . "$c";
>       }

See above x 3.

> 
>       if ($forwards ne "." && $forwards ne "$thisaddr") { $labels{$forwards}++; }
>     }
>   }
>   elsif ($q eq "localdocumenthits") {
>     print "Local Document Hits\n";
>     foreach $lineofdata (@infile)
>     {
>       ($mon,$mday,$year,$hour,$min,$sec,$documenturi,$remoteaddr,
>        $httpreferer,$remotehost) = split(/\|/, $lineofdata);
>       $labels{$documenturi}++;
>     }
>   }
>   elsif ($q eq "address") {
>     print "First Level Domains of Visitors\n";
>     foreach $lineofdata (@infile)
>     {
>       ($mon,$mday,$year,$hour,$min,$sec,$documenturi,$remoteaddr,
>        $httpreferer,$remotehost) = split(/\|/, $lineofdata);

>       chop($remotehost);

See above.  (This chop is unnecessary if you chomp(@infile) at the
beginning.)

>       $chp = chop($remotehost);
>       $remotehost = "$remotehost" . "$chp";

That's a silly way to get the last character in a string.

$chp = substr($remotehost, -1);

>       if ($chp eq "0" || $chp eq "1" || $chp eq "2" || $chp eq "3" ||
>           $chp eq "4" || $chp eq "5" || $chp eq "6" || $chp eq "7" ||
>           $chp eq "8" || $chp eq "9") {

That's a rather silly way to see if the last character in a string is a
digit.

if ($remotehost =~ /\d$/) {

>         $labels{'IP Address Only'}++;
>       }
>       else {

>         $backwords = "";
>         $len = length($remotehost);
>         for ($x = 1; $x <= $len; $x++) {
>           $c = chop($remotehost);
>           $backwords = "$backwords" . "$c";
>         }
>         ($one,$two,$a) = split(/\./, $backwords);
>         $backwords = "$one" . "." . "$two";
>         $len = length($backwords);
>         $forwards = "";
>         for ($x = 1; $x <= $len; $x++) {
>           $c = chop($backwords);
>           $forwards = "$forwards" . "$c";
>         }

See above x 3.

>         $labels{$forwards}++;
>       }
>     }
>   }
> 
>   print "</b></font></center><hr size=5>\n";
> 
>   $count=0;
>   $totalvalue=0;
> 
>   foreach $key (keys(%labels)) {
>     $count++;
>     $label[$count]=$key;
>     $value[$count]=$labels{$key};

>     $totalvalue=$totalvalue+$labels{$key};

$totalvalue += $labels{$key};

>   }
> 
>   for ($i = 1; $i <= ($count-1); $i++) {
>     for ($j = 1; $j <= ($count - %i); $j++) {

I don't think you meant to subtract %i there...

>       if ($value[$j] < $value[$j+1]) {
>         $temp = $value[$j+1];
>         $value[$j+1] = $value[$j];
>         $value[$j] = $temp;

($value[$j+1], $value[$j]) = ($value[$j], $value[$j+1]);

>         $temp = $label[$j+1];
>         $label[$j+1] = $label[$j];
>         $label[$j] = $temp;

See above.

>       }
>     }
>   }

Are you trying to sort the arrays there?  There is an easier way to do
it...

(Hint: sort)

>   print "<table width=100% border=0 cellspacing=0 cellpadding=0>\n";
>   for ($x = 1; $x <= $count; $x++) {
>     print "<tr><td align=right bgcolor=black><font color=white size=2
>     face=\"arial\">$label[$x]&nbsp;</font></td><td align=right width=100>
>     <font color=cyan size=2 face=\"arial\">$value[$x] (",
>     int($value[$x]/$totalvalue*1000)/10,"%)&nbsp;</font></td>
>     <td bgcolor=black align=left width=350><img src=\"$bargraph\" width=",
>     int(($value[$x]/$totalvalue)*350)," height=12></td></tr>\n";

See above.

>   }
> 
>   print "</table>\n";
>   
> }  
> 
> print "<hr size=5></td></tr></table></center><center>
                                      ^^^^^^^^^^^^^^^^^

That just seems silly.

>        <font color=white size=2 face=\"arial\">Copyright (C) 1998
>        <a href=\"http://www.thenetnow.com/dimension/\">Dimension's CGI
>         Workshop</a>, all rights reserved.</center></body></html>\n";

See above.  :-)

-- 
 _ / '  _      /         - aka -         rjk@coos.dartmouth.edu
( /)//)//)(//)/(     Ronald J Kimball      chipmunk@m-net.arbornet.org
    /                                  http://www.ziplink.net/~rjk/
        "It's funny 'cause it's true ... and vice versa."


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

Date: Mon, 02 Nov 1998 05:21:44 GMT
From: ehpoole@ingress.com (Ethan H. Poole)
Subject: Re: Help debugging a Perl script.
Message-Id: <Ijb%1.3894$Qf3.8926@news9.ispnews.com>

[Posted and Emailed]  In article <36146DBF.5C1B7858@fit2print.com>, 
kris@fit2print.com says...
>
>This is a multi-part message in MIME format.
>--------------BFFF15C96A99830121C88203
>Content-Type: text/plain; charset=us-ascii
>Content-Transfer-Encoding: 7bit
>
>Could someone help debug a script for me.  I don't have access to a Unix
>machine in house, I use an ISP, so the only way I know if there is a
>problem with a script is the Internal Server Error message (which I have
>grown to hate).  I've attached the file, and if someone could run it
>through the debugger, I would greatly appreciate it.  Thanks.
>
>print "Content-type:text/html\n\n";

Without looking beyond the second line of actual code...

There should be a space between "Content-type" and "text/html":

  print "Content-type: text/html\n\n";

There may or may not be additional problems, I didn't look any further into 
the script.

-- 
Ethan H. Poole              | Website Design and Hosting,
                            | CGI Programming (Perl & C)..
========Personal=========== | ============================
* ehpoole @ ingress . com * | --Interact2Day--
                            | http://www.interact2day.com/



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

Date: Sun, 01 Nov 1998 20:19:37 GMT
From: alastair@calliope.demon.co.uk (Alastair)
Subject: Re: How to pipe a file
Message-Id: <slrn73pggl.vc.alastair@calliope.demon.co.uk>

anonymous <anonymous@nouce.net> wrote:
>Hello,
>   I was wondering if anyone can help me write a perl script that can
>do the following:
>   Lets say a file is in the following directory http://www.2123.com/
>~username/test/. Now after 7 days I want this file to be moved automat-
>ically to a new directory(http://www.2123.com/~username/test/archives
>and after 30 days I want this file to be deleted automatically.

If you're using unix, look into using 'cron' to schedule this.

-- 

Alastair
work  : alastair@psoft.co.uk
home  : alastair@calliope.demon.co.uk


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

Date: Mon, 02 Nov 1998 08:06:52 +0000
From: Trevor Hilaiel <trevorh@curtco.com>
Subject: Interesting challenge:  Reformatting text to 80 chars.
Message-Id: <363D681C.80564F43@curtco.com>

Hello,

	I use vim-5.3 and was trying to figure out how to reformat my text to 80
characters after performing a bunch of edits.  basically breaking lines longer
than 80 and combining  lines shorter than 80..  I'm sure there's a built in
option that would allow me to do this without any external filter, but I figured
it would be an interesting challenge.   GNU indent exists for pretty printing C
text, and because this is such a (relatively) simple task, I imagine there are
robust tools already in existence..  But why use something preexisting when you
can reinvent the wheel? ;)

	So appended to the bottom of this message is what I came up with.  I'm using
negative lookbehind (5.005) and it might be a touch obfuscated, but I can't
imagine that this is a very efficient way to do this.  five seperate regex's
seems like an overkill.  I imagine that this is a relatively common problem, and
wanted to see if you folks had a more elegant solution..  (I've been staring at
it too long to be of any use)

Thanks,

Trevor Hilaiel

(off-topic) If there is a pre-existing tool to accomplish this (embeded in vim
or not), and you've got a free second, please drop me a line..  

--

#!/usr/bin/perl -w

require 5.005; # negative lookbehind.  Thanks, larry.

# a stream filter which reformats input to 80 chars wide, wrapping and 
# hypenating when appropriate  
#
# Usage: $0 <max columns>
#
# TODO:  Account for Tabs (indented paragraphs...  A backref that 
# counts the number of chars in \2 & multiplies by 8?  Can't effectivly 
# embed perl logic in a regex :(

$cols = ( defined($ARGV[0]) ? $ARGV[0] : 80 );
$hypenlim = $cols - 1;

$/ = undef;
my $content = <STDIN>;

$content =~ s/\\\n/\\ \n/g; #eliminate naturally occuring escaped newlines
$content =~ s/^\s*\n/\\\n/; #allow one line of leading whitespace to persist
$content =~ s/ *\n(?<!\\)([\r\t\f\ ]*\n)? */(defined($1) ? "\\\n" : ' ') /ge;
     #escape double returns and eat all unescaped newlines


$content =~ s{\G(\\\n)? # skip possible escaped newline
                (\t*)   # let sleeping tabs lie
                (
                    (?: .{1,$cols}? (?=\\\n) ) # 0-$cols amount of dot 
                                               # followed by an escaped newline
                |
                    (?:
                       .{1,$cols}(?<! \s )(?= \s ) # 0-$cols of dot (greedy)
                    )                         # followed by trailing whitespace
                |
                    ( .{$hypenlim} )        # $cols-1 of unbroken anything 
                 )\s*
             }{
               (defined($1)?$1:'') . (defined($2)?$2:'') .
               (defined($4) ? $4 . "-" : $3) . "\n"
             }gmxe;

$content =~ s/\\\n/\n/g; # Restore honest line breaks

print $content;



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

Date: 1 Nov 1998 17:30:17 -0000
From: Jonathan Stowe <gellyfish@btinternet.com>
Subject: Re: It works , but why
Message-Id: <71i5r9$36b$1@gellyfish.btinternet.com>

On Sun, 01 Nov 1998 08:57:33 -0500 Tk Soh <r28629@email.sps.mot.com> wrote:
> Lloyd Zusman wrote:
> 
>> The 'and' operator in Perl is a "short circuit" operator.  What that
> 
> One of the nice Perl features that you either hate or love. I actually have
> seen people got "short circuit'ed" and gave up Perl. <sigh>
> 

'Johnny Five is alive'

/J\
-- 
Jonathan Stowe <jns@btinternet.com>
Some of your questions answered:
<URL:http://www.btinternet.com/~gellyfish/resources/wwwfaq.htm>


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

Date: Sun, 1 Nov 1998 20:20:10 -0500
From: dragons@scescape.net (Matthew Bafford)
Subject: Re: It works , but why
Message-Id: <MPG.10a6d2d8b0cd3d439896f8@news.scescape.net>

In article <<363ce43a.1662068@news1.telia.com>>, 
no.unsolicited.mail.please@jarle.com (Jarle H Knudsen) pounded the 
following:
=> On Sun, 1 Nov 1998 11:23:56 -0600, tadmc@flash.net (Tad McClellan)
=> wrote:
=> >   You should put a -w there.
=> >   You should do this with every Perl program.
=> >   Really.
=> >   Every time.
=> 
=> If this is so important, why isn't this on by default? Then there
=> could be a switch to turn it of instead.

NOT AGAIN!

About a month ago (more?) this was discussed to death (or not) (on 
p5p).  And then, before that it was discussed to death we thought.

Mainly, backwards compatability.  To many people have been writing 
code that isn't -w clean, and they don't want to have to go back and 
fix it.  

While it'd be a great idea, too many people are against it.

Do a deja under the group:
perl.porters-gw

Subjects:
an opinion from c.l.p.m
Mandatory warnings revisited

HTH,

--Matthew


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

Date: Sun, 01 Nov 1998 15:50:40 -0700
From: bkf@infinityweb.com (Barry K Freeman)
Subject: modification of gcos field
Message-Id: <bkf-ya023580000111981550400001@news.azstarnet.com>
Keywords: unix gcos fiels modification

I know this is most likely a simple task, but I can't seem to get it
working. I have a file from my sql database that contains all the correct
info on my users. I need to write a perl script that can update the gcos
interactively. I have a file that contains the good data, (gcos_good) it
contain login:gcos I want to stuff it into the gcos field of my local
passwd file. I need to make sure the login, first_name, last_name match the
current gcos so I can populate the file. with my modified data. (:firstname
lastname depatment extention:)

your suggestions are eagerly anticipated.


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

Date: 1 Nov 1998 21:17:17 GMT
From: mikefurr@aol.com (Mikefurr)
Subject: Need help with encryption & passwords...
Message-Id: <19981101161717.03532.00003324@ng90.aol.com>

Hi all,
I'm making a cgi that does a simple multiple choice quize over the internet.  I
need to able to have a login/password authentication for these so I can track
each users progress.  Unfortunately, I don't know much about them and was
pretty confused after reading the documentation on the crypt function.  Can
anyone give me some pointers on how to go about doing this, or a good webpage
that has some documentation on security.
One thought I had which would solve the problem was if a perl script could see
if the current user passed the .htaccess autentication and could retrieve the
username from that.  But I don't know how to go about doing that either.
Thanks for any help you can give.
-Mike


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

Date: 01 Nov 1998 22:50:01 +0100
From: Tony Curtis <Tony.Curtis+usenet@vcpc.univie.ac.at>
Subject: Re: Need help with encryption & passwords...
Message-Id: <83n26bnkvq.fsf@vcpc.univie.ac.at>

Re: Need help with encryption & passwords..., Mikefurr
<mikefurr@aol.com> said:

Mikefurr> Hi all, I'm making a cgi that does a simple

s/cgi/perl script/

Mikefurr> multiple choice quize over the internet.  I need

s/internet/WWW/

Mikefurr> to able to have a login/password authentication
Mikefurr> for these so I can track each users progress.

You want to use the standard authentication mechanism
already provided by the HTTP server, q.v. but not in this
newsgroup.

For tracking session management you'd probably need to start
mucking around with cookies too.  CGI.pm allows you to play
with cookies, and see CPAN for other modules...

hth
tony
-- 
Tony Curtis, Systems Manager, VCPC,    | Tel +43 1 310 93 96 - 12; Fax - 13
Liechtensteinstrasse 22, A-1090 Wien,  | <URI:http://www.vcpc.univie.ac.at/>
"You see? You see? Your stupid minds!  | private email:
    Stupid! Stupid!" ~ Eros, Plan9 fOS.| <URI:mailto:tony_curtis32@hotmail.com>


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

Date: 1 Nov 1998 19:41:34 GMT
From: behrends@cse.msu.edu (Reimer Behrends)
Subject: Re: Not to start a language war but..
Message-Id: <slrn73ph85.ad.behrends@allegro.cse.msu.edu>

William Tanksley (wtanksle@cx930311-b.ocnsd1.sdca.home.com) wrote:
[...]
> for line in file.readlines(): # nice, but eats memory
> 
> line = file.readline()
> while line:
>   do ( something )
>   line = file.readline()  # better, but too redundant
> 
> There has to be a better way here.

import fileinput

reader = fileinput.input(file)
for line in reader:
  handle(line)
reader.close()

Note that in general the problem with while-loops is due to functions
with side effects (also called lack of command-query distinction).
file.readline() is just a very prominent example of this. Consider, for
instance:

file = SaneFile(name)

while not file.eof:
  handle(file.current_line)
  file.advance()

The difference is that you can get the current line independently from
advancing the file pointer.

[...]

				Reimer Behrends


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

Date: 1 Nov 1998 17:24:16 -0000
From: Jonathan Stowe <gellyfish@btinternet.com>
Subject: Re: parsing email address problem
Message-Id: <71i5g0$368$1@gellyfish.btinternet.com>

On Sun, 01 Nov 1998 15:54:12 GMT jlafosse@my-dejanews.com wrote:
> Hi,
> 
> I am trying to parse all of the email addresses out of my guestbook. I can
> successfully parse out the following:
> <a href="mailto:blah@blah.com">
> 
> However some of my entries are recorded as such:
> <a href="mailto:blah@blah.com?subject=blah">
> 
> This is where I have a problem in my regex. I am not sure how to check for a
> '?' and if it exists parse it at that point, if not then parse it at the
> ending '"'
> Here is my code:
> 

Here are my thoughts:

> #! /usr/local/bin/perl

    ^ You probably dont mean that space and you probably also want -w
> 
> open(FILE, "guestbook.html");

You havent checked the success of your open 

>   while (<FILE>){
>     if (/<a href="mailto:(.*\@.*)">/){

If your file is fairly consistent then you should be able to use a regex
thus:

      /<a href="mailto:(.+\@.+)\?.+$/i

You will notice that I have altered your * to + as there will be little
point in collected an empty address, the /i modifier will allow a case
insensitive match on the tag part.  The '?' needs to be escaped because
it has meaning in a regex, the $ anchor is probably unnecessary but is
there for completeness.

>       $email = $1;
>       open(OUT, ">>guestbook.txt");

You havent checked the success of your open 

>         print OUT "$email\n";
>       close (OUT);
>     }
>   }
> close (FILE);
> 
> Any help on this is appreciated.
> 

Having said all this it is generally recommended when attempting to parse
an HTML document to use the HTML::Parser module or similar to retrieve the
tags and their attribute/value pairs and in this case probably the module
URI::URL to parse the URL of the HREF attribute.

Hope that helps

/J\
-- 
Jonathan Stowe <jns@btinternet.com>
Some of your questions answered:
<URL:http://www.btinternet.com/~gellyfish/resources/wwwfaq.htm>


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

Date: Mon, 02 Nov 1998 04:42:10 GMT
From: jhardy@cins.com (John Hardy)
Subject: Passing $Variables from script to script
Message-Id: <CKa%1.802$%W.373380@198.235.216.4>



I'm having problems passing  $Value and $field, which contain the forms 
field names and values read from one script to another script.

I tried writing it to a file 

$file = 'varin'; 
open(INFO, ">$file");
print "$field\t$Value\n";
close(INFO);  



but the file remained empty

is there an easier way or a reference to passing form variables from one script 
to another, in an FAQ that I haven't seen?



Thanks 
John 



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

Date: Mon, 02 Nov 1998 05:17:51 GMT
From: ehpoole@ingress.com (Ethan H. Poole)
Subject: Re: Passing $Variables from script to script
Message-Id: <3gb%1.3891$Qf3.8926@news9.ispnews.com>

[Posted and Emailed]  In article <CKa%1.802$%W.373380@198.235.216.4>, 
jhardy@cins.com says...
>
>I'm having problems passing  $Value and $field, which contain the forms 
>field names and values read from one script to another script.
>
>I tried writing it to a file 
>
>$file = 'varin'; 
>open(INFO, ">$file");
>print "$field\t$Value\n";
>close(INFO);  
>
>but the file remained empty

You 'print'ed to the console (STDOUT), not the INFO filehandle.

-- 
Ethan H. Poole              | Website Design and Hosting,
                            | CGI Programming (Perl & C)..
========Personal=========== | ============================
* ehpoole @ ingress . com * | --Interact2Day--
                            | http://www.interact2day.com/



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

Date: Sun, 01 Nov 1998 15:58:05 -0500
From: Aravind Subramanian <aravind@genome.wi.mit.edu>
Subject: Perl Cookbook code on web?
Message-Id: <363CCB5D.4F61B2A2@genome.wi.mit.edu>

Is code from the programs presented in the Perl Cookbook available
online? Yeah, I know it might not make great business sense to have this
freely available on the web,  but it is unfair to make people who bought
the book type it out - especially as there is no accompanying CD.





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

Date: 1 Nov 1998 21:59:57 GMT
From: Stefaan.Eeckels@ecc.lu (Stefaan A Eeckels)
Subject: Re: Perl Cookbook code on web?
Message-Id: <71ilkt$aq7$1@justus.ecc.lu>

In article <363CCB5D.4F61B2A2@genome.wi.mit.edu>,
	Aravind Subramanian <aravind@genome.wi.mit.edu> writes:
> Is code from the programs presented in the Perl Cookbook available
> online? Yeah, I know it might not make great business sense to have this
> freely available on the web,  but it is unfair to make people who bought
> the book type it out - especially as there is no accompanying CD.

>From the Preface (page xxxi):

"We have a Web site for the book...all the source code from the
 book available for download so you don't have to type it all in.

    http://www.oreilly.com/catalog/cookbook/"

-- 
Stefaan
-- 

PGP key available from PGP key servers (http://www.pgp.net/pgpnet/)
___________________________________________________________________
Perfection is reached, not when there is no longer anything to add,
but when there is no longer anything to take away. -- Saint-Exupiry



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

Date: 01 Nov 1998 13:11:51 -0800
From: Ben Gertzfield <che@debian.org>
Subject: Re: Perl Cookbook code on web?
Message-Id: <yttk91fp17s.fsf@gilgamesh.cse.ucsc.edu>

>>>>> "Aravind" == Aravind Subramanian <aravind@genome.wi.mit.edu> writes:

    Aravind> Is code from the programs presented in the Perl Cookbook
    Aravind> available online? Yeah, I know it might not make great
    Aravind> business sense to have this freely available on the web,
    Aravind> but it is unfair to make people who bought the book type
    Aravind> it out - especially as there is no accompanying CD.

The code for the examples in all of O'Reilly's books are available
on ftp.oreilly.com, as far as I know.

Try:

ftp://ftp.oreilly.com/published/oreilly/perl/cookbook/

Ben

-- 
Brought to you by the letters B and N and the number 11.
"I'm calling from the plane. I'll call you when I get there." -- TMBG
Debian GNU/Linux -- where do you want to go tomorrow? http://www.debian.org/
I'm on FurryMUCK as Che, and EFNet and YiffNet IRC as Che_Fox.


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

Date: Mon, 02 Nov 1998 01:23:03 GMT
From: dturley@pobox.com
Subject: Re: Perl Cookbook code on web?
Message-Id: <71j1hn$ne9$1@nnrp1.dejanews.com>

In article <363CCB5D.4F61B2A2@genome.wi.mit.edu>,
  Aravind Subramanian <aravind@genome.wi.mit.edu> wrote:
> Is code from the programs presented in the Perl Cookbook available
> online? Yeah, I know it might not make great business sense to have this
> freely available on the web,  but it is unfair to make people who bought
> the book type it out - especially as there is no accompanying CD.

If you had actually bought the book (or ANY o'reilly book) you'd know where
all the code is since it tells you right in the introduction!  :-)

Buy the book.

cheers,

david

-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/       Search, Read, Discuss, or Start Your Own    


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

Date: 01 Nov 1998 22:56:01 +0100
From: Ask Bjoern Hansen <ask@netcetera.dk>
Subject: Re: Perl, DBI and Apache
Message-Id: <m3d877qdqm.fsf@ratatosk.netcetera.dk>

Nico <info@edoc.co.za> writes:

> When run from http://..../cgi-bin/select.pl, I get an error message in
> my errorlog:
> 
> [Tue Oct 27 17:18:37 1998] [error] Can't load
> '/usr/lib/perl5/site_perl/i586-linux/auto/DBI/DBI.so' for module DBI:
> Unable to resolve symbol at
> /usr/lib/perl5/i586-linux/5.00404/DynaLoader.pm line 166.

Reinstall the DBI module.


hth, 

-- 
ask bjoern hansen - <http://www.netcetera.dk/~ask/>
Perl Usage Survey - <http://www.perl.org/cgi-bin/survey>


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

Date: Sat, 31 Oct 1998 22:10:48 GMT
From: rob@NOSPAM%21nbnet.nb.ca (Rob Watson)
Subject: Re: Testing Perlscript at home
Message-Id: <363b88c9.1892701@allnews.nbnet.nb.ca>

Hi,

  Short of changing your OS there are a number of possibilities of
which I am aware: 
   Sambar server www.sambar.com;
 
   Xitami(which I'm using quite painlessly and seems the easiest to
set up), sorry but you will have to search for it as I don't have the
URL at hand, maybe tucows??;

    Apache, which I haven't used and seems to offer only tenative
support for Win32, could be wrong though,www.apache.org/.

  I chose Xitami and it seems to work quite well, painless to set up
too..

rob

"Hakan Kilic" <a9609339@unet.univie.ac.at> wrote:




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

Date: Mon, 02 Nov 1998 11:04:37 GMT
From: nicolasr@arrakis.es (Nicolas Rodrmguez)
Subject: VARIABLES DE ENTORNO CGI
Message-Id: <363d8fb3.11793548@news.arrakis.es>

Desde hace algun tiempo  la variable de entorno REMOTE_HOST me
devuelve una cadena vacia cuando deberma devolver la direccisn del
proveedor del navegante. ?Por qui?

Otra pregunta, ?Como conseguir la direccisn del navegante a partir de
la direccisn IP?

Gracias
nicolasr@arrakis.es  


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

Date: Mon, 02 Nov 1998 07:25:37 GMT
From: Kris <kris@fit2print.com>
Subject: What is gd.pm?
Message-Id: <36149BE9.BAA0C523@fit2print.com>

Does anyone know what gd.pm is?  The script I'm using calls for it, and
I don't have it.

Kris

--
fit2print.com - Your Digital Newsstand
Order magazines "on demand" @ http://www.fit2print.com




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

Date: Mon, 02 Nov 1998 07:40:25 +0000
From: Trevor Hilaiel <trevorh@curtco.com>
Subject: Re: What is gd.pm?
Message-Id: <363D61E9.44FDE0ED@curtco.com>

perldoc GD:

--> GD.pm - Interface to Gd Graphics Library

--> GD.pm is a port of Thomas Boutell's gd graphics library
--> (see below).  GD allows you to create color drawings using
--> a large number of graphics primitives, and emit the
--> drawings as GIF files.

--> The GD.pm interface is copyright 1995, Lincoln D. Stein.

Grab it from your favorite CPAN mirror:  LDS/GD-1.18.tar.gz

--
Trevor Hilaiel
 

Kris wrote:
> 
> Does anyone know what gd.pm is?  The script I'm using calls for it, and
> I don't have it.
> 
> Kris
> 
> --
> fit2print.com - Your Digital Newsstand
> Order magazines "on demand" @ http://www.fit2print.com



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

Date: Sun, 01 Nov 1998 21:46:19 GMT
From: Elaine -HappyFunBall- Ashton <eashton@bbnplanet.com>
Subject: Re: What is the "correct" location of perl under Solaris?
Message-Id: <363CD417.46BA1893@bbnplanet.com>

> > > Hi All.  I've got a pseudo-philosophical question for you.  My
> > > company was recently acquired by a bigger company.  Before the
> > > acquisition, we had the location of our 'perl' as /usr/local/bin/perl,
> > > and all our scripts started
> > > with:
> > >
> > > #!/usr/local/bin/perl
> > >
> > > The company that bought us has their Solaris perl located at:
> > >
> > > #!/opt/local/bin/perl

> I believe that /usr/local is much more common among the various unixes
> out there than anything the /opt hierarchy, which I have only
> encountered in Solaris.  Furthermore, I have also seen /usr/local
> partitions in use under Solaris, in addition to /opt.

/opt is a sun convention. I tend to only allow sun packages into this
filesystem as a personal taste. /usr/local is an old standard for
packages not part of the os. I have also seen /export/local and
/pkg/local etc. ad infinitum. Whichever you choose to use is fine as
there is no rule on this.

The nice thing about standards is that there are so many to choose from
:). 


e.

After all, the cultivated person's first duty is to
always be prepared to rewrite the encyclopedia.  - U. Eco -


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

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


Administrivia:

Special notice: in a few days, the new group comp.lang.perl.moderated
should be formed. I would rather not support two different groups, and I
know of no other plans to create a digested moderated group. This leaves
me with two options: 1) keep on with this group 2) change to the
moderated one.

If you have opinions on this, send them to
perl-users-request@ruby.oce.orst.edu. 


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 4127
**************************************

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