[18206] in Perl-Users-Digest
Perl-Users Digest, Issue: 374 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Feb 28 06:10:27 2001
Date: Wed, 28 Feb 2001 03:10:12 -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: <983358612-v10-i374@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Wed, 28 Feb 2001 Volume: 10 Number: 374
Today's topics:
Re: read.txt (long) was [Need some help to understand h <c_clarkson@hotmail.com>
Re: regex help needed <nouser@emailunwelcome.com>
Re: regex help please <krahnj@acm.org>
Re: Scalars and Arrays <krahnj@acm.org>
Secret planned perl feature revealed <cdh@ala.net>
Re: Secret planned perl feature revealed (Gwyn Judd)
Re: statement for(list); nobull@mail.com
Re: statement for(list); (Martien Verbruggen)
template loops. <snefsite@hotmail.com>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 27 Feb 2001 23:02:43 -0600
From: "Charles K. Clarkson" <c_clarkson@hotmail.com>
Subject: Re: read.txt (long) was [Need some help to understand how some scripts work]
Message-Id: <5D2A3FA9A60BE8A0.EE9AA5179AEF7AA9.3033F41533A21E61@lp.airnews.net>
Shawn Ryder <sryder@webryder.com> wrote:
: I have three scripts that I would like to have somebody explain to me
: exactly how they work. Is it okay if I simply post the links here for
: the community to look at or should I go about it another way ??
Note: I too am new to perl programming. I am willing to share
my vast months of experience though:
#!/usr/bin/perl
##############################################
# Configuration section.
# Database-directory
# Change this into your database-directory, the directory on
# the harddisk of your webserver that will hold the data. It
# must be an absolute path, do not use constructions like
# ".." or "$USER", and do not enter an URL.
# The directory should be outside the document-tree of your
# webserver, and have proper read/write permissions so
# that FlashDB can read/write files in it. This setting must
# be exactly the same in both the FlashDB scripts.
# Windows-NT users: use forward-slashes "/", not back-slashes "\".
$Database = '/export/web31/omega/webryd/cgi-bin/data/';
This should be the only line you have to change to
get the script up and running, assuming you can run
a CGI script on your system
# End of configuration.
#########################################
use Config;
Loads the Config module which allows access to Perl
configuration information. Used at the end of the
script. See perlfunc for more info on 'use'.
$Filename = "$$"; # There is no default filename.
Initialize $Filename;
# Send the standard HTTP header. Make sure output is not cached in the
# user's browser.
print "Content-type: text/html\n";
print "Expires: Thu, 01 Dec 1994 16:00:00 GMT\n";
You probably don't need the Expire header since your
clobbering cache.
print "Cache-Control: no-cache, must-revalidate\n";
print "Pragma: no-cache\n";
Tell the browser not to cache output from this script.
print "\n";
There should be a blank line between the header and the rest
of the page.
# Get the Filename from the parameters. Special characters in the
# filename such as '/' and '\' are translated into spaces, and '..' is
# removed altogether, as security against hackers.
if ($ENV{'REQUEST_METHOD'} eq 'POST') {
Information was passed to the script via POST
binmode(STDIN);
Arranges for STDIN to be read or written in binary
mode on incomplete operating systems like DOS
(aka Windows). For more info see perlfunc.
read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
POST sends information via STDIN. Read stashes this
info in $in.
For more info see perlfunc.
} else {
We are receiving information via GET.
$in = $ENV{'QUERY_STRING'};
Which sends information via the QUERY_STRING
environment variable.
}
@args = split(/[&;]/,$in);
Split $in (the information sent) on either a '&' or a ';' and
place the result in @args. $in probably looks like
'filename=mailman'
foreach $i (0 .. $#args) {
Foreach index $i from 0 to the number of elements in
@arg:
$args[$i] =~ s/\+/ /g;
On the first pass $i = 0. $arg[0] is the first element of
@arg. s/\+/ /g changes each '+' to a space
($key, $val) = split(/=/,$args[$i],2);
On the first pass $i = 0. Split $arg[0] on either a '=' and
place the result in $key and $value.
$key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
$val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
Sometimes we get characters in http that look like
%20, etc. These lines convert those back to normal
characters.
$val =~ s/[^a-zA-Z0-9]//g;
You may find it hard to beleive, but there exist certain
'testers' who will try to break your code. This regular
expression will allow only alphabetic and numeric
characters to remain in $val.
if (($key eq 'filename') && ($val ne '')) {
We only care about the filename.
if ($val =~ /^([\w]+)$/) { $Filename = $1; }
All this work was to get a filename.
}
}
______________________________________
Code reuse is important to me. I am very lazy
and always looking for shortcuts. While some
would disagree and keep this code as is. I
would most likely use CGI.pm. This would
change everything from $Filename = '$$' to
this line to:
use CGI qw/:standard/;
print header();
my $Filename = param('filename');
Of course, many who are more experienced
would leave well enough alone. Please note
that the original author was not following
HTML standards. While everything should
be displayed in a browser correctly, it is a
poor practice.
______________________________________
if ($Filename eq '') {
No filename specified - tell the browser!
print "state=no_filename_specified";
exit 0;
}
I have yet to use flock, so I'll leave this for
self-study. Take a look at perlopentut.
HTH,
Charles K. Clarkson
# Open and lock the file. If the file could not be opened then exit.
$fn = $Database . $Filename . ".txt";
if (!open(FILE,"<$fn")) {
print "state=cannot_open_file";
exit 0;
}
if ($Config{'d_flock'} eq "define") { flock(FILE,2); }
binmode(FILE);
# Print the contents of the file to Flash 4.
print "state=done&";
print <FILE>;
# Close and unlock the file on disk.
if ($Config{'d_flock'} eq "define") { flock(FILE,8); }
close(FILE);
------------------------------
Date: Wed, 28 Feb 2001 00:54:18 -0500
From: Jay Tilton <nouser@emailunwelcome.com>
Subject: Re: regex help needed
Message-Id: <6g4p9tkbltmkq3b2dpcm9hcflubn002m7v@4ax.com>
cryofan@mylinuxisp.com (cRYOFAN) wrote:
>Well, I think it's a regex problem anyway.
Yup.
>$array1[$num_words-1] =~>s/>.*$/$blank/;
Look into what the /s modifier does to a m// or s/// regex.
While you're at it, It wouldn't hurt to explore 'grep' and 'push' and
'qw'.
--
tiltonj at
erols dot com
------------------------------
Date: Wed, 28 Feb 2001 10:01:15 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: regex help please
Message-Id: <3A9CCDAF.ED9BFC77@acm.org>
The Mosquito ScriptKiddiot wrote:
>
> so for instance i need to simplify sumthing like
>
> ( ( ( ( ( ( x - ( 2 + ( 2x + 3 ( 4x + 5 ) - 8.345 ) ^ - 4 * ( 5 - x / 2 ) + 4 )
> - 6 ) ) ) ) ) )
>
> into just ( x - ( 2 + ( 2x + 3 ( 4x + 5 ) - 8.345 ) ^ - 4 * ( 5 - x / 2 ) + 4 )
> - 6 )
$ perl -e '$_ = "( ( ( ( ( ( x - ( 2 + ( 2x + 3 ( 4x + 5 ) - 8.345 ) ^ -
4 * ( 5 - x / 2 ) + 4 ) - 6 ) ) ) ) ) )"; i while
s/^\s*\(\s*(\(.+\))\s*\)\s*$/$1/g; print "$_\n";'
( x - ( 2 + ( 2x + 3 ( 4x + 5 ) - 8.345 ) ^ - 4 * ( 5 - x / 2 ) + 4 ) -
6 )
John
------------------------------
Date: Wed, 28 Feb 2001 09:34:57 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: Scalars and Arrays
Message-Id: <3A9CC78A.E6F2A193@acm.org>
David Taylor wrote:
>
> Could someone help me please with getting a scalar value back into an array?
> Extract from my program:
> ### Read in the data file - works ok.
> open (FILE,"<data.db") or die "Unable to open data.db. \nReason: $!";
> while (<FILE>) { $db .= $_; }
my @sorted_array = sort split /\n/, $db;
my $sorted_db = join "\n", @sorted_array;
> close (FILE);
John
------------------------------
Date: Tue, 27 Feb 2001 23:30:52 -0600
From: cdh <cdh@ala.net>
Subject: Secret planned perl feature revealed
Message-Id: <3A9C8D0C.ABFB44A1@ala.net>
perl -e 'print "Perl, please automatically write the program I am thinking of right now!\n"; $perl = sub { print "Yes Master, here
is what I need...\n" }; do &$perl()'
Yes, I know there's an error... therein lies the funny part;)
Later,
Chris Hickman
P.S. this works on 5.6.0, I don't know if it's present in other versions.
------------------------------
Date: Wed, 28 Feb 2001 10:18:28 GMT
From: tjla@guvfybir.qlaqaf.bet (Gwyn Judd)
Subject: Re: Secret planned perl feature revealed
Message-Id: <slrn99pk3i.mq9.tjla@thislove.dyndns.org>
I was shocked! How could cdh <cdh@ala.net>
say such a terrible thing:
>perl -e 'print "Perl, please automatically write the program I am
>thinking of right now!\n"; $perl = sub { print "Yes Master, here
>is what I need...\n" }; do &$perl()'
>
>Yes, I know there's an error... therein lies the funny part;)
Wow that Larry Wall thinks of everything :) Now someone explain that
message
--
Gwyn Judd (print `echo 'tjla@guvfybir.qlaqaf.bet' | rot13`)
A slick talking pirate named Bruce
To steal code, had a plan to seduce
An Apple II+.
Now Bruce wears a truss
And was jailed for computer abuse.
------------------------------
Date: 28 Feb 2001 08:43:07 +0000
From: nobull@mail.com
Subject: Re: statement for(list);
Message-Id: <u9d7c3p1t0.fsf@wcl-l.bham.ac.uk>
gbacon@HiWAAY.net (Greg Bacon) writes:
> In article <97gt8i$qk97@kcweb01.netnews.att.com>,
> Joe Pepin <joepepin@att.com> wrote:
>
> : I'm curious about the "statement for(list);" construct. I've seen it
> : used, and yet I can't find anything about it in the docs (maybe I'm
> : not looking in the right places). Did this come in in 5.6.0?
>
> The 5.5.30 perlsyn manpage contains
>
> Any simple statement may optionally be followed by a SINGLE modifier,
BTW, am I the only person around here who thinks this limitation is
artificial and stupid?
> just before the terminating semicolon (or block ending). The possible
> modifiers are:
>
> if EXPR
> unless EXPR
> while EXPR
> until EXPR
> foreach EXPR
Note that in the current (5.5 & 5.6) implementation the 'for' (or
'foreach') modifer does _not_ act like the others. In general
statement qualifiers do not create a new block scope, but the for
qualifier does. Presumably this in necessary in order to alias $_.
#!/usr/bin/perl
use warnings;
use strict;
'foo' =~ /(.*)/ if 1;
print "$1\n"; # prints foo
my $i = 0;
'baz' =~ /(.*)/ while !$i++;
print "$1\n"; # prints baz
'bar' =~ /(.*)/ for 1;
print "$1\n"; # prints baz again!
__END__
Indeed "STMNT for EXPR" is parsed as "for (EXPR) {STMNT}"...
$ perl -MO=Deparse -e '1 for 1'
-e syntax OK
foreach $_ (1) {
'???';
}
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Wed, 28 Feb 2001 21:45:50 +1100
From: mgjv@tradingpost.com.au (Martien Verbruggen)
Subject: Re: statement for(list);
Message-Id: <slrn99plmu.8ue.mgjv@martien.heliotrope.home>
On 28 Feb 2001 08:43:07 +0000,
nobull@mail.com <nobull@mail.com> wrote:
> gbacon@HiWAAY.net (Greg Bacon) writes:
>
>> In article <97gt8i$qk97@kcweb01.netnews.att.com>,
>> Joe Pepin <joepepin@att.com> wrote:
>>
>> : I'm curious about the "statement for(list);" construct. I've seen it
>> : used, and yet I can't find anything about it in the docs (maybe I'm
>> : not looking in the right places). Did this come in in 5.6.0?
>>
>> The 5.5.30 perlsyn manpage contains
>>
>> Any simple statement may optionally be followed by a SINGLE modifier,
>
> BTW, am I the only person around here who thinks this limitation is
> artificial and stupid?
No. You're not. I've found myself wanting to write things like
$_ *= 3 for (@a) if ($some_condition);
quite a few times. I find the above quite legible and parseable, but I'm
sure that there are good reasons why the perl parser at the moment can't
deal with that.
I also wouldn't mind having things like:
do_something_with($foo) for my $foo (@a);
In this small example it makes no difference, but I'm sure I've had
situations where I really wanted this. I just can't think of a concrete
example right now :)
If it ever becomes possible to have multiple modifiers, it'll also be
necessary to allow the second, because of nested looping:
fooble($i, $j) for my $i (@i) for my $j (@j);
or
feeble($_, $thing) for my $thing (@things) while (<FILE>);
Martien
--
Martien Verbruggen |
Interactive Media Division | For heaven's sake, don't TRY to be
Commercial Dynamics Pty. Ltd. | cynical. It's perfectly easy to be
NSW, Australia | cynical.
------------------------------
Date: Wed, 28 Feb 2001 11:05:46 +0100
From: "Sven Franke" <snefsite@hotmail.com>
Subject: template loops.
Message-Id: <97iihn$a97$1@ncc1701.cistron.net>
Hi,
I have a problem with templates (HTML::Template).
I have a a database with let say services. I substract data from the
database so that I get this field:
Service, Year, Month, Day, Count
I have put this information in:
$Bla{SERVICE}{YEAR}{MONTH}{DAY}=COUNT
Now I go to this 'hash' with the following: It prints as desired.
foreach $service (sort keys %lv_Bla) {
print "$service\n";
foreach $year (sort keys %{$lv_SMSMtAcc{$service}}) {
print "$year\n";
foreach $month(sort keys %{$lv_SMSMtAcc{$service}{$year}}) {
print "$month\n";
foreach $day (sort keys %{$lv_SMSMtAcc{$service}{$year}{$month}}) {
$i=$lv_SMSMtAcc{$service}{$year}{$month}{$day};
print "$day:\t$i\n";
$i_m+=$i;
}
print "Month total :\t$i_m\n";
$i_j+=$i_m;
$i_m=0;
}
print "Year total:\t$i_j\n";
$i_t+=$i_j;
$i_j=0;
}
print "Overal total:\t$i_t\n";
print "-----------------------\n";
$i_t=0;
}
But How can I use this with HTML::Template ?
I can make it work for only the service, but how do I do a loop in a loop in
a loop?
This is what the uotput should look like:
SERVIVE 1
2000
01 (month number)
01 1 (day number and count)
02 1
03 8
18 20
02 (month number)
10 25
23 44
I also want to add a year total, month total and overall total.
How?
Sven
------------------------------
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 V10 Issue 374
**************************************