[10536] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 4128 Volume: 8

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

Date: Mon, 2 Nov 98 06:00:17 -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: 4128

Today's topics:
        [HELP] I can't use Socket. (Taguti)
        Can CGI run without anyone "browsing it"? <kla95mgn@student1.lu.se>
        help compare directories <rolf.rettinger@desy.de>
        Help debugging a Perl script. <kris@fit2print.com>
        How do i remove Carriage Returns og Newlines from a str <maxm@normik.dk>
        making an executable under win95 <avitala@macs.biu.ac.il>
    Re: Not to start a language war but.. <msergeant@ndirect.co.uk_NOSPAM>
        Pack and Unpack slok00@yahoo.com
        perl&cgi question <kjetil@balder.no>
    Re: perl&cgi question (Sam Holden)
    Re: splitting on . <toml@synnet.com>
    Re: system statistics from Perl (clay irving)
        Text::CSV install? (Steve Vertigan)
    Re: vec() (Steffen Beyer)
    Re: vec() (Matt Knecht)
    Re: What is gd.pm? dave@mag-sol.com
    Re: What is the "correct" location of perl under Solari <jhi@alpha.hut.fi>
        Special: Digest Administrivia (Last modified: 12 Mar 98 (Perl-Users-Digest Admin)

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

Date: 2 Nov 1998 02:46:26 GMT
From: taguti@secom-sis.co.jp (Taguti)
Subject: [HELP] I can't use Socket.
Message-Id: <71j6e2$i3q$1@lucifer.secom-sis.co.jp>

I can't use Socket.
I guess is is derived from Perl installation, but I don't know
what is wrong.

Please help!L

11:38:53 ~ $ perl -e 'use Socket; exit;'
Can't find 'boot_Socket' symbol in 
/opt/perl5/lib/PA-RISC1.1/5.00401/auto/Socket
/Socket.sl
 at -e line 1
BEGIN failed--compilation aborted at -e line 1.
11:38:55 ~ $
11:38:57 ~ $ perl -v

This is perl, version 5.004_01

Copyright 1987-1997, Larry Wall

Perl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl 5.0 source kit.

11:39:02 ~ $
--
taguti@secom-sis.co.jp



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

Date: Sun, 1 Nov 1998 21:59:12 +0100
From: "Magnus Nilsson" <kla95mgn@student1.lu.se>
Subject: Can CGI run without anyone "browsing it"?
Message-Id: <71ii45$cj9$1@merkurius.lu.se>

Is it possible for a CGI program to, for example, read email from one
account and send it to another - without constantly being activated by
someone browsing by?

I'm really curious... thanks in advance!
/Magnus Nilsson




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

Date: Mon, 2 Nov 1998 10:22:21 +0100
From: "Rolf Rettinger" <rolf.rettinger@desy.de>
Subject: help compare directories
Message-Id: <71jtl7$bjb$1@claire.desy.de>

Hi,

I would like to compare two directories including file size and date. Is
there a perl module to do that?

Thanks

Rolf




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

Date: Mon, 02 Nov 1998 04:08:30 GMT
From: Kris <kris@fit2print.com>
Subject: Help debugging a Perl script.
Message-Id: <36146DBF.5C1B7858@fit2print.com>

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.

Kris

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


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

#!/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.              ##
###################################################################

##################################################################
### *** NO VARIABLES NEED TO BE CUSTOMIZED IN THIS SCRIPT **** ###
##################################################################

use GD;

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

### 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;
}

### 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);

print "$tempgifurl\n";

### 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; }

### 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");
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
if ($sec < 10) { $sec = "0$sec"; }
if ($min < 10) { $min = "0$min"; }
$mon++;
@months = (January, February, March, April, May, June, July, August, September, October, November, December);
$month = $months[$mon - 1];
if ($year <= 97) { $yr = "20$year"; }
if ($year >= 98) { $yr = "19$year"; }
$ampm = "A.M.";
$hr = $hour;
if ($hour >= 12) { $hr = $hour - 12; $ampm = "P.M."; }


### OPEN & READ LOG FILE ###
open(FILE, "$logfile");
@infile = <FILE>;
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; }
}
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";

### IF CHART ###
if ($option eq "chart") {
	$credit = 0;
	$bad = "yes";
	if ($q eq "Today") {
		$bad = "no";
		$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];
		}

		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}); }
			$yy = $FORM{spyear};
			if ($yy >= 98) { $yy = "19$yy"; }
			else { $yy = "20$yy"; }
			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) {
			$bad="no";
			while (length($FORM{spday}) > 2) { chop($FORM{spday}); }
			while (length($FORM{spyear}) > 2) { chop($FORM{spyear}); }
			$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"; }

			$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;
	print "<table border=0>\n";
	$cnt=0;
	foreach $lineofdata (@infile)
	{
		$cnt++;
	}
	for ($x = $cnt; $x>=1; $x--) {
		$lineofdata = $infile[$x];
		($mon,$mday,$year,$hour,$min,$sec,$documenturi,$remoteaddr,$httpreferer,$remotehost) = split(/\|/, $lineofdata);
		$httprefererlink = $httpreferer;
		chop($remotehost);
		$onoff = "off";
		while (length($httprefererlink) >= 60) { chop($httprefererlink); $onoff = "on";}
		if ($onoff eq "on") { $httprefererlink = "$httprefererlink..."; }
		$recorddate = ($year * 100000000) + ($mon * 1000000) + ($mday * 10000) + ($hour * 100) + $min;
		if ($x eq $cnt && $credit > 0) { $i = "bad"; }


		if (($recorddate <= $combenddate && $recorddate >= $combstartdate) && $q ne "sphits") {
			$count++;
			$color="000088";
			if (($count/2) eq int($count/2)) { $color="006666"; }
			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"; }
			$ampm = "PM";
			if ($hour < 12) { $ampm = "AM"; }
				else { $hour = $hour - 12; }
			if ($hour eq 0) { $hour = 12; }
			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) {
				$credit--;
				$count++;
				$color="000088";
				if (($count/2) eq int($count/2)) { $color="006666"; }
				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"; }
				$ampm = "PM";
				if ($hour < 12) { $ampm = "AM"; }
					else { $hour = $hour - 12; }
				if ($hour eq 0) { $hour = 12; }
				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"; }
	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";
}
}
### 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;
		$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];
			}
			$xlabels[$x] = "$stmonth/$stday";
		}
		$combstartdate = $styear * 10000 + $stmonth * 100 + $stday;
		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"; }
			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; }
			$xvalues[$hour+1]++;
		}
		for ($x=1; $x<=24; $x++) {
			$xvalues[$x] = $xvalues[$x] / $days;
		}
		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;
			if ($comb < $low && $mday ne "") { $low = $comb; }
			if ($comb > $high && $mday ne "") { $high = $comb; }
			if ($year <= 94) { $year = "20$year"; }
			else { $year = "19$year"; }
			if ($done{$mon/$mday/$year} ne "yes") {
				$done{$mon/$mday/$year} = "yes";
				$m = $mon;
				$d = $mday;
				$y = $year;
				$leapyear = "no";
				if (($y/4) eq int($y/4)) {
					if ((($y/100) ne int($y/100)) || (($y/400) eq int($y/400)))
					{
						$leapyear = "yes";
					}
				}
				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; }
				$count = 0;
				for ($x = 1995; $x < $y; $x++) {
					if (($x/4) eq int($x/4) && (($x/100) ne int($x/100) ||
				           ($x/400) eq int($x/400))) {
						$count = $count+2;
					}
					else { $count++; }
				}
				$d = $count + $d;
				while ($d > 7) { $d = $d - 7; }	
				$dd{$mon/$mday/$year} = $d;
			}
			else { $d = $dd{$mon/$mday/$year}; }
			$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;
		}
		$count = 1;
		while ($difference > 7) { $count++; $difference = $difference - 7; }
		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;
			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);
	$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; }
	$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]); }
		$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); }
		$oldx = $x; $oldy = $y;
		$count++;
	}
	open (FILE, ">$tempgif");
        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";
		}
		($one,$two,$a) = split(/\./, $backwords);
		$backwords = "$one" . "." . "$two";
		$len = length($backwords);
		$forwards = "";
		for ($x = 1; $x <= $len; $x++) {
			$c = chop($backwords);
			$forwards = "$forwards" . "$c";
		}
		$thisaddr=$forwards;
		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";
			}

			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);
			$chp = chop($remotehost);
			$remotehost = "$remotehost" . "$chp";
			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") {
				$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";
				}
				$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};
	}

	for ($i = 1; $i <= ($count-1); $i++) {
		for ($j = 1; $j <= ($count - %i); $j++) {
			if ($value[$j] < $value[$j+1]) {
				$temp = $value[$j+1];
				$value[$j+1] = $value[$j];
				$value[$j] = $temp;
				$temp = $label[$j+1];
				$label[$j+1] = $label[$j];
				$label[$j] = $temp;
			}
		}
	}

	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";
	}

	print "</table>\n";
	
}  

print "<hr size=5></td></tr></table></center><center><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";
--------------BFFF15C96A99830121C88203--



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

Date: Mon, 2 Nov 1998 11:26:18 +0100
From: "maxm" <maxm@normik.dk>
Subject: How do i remove Carriage Returns og Newlines from a string via regexp's ?
Message-Id: <71k196$g1a$1@miri.tele.dk>

I read in a whole file line by line and then concatenate the lines into one
string. Including \n \r. How do I remove selected \n \r via s/// ?

Something like s/somepattern$//

Can anybody help?

Hilsen/regards

Max M Rasmussen
New Media Director
Denmark

Work:
mailto:maxm@normik.dk
http://www.normik.dk

Private:
mailto:maxm@maxmcorp.dk
http://www.maxmcorp.dk

Download my latest album in
high quality MP3 format for free at:
http://www.maxmcorp.dk/html/musical.htm#MaxMCorporation




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

Date: Mon, 2 Nov 1998 12:28:40 +0200
From: "Avshi Avital" <avitala@macs.biu.ac.il>
Subject: making an executable under win95
Message-Id: <71k1l4$bos$1@cnn.cc.biu.ac.il>

hi,
suppose i have a perl-script 'foo', how do I  turn it into an executable
(so that another user does not need perl to be installed on his
computer)? that is: 'foo.exe'.

thanx,

--
Avshalom Avital
Information Retrieval Laboratory
Bar-Ilan University, Israel
avitala@macs.biu.ac.il





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

Date: Mon, 02 Nov 1998 09:56:43 +0000
From: Matt Sergeant <msergeant@ndirect.co.uk_NOSPAM>
Subject: Re: Not to start a language war but..
Message-Id: <363D81DB.6FC53C67@ndirect.co.uk_NOSPAM>

Dave Kirby wrote:
> 
> >: * better cross platform support. Since I work in Windows/NT this is a
> >: biggie.
> > [snip]
> >: and with PythonWin I can create COM objects, do Active
> >: Scripting, access the windows API & MFC etc.
> >
> >       And there goes your praised "truely cross-platform" argument. :-)
> >
> >       Seriously, you really should check out the Win32::* modules.
> 
> I've just had a look at the latest CPAN listing. I dont see any
> mention of COM, ActiveX, Active Scripting, calling the C or MFC API
> etc. With PythonWin you can write a full blown Windows application
> using all of these.

That's all in Libwin32. It's all there. There are several options
(choice is a good thing) for writing COM objects in Perl. You can access
COM objects using Win32::OLE, you can access any API using Win32::API,
you can write GUI's using Win32::GUI (easier to use than MFC).
ActiveScripting is there with PerlScript.

With Perl, you can write a full blown windows application using all of
these.

-- 
<Matt/>

| Fastnet Software Ltd              |   Perl in Active Server Pages   |
| Perl Consultancy, Web Development |   Database Design   |    XML    |
| http://come.to/fastnet            |    Information Consolidation    |


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

Date: Mon, 02 Nov 1998 11:17:18 GMT
From: slok00@yahoo.com
Subject: Pack and Unpack
Message-Id: <71k4br$79j$1@nnrp1.dejanews.com>

I got a input file and a output file.
The input file is in some kind of format which I need to extract
using some kind of logic and output to a pipe "|" delimited file.

For the input file, it will read and ignore the first 10 lines
as they represent headers. From the 11th line onwards,
it will check whether it began with 3, if it does output it.
And for every line that has 3, it has some kind of format.
eg. pos 1 - 10 stands for name, 11-30 stands for address etc.
I would like to extract it and output it.

How can I achieve this?

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


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

Date: Mon, 02 Nov 1998 10:24:05 +0100
From: Kjetil Svendsberget <kjetil@balder.no>
Subject: perl&cgi question
Message-Id: <363D7A35.D88C4DC4@balder.no>

Ive written several perl scripts which build html pages, some with forms
some without. I have a starting script called login.pl , and i have 2
machines both setup with IE. v. 4.0 (v.4.72). One of those machines
insist on dowloading install.pl. (With communicator v 4.05 also) On the
other one machine it works. (If you wanna look at it take a peek at
http://www.balder.no/scripts/tmweb/login.pl)

I think it is because that machine has perl installed. I then tried to
remove the file assosication from windows explorer. Voila it now works
in communicator, but IE insists still on dowloading the page.

Any idea why it does that?


Kjetil


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

Date: 2 Nov 1998 09:38:10 GMT
From: sholden@pgrad.cs.usyd.edu.au (Sam Holden)
Subject: Re: perl&cgi question
Message-Id: <slrn73qvc2.fsc.sholden@pgrad.cs.usyd.edu.au>

On Mon, 02 Nov 1998 10:24:05 +0100, Kjetil Svendsberget <kjetil@balder.no>
	wrote:
>Ive written several perl scripts which build html pages, some with forms
>some without. I have a starting script called login.pl , and i have 2
>machines both setup with IE. v. 4.0 (v.4.72). One of those machines
>insist on dowloading install.pl. (With communicator v 4.05 also) On the
>other one machine it works. (If you wanna look at it take a peek at
>http://www.balder.no/scripts/tmweb/login.pl)

Sounds like a web server problem...

>
>I think it is because that machine has perl installed. I then tried to
>remove the file assosication from windows explorer. Voila it now works
>in communicator, but IE insists still on dowloading the page.

Then it doesn't have anything to do with perl, but with the server setup.

Maybe you should ask in whatever newsgroup talks about your webserver.
>

-- 
Sam

You can blame it all on the internet. I do...
	--Larry Wall


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

Date: Mon, 02 Nov 1998 08:40:26 -0500
From: Tom Lynch <toml@synnet.com>
Subject: Re: splitting on .
Message-Id: <363DB64A.824B851D@synnet.com>

Mark Sholund wrote:
> 
> I have been trying to split a string into parts that are delimited by
> periods.  I started by trying split(/./,$IP), but since "." matches
> everything, split has no effect.
> 
> I have found a way around this by split(/\W/,$IP) (split by
> non-alphanumic characters), but what if I wanted to split time such as
> "12:00:00.000543" into "12:00:00" and "000543"?  Splitting by
> non-alphanumerics will split it into four parts, not two.
> --
> in accordance with prophecy.
> 
>         "The price of freedom is eternal vigilance."
>                 - Admiral Tolwyn (Wing Commander IV)

Try escaping the "."

	split(/\./,$IP);

	Tom
-- 
#--------------------------------------------------------------+
# Tom Lynch                 |  Email: toml@synnet.com          |
# Switching Division        |  Phone: (978)-264-1443           |
# 3COM Corporation          |  Fax  : (978)-264-1418           |
# 80 Central Street         |  MS   : MA#35                    |
# Boxborough, Massachusetts |  Zip  : 01719                    |
#--------------------------------------------------------------+


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

Date: 2 Nov 1998 08:16:23 -0500
From: clay@panix.com (clay irving)
Subject: Re: system statistics from Perl
Message-Id: <71kbb7$nfe@panix.com>

In <363C74A7.5D02C17C@together.net> Bob Proctor <rproctor@together.net> writes:

>  You will find an article titled "Benchmarking", by Brian D Foy, in the
                                                      ^^^^^^^^^^^
It's "brian d foy"... :)

-- 
Clay Irving
clay@panix.com


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

Date: Mon, 2 Nov 1998 16:38:33 +0800
From: vertigan@bigfoot.com (Steve Vertigan)
Subject: Text::CSV install?
Message-Id: <199811020838.QAA07650@opera.iinet.net.au>

I have some scripts that use the Text::CSV module that I have to run on a 
user account on a remote system that I don't have root priviledges on.  
However the system doesn't have this module on it.  I thought I may be able 
to install it in the accounts file space but didn't get further than running 
the Makefile.PL as it needs 5.004 and this system only has 5.003.  I've 
contacted tech support and they've refused to put it on saying they "only 
provide modules that are part of the standard perl install".  Does anyone 
have any suggestions as to what I can do here short of cancelling the 
account?

Thanks,
--Steve


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

Date: 2 Nov 1998 11:42:38 GMT
From: sb@engelschall.com (Steffen Beyer)
Subject: Re: vec()
Message-Id: <71k5re$nk6$1@en1.engelschall.com>

If you want to avoid these problems altogether, you might want to check out
the module "Bit::Vector" from CPAN, which is written in C internally (thus
it's fast) and provides a lot of functions "vec" doesn't provide.

And it's not so much counter-intuitive as "vec"... :-)

See http://www.perl.com/CPAN/modules/by-module/Bit/
or http://www.engelschall.com/u/sb/download/.

HTH.

Regards,
Steffen Beyer

Matt Knecht <hex@voicenet.com> wrote:
> Tom Christiansen <tchrist@mox.perl.com> wrote:

>>:$bv |= (1 << 0);
>>
>>Oh no!  You broke it.  You just did a numeric 
>>thing on it.  You have to either use only vec, 
>>or make sure both your operands are stringy.

> For some reason "bit vector operation is desired when both operands are
> strings" from perldoc -f vec didn't stick with me.  Thanks for the
> reminder.

> But I still can't seem to get:

> $bv |= '3'
> or
> $bv |= '1 << 0'; $bv |= '1 << 1';

> On a clear bitvector to give me '0011' and not the representation of the
> string 3.  What's the syntax for that?

> Similarly:

> $one = $bv | 1;
> or
> $one = $bv | '1';   # Both operands are strings!
> or
> $one = $bv | '00000000000000000000000000000001';
> or
> $one = $bv | pack("b32", 1);   # Sets the MSB on a Sparc

> This can't be hard.  What am I missing?

>>:vec($bv, 0, 32) = 0;
>>
>>or
>>
>>    vec($bv, 31, 1) = 0;
>> ...
>> Does that help clarify things?

> Sort of.  The way I would read what I wrote would be: "Take an empty
> bitvector.  Go to the first offset.  Use all 32 bits.  Set those bits
> to zero".

> I read what you wrote as: "Take an empty bitvector.  Go to the 32nd
> offset.  Use one bit.  Set that bit to zero".

> So, vec($bv, 31, 1) = 1 give me the expected LSB set on, and all the
> other bits off.  I can set, or unset all bits in the vector by changing
> the offest, and leaving BITS set to 1.  This is good.


> What isn't good is when I tried (Again, many variants of) something
> like:

> vec($bv, 27, 4) = 3;

> I read that as: "Take an empty bitvector.  Go to the 28 bit.  set the
> next four bits to the bit pattern of 3 (0011)".

> I can't get anything other than turning a single bit on or off at a time
> to work (Which, is exactly what I needed.  But now I'm just curious as
> to how everything else works).

> -- 
> Matt Knecht - <hex@voicenet.com>

-- 
    Steffen Beyer <sb@engelschall.com>
    Free Perl and C Software for Download: www.engelschall.com/u/sb/download/


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

Date: Mon, 02 Nov 1998 13:44:13 GMT
From: hex@voicenet.com (Matt Knecht)
Subject: Re: vec()
Message-Id: <NGi%1.47351$ZF.7748819@news3.voicenet.com>

Steffen Beyer <sb@engelschall.com> wrote:
>If you want to avoid these problems altogether, you might want to check out
>the module "Bit::Vector" from CPAN, which is written in C internally (thus
>it's fast) and provides a lot of functions "vec" doesn't provide.

Wow.  I just installed this module.  It's *perfect*.  The only problem
with it is that there is too much documentation. :)

It's a great module.  Thanks for writing it!

>And it's not so much counter-intuitive as "vec"... :-)

I still haven't figured out Perl's vec() yet (I'd still like to, if
anybody can give me a quick summary on it), but after about 15 minutes
with this module I have everything (And more) of what I need.

-- 
Matt Knecht - <hex@voicenet.com>


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

Date: Mon, 02 Nov 1998 13:14:02 GMT
From: dave@mag-sol.com
Subject: Re: What is gd.pm?
Message-Id: <71kb6p$flm$1@nnrp1.dejanews.com>

In article <36149BE9.BAA0C523@fit2print.com>,
  Kris <kris@fit2print.com> wrote:
> Does anyone know what gd.pm is?  The script I'm using calls for it, and
> I don't have it.

It's a Perl module that intefaces with the GD library for drawing graphs and
graphics. If you don't have it (it's not part of the standard Perl
distribution) you can get it from CPAN <http://www.cpan.org/>.

hth,

Dave...

--
dave@mag-sol.com
London Perl M[ou]ngers: <http://london.pm.org/>
[Note Changed URL]

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


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

Date: 02 Nov 1998 15:11:07 +0200
From: Jarkko Hietaniemi <jhi@alpha.hut.fi>
Subject: Re: What is the "correct" location of perl under Solaris?
Message-Id: <oee3e82ck9g.fsf@alpha.hut.fi>


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

You are in a maze of twisty little standards, all alike.

-- 
$jhi++; # http://www.iki.fi/~jhi/
        # There is this special biologist word we use for 'stable'.
        # It is 'dead'. -- Jack Cohen


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

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

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