[19582] in Perl-Users-Digest
Perl-Users Digest, Issue: 1777 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Sep 19 21:05:35 2001
Date: Wed, 19 Sep 2001 18:05:08 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <1000947908-v10-i1777@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Wed, 19 Sep 2001 Volume: 10 Number: 1777
Today's topics:
Re: copy STDERR to file (Rory)
Re: copy STDERR to file <bart.lateur@skynet.be>
Re: DBI/MySQL help needed (Malcolm Dew-Jones)
Re: filter out short strings <bart.lateur@skynet.be>
Re: filter out short strings (Tad McClellan)
Re: numerical then alpha sort of files <bart.lateur@skynet.be>
Re: numerical then alpha sort of files (Mark Jason Dominus)
Re: only allowing characters from a list to be inputed <tintin@snowy.calculus>
pattern matcher for embedded seperators. <ychandra@cisco.com>
Re: pattern matcher for embedded seperators. (Tad McClellan)
Re: pattern matcher for embedded seperators. <davidhilseenews@yahoo.com>
Re: Perl Compiler <bart.lateur@skynet.be>
Re: Perl Compiler (Malcolm Dew-Jones)
Pre spawning in perl <irl.com@ntlworld.com>
Re: Pre spawning in perl (Mark Jason Dominus)
Re: pretty printing a web page <bart.lateur@skynet.be>
Re: returnvalues in perl (Damian James)
Re: returnvalues in perl <bart.lateur@skynet.be>
Re: Simple Server/Client (Malcolm Dew-Jones)
Re: Sorting Hashes <uri@sysarch.com>
Re: Sorting Hashes <stevea@wrq.com>
Re: Sorting Hashes <ren@tivoli.com>
truncate problem (Kevin J. Schmidt)
Re: truncate problem (Mark Jason Dominus)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 19 Sep 2001 17:32:38 -0700
From: rory@campbell-lange.net (Rory)
Subject: Re: copy STDERR to file
Message-Id: <ba9de059.0109191632.4b62e71c@posting.google.com>
mgjv@tradingpost.com.au (Martien Verbruggen) wrote in message news:<slrn9qh5i1.2ut.mgjv@martien.heliotrope.home>...
> On 19 Sep 2001 03:47:12 -0700,
> Rory <rory@campbell-lange.net> wrote:
> > I would like, for part of a script, to copy STDERR to a file, as I
> > have a script that takes ages to run, and I might miss some of the
> > messages written to the console.
> >
> > I have tried the recipe in perlfunc, but after closing the STDERR
> > filehandle, I don't get messages reported to the console at all.
>
> Then don't close it.
>
> Where's the actual code you're using?
>
> Martien
Hi Martien.
Step 16 shows the problem. (Also I'd be grateful for general comments,
and ideas on how best to start up and pass parameters to another
script without making that other script a module!).
Thanks
Rory
#!/usr/bin/perl -w
########################
########################## #
# #
# Program purpose: #
# Desktop database corruption problems on Ethershare #
# File Server for Macintosh require logging of state #
# of both data and resource trees of server shares. #
# This script goes through this process and mails the #
# results (which are gzipped and tarred). #
# #
# Rory Campbell-Lange #
# Created: 15/9/01 #
# #
######################## #########################
use strict;
my ($dump, $lsalR, $rebuild, $tailer,
$find, $msg, $stopper, $starter, $copy) = '';
my $start_dir = '/x/y/z/';
my $file_base = qx{date '+%d%m%y_'};
$file_base =~ s/\n//g;
my $filename = '';
my $error_file = 'errors';
my $f_date = qx{date '+%d%m%y_%H%M_rblogs'};
$f_date =~ s/\n//g;
my $dir = $start_dir . $f_date;
mkdir ($dir,0666) or die "Couldn't make dir $dir $!\n";
chdir $dir or die "Couldn't chdir to $dir $!\n";
commander();
# 1. setup error logging
open (STDERR, "> $error_file") or die
"Couldn't open file $error_file to take STDERR $!\n";
# 2. dump
print "Dumping...";
$filename = $file_base . 'dump.1';
$dump =~ s/filename/$filename/;
qx{$dump};
# 3. find
print "\nFinding...";
$filename = $file_base . 'find.1';
$find =~ s/filename/$filename/;
qx{$find};
# 4. lsalR
print "\nSearching...";
$filename = $file_base . 'lsalR.1';
$lsalR =~ s/filename/$filename/;
qx{$lsalR};
# 5. stop
qx{$msg};
print "\nStopping...";
qx{$stopper};
# 6. date
# first make rebuild filename
$filename = $file_base . 'rebuild.out';
open (OUT, ">> $filename") or die
"Can't open file $filename for writing rebuild header\n";
print OUT qx{date};
close OUT;
# 7. rebuild
print "\nRebuilding...";
$rebuild =~ s/filename/$filename/;
qx{$rebuild};
# 8. date
open (OUT, ">> $filename") or die
"Can't open file $filename for writing rebuild footer\n";
print OUT qx{date};
close OUT;
# 9. restart
print "\nRestarting...";
qx{$starter};
commander();
# 10. dump after
print "\n2nd Dump...";
$filename = $file_base . 'dump.2';
$dump =~ s/filename/$filename/;
qx{$dump};
# 11. find after
print "\n2nd Find...";
$filename = $file_base . 'find.2';
$find =~ s/filename/$filename/;
qx{$find};
# 12. lsalR after
print "\n2nd Search...";
$filename = $file_base . 'lsalR.2';
$lsalR =~ s/filename/$filename/;
qx{$lsalR};
# 13. tail daemon log
print "\nGetting tail of daemon log...";
$filename = $file_base . 'daemon.log';
$tailer =~ s/filename/$filename/;
qx{$tailer};
# 14. copy server account
print "\nCopying server account...";
$filename = $file_base . 'server.log';
$copy =~ s/filename/$filename/;
qx{$copy};
# 15. finish
print "\nfinished rebuild and tests...";
# 16. stop error logging to file so that this can be mailed
close STDERR;
# oops: what happens with error messages here?
# 17. mail
print "\nmailing...\n";
chdir $start_dir or die
"Couldn't chdir to $start_dir $!\nCould not mail\n";
qx{./mail.pl $dir};
print "FINISHED!!!\n\n";
exit;
sub commander {
$dump = '/usr/local/es/dt iddump /home/esvols/MHP > filename';
$lsalR = 'ls -laR /home/esvols/MHP > filename';
$rebuild = '/usr/local/es/rebuild -v /home/esvols/MHP >> filename';
$tailer = 'tail -n30 /var/log/daemon.log > filename';
$find = 'find /home/esvols/MHP \( ! -name \'.rsrc\' -a -type d \)
-exec \
/usr/local/es/dt ls -l >> filename {} \;';
$msg = '/usr/local/es/etc/afpmsg \
"The fileserver is goind down for an emergency rebuild. Please quit
NOW!"';
$stopper = '/usr/local/es/etc/stop-afp';
$starter = '/usr/local/es/afpsrv';
$copy = 'cp /usr/local/es/server.acct filename';
}
------------------------------
Date: Thu, 20 Sep 2001 00:52:18 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: copy STDERR to file
Message-Id: <t5fiqtck2r71g81rmqkjjcq7p94lfg1d1s@4ax.com>
Rory wrote:
># 16. stop error logging to file so that this can be mailed
>close STDERR;
># oops: what happens with error messages here?
Oh. You'd better use the other alternative then, by duping the old
STDERR before reopening it, end then reopening it by duping the saved
filehandle.
open SAVEERR, ">&STDERR";
open STDERR, "> stderr.txt";
warn "This goes to the file";
open STDERR, ">&SAVEERR";
warn "This goes to the old STDERR";
It works, apart from this warning:
Name "main::SAVEERR" used only once: possible typo at test.pl line 2.
Grrr. Silly perl.
--
Bart.
------------------------------
Date: 19 Sep 2001 15:23:33 -0800
From: yf110@vtn1.victoria.tc.ca (Malcolm Dew-Jones)
Subject: Re: DBI/MySQL help needed
Message-Id: <3ba91ae5@news.victoria.tc.ca>
martinblack (martinblack26@yahoo.com) wrote:
: Hi, I have a problem with one of my scripts that supposedly creates
: database tables. ? Okay, this ones probably quite easy, but I haven't
: had very much DBI experience. The error message says:
: "DBD::mysql::st execute failed: You have an error in your SQL syntax
: near ')' at line 10 at dbstart.cgi line 56.
: Can't execute: You have an error in your SQL syntax near ')' at line
: 10 at dbstart.cgi line 56."
: The "Error" line in question is:
: $sth->execute() || die "Can't execute: ", $dbh->errstr;
The SQL must have a syntax error. Due to the way this particular database
software works the error is not detected until you try to execute the sql.
I would print out the sql string you are trying to run and test it by cut
and paste into your favourite sql command line tool.
: eval {
: $sth = $dbh->prepare(
: $sql="CREATE TABLE product
: (company_id VARCHAR (5) NOT NULL,
: product_id INT NOT NULL,
: title VARCHAR($max),
: description VARCHAR($max),
: spex tinyblob,
: price Float not null,
: sex char (2),
: PRIMARY KEY (company_id, product_id),)
: ") || die "Can't prepare the sandwich: ", $dbh->errstr;
: };
# lets add some debug code. Just dump the sql everytime
# until we get things working.
print "Content-type: text/plain\n\n";
print "$sql\n";
exit;
now cut and paste the sql from your browser and try it from the sql
command line.
------------------------------
Date: Wed, 19 Sep 2001 23:30:11 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: filter out short strings
Message-Id: <jjaiqtkbv612jt67do6i48bklajc64p4tg@4ax.com>
* Tong * wrote:
>How can I filter out strings that are too short from an array?
>
>@out = grep { (=~ tr/a-z//i) <3} @in;
>
>Bareword found where operator expected, near "tr/a-z//i"
Get rid of that "=~".
--
Bart.
------------------------------
Date: Wed, 19 Sep 2001 23:50:20 GMT
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: filter out short strings
Message-Id: <slrn9qi8vg.6t0.tadmc@tadmc26.august.net>
Bart Lateur <bart.lateur@skynet.be> wrote:
>* Tong * wrote:
>
>>How can I filter out strings that are too short from an array?
>>
>>@out = grep { (=~ tr/a-z//i) <3} @in;
>>
>>Bareword found where operator expected, near "tr/a-z//i"
>
>Get rid of that "=~".
And the "i". tr/// is not a pattern match, it doesn't _have_
an "i" option
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Wed, 19 Sep 2001 23:57:54 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: numerical then alpha sort of files
Message-Id: <5hbiqtkclhejmpvu8ln9tgpsr1pa11r74m@4ax.com>
Marc Ulrich wrote:
>Here's an interesting sort problem. I've got files like:
>
>ag1, ag2, ag2a, ag2b, ag10, ag11, ag11b, ag20, ....
>
>If I just tell perl to sort them, I get an alpha only sort:
>
>ag1, ag10, ag11, ag11b, ag2, ag20, ag2a, ag2b, ....
I'd split the strings on numbers, i.e into (left text, middle number,
right text), and then sort on the subparts. The Schwartzian Transform
will do.
@list = qw/ah1 af9 ag1 ag2 ag2a ag2b ag10 ag11 ag11b ag20/;
@list = map { $_->[0] }
sort { local $^W; # in case split// returned just one part
$a->[1] cmp $b->[1] || # sort as text on left part
$a->[2] <=> $b->[2] || # sort as number on middle part
$a->[3] cmp $b->[3] # sort as text on right part
} map { [ $_, split /(\d+)/, $_, 2 ] } @list;
print "@list\n";
I get:
af9 ag1 ag2 ag2a ag2b ag10 ag11 ag11b ag20 ah1
which looks fine to me.
You'll get a more optimized solution if you put the "local $^W;" outside
the sort routine.
--
Bart.
------------------------------
Date: Thu, 20 Sep 2001 00:18:33 GMT
From: mjd@plover.com (Mark Jason Dominus)
Subject: Re: numerical then alpha sort of files
Message-Id: <3ba935d8.6427$37a@news.op.net>
Lately I've been using this:
sub byfile {
my @a = split /(\d+)/, $a;
my @b = split /(\d+)/, $b;
my $M = @a > @b ? @a : @b;
my $res = 0;
for (my $i = 0; $i < $M; $i++) {
return -1 if ! defined $a[$i];
return 1 if ! defined $b[$i];
if ($a[$i] =~ /\d/) {
$res = $a[$i] <=> $b[$i];
} else {
$res = $a[$i] cmp $b[$i];
}
last if $res;
}
$res;
}
Given your sample file list as input:
>ag1, ag10, ag11, ag11b, ag2, ag20, ag2a, ag2b, ....
It produces the following output:
> ag1, ag2, ag2a, ag2b, ag10, ag11, ag11b, ag20
But it may be more complicated (and slow) than you need.
--
@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{
@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord
($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print
------------------------------
Date: Thu, 20 Sep 2001 08:05:28 +1000
From: "Tintin" <tintin@snowy.calculus>
Subject: Re: only allowing characters from a list to be inputed
Message-Id: <JF8q7.2$Db6.132226@news.interact.net.au>
"Kiaya" <kiaya_halilah@yahoo.com> wrote in message
news:e5340dbc.0109190706.f59ab28@posting.google.com...
> We have a cgi form that inputs to a pipe-delimited file. We want to
> prevent people from inputing symbols, hard returns, etc. which mess up
> the flat file. We tried using:
>
> elsif ($email !~ /A-Za-z,.\;'\/\@\-_/) {
> $field="E-mail";
> $character="E-mail";
> &error;
> exit(0);
> }
>
> But this is not working. Any ideas? We only want to allow A-Z a-z , .
> ; / @ - _ We should probably allow parenthesis also. Thanks, Kiaya
For validating email addresses, try one of the modules on CPAN like
Email::Valid
------------------------------
Date: Wed, 19 Sep 2001 17:04:50 -0700
From: Chandra Yemparala <ychandra@cisco.com>
Subject: pattern matcher for embedded seperators.
Message-Id: <3BA932A2.F78D731A@cisco.com>
Is there a way to write pattern matcher for the following pattern:
<x:<a><b><c><d>>
x,a,b,c,d are going to some value. I want to check if a line is
according to this format.
I wrote up something like this - if( $line =~ /(<.*>){5}/ ) to check for
five <..>, but this is stopping at <c>,
I guess it is taking <x:<a> as one set.
thx
chandra
------------------------------
Date: Thu, 20 Sep 2001 00:24:11 GMT
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: pattern matcher for embedded seperators.
Message-Id: <slrn9qib4o.74t.tadmc@tadmc26.august.net>
Chandra Yemparala <ychandra@cisco.com> wrote:
>Is there a way to write pattern matcher for the following pattern:
>
><x:<a><b><c><d>>
print "matched\n" if $_ eq '<x:<a><b><c><d>>';
>x,a,b,c,d are going to some value. I want to check if a line is
>according to this format.
^^^^^^^^^^^
One example does not define a format. What are the rules?
Do we get to make up any rules as long as that one example
follows them? If so, then I have solved the problem above :-)
>I wrote up something like this - if( $line =~ /(<.*>){5}/ ) to check for
>five <..>, but this is stopping at <c>,
How do you know it is "stopping" there? Code please.
>I guess it is taking <x:<a> as one set.
Right. And there are 3 other "sets", for a total of 4. But your
pattern requires 5. The pattern above cannot match.
Please define what format you want. Can there be only 3 "sub tags":
<x:<a><b><d>>
can there be 5 of them?
<x:<a><b><c><d><e>>
can the angle brackets "overlap"?
<x:<a<b>><c><d><e>>
Too many open questions to even try and write code, can't help
without a better description of what you want.
Perhaps this will help too:
perldoc -q balanced
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Thu, 20 Sep 2001 00:34:08 GMT
From: "David Hilsee" <davidhilseenews@yahoo.com>
Subject: Re: pattern matcher for embedded seperators.
Message-Id: <4Qaq7.492$kA.396377@news1.rdc1.md.home.com>
"Chandra Yemparala" <ychandra@cisco.com> wrote in message
news:3BA932A2.F78D731A@cisco.com...
> Is there a way to write pattern matcher for the following pattern:
>
> <x:<a><b><c><d>>
>
> x,a,b,c,d are going to some value. I want to check if a line is
> according to this format.
>
> I wrote up something like this - if( $line =~ /(<.*>){5}/ ) to check for
> five <..>, but this is stopping at <c>,
> I guess it is taking <x:<a> as one set.
>
> thx
> chandra
>
Your code suggests that the angle brackets are the only thing significant in
the regular expression. That is, <<><><><>> would be considered valid. If
so, then this would work:
/<[^<]*(?:<[^>]*>){4}>/
I think it would be good if you clarified what the input data can and can't
be. If there must be values, then the quantifiers should probably be + and
not *. Perhaps you also want to match the colon. Is whitespace to be
ignored? How many embedded tagged items can there be? It's hard to write
code without knowing these things (mine amounts to a random guess).
By the way, the camel book has an example for matching balanced parenthesis
that could possibly be modified to help you here. Again, that depends on
what the input data can be.
--
David Hilsee
------------------------------
Date: Wed, 19 Sep 2001 23:39:00 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: Perl Compiler
Message-Id: <6maiqt8l23v8bmirh2cdmptt77qslt242s@4ax.com>
Tassilo von Parseval wrote:
>> I heared that there is a compilers for a perl ?
>
>
>Yes. perlcc. Perhaps we should set up a reward for succesful usage
>($500.000 for the one who successfully compiles a script >= 5k).
Perhaps granting a fund to the developer (singular!) would be more
effective.
As most of the B::* modules, B::C and B:::CC are written by Malcolm
Beattie.
Er... can anybody please explain to me why development seems to have
stopped in 1998?
--
Bart.
------------------------------
Date: 19 Sep 2001 17:14:56 -0800
From: yf110@vtn1.victoria.tc.ca (Malcolm Dew-Jones)
Subject: Re: Perl Compiler
Message-Id: <3ba93500@news.victoria.tc.ca>
eDeveloper (webmaster@kwakeb.net) wrote:
: is there a graphical compiler for perl for Linux ? or Windows
Activestate sells a Windows based developer environment for perl, I
believe.
Someone posted an announcement not too long ago about a free one. I tried
it, it looked fine, though I didn't keep it (I'm happy enough with a plain
old editor and my own glue/utility scripts) so I can't tell you what the
url was now.
As for true graphical compilers, there was an interesting article in Dr
Dobbs (?) from a guy working at Digital (?) (no longer of course) who had
a prototype system where you drew little machines that performed tasks and
built your program that way. (I doubt it had anything to do with perl
though.) You could imagine this would be particularly helpful with things
like assembler languages where much of the work consists of shuffling bits
and bytes around between various places in memory, or string
manipulations.
--
Want to access the command line of your CGI account? Need to debug your
installed CGI scripts? Transfer and edit files right from your browser?
What you need is "ispy.cgi" - visit http://nisoftware.com/ispy.cgi
------------------------------
Date: Thu, 20 Sep 2001 01:51:12 +0100
From: "cubol" <irl.com@ntlworld.com>
Subject: Pre spawning in perl
Message-Id: <10aq7.6660$OU5.939131@news2-win.server.ntlworld.com>
Hi all,
I am building a client/server program in perl and would like to
pre-spawn, say 10, child process's and hold them in a pool and pass incoming
connections to these process's.
My theory behind this is that I assume this will give me a increase in
speed if not please tell me, otherwise any ideas on how to do this will be
greatly appreciated.
Gary..
------------------------------
Date: Thu, 20 Sep 2001 00:36:03 GMT
From: mjd@plover.com (Mark Jason Dominus)
Subject: Re: Pre spawning in perl
Message-Id: <3ba939ee.6532$5c@news.op.net>
In article <10aq7.6660$OU5.939131@news2-win.server.ntlworld.com>,
cubol <irl.com@ntlworld.com> wrote:
>Hi all,
> I am building a client/server program in perl and would like to
>pre-spawn, say 10, child process's and hold them in a pool and pass incoming
>connections to these process's.
You don't want to 'pass' incoming connections; it's better if the
incomming connections are attached to the child automatically.
I think you will want to follow an outline something like this:
use POSIX ":sys_wait_h";
socket(S, ...);
bind(S, ...);
listen(S, ...);
my $children = 0;
my $MAX_CHILDREN = 10; # This many children active at once
my $MAX_SERVICE = 100; # children exit after serving this many clients
while (1) {
my $dead_child;
if ($children == $MAX_CHILDREN) {
# Do not continue until at least one child is dead
wait(); # don't forget to check for error here
$children--;
}
# See if any other children are dead
# continue immediately if none are dead
do {
$dead_child = waitpid(-1, &WNOHANG);
--$children unless $dead_child == -1;
} until $dead_child == -1;
# Spawn new children
while ($children < $MAX_CHILDREN) {
my $pid = fork();
unless (defined $pid) {
# couldn't fork; handle this error somehow
}
if ($pid == 0) {
# I am the child
handle_clients();
exit;
}
# I am the parent
$children++;
}
}
sub handle_clients {
my $clients_served = 0;
accept(S, NS); # wait until a conection comes in
# Now deal with the client; it is connected via NS
close NS;
exit if ++$clients_served == $MAX_SERVICE;
}
Here you are letting the child processes inherit the main socket S,
which was set up by the parent process. The parent never bothers to
listen for clients; only the children do that. All ten listen at the
same time. When a client tries to connect, it will be connected to
one of the idle children.
The parent waits around in the while() loop, managing the children and
ignoring the network. When a child dies, the parent tries to spawn a
new one. Most of the time, the parent will be doing wait(), which
will return only when there is a dead child.
I hope I haven't made any serious errors, and that this is helpful.
--
@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{
@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord
($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print
------------------------------
Date: Wed, 19 Sep 2001 23:45:03 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: pretty printing a web page
Message-Id: <nebiqt4n34di75i9cg55b9ki7628oaabdk@4ax.com>
Desrosiers, Benoit [CAR:9F53:EXCH] wrote:
>I have a perl program which generate a web page but when I want to print
>that web page, I only get the left part of it.
Use a browser to print out the rendered page.
--
Bart.
------------------------------
Date: 19 Sep 2001 22:45:57 GMT
From: damian@qimr.edu.au (Damian James)
Subject: Re: returnvalues in perl
Message-Id: <slrn9qi7su.bbg.damian@puma.qimr.edu.au>
On 19 Sep 2001 10:37:55 -0700, Markus said:
>hi,
>i'm new in programming perl, my problem is that I use http_get to a
>perlscript and this script should not gernerate html-code it should
>only return one value,
>has anybody got a code-snippet or an example how this script could
>look like??
Um, is there any particular value you want it to return? And what
exactly do you mean by 'return' if it is not generating valid html,
and you are running in a CGI environment as the above suggests?
I would suggest that you first have a look at the documentation for
the CGI module, which comes as standard with any recent version of
perl. Try `perldoc CGI` from the command line.
Note that is your script is run in a CGI environment, it NEEDS to
output valid http headers at least, otherwise the browser will report
an 'Internal Server Error'.
A simple script unsing the CGI module to dump back whatever form
or query data the browser has passed to it would look like this:
#!/usr/bin/perl -w
use strict;
use CGI;
my $cgi = CGI->new();
print
$cgi->header,
$cgi->start_html("Parameter Dump: $0"),
$cgi->table(
{ -border => 1 },
$cgi->Tr(
[
$cgi->th([ 'Field', 'Value(s)' ]),
map {
$cgi->td(
[
$_, join ', ', $cgi->param($_)
]
)
} sort $cgi->param
]
),
),
$cgi->end_html;
exit;
__END__
HTH
Cheers,
Damian
--
@:=grep!(m!$/|#!..$|),split//,<DATA>;@;=0..$#:;while($:=@;){$;=rand
$:--,@;[$;,$:]=@;[$:,$;]while$:;push@|,shift@;if$;[0]==@|;select$,,
$,,$,,1/80;print qq x\bxx((@;+@|)*$|++),@:[@|,@;],!@;&&$/} __END__
Just another Perl Hacker,### http://home.pacific.net.au/~djames.hub
------------------------------
Date: Wed, 19 Sep 2001 23:43:28 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: returnvalues in perl
Message-Id: <i8biqtk0hv36n02ptjtcge8dln7hvg4dfe@4ax.com>
Markus wrote:
>i'm new in programming perl, my problem is that I use http_get to a
>perlscript and this script should not gernerate html-code it should
>only return one value,
>has anybody got a code-snippet or an example how this script could
>look like??
???
Maybe it's just me, but I have no clue what you're talking about.
"perlscript"? Is this "a perl script" or indeed "PerlScript"? And what
is http_get? That most definitely is not a standard perl command.
Mayben just maybe, you're trying to retrieve a web page, or a status
code, over HTTP. In that case, check out the module set LWP, focussing
on LWP::Simple.
--
Bart.
------------------------------
Date: 19 Sep 2001 15:26:41 -0800
From: yf110@vtn1.victoria.tc.ca (Malcolm Dew-Jones)
Subject: Re: Simple Server/Client
Message-Id: <3ba91ba1@news.victoria.tc.ca>
eDeveloper (webmaster@kwakeb.net) wrote:
: Hi
: Thanks too much
: It really useful
: I created a server and client
: my question is how to pass a scalar form the client to the server ? or from
: the server to client
Exactly the same as if one script writes the data into a file, and then a
second script opens the file and reads in the data.
(It's hard to be more specific than that.)
------------------------------
Date: Wed, 19 Sep 2001 22:18:42 GMT
From: Uri Guttman <uri@sysarch.com>
Subject: Re: Sorting Hashes
Message-Id: <x7d74m7rjb.fsf@home.sysarch.com>
>>>>> "SA" == Steve Allan <stevea@wrq.com> writes:
SA> I added a brute-force routine to sort the ip addresses:
SA> sub sortips {
SA> my($aa, $bb) = @_;
SA> my @aa = split /\./, $aa;
SA> my @bb = split /\./, $bb;
SA> for (0..3) {
SA> return -1 if $aa[$_] < $bb[$_];
SA> return 1 if $aa[$_] > $bb[$_];
SA> }
SA> return 0;
SA> }
SA> exit 0;
SA> __END__
SA> Critiques welcome - that's how I learn.
brute force, i would say brutal. :)
at least seems to be correct. :)
there are several ways to sort IP addresses and one is to pack the value
into an integer and sort on that. this is addressed in:
http://www.sysarch.com/perl/sort_paper.html
along with many other perl sorting ideas.
uri
--
Uri Guttman --------- uri@sysarch.com ---------- http://www.sysarch.com
SYStems ARCHitecture and Stem Development ------ http://www.stemsystems.com
Search or Offer Perl Jobs -------------------------- http://jobs.perl.org
------------------------------
Date: Wed, 19 Sep 2001 22:40:26 GMT
From: Steve Allan <stevea@wrq.com>
Subject: Re: Sorting Hashes
Message-Id: <uwv2un6q0.fsf@wrq.com>
Uri Guttman <uri@sysarch.com> writes:
>>>>>> "SA" == Steve Allan <stevea@wrq.com> writes:
>
>
> SA> I added a brute-force routine to sort the ip addresses:
>
> SA> sub sortips {
> SA> my($aa, $bb) = @_;
> SA> my @aa = split /\./, $aa;
> SA> my @bb = split /\./, $bb;
> SA> for (0..3) {
> SA> return -1 if $aa[$_] < $bb[$_];
> SA> return 1 if $aa[$_] > $bb[$_];
> SA> }
> SA> return 0;
> SA> }
> SA> exit 0;
> SA> __END__
>
> SA> Critiques welcome - that's how I learn.
>
>brute force, i would say brutal. :)
>
>at least seems to be correct. :)
>
>there are several ways to sort IP addresses and one is to pack the value
>into an integer and sort on that. this is addressed in:
>
> http://www.sysarch.com/perl/sort_paper.html
Great stuff - thanks!
--
-- Steve __
------------------------------
Date: 19 Sep 2001 16:13:43 -0500
From: Ren Maddox <ren@tivoli.com>
Subject: Re: Sorting Hashes
Message-Id: <m3zo7qkho8.fsf@dhcp9-161.support.tivoli.com>
On 19 Sep 2001, mjvincent@lucent.com wrote:
> perl guru's,
>
> I have a hash whose index is IP addresses and value is the
> number of times the IP address appears in a file. I'd like to print
> output sorted by the most occurances to the least and secondary
> sorted on the increasing IP address.
>
> An example:
>
> $hash{172.16.5.1} = 5
> $hash{172.16.5.2} = 5
> $hash{172.16.5.3} = 7
> $hash{172.16.6.1} = 10
> $hash{172.16.7.1} = 2
First, are you really using version strings as the keys? It's fine if
you are, but it does make a difference.
> I would like the output to be:
>
> 10 172.16.6.1
> 7 172.16.5.3
> 5 172.16.5.1
> 5 172.16.5.2
> 2 172.16.7.1
[rest snipped]
OK, that's pretty straight-forward. Simply sort the keys by their
corresponding value and break ties by comparing the keys themselves.
If they really are version strings, than they can be compared with a
regular string compare. Otherwise, it is a bit more complicated.
Assuming version strings:
print "$hash{$_} ", join(".", unpack "C4", $_), "\n"
for sort { $hash{$b} <=> $hash{$a} || $a cmp $b } keys %hash;
Assuming literal strings:
print "$hash{$_} $_\n"
for sort { $hash{$b} <=> $hash{$a} ||
pack("C4", split /\./, $a) cmp pack("C4", split /\./, $b)
} keys %hash;
Depending on how big the hash is, that second example could benefit
from a ST or GRT. I expect the first example has little to gain from
such an optimization.
--
Ren Maddox
ren@tivoli.com
------------------------------
Date: 19 Sep 2001 15:10:40 -0700
From: kschmidt@mindspring.com (Kevin J. Schmidt)
Subject: truncate problem
Message-Id: <92541e99.0109191410.856b8e5@posting.google.com>
Hi,
I'm trying to truncate a file to length 0 (truncate FILEH, 0). The
file is being written to by another application, and I do not have the
source code to it. I have no idea if it is using any kind of locking
mechanism (flock, lockf, etc.) when it tries to write to the file, so
I'm not sure if locking the file from my Perl code will do any good.
The call to truncate seems to work at first. If I do an ls -l on the
file, it shows up as 0 bytes. If I do an ls -l a few moments later,
presumably after the other application writes to the file again, the
file has a length and there appears to be holes in the file. This
probably has to do with (at least) the application seeking past the
end of the file when it tries to write new data to the file.
My question is this: How do I truncate a file to length 0, using Perl,
that is being written to by an application that I have no control
over?
Thanks,
-Kevin
Summary of my perl5 (revision 5.0 version 6 subversion 0)
configuration:
Platform:
osname=linux, osvers=2.2.5-22smp, archname=i386-linux
uname='linux porky.devel.redhat.com 2.2.5-22smp #1 smp wed jun 2
09:11:51 edt 1999 i686 unknown '
config_args='-des -Doptimize=-O2 -march=i386 -mcpu=i686 -Dcc=gcc
-Dcccdlflags=-fPIC -Dinstallprefix=/usr -Dprefix=/usr
-Darchname=i386-linux -Dd_dosuid -Dd_semctl_semun -Di_db -Di_ndbm
-Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Uuselargefiles'
hint=recommended, useposix=true, d_sigaction=define
usethreads=undef use5005threads=undef useithreads=undef
usemultiplicity=undef
useperlio=undef d_sfio=undef uselargefiles=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usesocks=undef
Compiler:
cc='gcc', optimize='-O2 -march=i386 -mcpu=i686', gccversion=2.96
20000731 (experimental)
cppflags='-fno-strict-aliasing'
ccflags ='-fno-strict-aliasing'
stdchar='char', d_stdstdio=define, usevfork=false
intsize=4, longsize=4, ptrsize=4, doublesize=8
d_longlong=define, longlongsize=8, d_longdbl=define,
longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=4
alignbytes=4, usemymalloc=n, prototype=define
Linker and Libraries:
ld='gcc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lnsl -ldl -lm -lc -lcrypt
libc=/lib/libc-2.1.92.so, so=so, useshrplib=false,
libperl=libperl.a
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef,
ccdlflags='-rdynamic'
cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'
Characteristics of this binary (from libperl):
Compile-time options:
Built under linux
Compiled at Aug 7 2000 10:59:51
@INC:
/usr/lib/perl5/5.6.0/i386-linux
/usr/lib/perl5/5.6.0
/usr/lib/perl5/site_perl/5.6.0/i386-linux
/usr/lib/perl5/site_perl/5.6.0
/usr/lib/perl5/site_perl
.
------------------------------
Date: Thu, 20 Sep 2001 00:11:54 GMT
From: mjd@plover.com (Mark Jason Dominus)
Subject: Re: truncate problem
Message-Id: <3ba93449.63c5$2f5@news.op.net>
In article <92541e99.0109191410.856b8e5@posting.google.com>,
Kevin J. Schmidt <kschmidt@mindspring.com> wrote:
>This probably has to do with (at least) the application seeking past
>the end of the file when it tries to write new data to the file.
Not exactly, but close.
Every filehandle contains a 'file pointer' that points to the 'current
position' in the file. Reading and writing always takes place at the
current position, as indicated by the file pointer. When the process
writes 57 bytes, the file pointer is incremented by 57 so that the
next write occurs after the previous one.
The other process has its own notion of the 'current position', which
is unaffected by your attempt to truncate the file.
>My question is this: How do I truncate a file to length 0, using Perl,
>that is being written to by an application that I have no control
>over?
I don't think there is any way to do that with Perl or any other
language unless you can get strange help from the OS. For example, I
had a brief fantasy that you might be able to open /proc/$PID/fd/$FD
for the other process and use 'seek' to forcibly modify the file
pointer in the other process, supposing that your OS supports such
tampering. But I don't know of any system that does support such
tampering, and if it didn't work on my (Linux 2.4) machine, it
probably won't work on yours either.
You might want to ask in comp.unix.programmer for more advice, and
then come back here if you can't figure out how to implement the
advice in Perl. (Although I expect the answer will be thatthere is no
solution, I'd be delighted to learn otherwise.)
A workaround may be to replace the file with a FIFO, and let the
mystery application write the data into the FIFO. Then you write a
program to read the FIFO and save the data elsewhere in the manner you
prefer.
--
@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{
@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord
($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.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 1777
***************************************
