[17487] in Perl-Users-Digest
Perl-Users Digest, Issue: 4907 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Nov 16 21:05:41 2000
Date: Thu, 16 Nov 2000 18:05:15 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <974426714-v9-i4907@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Thu, 16 Nov 2000 Volume: 9 Number: 4907
Today's topics:
Re: about .htaccess <sam@cplhk.com>
Re: Can anyone help with this (Martien Verbruggen)
Re: Capital Letters Won't Sort - HeLp! <mjcarman@home.com>
Re: CRC Check <me@privacy.net>
Re: CRC Check (Gwyn Judd)
Re: Date <wyzelli@yahoo.com>
Re: Delete empty directories (Gwyn Judd)
Re: Fun with arrays <sumus@aut.dk>
Re: Fun with arrays <whtwlf@NOSPAMoptushome.com.au>
Re: Fun with arrays <sumus@aut.dk>
Re: how would you know the no of people accessing a per <jboes@eomonitor.com>
Re: IP geography <nospam@david-steuber.com>
Re: IP geography (Gary E. Ansok)
Re: More advanced number conversion. <ddunham@redwood.taos.com>
Newbie Rename() Function <tech-removethis-@rch-usa.com>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 17 Nov 2000 10:00:03 +0800
From: "Sam Tsui" <sam@cplhk.com>
Subject: Re: about .htaccess
Message-Id: <8v23f1$7g6$1@horn.hk.diyixian.com>
Thank you for your reply.
> I would advise looking into other methods of authentication which are more
> portable and generally better and securer than htaccess.
May I ask you what other methods of authentication you usually use?
Thanks.
------------------------------
Date: Fri, 17 Nov 2000 00:06:39 GMT
From: mgjv@tradingpost.com.au (Martien Verbruggen)
Subject: Re: Can anyone help with this
Message-Id: <slrn918tjj.425.mgjv@verbruggen.comdyn.com.au>
On Thu, 16 Nov 2000 22:22:23 +0000,
Sean W <sean@motorsports.co.uk> wrote:
> I have no knowledge whatsoever of either programming or perl but I am of
> average inteligence with a need for a number of scripts that perform
> certain tasks for a new website I am working on. I don't if it is
> acceptable but am I able to ask question here as long as I am trying my
> hardest to self teach but getting stuck.
A willingness to do the work yourself is all that's needed. :) And
maybe a willingness to dive into the documentation and read stuff.
> If so here are questions 1 and 2
>
> Iam using 3 existing scripts each of which does a function of what I am
> looking for but none of which does all three.
>
> if(!$ENV{'QUERY_STRING'} | !$call_page) {
I will assume that you typed this, instead of copy-and-past, and that
it was intended to read
if(!$ENV{'QUERY_STRING'} || !$call_page) {
If that assumption is wrong, then throw the script out.
These scripts obviously don't use the CGI module. While it is hard to
judge their quality from just this line, it's highly unlikely they're
as robust as programs that do use CGI.pm. If these scripts are by any
chance have a copyright associated with Matt Wright or Selena Sol, you
should probably use a Usenet archive to find out what the general
opinion on those scripts are. They were writen by a beginning
programmer, and their quality is in general dubious.
While you can directly fiddle around with the CGI yourself, for
anything more than the most trivial programs, it is definitely worth
it to use the CGI.pm module.
> why does the above use the ! before the $ENV and $call_page.
What that line means is
If not (the environment variable QUERY_STRING) or not (the scalar
call_page), then..
The exclamation mark signifies a logical negation (not).
In a bit more decent English:
If the value of the environment variable QUERY_STRING is false, OR
the variable $call_page is false, then....
In other words, the block following that statement will only be
executed if the environment variable QUERY_STRING is false (undef, 0,
"", or "0"), or the scalar $call_page is false.
It could have used unless, instead of if and avoided those nots:
unless ($ENV{QUERY_STRING} && $call_page) {
All of Perl's operators are documented in the perlop documentation.
All of the flow control operations in perlsyn. On
a unix system, use:
# man perlop
# man perlsyn
On Win32 systems:
C:\DOS> perldoc perlop
On Macs, use Shuck.
Also do a
# man perl
to get pointers to all the documentation.
> Second when do you use { and }
- To signify a block. Anywhere a block is needed, you use those curlies.
- To denote an index into a hash (to read about Perl data types,
read the perldata documentation).
- It can also be used to disambiguate variable names and other things
I'm probably forgetting one or two, but most uses are covered by the
first two.
> Before people say buy a book, I have two both of which must assume you
> have a phd before you start. People aren't good at explaining in plain
> English why something happens.
You don't say which books you have, but one excellent book for
beginning programmers that uses Perl is Andrew Johnson's /Elements of
Programming with Perl/. /Learning Perl/ (Randal Schwartz, Tom
Christiansen) is also good, although I believe it assumes you have
already got some programming experience.
The Perl FAQ, part 2 contains a list of references to books. Uri
Guttman posts here regularly, and his signature contains (contained?)
a reference to a list of book reviews.
> PS if anyone programs well for $30 an hour instead of $130 email me
> perhaps you can save me all this hassle sean@motorsports.co.uk
I don't think I'd trust a programmer that works for that rate. But of
course, it depends on the task that needs to be done.
Martien
--
Martien Verbruggen |
Interactive Media Division | Failure is not an option. It comes
Commercial Dynamics Pty. Ltd. | bundled with your Microsoft product.
NSW, Australia |
------------------------------
Date: Thu, 16 Nov 2000 16:12:27 -0600
From: Michael Carman <mjcarman@home.com>
Subject: Re: Capital Letters Won't Sort - HeLp!
Message-Id: <3A145BCB.157E7D9A@home.com>
eggrock@my-deja.com wrote:
>
> fhinchey@my-deja.com wrote:
>
> > I'm having problems alphabetically sorting an array using...
> > @sorted = sort @list;
> >
> > It's working great for words beginning with lower case letters,
> > however, for words beginning with capital letters, it's putting them
> > all at the top of the list.
>
> Perl sorts in ASCII order by default. ASCII "Z" is lower (numerically)
> than ASCII "a".
>
> To fix... ? Never ran into the problem yet. Someone more knowledgeable
> will know how to 'fix' it in an elegant fashion.
To fix, specify a case-insensitive sortsub. The simplest example would
be:
@sorted = sort {lc($a) cmp lc($b)} @list;
That's fine if @list is small, but wasteful if its large because it has
to recompute the lowercase value each time. For larger arrays, try a
map-sort-map approach (a.k.a. "Schwartzian Transform"):
@sorted =
map {$_->[0]}
sort {$a->[1] cmp $b->[1]}
map {[$_, lc($_)]}
@list;
-mjc
------------------------------
Date: Thu, 16 Nov 2000 23:58:17 GMT
From: "EM" <me@privacy.net>
Subject: Re: CRC Check
Message-Id: <tw_Q5.3857$Nw6.12428@news.iol.ie>
is there a way to do it with activeperl?
i cannot install modules from cpan
i tried hashing with crypt but it didnt work
is there something similar without installing more modules
EM
"Gwyn Judd" <tjla@guvfybir.qlaqaf.bet> wrote in message
news:slrn918f7p.4ut.tjla@thislove.dyndns.org...
> I was shocked! How could EM <me@privacy.net>
> say such a terrible thing:
> >Is there a way to perform a CRC check on a file with perl?
>
> Yes.
>
> okay, okay just for you I went and looked on CPAN and there are a couple
> of modules with the text "CRC" in their name.
>
> http://search.cpan.org
>
> --
> Gwyn Judd (print `echo 'tjla@guvfybir.qlaqaf.bet' | rot13`)
> I'd rather just believe that it's done by little elves running around.
------------------------------
Date: Fri, 17 Nov 2000 01:43:57 GMT
From: tjla@guvfybir.qlaqaf.bet (Gwyn Judd)
Subject: Re: CRC Check
Message-Id: <slrn9193aq.4ut.tjla@thislove.dyndns.org>
I was shocked! How could EM <me@privacy.net>
say such a terrible thing:
>is there a way to do it with activeperl?
>i cannot install modules from cpan
I think you use the "ppm" utility but all I know is the name, no idea
how to use it.
--
Gwyn Judd (print `echo 'tjla@guvfybir.qlaqaf.bet' | rot13`)
Lookie, lookie, here comes cookie...
-- Stephen Sondheim
------------------------------
Date: Fri, 17 Nov 2000 10:41:32 +0930
From: "Wyzelli" <wyzelli@yahoo.com>
Subject: Re: Date
Message-Id: <4w%Q5.19$y81.3346@vic.nntp.telstra.net>
"Bart Lateur" <bart.lateur@skynet.be> wrote in message
news:ieq71t8n7irbre48vhc7r9je3q04ps1pav@4ax.com...
> ameen @ dausha . net (Ameen Dausha) wrote:
>
> >Yes, buy with localtime don't you need to incriment the month and
day?
> >Don't you need to handle the fact that this is Perl Year 100?
Granted,
> >that can be handled by adding a few lines of code, but:
>
> A few lines of code?
>
> @now = localtime;
> $today = sprintf "%02d/%02d/%02d", 1+$now[4], $now[3],
$now[5]%100;
>
Do it in one line if you really want to, (despite the wasted resources
of multiple calls to 'localtime' - I never said was a GOOD idea).
$today = sprintf
"%02d/%02d/%4d",(localtime)[3],(localtime)[4]+1,(localtime)[5]+1900;
# Note my use of European Date format and 4 digit year - just to be
different
My preference would be :
($day, $mon, $year) = (localtime)[3..5];$mon+=1;$year+=1900;
$today = sprintf "%02d/%02d/%4d",$day,$mon,$year;
Which is real simple, and it is pretty damn obvious what is what.
:)
Wyzelli
--
($a,$b,$w,$t)=(' bottle',' of beer',' on the wall','Take one down, pass
it around');
for(reverse(1..100)){$s=($_!=1)?'s':'';$c.="$_$a$s$b$w\n$_$a$s$b\n$t\n";
$_--;$s=($_!=1)?'s':'';$c.="$_$a$s$b$w\n\n";}print"$c*hic*";
------------------------------
Date: Fri, 17 Nov 2000 01:51:13 GMT
From: tjla@guvfybir.qlaqaf.bet (Gwyn Judd)
Subject: Re: Delete empty directories
Message-Id: <slrn9193of.4ut.tjla@thislove.dyndns.org>
I was shocked! How could Martien Verbruggen <mgjv@tradingpost.com.au>
say such a terrible thing:
>Yeah, maybe it's slightly more elegant. But I believe that there are
More elegant and also more flexible too. I can use it to get a list of
all the empty directories without actually deleting them. I agree with
you on all your other points though.
--
Gwyn Judd (print `echo 'tjla@guvfybir.qlaqaf.bet' | rot13`)
Fortune's real live weird band names #785:
Your Damn Neighbors
------------------------------
Date: 17 Nov 2000 00:28:46 +0100
From: Jakob Schmidt <sumus@aut.dk>
Subject: Re: Fun with arrays
Message-Id: <d7fv5wep.fsf@macforce.sumus.dk>
"Shane Lowry" <whtwlf@NOSPAMoptushome.com.au> writes:
> The data is there as it should be ...
> however the split below that produces the errors i have included below the
> code snippet.
Those are warnings - good thing you used -w :-)
> # split out the info
> $ves_code,$berth_date,$begin_rec,$remainder = split /`/,$vessel;
try
( $ves_code,$berth_date,$begin_rec,$remainder ) = split /`/,$vessel;
- that is assign the list result of split to a _list_.
You'll feel much better.
--
Jakob Schmidt
http://aut.dk/orqwood
etc.
------------------------------
Date: Fri, 17 Nov 2000 10:48:13 +1100
From: "Shane Lowry" <whtwlf@NOSPAMoptushome.com.au>
Subject: Re: Fun with arrays
Message-Id: <8v1rpj$lk6$1@merki.connect.com.au>
Thanks Jakob ... worked a treat ... i looked through my other progs and saw
that they had the parens but it didnt twig. I was under the impression that
a lot of parens in perl were optional.
thanks again
Shane
Jakob Schmidt <sumus@aut.dk> wrote in message
news:d7fv5wep.fsf@macforce.sumus.dk...
> "Shane Lowry" <whtwlf@NOSPAMoptushome.com.au> writes:
>
> > The data is there as it should be ...
> > however the split below that produces the errors i have included below
the
> > code snippet.
>
> Those are warnings - good thing you used -w :-)
>
> > # split out the info
> > $ves_code,$berth_date,$begin_rec,$remainder = split /`/,$vessel;
>
> try
>
> ( $ves_code,$berth_date,$begin_rec,$remainder ) = split
/`/,$vessel;
>
> - that is assign the list result of split to a _list_.
>
> You'll feel much better.
>
> --
> Jakob Schmidt
> http://aut.dk/orqwood
> etc.
------------------------------
Date: 17 Nov 2000 00:53:55 +0100
From: Jakob Schmidt <sumus@aut.dk>
Subject: Re: Fun with arrays
Message-Id: <bsvf5v8s.fsf@macforce.sumus.dk>
"Shane Lowry" <whtwlf@NOSPAMoptushome.com.au> writes:
> Thanks Jakob
You're welcome
>I was under the impression that
> a lot of parens in perl were optional.
They are - and sometimes it's kinda cool to omit them.
But these were not optional alas :-)
--
Jakob Schmidt
http://aut.dk/orqwood
etc.
------------------------------
Date: Wed, 15 Nov 2000 11:32:14 -0500
From: Jeff Boes <jboes@eomonitor.com>
Subject: Re: how would you know the no of people accessing a perl file?
Message-Id: <3a1467d7$0$30010$44a10c7e@news.net-link.net>
I'm a good man wrote:
>
> how can you know the no. of people reading a particular page?
> or the no. of visitors in your site at a particular moment?
>
> is that possible with perl?
>
Not a Perl question, as the answer's the same whether you are talking
about a Perl script, an HTML page, or something else.
1) Try a CGI newsgroup.
2) Read up on how HTTPD actually works. When I reference your page, I
establish a temporary connection to get the page, and download it into
my browser. After the connection closes you have no idea whether I'm
sitting there reading it, or if I've clicked on a bookmark link in my
browser, or if I've shut down the browser. You can do some tricks with
Javascript, but they're not worth it.
--
Jeff Boes <jboes@eoexchange.com> Tel: (616) 381-9889 x.18
Sr. Software Engineer, EoExchange, Inc. http://www.eoexchange.com/
Search, Monitor, Notify. http://www.eomonitor.com/
------------------------------
Date: Fri, 17 Nov 2000 00:34:35 GMT
From: David Steuber <nospam@david-steuber.com>
Subject: Re: IP geography
Message-Id: <m3y9yjh1wl.fsf@solo.david-steuber.com>
cfedde@fedde.littleton.co.us (Chris Fedde) writes:
' We couldn't find documentation on ICBM::Launch::launch? Does
' it block till there is a detonation? I'll assume that it does.
' Otherwise we will report bad locations.
Check with http://wopr.norad.mil/
Login with user Falken, password Joshua.
--
David Steuber | Perl apprentice. The axe did not stop the
NRA Member | mops and buckets from flooding my home.
ICQ# 91465842
*** http://www.david-steuber.com/ ***
------------------------------
Date: 17 Nov 2000 01:22:25 GMT
From: ansok@alumni.caltech.edu (Gary E. Ansok)
Subject: Re: IP geography
Message-Id: <8v218h$fdk@gap.cco.caltech.edu>
In article <dWWQ5.466$Bf7.189491712@news.frii.net>,
Chris Fedde <cfedde@fedde.littleton.co.us> wrote:
>We couldn't find documentation on ICBM::Launch::launch? Does
>it block till there is a detonation? I'll assume that it does.
>Otherwise we will report bad locations.
What happened when you tried it?
-- Gary
------------------------------
Date: Fri, 17 Nov 2000 01:24:36 GMT
From: Darren Dunham <ddunham@redwood.taos.com>
Subject: Re: More advanced number conversion.
Message-Id: <oN%Q5.55$WE1.42494@news.pacbell.net>
fallenang3l@my-deja.com wrote:
> Using pack or unpack, how do I convert an 8 bit number to a 1 byte
> string, low order nybble first?
Something like this?
$number = 120;
$string = pack ("c", $number);
print "-->$string<--\n";
-->x<--
I don't know about the "low order nybble first" bit. While lots of
machines have different byte orders, I don't know of any that have
different nybble orders. If you need to pack it differently, you'll
probably have to swap the bits yourself first, then pack.
--
Darren Dunham ddunham@taos.com
Unix System Administrator Taos - The SysAdmin Company
Got some Dr Pepper? San Francisco, CA bay area
< Please move on, ...nothing to see here, please disperse >
------------------------------
Date: 16 Nov 2000 17:15:30 -0600
From: Randall <tech-removethis-@rch-usa.com>
Subject: Newbie Rename() Function
Message-Id: <q6q81tkdnfpnvmgbmktdgjo6dmg69unoto@4ax.com>
I'm using this popular (?) script:
and I've got to use the rename() function to get the files uploaded to
keep the same name as they had. Where is this inserted?
Sorry for the long post but I do not know which part is pertinent.
*********** snip **************
# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# key/value pairs in %in, using "\0" to separate multiple selections
# Returns >0 if there was input, 0 if there was no input
# undef indicates some failure.
# Now that cgi scripts can be put in the normal file space, it is
useful
# to combine both the form and the script in one place. If no
parameters
# are given (i.e., ReadParse returns FALSE), then a form could be
output.
# If a reference to a hash is given, then the data will be stored in
that
# hash, but the data from $in and @in will become inaccessable.
# If a variable-glob (e.g., *cgi_input) is the first parameter to
ReadParse,
# information is stored there, rather than in $in, @in, and %in.
# Second, third, and fourth parameters fill associative arrays
analagous to
# %in with data relevant to file uploads.
# If no method is given, the script will process both command-line
arguments
# of the form: name=value and any text that is in $ENV{'QUERY_STRING'}
# This is intended to aid debugging and may be changed in future
releases
sub ReadParse {
# Disable warnings as this code deliberately uses local and
environment
# variables which are preset to undef (i.e., not explicitly
initialized)
local ($perlwarn);
$perlwarn = $^W;
$^W = 0;
local (*in) = shift if @_; # CGI input
local (*incfn, # Client's filename (may not be
provided)
*inct, # Client's content-type (may not be
provided)
*insfn) = @_; # Server's filename (for spooled
files)
local ($len, $type, $meth, $errflag, $cmdflag, $got, $name);
binmode(STDIN); # we need these for DOS-based systems
binmode(STDOUT); # and they shouldn't hurt anything else
binmode(STDERR);
# Get several useful env variables
$type = $ENV{'CONTENT_TYPE'};
$len = $ENV{'CONTENT_LENGTH'};
$meth = $ENV{'REQUEST_METHOD'};
if ($len > $cgi_lib'maxdata) { #'
&CgiDie("cgi-lib.pl: Request to receive too much data: $len
bytes\n");
}
if (!defined $meth || $meth eq '' || $meth eq 'GET' ||
$meth eq 'HEAD' ||
$type eq 'application/x-www-form-urlencoded') {
local ($key, $val, $i);
# Read in text
if (!defined $meth || $meth eq '') {
$in = $ENV{'QUERY_STRING'};
$cmdflag = 1; # also use command-line options
} elsif($meth eq 'GET' || $meth eq 'HEAD') {
$in = $ENV{'QUERY_STRING'};
} elsif ($meth eq 'POST') {
if (($got = read(STDIN, $in, $len) != $len))
{$errflag="Short Read: wanted $len, got $got\n";};
} else {
&CgiDie("cgi-lib.pl: Unknown request method: $meth\n");
}
@in = split(/[&;]/,$in);
push(@in, @ARGV) if $cmdflag; # add command-line parameters
foreach $i (0 .. $#in) {
# Convert plus to space
$in[$i] =~ s/\+/ /g;
# Split into key and value.
($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
# Convert %XX from hex numbers to alphanumeric
$key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
$val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
# Associate key and value
$in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple
separator
$in{$key} .= $val;
}
} elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
# for efficiency, compile multipart code only if needed
$errflag = !(eval <<'END_MULTIPART');
local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype,
$blen);
local ($bpos, $lpos, $left, $amt, $fn, $ser);
local ($bufsize, $maxbound, $writefiles) =
($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles);
# The following lines exist solely to eliminate spurious warning
messages
$buf = '';
($boundary) = $type =~ /boundary="([^"]+)"/; #"; # find boundary
($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;
&CgiDie ("Boundary not provided: probably a bug in your server")
unless $boundary;
$boundary = "--" . $boundary;
$blen = length ($boundary);
if ($ENV{'REQUEST_METHOD'} ne 'POST') {
&CgiDie("Invalid request method for multipart/form-data:
$meth\n");
}
if ($writefiles) {
local($me);
stat ($writefiles);
$writefiles = "/tmp" unless -d _ && -w _;
# ($me) = $0 =~ m#([^/]*)$#;
$writefiles .= "/$cgi_lib'filepre";
}
# read in the data and split into parts:
# put headers in @in and data in %in
# General algorithm:
# There are two dividers: the border and the '\r\n\r\n' between
# header and body. Iterate between searching for these
# Retain a buffer of size(bufsize+maxbound); the latter part is
# to ensure that dividers don't get lost by wrapping between two
bufs
# Look for a divider in the current batch. If not found, then
# save all of bufsize, move the maxbound extra buffer to the front
of
# the buffer, and read in a new bufsize bytes. If a divider is
found,
# save everything up to the divider. Then empty the buffer of
everything
# up to the end of the divider. Refill buffer to bufsize+maxbound
# Note slightly odd organization. Code before BODY: really goes
with
# code following HEAD:, but is put first to 'pre-fill' buffers.
BODY:
# is placed before HEAD: because we first need to discard any
'preface,'
# which would be analagous to a body without a preceeding head.
$left = $len;
PART: # find each part of the multi-part while reading data
while (1) {
die $@ if $errflag;
$amt = ($left > $bufsize+$maxbound-length($buf)
? $bufsize+$maxbound-length($buf): $left);
$errflag = (($got = read(STDIN, $buf, $amt, length($buf))) !=
$amt);
die "Short Read: wanted $amt, got $got\n" if $errflag;
$left -= $amt;
$in{$name} .= "\0" if defined $in{$name};
$in{$name} .= $fn if $fn;
$name=~/([-\w]+)/; # This allows $insfn{$name} to be untainted
if (defined $1) {
$insfn{$1} .= "\0" if defined $insfn{$1};
$insfn{$1} .= $fn if $fn;
}
BODY:
while (($bpos = index($buf, $boundary)) == -1) {
if ($left == 0 && $buf eq '') {
foreach $value (values %insfn) {
unlink(split("\0",$value));
}
&CgiDie("cgi-lib.pl: reached end of input while seeking
boundary " .
"of multipart. Format of CGI input is wrong.\n");
}
die $@ if $errflag;
if ($name) { # if no $name, then it's the prologue -- discard
if ($fn) { print FILE substr($buf, 0, $bufsize); }
else { $in{$name} .= substr($buf, 0, $bufsize); }
}
$buf = substr($buf, $bufsize);
$amt = ($left > $bufsize ? $bufsize : $left);
#$maxbound==length($buf);
$errflag = (($got = read(STDIN, $buf, $amt, length($buf))) !=
$amt);
die "Short Read: wanted $amt, got $got\n" if $errflag;
$left -= $amt;
}
if (defined $name) { # if no $name, then it's the prologue --
discard
if ($fn) { print FILE substr($buf, 0, $bpos-2); }
else { $in {$name} .= substr($buf, 0, $bpos-2); } # kill
last \r\n
}
close (FILE);
last PART if substr($buf, $bpos + $blen, 2) eq "--";
substr($buf, 0, $bpos+$blen+2) = '';
$amt = ($left > $bufsize+$maxbound-length($buf)
? $bufsize+$maxbound-length($buf) : $left);
$errflag = (($got = read(STDIN, $buf, $amt, length($buf))) !=
$amt);
die "Short Read: wanted $amt, got $got\n" if $errflag;
$left -= $amt;
undef $head; undef $fn;
HEAD:
while (($lpos = index($buf, "\r\n\r\n")) == -1) {
if ($left == 0 && $buf eq '') {
foreach $value (values %insfn) {
unlink(split("\0",$value));
}
&CgiDie("cgi-lib: reached end of input while seeking end of
" .
"headers. Format of CGI input is wrong.\n$buf");
}
die $@ if $errflag;
$head .= substr($buf, 0, $bufsize);
$buf = substr($buf, $bufsize);
$amt = ($left > $bufsize ? $bufsize : $left);
#$maxbound==length($buf);
$errflag = (($got = read(STDIN, $buf, $amt, length($buf))) !=
$amt);
die "Short Read: wanted $amt, got $got\n" if $errflag;
$left -= $amt;
}
$head .= substr($buf, 0, $lpos+2);
push (@in, $head);
@heads = split("\r\n", $head);
($cd) = grep (/^\s*Content-Disposition:/i, @heads);
($ct) = grep (/^\s*Content-Type:/i, @heads);
($name) = $cd =~ /\bname="([^"]+)"/i; #";
($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;
($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be
null-str
($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined
$fname;
$incfn{$name} .= (defined $in{$name} ? "\0" : "") .
(defined $fname ? $fname : "");
($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i; #";
($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless
defined $ctype;
$inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype;
if ($writefiles && defined $fname) {
$ser++;
$fn = $writefiles . ".$$.$ser";
open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n");
binmode (FILE); # write files accurately
}
substr($buf, 0, $lpos+4) = '';
undef $fname;
undef $ctype;
}
1;
END_MULTIPART
if ($errflag) {
local ($errmsg, $value);
$errmsg = $@ || $errflag;
foreach $value (values %insfn) {
unlink(split("\0",$value));
}
&CgiDie($errmsg);
} else {
# everything's ok.
}
} else {
&CgiDie("cgi-lib.pl: Unknown Content-type:
$ENV{'CONTENT_TYPE'}\n");
}
# no-ops to avoid warnings
$insfn = $insfn;
$incfn = $incfn;
$inct = $inct;
$^W = $perlwarn;
return ($errflag ? undef : scalar(@in));
}
# PrintHeader
# Returns the magic line which tells WWW that we're an HTML document
sub PrintHeader {
return "Content-type: text/html\n\n";
}
# HtmlTop
# Returns the <head> of a document and the beginning of the body
# with the title and a body <h1> header as specified by the parameter
sub HtmlTop
{
local ($title) = @_;
return <<END_OF_TEXT;
<html>
<head>
<title>$title</title>
</head>
<body>
<h1>$title</h1>
END_OF_TEXT
}
# HtmlBot
# Returns the </body>, </html> codes for the bottom of every HTML page
sub HtmlBot
{
return "</body>\n</html>\n";
}
# SplitParam
# Splits a multi-valued parameter into a list of the constituent
parameters
sub SplitParam
{
local ($param) = @_;
local (@params) = split ("\0", $param);
return (wantarray ? @params : $params[0]);
}
# MethGet
# Return true if this cgi call was using the GET request, false
otherwise
sub MethGet {
return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq
"GET");
}
# MethPost
# Return true if this cgi call was using the POST request, false
otherwise
sub MethPost {
return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq
"POST");
}
# MyBaseUrl
# Returns the base URL to the script (i.e., no extra path or query
string)
sub MyBaseUrl {
local ($ret, $perlwarn);
$perlwarn = $^W; $^W = 0;
$ret = 'http://' . $ENV{'SERVER_NAME'} .
($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
$ENV{'SCRIPT_NAME'};
$^W = $perlwarn;
return $ret;
}
# MyFullUrl
# Returns the full URL to the script (i.e., with extra path or query
string)
sub MyFullUrl {
local ($ret, $perlwarn);
$perlwarn = $^W; $^W = 0;
$ret = 'http://' . $ENV{'SERVER_NAME'} .
($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
$ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} .
(length ($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" :
'');
$^W = $perlwarn;
return $ret;
}
# MyURL
# Returns the base URL to the script (i.e., no extra path or query
string)
# This is obsolete and will be removed in later versions
sub MyURL {
return &MyBaseUrl;
}
# CgiError
# Prints out an error message which which containes appropriate
headers,
# markup, etcetera.
# Parameters:
# If no parameters, gives a generic error message
# Otherwise, the first parameter will be the title and the rest will
# be given as different paragraphs of the body
sub CgiError {
local (@msg) = @_;
local ($i,$name);
if (!@msg) {
$name = &MyFullUrl;
@msg = ("Error: script $name encountered fatal error\n");
};
if (!$cgi_lib'headerout) { #')
print &PrintHeader;
print "<html>\n<head>\n<title>$msg[0]</title>\n</head>\n<body>\n";
}
print "<h1>$msg[0]</h1>\n";
foreach $i (1 .. $#msg) {
print "<p>$msg[$i]</p>\n";
}
$cgi_lib'headerout++;
}
# CgiDie
# Identical to CgiError, but also quits with the passed error message.
sub CgiDie {
local (@msg) = @_;
&CgiError (@msg);
die @msg;
}
# PrintVariables
# Nicely formats variables. Three calling options:
# A non-null associative array - prints the items in that array
# A type-glob - prints the items in the associated assoc array
# nothing - defaults to use %in
# Typical use: &PrintVariables()
sub PrintVariables {
local (*in) = @_ if @_ == 1;
local (%in) = @_ if @_ > 1;
local ($out, $key, $output);
$output = "\n<dl compact>\n";
foreach $key (sort keys(%in)) {
foreach (split("\0", $in{$key})) {
($out = $_) =~ s/\n/<br>\n/g;
$output .= "<dt><b>$key</b>\n <dd>:<i>$out</i>:<br>\n";
}
}
$output .= "</dl>\n";
return $output;
}
# PrintEnv
# Nicely formats all environment variables and returns HTML string
sub PrintEnv {
&PrintVariables(*ENV);
}
# The following lines exist only to avoid warning messages
$cgi_lib'writefiles = $cgi_lib'writefiles;
$cgi_lib'bufsize = $cgi_lib'bufsize ;
$cgi_lib'maxbound = $cgi_lib'maxbound;
$cgi_lib'version = $cgi_lib'version;
$cgi_lib'filepre = $cgi_lib'filepre;
1; #return true
------------------------------
Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 16 Sep 99)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
| NOTE: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.
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.
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 V9 Issue 4907
**************************************
