[7185] in Perl-Users-Digest
Perl-Users Digest, Issue: 809 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Aug 4 02:20:41 1997
Date: Sat, 2 Aug 97 18:03:26 -0700
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sat, 2 Aug 1997 Volume: 8 Number: 809
Today's topics:
Re: file extensions (Tad McClellan)
File::Find bugs (and patches) (Conrad E. Kimball)
Re: Microsoft violating Perl license? (was Re: arrogant Steve_Kilbane@cegelecproj.co.uk
query string on a security server <dcanham@rochgrp.com>
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 31 Jul 1997 07:13:05 -0500
From: tadmc@flash.net (Tad McClellan)
Subject: Re: file extensions
Message-Id: <hgvpr5.br.ln@localhost>
Simon Fairey (sfairey@adc.metrica.co.uk) wrote:
: Shaun O'Shea wrote:
: > I would like to use this array to create another array which just
: > contains the file extensions i.e.
: > .Uen.A.fmk
: > .Uen.B.fmk
: > .Uen.A.fmk
: > .Uen.A.fmk
: >
: > I tried to find some way to substitute everything up as far as the
: > first
: > "." with nothing but I couldn't.
: >
: > Any offerings appreciated.
: Try the following:
: @files = ( 'address/of/the/file/in/question/file1.Uen.A.fmk',
: 'address/of/the/file/in/question/file1.Uen.B.fmk',
: 'address/of/the/file/in/question/file2.Uen.A.fmk',
: 'address/of/the/file/in/question/file3.Uen.A.fmk' );
: foreach( @files ) {
: /\/\w+([\w\.]+)$/;
: push @exts, $1;
If you process one that has no dots in it, then the previous one
will get entered twice ($1 from the _previous_ match...)
push @exts, $1 if /\/\w+([\w\.]+)$/;
: }
That one fails on:
address/of/the/file/in/question/file-1.Uen.A.fmk
address/of/the/file/in/question/file1.Uen-A.fmk
/file1.Uen-A.fmk
--
Tad McClellan SGML Consulting
Tag And Document Consulting Perl programming
tadmc@flash.net
------------------------------
Date: Fri, 1 Aug 1997 08:42:33 GMT
From: cek@bcstec.ca.boeing.com (Conrad E. Kimball)
Subject: File::Find bugs (and patches)
Message-Id: <EE886x.8HI@news.boeing.com>
>From cek Thu Jul 3 17:45:40 1997
To: perlbug@perl.com
Subject: File::Find bugs (and patches)
This is a bug report for perl from cek@bcstec.ca.boeing.com,
generated with the help of perlbug 1.17 running under perl 5.00401.
-----------------------------------------------------------------
[Please enter your report here]
The File::Find module exhibits the following defects:
1) If the top-level directory is a symbolic link to another directory,
the find() and finddepth() functions follow that symbolic link and
traverse that directory. This behavior is both contrary to the way
the real find command works and contrary to the way find() and
finddepth() treat symbolic links that occur lower down in the
directory hierarchy (which aren't followed).
Example:
$ cd $HOME
$ mkdir findbug; cd findbug
$ ln -s /usr usr
$ find usr -print
usr
$ find2perl usr -print | perl
usr
usr/lost+found
usr/tmp
usr/tmp/.zma25637cbbb
...
2) If the wanted() function sets $prune = 1 for a top-level directory,
the find() function ignores it. It honors $prune for all lower level
directories, but not the top-level ones. This, too, is contrary to
the way the real find command works.
Example:
$ find /usr -print -prune
/usr
$ find2perl /usr -print -prune | perl
/usr
/usr/lost+found
/usr/tmp
/usr/bin
/usr/man
/usr/etc
/usr/lib
/usr/netdemo
/usr/include
/usr/adm
...
3) If finddepth() is passed a top-level path that is not a directory, it
fails to set $name before calling the wanted() function. This, too,
is contrary to the way the real find command works.
Example:
$ cd $HOME
$ find /dev/null -depth -print
/dev/null
$ find2perl /dev/null -depth -print | perl
$
4) finddepth() uses fastcwd(), while find() uses cwd(). fastcwd()
is less reliable than cwd().
5) When find() calls wanted() on top-level directories it sets $name
and $dir to $topdir (the original top-level directory name) but
when finddepth() calls wanted() on top-level directories it sets
$name and $dir as $fixtopdir (the original top-level directory
name stripped of any trailing slash, ".dir" suffix on VMS systems,
or "\\dir" suffix on NT systems). I'm not sure which behavior is
"correct", but surely find() and finddepth() should behave the
same way. (I chose to make finddepth() behave as find().)
6) If finddepthdir() can't open a directory, it prints a warning
message but then keeps going and tries to read the directory.
By contrast finddir() handles that case by printing a warning
message and immediately returning.
7) In several places find() and finddepth() silently ignore failed
chdir()'s, instead of printing a warning message. This isn't a
defect per se, but it is inconsistent with behavior of failed
stat()'s and chdir()'s elsewhere that do print messages.
The following patch corrects all these defects:
*** lib/File/Find.pm.orig Fri Aug 1 00:36:24 1997
--- lib/File/Find.pm Fri Aug 1 01:14:37 1997
***************
*** 17,23 ****
use File::Find;
find(\&wanted, '/foo','/bar');
sub wanted { ... }
!
use File::Find;
finddepth(\&wanted, '/foo','/bar');
sub wanted { ... }
--- 17,23 ----
use File::Find;
find(\&wanted, '/foo','/bar');
sub wanted { ... }
!
use File::Find;
finddepth(\&wanted, '/foo','/bar');
sub wanted { ... }
***************
*** 34,40 ****
File::Find assumes that you don't alter the $_ variable. If you do then
make sure you return it to its original value before exiting your function.
! This library is primarily for the C<find2perl> tool, which when fed,
find2perl / -name .nfs\* -mtime +7 \
-exec rm -f {} \; -o -fstype nfs -prune
--- 34,40 ----
File::Find assumes that you don't alter the $_ variable. If you do then
make sure you return it to its original value before exiting your function.
! This library is primarily for the C<find2perl> tool, which when fed,
find2perl / -name .nfs\* -mtime +7 \
-exec rm -f {} \; -o -fstype nfs -prune
***************
*** 63,69 ****
sub wanted {
-l && !-e && print "bogus link: $File::Find::name\n";
! }
=cut
--- 63,69 ----
sub wanted {
-l && !-e && print "bogus link: $File::Find::name\n";
! }
=cut
***************
*** 78,92 ****
# compatibility.
local($topdir,$topdev,$topino,$topmode,$topnlink);
foreach $topdir (@_) {
! (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
|| (warn("Can't stat $topdir: $!\n"), next);
if (-d _) {
if (chdir($topdir)) {
($dir,$_) = ($topdir,'.');
$name = $topdir;
&$wanted;
my $fixtopdir = $topdir;
! $fixtopdir =~ s,/$,, ;
$fixtopdir =~ s/\.dir$// if $Is_VMS;
$fixtopdir =~ s/\\dir$// if $Is_NT;
&finddir($wanted,$fixtopdir,$topnlink);
--- 78,95 ----
# compatibility.
local($topdir,$topdev,$topino,$topmode,$topnlink);
foreach $topdir (@_) {
! (($topdev,$topino,$topmode,$topnlink) =
! ($Is_VMS ? stat($topdir) : lstat($topdir)))
|| (warn("Can't stat $topdir: $!\n"), next);
if (-d _) {
if (chdir($topdir)) {
($dir,$_) = ($topdir,'.');
$name = $topdir;
+ $prune = 0;
&$wanted;
+ next if $prune;
my $fixtopdir = $topdir;
! $fixtopdir =~ s,/$,, ;
$fixtopdir =~ s/\.dir$// if $Is_VMS;
$fixtopdir =~ s/\\dir$// if $Is_NT;
&finddir($wanted,$fixtopdir,$topnlink);
***************
*** 99,106 ****
unless (($_,$dir) = File::Basename::fileparse($topdir)) {
($dir,$_) = ('.', $topdir);
}
! $name = $topdir;
! chdir $dir && &$wanted;
}
chdir $cwd;
}
--- 102,114 ----
unless (($_,$dir) = File::Basename::fileparse($topdir)) {
($dir,$_) = ('.', $topdir);
}
! if (chdir($dir)) {
! $name = $topdir;
! &$wanted;
! }
! else {
! warn "Can't cd to $dir: $!\n";
! }
}
chdir $cwd;
}
***************
*** 127,133 ****
&$wanted;
}
}
! else { # This dir has subdirectories.
$subcount = $nlink - 2;
for (@filenames) {
next if $_ eq '.';
--- 135,141 ----
&$wanted;
}
}
! else { # This dir has subdirectories.
$subcount = $nlink - 2;
for (@filenames) {
next if $_ eq '.';
***************
*** 141,158 ****
($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
# unless ($nlink || $dont_use_nlink);
!
if (-d _) {
# It really is a directory, so do it recursively.
! if (!$prune && chdir $_) {
$name =~ s/\.dir$// if $Is_VMS;
$name =~ s/\\dir$// if $Is_NT;
&finddir($wanted,$name,$nlink);
chdir '..';
}
! --$subcount;
}
}
}
--- 149,170 ----
($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
# unless ($nlink || $dont_use_nlink);
!
if (-d _) {
# It really is a directory, so do it recursively.
! --$subcount;
! next if $prune;
! if (chdir $_) {
$name =~ s/\.dir$// if $Is_VMS;
$name =~ s/\\dir$// if $Is_NT;
&finddir($wanted,$name,$nlink);
chdir '..';
}
! else {
! warn "Can't cd to $_: $!\n";
! }
}
}
}
***************
*** 162,175 ****
sub finddepth {
my $wanted = shift;
!
! $cwd = Cwd::fastcwd();;
!
# Localize these rather than lexicalizing them for backwards
# compatibility.
! local($topdir, $topdev, $topino, $topmode, $topnlink);
foreach $topdir (@_) {
! (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
|| (warn("Can't stat $topdir: $!\n"), next);
if (-d _) {
if (chdir($topdir)) {
--- 174,186 ----
sub finddepth {
my $wanted = shift;
! my $cwd = Cwd::cwd();
# Localize these rather than lexicalizing them for backwards
# compatibility.
! local($topdir,$topdev,$topino,$topmode,$topnlink);
foreach $topdir (@_) {
! (($topdev,$topino,$topmode,$topnlink) =
! ($Is_VMS ? stat($topdir) : lstat($topdir)))
|| (warn("Can't stat $topdir: $!\n"), next);
if (-d _) {
if (chdir($topdir)) {
***************
*** 178,185 ****
$fixtopdir =~ s/\.dir$// if $Is_VMS;
$fixtopdir =~ s/\\dir$// if $Is_NT;
&finddepthdir($wanted,$fixtopdir,$topnlink);
! ($dir,$_) = ($fixtopdir,'.');
! $name = $fixtopdir;
&$wanted;
}
else {
--- 189,196 ----
$fixtopdir =~ s/\.dir$// if $Is_VMS;
$fixtopdir =~ s/\\dir$// if $Is_NT;
&finddepthdir($wanted,$fixtopdir,$topnlink);
! ($dir,$_) = ($topdir,'.');
! $name = $topdir;
&$wanted;
}
else {
***************
*** 190,196 ****
unless (($_,$dir) = File::Basename::fileparse($topdir)) {
($dir,$_) = ('.', $topdir);
}
! chdir $dir && &$wanted;
}
chdir $cwd;
}
--- 201,213 ----
unless (($_,$dir) = File::Basename::fileparse($topdir)) {
($dir,$_) = ('.', $topdir);
}
! if (chdir($dir)) {
! $name = $topdir;
! &$wanted;
! }
! else {
! warn "Can't cd to $dir: $!\n";
! }
}
chdir $cwd;
}
***************
*** 199,213 ****
sub finddepthdir {
my($wanted, $nlink);
local($dir, $name);
! ($wanted,$dir,$nlink) = @_;
my($dev, $ino, $mode, $subcount);
# Get the list of files in the current directory.
! opendir(DIR,'.') || warn "Can't open $dir: $!\n";
my(@filenames) = readdir(DIR);
closedir(DIR);
! if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories.
for (@filenames) {
next if $_ eq '.';
next if $_ eq '..';
--- 216,230 ----
sub finddepthdir {
my($wanted, $nlink);
local($dir, $name);
! ($wanted, $dir, $nlink) = @_;
my($dev, $ino, $mode, $subcount);
# Get the list of files in the current directory.
! opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
my(@filenames) = readdir(DIR);
closedir(DIR);
! if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories.
for (@filenames) {
next if $_ eq '.';
next if $_ eq '..';
***************
*** 216,222 ****
&$wanted;
}
}
! else { # This dir has subdirectories.
$subcount = $nlink - 2;
for (@filenames) {
next if $_ eq '.';
--- 233,239 ----
&$wanted;
}
}
! else { # This dir has subdirectories.
$subcount = $nlink - 2;
for (@filenames) {
next if $_ eq '.';
***************
*** 228,238 ****
# Get link count and check for directoriness.
($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
!
if (-d _) {
# It really is a directory, so do it recursively.
if (chdir $_) {
$name =~ s/\.dir$// if $Is_VMS;
$name =~ s/\\dir$// if $Is_NT;
--- 245,256 ----
# Get link count and check for directoriness.
($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
!
if (-d _) {
# It really is a directory, so do it recursively.
+ --$subcount;
if (chdir $_) {
$name =~ s/\.dir$// if $Is_VMS;
$name =~ s/\\dir$// if $Is_NT;
***************
*** 239,245 ****
&finddepthdir($wanted,$name,$nlink);
chdir '..';
}
! --$subcount;
}
}
&$wanted;
--- 257,265 ----
&finddepthdir($wanted,$name,$nlink);
chdir '..';
}
! else {
! warn "Can't cd to $_: $!\n";
! }
}
}
&$wanted;
--
Conrad Kimball | Client Server Tech Svcs, Boeing Information & Supt.
cek@bcstec.ca.boeing.com | P.O. Box 24346, MS 7M-HC
(425) 865-6410 | Seattle, WA 98124-0346
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Site configuration information for perl 5.00401:
Configured by vds at Fri Jun 20 13:43:07 PDT 1997.
Summary of my perl5 (5.0 patchlevel 4 subversion 1) configuration:
Platform:
osname=hpux, osvers=10, archname=PA-RISC1.1
uname='hp-ux tblv021 a.09.04 e 9000887 473356251 8-user license '
hint=recommended, useposix=true, d_sigaction=define
bincompat3=y useperlio= d_sfio=
Compiler:
cc='cc', optimize='-O', gccversion=
cppflags='-D_HPUX_SOURCE -Aa'
ccflags ='-D_HPUX_SOURCE -Aa'
stdchar='unsigned char', d_stdstdio=define, usevfork=false
voidflags=15, castflags=0, d_casti32=, d_castneg=define
intsize=4, alignbytes=8, usemymalloc=y, randbits=15
Linker and Libraries:
ld='ld', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib/pa1.1 /lib /usr/lib
libs=-lnet -lnsl_s -lndbm -ldld -lm -lc -lndir -lcrypt
libc=/lib/libc.sl, so=sl
useshrplib=false, libperl=libperl.a
Dynamic Linking:
dlsrc=dl_hpux.xs, dlext=sl, d_dlsymun=, ccdlflags='-Wl,-E -Wl,-B,deferred '
cccdlflags='+z', lddlflags='-b -L/usr/local/lib'
---
@INC for perl 5.00401:
/opt/perl5.004/lib/PA-RISC1.1/5.00401
/opt/perl5.004/lib
/opt/perl5.004/lib/site_perl/PA-RISC1.1
/opt/perl5.004/lib/site_perl
.
---
Environment for perl 5.00401:
HOME=/tblv021/home1/cek
LANG (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=.:/tblv021/home1/cek/bin/parisc-hpux-9:/tblv021/home1/cek/bin:/tblv021/home1/cek/opt/bin/parisc-hpux-9:/tblv021/home1/cek/opt/bin:/bin/posix:/bin:/usr/bin:/usr/contrib/bin:/usr/bin/X11:/usr/contrib/bin/X11:/usr/vue/bin:/etc:/usr/dt/bin:/opt/bin:/boeing/bin:/usr/local/bin:/usr/atria/bin
PERL_BADLANG (unset)
SHELL=/bin/ksh
--
Conrad Kimball | Client Server Tech Svcs, Boeing Information & Supt.
cek@bcstec.ca.boeing.com | P.O. Box 24346, MS 7M-HC
(425) 865-6410 | Seattle, WA 98124-0346
------------------------------
Date: Fri, 01 Aug 1997 08:51:55 GMT
From: Steve_Kilbane@cegelecproj.co.uk
Subject: Re: Microsoft violating Perl license? (was Re: arrogant #*(@#)
Message-Id: <817cd$83337.35c@news.cegelecproj.co.uk>
In article <5rrna3$mag$1@lennon.postino.com>, danny@lennon.postino.com (Danny Aldham) writes:
> Get the GNU-win32 dev kit at ftp.cygnus.com , and roll your own
> fully-functional perl.
Or, indeed, just build the varients included in 5.004_1. I don't
*think* we've had any problems with it on our wintel and OS/2
boxes...
No, I take that back. We`ve had problems due to bizarre
shell-ness when using system(), but that's hardly surprising.
--
<Steve_Kilbane@cegelecproj.co.uk> - All opinions are mine alone.
Kilbane's law of integration: standardise on protocols and file
formats, and the applications take care of themselves.
------------------------------
Date: Thu, 31 Jul 1997 12:50:29 -0400
From: Daniel Canham <dcanham@rochgrp.com>
Subject: query string on a security server
Message-Id: <33E0C255.80113614@rochgrp.com>
The below subroutine attatches to a httpd that requires password
authentication. It works perfectly for capturing the HTML at the URL.
However I'm having problems getting a similar subroutine to work with
the URI::URL module, more specifically the $url->equery() function. I
just want to get the Query string back from the webpage. Anyone know
what I'm doing wrong, or another function that would perform the same
thing??
-Dan
sub cap_html
{
# initializing the user agent
my $useragent = new LWP::UserAgent;
# setting the user agent value
$useragent->agent("project/1.0");
# initializing the request value
my $request = new HTTP::Request("GET", $requestpage);
# sending request with login name and password
$request->authorization_basic("username","password");
# setting value of the response variable
my $response = $useragent->request($request);
# checking to see if there is a good response
if($response->is_success)
{
# setting the html capture variablethe html received
$html_capture = $response->content;
}
else
{
# printing the error received
print "HTML Error: " . $response->message . "\n";
}
}
------------------------------
Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 8 Mar 97)
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.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V8 Issue 809
*************************************
