[19920] in Perl-Users-Digest
Perl-Users Digest, Issue: 2115 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Nov 12 09:10:33 2001
Date: Mon, 12 Nov 2001 06:10:13 -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: <1005574212-v10-i2115@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Mon, 12 Nov 2001 Volume: 10 Number: 2115
Today's topics:
Re: Return from subroutine behaving unexpectedly <andrew_harton@agilent.com>
Re: Return from subroutine behaving unexpectedly <Tassilo.Parseval@post.rwth-aachen.de>
Re: sorting qestion <perl@cableone.net>
Re: sorting qestion <uri@stemsystems.com>
Re: sorting qestion <Tassilo.Parseval@post.rwth-aachen.de>
starting perl (=?iso-8859-1?q?M=E5ns_Rullg=E5rd?=)
Re: Unencoding <bart.lateur@skynet.be>
Re: Unencoding <geoff@REMOVETHISgeoffball.net>
Writing files using FTP H E L P ! ! <paul.roberts@zfree.co.nz>
Re: Writing files using FTP H E L P ! ! (David Efflandt)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Mon, 12 Nov 2001 09:35:16 -0000
From: "Andrew Harton" <andrew_harton@agilent.com>
Subject: Re: Return from subroutine behaving unexpectedly
Message-Id: <1005557719.530083@cswreg.cos.agilent.com>
> Please produce a small but complete script that actually compiles and
> runs and which illustrates the symptoms.
Here's the complete script. You can see at the top, there are two ways of
calling the main DialogBox subroutine, but only one of them works and I have
no idea why the other one doesn't. I'm using ActiveState Perl 5.6.1 build
628 with Windows NT, in case that's relevant.
Thanks,
Andrew
#!/usr/bin/perl
use strict;
use warnings;
use Win32::Console;
use File::Spec;
if(my $val = DialogBox("c:\\cpi",".txt","Select Text File : ")) # This
works
{
print "Selection : $val \n";
}
#my ($val) = DialogBox("c:\\winnt",".txt","Select Text File : "); # This
doesn't work
#print "Selection : $val \n";
sub DialogBox
{
my ($dir,$extn,$message) = @_;
my $OUT = new Win32::Console(STD_OUTPUT_HANDLE);
my $IN = new Win32::Console(STD_INPUT_HANDLE);
my($x_size, $y_size) = $OUT->Size();
my $selection = "";
do
{
my @filelist = GetFiles($dir,$extn);
my $columns = int($#filelist/($y_size-4))+1;
DisplayDirectory($OUT,$x_size,$y_size,$columns,$message,@filelist);
do
{
$selection = GetInput($IN,$x_size,$y_size,$columns,@filelist);
}
while(!$selection);
$OUT->WriteChar("$selection",1,$y_size-1);
if(-d $selection)
{
$dir = $selection;
}
}
while(!-f $selection);
$OUT->Cls();
print "Returning $selection\n";
return $selection;
}
sub GetInput
{
my ($INPUT,$x_sz,$y_sz,$cols,@list) = @_;
my $col_width = int($x_sz / $cols);
my $selection = "";
$INPUT->Mode(ENABLE_MOUSE_INPUT);
my @event = $INPUT->Input();
if($event[5] && $event[5] == 2)
{
my $x = int($event[1]/$col_width);
my $y = $event[2]-2;
if($selection = $list[$x*($y_sz-4)+$y])
{
return $selection;
}
}
}
sub GetFiles
{
my ($directory, $extension) = @_;
chdir($directory);
my @dirs = ();
my @files = ();
my @drives = ("C:","D:","E:");
while ($#drives >0)
{
my $drv = shift @drives;
if (-d $drv)
{
push @dirs,$drv;
}
}
push @dirs,"..";
while(<*>)
{
if(-d $_)
{
push @dirs,$_;
}
elsif($_ =~ m/$extension$/)
{
push @files,$_;
}
}
return @dirs,@files;
}
sub DisplayDirectory
{
my ($CONSOLE,$x_sz,$y_sz,$cols,$message,@list) = @_;
$CONSOLE->Cls();
$CONSOLE->WriteChar("$message",1,0);
my $directory = File::Spec->rel2abs();
$CONSOLE->WriteChar("$directory",40,0);
my $col_width = int($x_sz / $cols);
for(my $x = 0;$x < $cols;$x++)
{
FilledBox($CONSOLE,$::FG_WHITE|$::BG_BLUE," ",$x*$col_width+1, 1,
$col_width-2, $y_sz-3);
BorderBox($CONSOLE,$x*$col_width+1, 1, $col_width-2, $y_sz-3);
}
for(my $x = 0;$x < $cols;$x++)
{
for(my $y = 0;$y < $y_sz-4;$y++)
{
if(my $name = $list[$x*($y_sz-4)+$y])
{
if(length($name) > $col_width-4)
{
$name = substr($name,0,$col_width-5).">";
}
if(-d $list[$x*($y_sz-4)+$y])
{
$CONSOLE->FillAttr($::FG_YELLOW|$::BG_BLUE,$col_width-4,
$x*$col_width+2, $y+2);
}
$CONSOLE->WriteChar("$name", $x*$col_width+2, $y+2);
}
}
}
if($#list > $cols*($y_sz-4) )
{
$CONSOLE->WriteChar("-->", $x_sz-3,$y_sz-1);
}
}
sub FilledBox
{
my($O, $color, $char, $left, $top, $width, $height) = @_;
my $row = 0;
for $row ($top..$top+$height)
{
$O->FillAttr($color, $width, $left, $row);
$O->FillChar($char, $width, $left, $row);
}
}
sub BorderBox
{
my($O, $left, $top, $width, $height) = @_;
$O->FillChar(chr(218), 1, $left, $top);
$O->FillChar(chr(196), $width-2, $left+1, $top);
$O->FillChar(chr(191), 1, $left+$width-1, $top);
my $row = 0;
for $row ($top+1..$top+$height-1)
{
$O->FillChar(chr(179), 1, $left, $row);
$O->FillChar(chr(179), 1, $left+$width-1, $row);
}
$O->FillChar(chr(192), 1, $left, $top+$height);
$O->FillChar(chr(196), $width-2, $left+1, $top+$height);
$O->FillChar(chr(217), 1, $left+$width-1, $top+$height);
}
------------------------------
Date: Mon, 12 Nov 2001 10:44:38 +0100
From: "Tassilo v. Parseval" <Tassilo.Parseval@post.rwth-aachen.de>
Subject: Re: Return from subroutine behaving unexpectedly
Message-Id: <9so5m6$mng$01$1@news.t-online.com>
On Mon, 12 Nov 2001 09:35:16 -0000, Andrew Harton wrote:
>
>> Please produce a small but complete script that actually compiles and
>> runs and which illustrates the symptoms.
>
> Here's the complete script. You can see at the top, there are two ways of
> calling the main DialogBox subroutine, but only one of them works and I have
> no idea why the other one doesn't. I'm using ActiveState Perl 5.6.1 build
> 628 with Windows NT, in case that's relevant.
[snipped massive amount of Perl code]
When nobull asked for a complete script he (explicitely) asked for a
small one. No one here really wants to dig through 180 or so lines of
code written by someone else with someone else's logic.
Now again: Can you produce a *working* *subset* of your current script
that reproduces the error you had been mentioning?
If this is not possible (there are situations when it is hard to subset
a script) then please add marks to it so that we can quickly find the
relevant parts. In such cases, line numbers would also be a good thing.
Thank you.
Tassilo
--
A complex system that works is invariably found to have evolved from a
simple system that works.
------------------------------
Date: Mon, 12 Nov 2001 02:21:25 -0600
From: "Jason Gray" <perl@cableone.net>
Subject: Re: sorting qestion
Message-Id: <tuv1llbs3079cf@corp.supernews.com>
You can also try this:
# Sorts a list in alphabetical order
# Example @array = sort_list(@array);
sub sort_list {
local(@list) = @_;
local($a, $b) = "";
@list = sort {uc($a) cmp uc($b)} @list;
return @list;
}
------------------------------
Date: Mon, 12 Nov 2001 08:34:50 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: sorting qestion
Message-Id: <x7bsi8l729.fsf@home.sysarch.com>
>>>>> "JG" == Jason Gray <perl@cableone.net> writes:
JG> You can also try this:
JG> # Sorts a list in alphabetical order
JG> # Example @array = sort_list(@array);
JG> sub sort_list {
JG> local(@list) = @_;
why local? why copy @_?
JG> local($a, $b) = "";
what does that do? it is wrong on severl levels. why does $a get "" and
$b get undef? do you realize that $a and $b are aliased in the sort
block and this won't affect them in any useful way?
JG> @list = sort {uc($a) cmp uc($b)} @list;
why assign @list just to return it next?
JG> return @list;
how about:
@array = sort { uc( $a ) cmp uc( $b ) } @array
kinda looks a little simpler.
:)
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
-- Stem is an Open Source Network Development Toolkit and Application Suite -
----- Stem and Perl Development, Systems Architecture, Design and Coding ----
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
------------------------------
Date: Mon, 12 Nov 2001 09:41:22 +0100
From: "Tassilo v. Parseval" <Tassilo.Parseval@post.rwth-aachen.de>
Subject: Re: sorting qestion
Message-Id: <9so1vi$he2$01$1@news.t-online.com>
[
It'd be nice if you quoted the relevant part of the original post.
Now I have to press "ESCAPE p" to find out what you have been
referring to.
]
On Mon, 12 Nov 2001 02:21:25 -0600, Jason Gray wrote:
> You can also try this:
>
> # Sorts a list in alphabetical order
> # Example @array = sort_list(@array);
> sub sort_list {
> local(@list) = @_;
> local($a, $b) = "";
> @list = sort {uc($a) cmp uc($b)} @list;
> return @list;
> }
These local-statements look dubious. As for the first one, you should
definitely use my there since this is not about dynamic scoping here.
The second one will set $a = "" and leave $b untouched. Anyway, you
don't need to localize nor to my the two special variables $a and $b.
Tassilo
--
Variables don't; constants aren't.
------------------------------
Date: 12 Nov 2001 13:38:19 +0100
From: mru@users.sf.net (=?iso-8859-1?q?M=E5ns_Rullg=E5rd?=)
Subject: starting perl
Message-Id: <yw1xr8r46u6c.fsf@flour.e.kth.se>
What is the right way to execute a perl script with the first perl in
PATH? Since perl will run whatever is on a #! line things like
#!/bin/sh
#\
exec perl $0 $*
will not work as it does with e.g. wish. The problem is that
/usr/bin/perl is old but there is a new version elsewhere.
--
Måns Rullgård
e99_mru@e.kth.se
------------------------------
Date: Mon, 12 Nov 2001 08:51:18 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: Unencoding
Message-Id: <s73vutk4fnpfinqg7ganimt43i6nqitk8l@4ax.com>
Geoff wrote:
>> I just found this on CPAN:
>>
>> $code =~ s/([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
>>
>> Is that going to work for all hex codes?
You forgot a "%" in the regex.
>> Geoff
>
>Does not work!!
>
>All I get as output is a whole bunch of %'s, which are occasionally followed
>by a character (usually letters).
>
>I guess this wasn't what I saw before.
No. It's more like:
$code =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
But if you don't have a good reason to reinvent that wheel, I'd suggest
using a CGI library to decode those CGI parameters, like CGI, CGI::Lite,
CGI::Minimal, CGI::Query, and then some more.
--
Bart.
------------------------------
Date: Mon, 12 Nov 2001 13:44:11 GMT
From: "Geoff" <geoff@REMOVETHISgeoffball.net>
Subject: Re: Unencoding
Message-Id: <LmQH7.45559$5e2.7656519@news1.telusplanet.net>
"Bart Lateur" <bart.lateur@skynet.be> wrote in message
news:s73vutk4fnpfinqg7ganimt43i6nqitk8l@4ax.com...
> $code =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
This works perfectly. Thank you Bart, and Tassilo too.
Geoff
------------------------------
Date: Mon, 12 Nov 2001 08:42:55 GMT
From: "Perly Paul" <paul.roberts@zfree.co.nz>
Subject: Writing files using FTP H E L P ! !
Message-Id: <3bef8b8c$1@zfree.co.nz>
Hi
I'm learning Perl, but I'm having so many problems trying to write a file
to a secure server.
I haven't had any problems witing a normal text file, but as the directory
where I want to place the file is different from the location of the CGI
script (It sits in the cgi-bin, and I'm not allowed to change this). As this
directory will be protected with an htaccess file, I think I'll have to do
this using a ftp address with the password & username included in the string:
The format I used was ftp://username:password\@myhost.com/data but I just
can't work out why I can't seem to write to the server. The same format worked
for PHP without the backslash, but I'm not allowed PHP.
Any ideas
Perly Paul
http://www.zfree.co.nz
------------------------------
Date: Mon, 12 Nov 2001 13:29:43 +0000 (UTC)
From: efflandt@xnet.com (David Efflandt)
Subject: Re: Writing files using FTP H E L P ! !
Message-Id: <slrn9uvjm6.4l9.efflandt@typhoon.xnet.com>
On Mon, 12 Nov 2001 08:42:55 GMT, Perly Paul <paul.roberts@zfree.co.nz> wrote:
>
> I'm learning Perl, but I'm having so many problems trying to write a file
> to a secure server.
>
> I haven't had any problems witing a normal text file, but as the directory
> where I want to place the file is different from the location of the CGI
> script (It sits in the cgi-bin, and I'm not allowed to change this). As this
> directory will be protected with an htaccess file, I think I'll have to do
> this using a ftp address with the password & username included in the string:
>
> The format I used was ftp://username:password\@myhost.com/data but I just
> can't work out why I can't seem to write to the server. The same format worked
> for PHP without the backslash, but I'm not allowed PHP.
I hope you are not trying to use a URL in an open() statement.
If the file is on the same server and your CGI has write permission to it,
you could simply write it locally. The .htaccess file has no effect for
access from FTP, the local shell, or from your CGI on the same server, it
only controls http access. But it is quite possible to have a permission
or path problem. That is why you should always return a meaningful error
msg including $! if an open fails.
If it is on a different server, use the Perl Net::FTP module or LWP.
--
David Efflandt - All spam is ignored - http://www.de-srv.com/
http://www.autox.chicago.il.us/ http://www.berniesfloral.net/
http://cgi-help.virtualave.net/ http://hammer.prohosting.com/~cgi-wiz/
------------------------------
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 2115
***************************************
