[22900] in Perl-Users-Digest
Perl-Users Digest, Issue: 5120 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Jun 14 09:05:49 2003
Date: Sat, 14 Jun 2003 06:05:09 -0700 (PDT)
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, 14 Jun 2003 Volume: 10 Number: 5120
Today's topics:
** EVIDENCE ELIMINATING SOFTWARE** lfmzps@yhd65.com
** EVIDENCE ELIMINATING SOFTWARE** lfmzps@yhd65.com
Re: book <matthew@weierophinney.net>
Re: book <dont@want.spam>
Re: book <ict@eh.org>
DB_File:Lock <ixanthi@ixanthi.remove.gr>
Re: DB_File:Lock <nobody@dev.null>
Re: encrypt/decrypt module that uses only printable cha <zentara@highstream.net>
Re: https authentication ([nix])
Re: JPG RGB to JPG CMYK <mgjv@tradingpost.com.au>
Mail::POP3Client - Login Issue <soneill@ciktech.com>
Re: Mail::POP3Client - Login Issue <noreply@gunnar.cc>
Re: Perl 5.8 UTF-8 RedHat SLOW (Graham Smith)
read locks <john62@electronmail.com>
Re: read locks <tassilo.parseval@rwth-aachen.de>
Re: read locks <arc_of_descent@gmx.net>
Re: Recursive Copying Script Question <kha@rogers.com>
Re: Recursive Copying Script Question (Graham Smith)
Re: redirect location prints to screen jnam@sunnybrook.com
Re: redirect location prints to screen <flavell@mail.cern.ch>
Re: regexp challenge (Graham Smith)
Tad McClellan <jds@trumpetweb.co.uk>
Re: Tad McClellan (Randal L. Schwartz)
Re: Tad McClellan (Graham Smith)
Re: Tad McClellan <mgjv@tradingpost.com.au>
Re: Using a while loop to search/remove lines.. (Eric)
Re: variables printed are the same yet fail equality te (David Sperling)
Re: Which value is tha largest(benchmarked) <mgjv@tradingpost.com.au>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 14 Jun 2003 05:28:38 GMT
From: lfmzps@yhd65.com
Subject: ** EVIDENCE ELIMINATING SOFTWARE** ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd 3100 [1/2]
Message-Id: <3eeab286$0$28032$ba620e4c@reader1.news.skynet.be>
You're in Serious Trouble - It's a Proven Fact!
FBI FORENSICS CAN FIND DELETED FILES
THERE ARE THINGS ON YOUR COMPUTER
THAT YOU THOUGHT YOU DELETED.
!!!!BUT THEY ARE STILL THERE!!!
Click here for details on the EVIDENCE ELIMINATOR
Clear your computer of incriminating files
that you cannot delete.
www.cleanthedisk.com
THIS IS A MUST READ!!!!
www.cleanthedisk.com
ew5r4325435435435435
43
543
5
435
435
43
5
435
435435
4360i0iretret=reyt-=erfgytkretretretretretretretretredfgfdgfdgfd
ertretretretretretg
dfgh
gfd
hgfd
h
d
gf
h
gfd
hgfd
h
fdgh
gfd
hgfdh
ewfrgh32gh02439-eftrpewjtrrewgfs
dg
fd
g
fds
g
fds
g
fds
g
fds
g
fds
gfds
g
fd
g
fdasdsadsadsad
fds
g
fd
g
fdsg
sbpprlrjjrqstkynhgjxoggzkplqhwcqvywdrvqgmetyjliileiqpncjrvxvqwcnibdffucxkmmpckzjbzwunkjrhffvwjwijtqqxjxsggflnkwzhgm
------------------------------
Date: 14 Jun 2003 05:28:39 GMT
From: lfmzps@yhd65.com
Subject: ** EVIDENCE ELIMINATING SOFTWARE** ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd 3100 [639/2]
Message-Id: <3eeab286$1$28032$ba620e4c@reader1.news.skynet.be>
begin 644 407dfr.txt
M66]U)W)E(&EN(%-E<FEO=7,@5')O=6)L92 M($ET)W,@82!0<F]V96X@1F%C
M="$-"@T*1D))($9/4D5.4TE#4R!#04X@1DE.1"!$14Q%5$5$($9)3$53#0H-
M"E1(15)%($%212!42$E.1U,@3TX@64]54B!#3TU0551%4@T*5$A!5"!93U4@
M5$A/54=(5"!93U4@1$5,151%1"X-"@T*(2$A(4)55"!42$59($%212!35$E,
M3"!42$5212$A(0T*#0I#;&EC:R!H97)E(&9O<B!D971A:6QS(&]N('1H92!%
M5DE$14Y#12!%3$E-24Y!5$]2#0H-"D-L96%R('EO=7(@8V]M<'5T97(@;V8@
M:6YC<FEM:6YA=&EN9R!F:6QE<PT*=&AA="!Y;W4@8V%N;F]T(&1E;&5T92X-
M"@T*=W=W+F-L96%N=&AE9&ES:RYC;VT-"@T*5$A)4R!)4R!!($U54U0@4D5!
M1"$A(2$-"@T*=W=W+F-L96%N=&AE9&ES:RYC;VT-"@T*#0H-"@T*#0H-"@T*
M#0H-"@T*#0H-"@T*#0H-"@T*#0H-"@T*#0H-"@T*#0IE=S5R-#,R-30S-30S
M-30S-30S-0T*-#,-"C4T,PT*-0T*-#,U#0H-"C0S-0T*-#,-"C4-"@T*-#,U
M#0HT,S4T,S4-"@T*#0H-"@T*#0H-"C0S-C!I,&ER971R970]<F5Y="T]97)F
M9WET:W)E=')E=')E=')E=')E=')E=')E=')E=')E9&9G9F1G9F1G9F0-"@T*
M#0H-"@T*#0H-"@T*#0H-"@T*#0H-"@T*#0H-"@T*#0H-"@T*#0H-"@T*#0IE
M=V9R9V@S,F=H,#(T,SDM969T<G!E=VIT<G)E=V=F<PT*9&<-"F9D#0IG#0IF
M9',-"F<-"@T*9F1S#0IG#0IF9',-"@T*9PT*9F1S#0H-"F<-"F9D<PT*#0IG
M9F1S#0IG#0H-"F9D#0IG#0IF9&%S9'-A9'-A9'-A9 T*9F1S#0IG#0IF9 T*
'9PT*9F1S9R @
end
------------------------------
Date: Sat, 14 Jun 2003 04:07:51 GMT
From: Matthew Weier O'Phinney <matthew@weierophinney.net>
Subject: Re: book
Message-Id: <slrnbel7sq.1a6.matthew@kavalier.weierophinney.net>
* j <john62@electronmail.com>:
> could someone recommend a good perl book to me?
Learning Perl, Programming Perl, Advanced Perl Programming...
--
Matthew Weier O'Phinney
matthew@weierophinney.net
http://matthew.weierophinney.net
------------------------------
Date: Sat, 14 Jun 2003 13:08:17 +0100
From: Chris Lowth <dont@want.spam>
Subject: Re: book
Message-Id: <ReEGa.3181$LP.950@newsfep4-winn.server.ntli.net>
j wrote:
> could someone recommend a good perl book to me?
>
There's a list of the "top 20" perl books (by popularity) at
http://www.lowth.com/books/top20perl.php
This is an Amazon jump page showing prices (list, discounted and 2nd hand)
and popularity ratings in terms of number of "stars" awarded by readers.
--
Real address: chris at lowth dot sea oh em.
World's first wrist-watch PDA with Palm OS, available June 30
from Amazon.com. Order now to beat the rush!
http://www.lowth.com/shop/wrist_pda
------------------------------
Date: 14 Jun 2003 22:14:53 +1100
From: Iain Truskett <ict@eh.org>
Subject: Re: book
Message-Id: <slrnbem4vm.d9g.ict@gytha.anu.edu.au>
* j <john62@electronmail.com>:
> could someone recommend a good perl book to me?
See http://learn.perl.org/ and http://books.perl.org/
In particular, "Learning Perl" and "Learning Perl Objects,
References & Modules", assuming you're starting out in the
world of Perl.
cheers,
--
Iain.
------------------------------
Date: Sat, 14 Jun 2003 15:20:25 +0300
From: "Vassilis Tavoultsidis" <ixanthi@ixanthi.remove.gr>
Subject: DB_File:Lock
Message-Id: <bcf3ue$o8m$1@nic.grnet.gr>
I use the following code on unix (don't know version) and it works fine
the same code under linux (both running apache server) is giving me an error
anybody knows whay is that?
use DB_File::Lock;
use Fcntl qw(:flock O_RDWR O_CREAT);
open(LOCK, "<$db_filename.lock") or die;
flock(LOCK, LOCK_SH) or die;
tie(%db_hash, 'DB_File', $db_filename, O_RDONLY, 0755, $DB_HASH) or die;
while (($k, $v) = each(%db_hash))
{
print $k."::".$v."<br>";
};
untie(%db_hash);
close(LOCK);
------------------------------
Date: Sat, 14 Jun 2003 12:46:04 GMT
From: Andras Malatinszky <nobody@dev.null>
Subject: Re: DB_File:Lock
Message-Id: <3EEB18B9.9040204@dev.null>
Vassilis Tavoultsidis wrote:
> I use the following code on unix (don't know version) and it works fine
> the same code under linux (both running apache server) is giving me an error
> anybody knows whay is that?
>
>
>
Older version of the database driver on your Linux box? It would be
easier to guess if you told us what the error message was.
------------------------------
Date: Sat, 14 Jun 2003 07:59:49 -0400
From: zentara <zentara@highstream.net>
Subject: Re: encrypt/decrypt module that uses only printable chars?
Message-Id: <2d3mev4bavas4ngmndeqdip0qqsfse650d@4ax.com>
On 13 Jun 2003 12:29:21 -0700, olhipie@qwest.net (mark) wrote:
>I'm trying to encrypt and decrypt ascii strings, and the Crypt::xx
>modules that I have tried all work great, but produce non printable
>chars in the encryption phase. Is there a switch or particular module
>that that I could use?
>
>Thanks, Mark
You could use MIME::Base64
#!/usr/bin/perl
use strict;
use warnings;
use Crypt::RC4;
use MIME::Base64;
my $key = "abcdefghijklm";
my $plaintext = "Hello, World!";
my $encrypted = RC4($key, $plaintext);
my $encoded = encode_base64($encrypted);
my $decoded = decode_base64($encoded);
print "$encoded\n";
print "$decoded\n";
my $decrypted = RC4($key, $decoded);
print "$decrypted\n";
------------------------------
Date: 13 Jun 2003 21:21:00 -0700
From: maumul@hotmail.com ([nix])
Subject: Re: https authentication
Message-Id: <f9b2fa1a.0306132021.42ef5f47@posting.google.com>
My guess is the code is doing fine. I need to know if I have to have a
signed certificate and key in order for the script to be able to run
correctly. How can I have my own signed certificate and key? Can I
just generate ones using openssl? I have already done it, but, it
failed when I test it.
maumul@hotmail.com ([nix]) wrote in message news:<f9b2fa1a.0306131349.49d6a55f@posting.google.com>...
> Hi,
>
> I have a script which log on to a secure website, but it's always
> failed. I mean, It can't log in. For HTTPS request, I'm using
> Crypt::SSLeay 0.49. I really appreciate it if someone could give me
> advice on this, like the complete requirements for authentication
> against a secure website from perl.
>
> Below is my code:
>
> #!/usr/bin/perl -w
>
> #$|++;
>
> use LWP;
> use LWP::Debug '+'; # debug mode active
> use URI::URL;
> use HTTP::Cookies::Mozilla;
> use HTTP::Request;
> use HTTP::Request::Common;
> use HTTP::Headers;
> use strict;
>
> $ENV{HTTPS_VERSION} = 23;
> $ENV{HTTPS_DEBUG} = 8;
> $ENV{HTTPS_CERT_FILE} = 'Crypt-SSLeay-0.49/certs/notacacert.pem';
> $ENV{HTTPS_KEY_FILE} = 'Crypt-SSLeay-0.49/certs/notacakeynopass.pem';
> $ENV{HTTPS_CA_FILE} = '/usr/share/ssl/certs/ca-bundle.crt';
> $ENV{HTTPS_CA_DIR} = '/usr/share/ssl/certs';
>
> my($statement_URL,$hdr,$server_response,$redirect_location);
>
> $statement_URL="https://some.secure.site/loc/thefile.dll";
> $hdr="param1=val1¶m2=val2";
>
> $server_response=&browse($statement_URL,$hdr,'POST','login'); ##
> Fire the URL
> $server_response=~ /Location:\s+(.*)\n/;
> $redirect_location=$1;
>
> #print $server_response;
>
> sub browse(){
> my($statement_URL,$hdr,$method,$action)=@_;
>
> my($content_type,$response);
>
> $content_type = "application/x-www-form-urlencoded";
>
> my($ua) = new LWP::UserAgent;
>
> $ua->agent("Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.2.1)");
> push @{ $ua->requests_redirectable }, 'POST';
>
> my($cookie) = new HTTP::Cookies::Mozilla(File =>
> '/my/cookies/loc/cookies.txt', autosave => 1, ignore_discard => 1);
>
> my($headers) = new HTTP::Headers('Content-Type' => $content_type,
> 'Date' => HTTP::Date::time2str(time), 'Accept' => 'text/html');
>
> my($url)= new URI::URL($statement_URL);
> my($request)= new HTTP::Request($method, $url, $headers, $hdr);
>
> print "\n\nprocessing URL: ".$url."\n\n";
>
> $request->authorization_basic('mchandra', 'N4W4ilum');
> $ua->cookie_jar($cookie);
> $cookie->add_cookie_header($request);
> $response= $ua->request($request);
> $cookie->extract_cookies($response);
>
> my($reply);
>
> if ($response->is_success){
> $reply=$response->content;
> } else {
> $reply=$response->error_as_HTML();
> }
> return $reply;
> }
------------------------------
Date: Sat, 14 Jun 2003 22:39:51 +1000
From: Martien Verbruggen <mgjv@tradingpost.com.au>
Subject: Re: JPG RGB to JPG CMYK
Message-Id: <slrnbem5sn.rlm.mgjv@martien.heliotrope.home>
On Sun, 16 Feb 2003 18:10:11 +1100,
Adam Ferla <aferla01@postoffice.csu.edu.au> wrote:
> Hey peoples,
>
> I was just wondering if there is a Perl module than can convert between
> RGB and CMYK jpeg images?
Image::Magick should be able to do that (http://www.imagemagick.org/),
although I am not sure whether it knows about the CMYK JPEG format. I'm
pretty certain it does.
Martien
--
|
Martien Verbruggen | Useful Statistic: 75% of the people make up
| 3/4 of the population.
|
------------------------------
Date: Sat, 14 Jun 2003 01:15:42 -0400
From: "SeanCIK" <soneill@ciktech.com>
Subject: Mail::POP3Client - Login Issue
Message-Id: <3eeab0c1_8@corp.newsgroups.com>
All,
I am trying to do a simple email script on my ISP's web server. I am SSH'd
onto the server and can upload and execute SMTP scripts. My problem is with
POP3. Here is my current test script (which was copied straight from a
tutorial to get me going):
#!/usr/bin/perl
use Mail::POP3Client;
$pop2 = new Mail::POP3Client( USER => "myusername", PASSWORD =>
"mypassword", HOST =>
"my.hosting.server", PORT => 110, DEBUG => 0, AUTH_MODE => "PASS", TIMEOUT
=> 60 );
$pop2->Connect() || die $pop2->Message();
print "you have ", $pop2->Count, " new messages.\n";
$pop2->Close();
Here is the error code I get in return:
at pop3test.pl line 4, <GEN1> line 3.password, please try again
I have checked the password and it is entered correctly. Any ideas what's
causing this?
Please forgive me if this has been posted before, I scoured every list I
could find and Google a hundred times over and found no support.
Thanks in advance,
Sean O.
-----= Posted via Newsfeeds.Com, Uncensored Usenet News =-----
http://www.newsfeeds.com - The #1 Newsgroup Service in the World!
-----== Over 80,000 Newsgroups - 16 Different Servers! =-----
------------------------------
Date: Sat, 14 Jun 2003 12:24:56 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Mail::POP3Client - Login Issue
Message-Id: <bcet7q$i9jn2$1@ID-184292.news.dfncis.de>
SeanCIK wrote:
>
> #!/usr/bin/perl
> use Mail::POP3Client;
> $pop2 = new Mail::POP3Client( USER => "myusername", PASSWORD =>
> "mypassword", HOST =>
> "my.hosting.server", PORT => 110, DEBUG => 0, AUTH_MODE => "PASS", TIMEOUT
> => 60 );
> $pop2->Connect() || die $pop2->Message();
> print "you have ", $pop2->Count, " new messages.\n";
> $pop2->Close();
>
> Here is the error code I get in return:
> at pop3test.pl line 4, <GEN1> line 3.password, please try again
>
> I have checked the password and it is entered correctly. Any ideas what's
> causing this?
I'd try it without the line:
$pop2->Connect() || die $pop2->Message();
/ Gunnar
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: 14 Jun 2003 02:04:01 -0700
From: grehom@ntlworld.com (Graham Smith)
Subject: Re: Perl 5.8 UTF-8 RedHat SLOW
Message-Id: <98eb7f13.0306140104.7c71d907@posting.google.com>
>
> I have built a new P4 RedHat 9 webserver to replace my old P3 Linux
> 7.2 webserver, and found it to be significantly slower than the old P3
> machine.
When you say you built the new machine, are we talking about the
hardware as well as the software for the os and web site. When I
assembled my new computer from m/board and Athlon 2700 processor by
default it ran (strolled) at a lot slower speed than it is capable
(defaulted to underclocking). Have you bench tested the new machine
with any non-perl software?
------------------------------
Date: Sat, 14 Jun 2003 02:52:46 -0400
From: j <john62@electronmail.com>
Subject: read locks
Message-Id: <3EEAC63E.9000402@electronmail.com>
does perl have any read lock functions? for instance, if i want to have
multiple processes attempting to read from a file but only want the
first one to succeed, is there a simple way to do this?
thx.
--
-------------------------------------------------------------
Coldmail.us offers free web access to newsgroups.
http://www.coldmail.us/
-------------------------------------------------------------
------------------------------
Date: 14 Jun 2003 08:29:07 GMT
From: "Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de>
Subject: Re: read locks
Message-Id: <bcemcj$d0e$1@nets3.rz.RWTH-Aachen.DE>
Also sprach j:
> does perl have any read lock functions? for instance, if i want to have
> multiple processes attempting to read from a file but only want the
> first one to succeed, is there a simple way to do this?
Your operating system hopefully has...if so, Perl has it too. First try
whether you have a flock() system-call. If you have you can do:
use Fcntl qw/:flock/;
...
open FILE, "read_from_that" or die $!;
flock FILE, LOCK_EX|LOCK_NB or die "Could not acquire lock: $!";
In your case you need an exclusive lock even though you are just
reading. You can drop the LOCK_NB if you want your other processes to
block until they get the lock. In the above they try to lock once and if
the file has been exclusively locked they'll exit.
If there is no flock() you have to manually lock the file:
sysopen LOCK, ".lock", O_WRONLY|O_CREAT|O_EXCL or
die "File appears to be locked: $!";
open FILE, "read_from_that" or die $!;
...
# when done clean up
close LOCK;
unlink ".lock";
That creates a file called '.lock' only if it does not yet exist. When
it exists it means that another process is already reading the file. If
a process is done with readingit removes '.lock' again so that the next
process can get it.
Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
------------------------------
Date: Sat, 14 Jun 2003 15:22:27 +0530
From: Rohan Romanus Almeida <arc_of_descent@gmx.net>
Subject: Re: read locks
Message-Id: <20030614152227.5eb65963.arc_of_descent@gmx.net>
j <john62@electronmail.com> thus wrote:
> does perl have any read lock functions? for instance, if i want to have
> multiple processes attempting to read from a file but only want the
> first one to succeed, is there a simple way to do this?
There is no simple way to do anything.
Once you learn how, it seems simple!
Perl supports 'flock' on platforms which support 'flock'.
$ perldoc -f flock
Note that this allows access to a "flock'd" file by only one
process. After "this" process is finished with the file,
the next process in queue gets access to the file.
So most probably you will need to set some flag after
the first process is done with your file, so that the
remaining processes can ignore the file.
--
arc_of_descent
------------------------------
Date: Sat, 14 Jun 2003 06:03:14 GMT
From: Kien Ha <kha@rogers.com>
Subject: Re: Recursive Copying Script Question
Message-Id: <3EEABAA4.129C3859@rogers.com>
abstractjoe wrote:
>
> Below is recursive copy script (Written by Randal L. Schwartz). It
> does everything I want it to do. Except, it doesn't copy files in the
> sub directory. Example:
Yes it does. It hierarchically pulls all the new or most recent files
under $top_src and put them in $dest.
> I updated a file in /usr/local/htdocs/www/files1/files1sub/ call
> index.html I run the script and it prints out the following.
>
> copying /usr/local/htdocs/www/files1/files1sub/index.html to
> /usr/local/htdocs/www/files2/index.html
That's what the code is supposed to do.
>
> It copies the html file to files2 instead of files1sub directory...
>
You mean you want to keep the file tree, then that's different.
> Wish someone can help me troubleshoot this script. Thanks ahead.
Wish Mr. Schwartz would drop by sooner :-)
Code revised:
#! /usr/bin/perl
use File::Find;
use File::Copy;
use File::Path;
my $top_src = "/usr/local/htdocs/www/files1";
my $dest = "/usr/local/htdocs/www/files2";
find sub {
##might need it for later on
##ignore non html files
return unless -f and /\.html$/;
my $more_subdir;
for ( $more_subdir = $File::Find::dir) {
s#^\Q$top_src##;
s#^/##;
}
## don't copy if we already have a later file
if (-e "$dest/$more_subdir/$_" and -M "$dest/$more_subdir/$_" <= -M
$_) {
## tracing: turn off when you're happy
warn "ignoring older $File::Find::name\n";
return;
}
mkpath( ["$dest/$more_subdir"], 0, 0711); # $dest must be an absolute
## tracing: turn off when you're happy
warn "copying $File::Find::name to $dest/$more_subdir/$_\n";
copy $_, "$dest/$more_subdir/$_";
}, $top_src;
__
Kien
------------------------------
Date: 14 Jun 2003 03:25:02 -0700
From: grehom@ntlworld.com (Graham Smith)
Subject: Re: Recursive Copying Script Question
Message-Id: <98eb7f13.0306140225.e008de8@posting.google.com>
> Below is recursive copy script (Written by Randal L. Schwartz). It
> does everything I want it to do.
a good sign if he wrote it
> Except, it doesn't copy files in the sub directory. Example:
> I updated a file in /usr/local/htdocs/www/files1/files1sub/ call
> index.html I run the script and it prints out the following.
>
> copying /usr/local/htdocs/www/files1/files1sub/index.html to
> /usr/local/htdocs/www/files2/index.html
>
does it or doesn't it?
> It copies the html file to files2 instead of files1sub directory...
>
which is exactly what you asked it to do!! You don't want them copied
to
the source directory do you? If however it is just the files in and
below the directory '/usr/local/htdocs/www/files1/files1sub' that you
want copying, to say a new directory called
'/usr/local/htdocs/www/files1/files1sub_COPY', then the two lines
below change to:
my $top_src = "/usr/local/htdocs/www/files1/files1sub";
my $dest = "/usr/local/htdocs/www/files1/files1sub_COPY";
you might also want to change the following line:
> copy $_, "$dest/$_";
to:
copy $_, "$dest/$_" or die "copy failed";
since on my machine (at least) the copy might fail silently
(Windows!!). Although this doesn't apply to you since you appear to
be using a Unix machine. Any windows users out there need to change
this script to create new directories if and when the are needed. My
(windows) version of his script is shown in full below:
use strict;
use warnings;
use File::Find;
use File::Copy;
use File::Path;
use File::Basename;
fileparse_set_fstype("Unix");
my @suffixlist = qw/ \.\w* /;
my $top_src = "/tmp/a/b/files1";
my $dest = "/tmp/a/b/files2";
my $previous_path = "";
find sub {
# ignore non html files
return unless -f and /\.html$/;
# don't copy if we already have a later file
if (-e "$dest/$_" and -M "$dest/$_" <= -M $_) {
# tracing: turn off when you're happy
warn "ignoring older $File::Find::name\n";
return;
}
# split file name into name, path and suffix
my ($name, $path, $suffix) = fileparse("$dest/$_", @suffixlist);
unless ($path eq $previous_path) {
# tracing: turn off when you're happy
warn "making new path $path";
mkpath $path or die "Can't make path";
$previous_path = $path;
}
# tracing: turn off when you're happy
warn "copying $File::Find::name to $dest/$_\n";
copy $_, "$dest/$_" or die "copy failed";
}, $top_src;
------------------------------
Date: Sat, 14 Jun 2003 01:05:02 -0400
From: jnam@sunnybrook.com
Subject: Re: redirect location prints to screen
Message-Id: <u4blevkm74p992cjd8fs6cb8uuojb5icac@4ax.com>
On Fri, 06 Jun 2003 21:51:25 +1000, Cat <cat@no-spam.com> wrote:
>Cat wrote:
>> Harvey Siegelman wrote:
>>
>>> I have written a cgi that uses an environment variable (remote_user)
>>> on a password protected page to redirect the user to one of several
>>> folders, each named after on of the likely users. The purpose is to
>>> have a link to a client access area where each client can 'sign in'
>>> and be directed to their own private page.
>>>
>>> The problem: when the cgi executes it generates a hyperlink printed at
>>> the the top of an otherwise blank page. When clicked, the hyperlink
>>> will take the user to the correct page, but that is not the effect
>>> that I wish to achieve. I had hoped to have the redirect print to the
>>> location bar and not the page. The cgi is being executed from a shtml
>>> page. What am I doing wrong? Here is the cgi code:
>>>
>>> #!/usr/bin/perl
>>> $baseurl = 'http://www.economicsgroup.com/clients/';
>>> $user = $ENV{'REMOTE_USER'};
>>> $fullurl = $baseurl.lc($user);
>>> print "Location: $fullurl/\n\n";
>>>
>>
>> Hey, correct me if I'm wrong, but that doesn't look like a CGI script.
>> It is just an ordinary perl script doing ordinary perl stuff.
>>
>> #!/usr/bin/perl
>> $baseurl = 'http://www.economicsgroup.com/clients/';
>> $user = $ENV{'REMOTE_USER'};
>> $fullurl = $baseurl.lc($user);
>> print "Location: $fullurl/\n\n";
>>
>> All you've done is created three variables and printed a line to
>> standard output.
>>
>> And from the sounds of things, that exactly what you have described as
>> the result of running this script. I'd like to help you with some real
>> code, but CGI scripting is not my expertise. Maybe another reader can
>> help.
>>
>> Good luck
>>
>
>Having said that... I've managed to get something... hope it helps
>
>#!/usr/bin/perl
>use strict;
>use warnings;
>
>use CGI;
>
>my $baseurl = 'http://www.economicsgroup.com/clients/';
>my $user = $ENV{'REMOTE_USER'};
>my $fullurl = $baseurl.lc($user);
>#print "Location: $fullurl/\n\n";
>
>my $co = new CGI;
>
>print(
> "<meta HTTP-EQUIV='Refresh' CONTENT='0;URL=$fullurl/index.html'>",
> $co->start_html(),
> $co->end_html
> );
CAT:
BLESS YOUR SOUL!!! I AM IN YOUR DEBT FOR AT LEAST THIS WEEKEND. I HAD THE SAME PROBLEM AND THIS SOLVED IT.
THANK YOU THANK YOU THANK YOU!!
------------------------------
Date: Sat, 14 Jun 2003 11:46:08 +0200
From: "Alan J. Flavell" <flavell@mail.cern.ch>
Subject: Re: redirect location prints to screen
Message-Id: <Pine.LNX.4.53.0306141142370.3777@lxplus066.cern.ch>
On Sat, Jun 14, jnam@sunnybrook.com inscribed on the eternal scroll:
> On Fri, 06 Jun 2003 21:51:25 +1000, Cat <cat@no-spam.com> wrote:
[...vast over-quotage snipped...]
> > "<meta HTTP-EQUIV='Refresh' CONTENT='0;URL=$fullurl/index.html'>",
Garbage. A pathetic ersatz for a real redirection.
> CAT:
> BLESS YOUR SOUL!!! I AM IN YOUR DEBT FOR AT LEAST THIS WEEKEND. I HAD THE SAME PROBLEM AND THIS SOLVED IT.
> THANK YOU THANK YOU THANK YOU!!
My weekend has been saddened. But this is off-topic for Perl. You'd
do well to find a real WWW usenet group.
------------------------------
Date: 14 Jun 2003 04:55:38 -0700
From: grehom@ntlworld.com (Graham Smith)
Subject: Re: regexp challenge
Message-Id: <98eb7f13.0306140355.59b44804@posting.google.com>
I'm not an expert at regular expressions so I'm not sure if anyone
will come up with anything suitable - however Damian Conway's module
Parse::Recdescent makes fairly light work of it and produces quite
readable code, might be worth the investment studying it for your
problem, my solution below and sample output beneath it.
# Where an "opcode" is a word like JUMP, REPEAT, LABEL and an "arg" is
# any old alphanumeric. The vector field is all [10HLX-]. and the
# width and composition of the file varies with file, of course.
use strict;
use warnings;
use Parse::RecDescent;
$::RD_HINT = 1;
my $parse = Parse::RecDescent->new(<<'END_OF_GRAMMAR');
main: <rulevar: local @opcodes = (); >
main: <rulevar: local @args = (); >
main: <rulevar: local @vectors = (); >
main: expr /\Z/
| <error>
expr: opcodes_and_args(s) vector(s)
{ print "opcodes: @opcodes, arguments: @args and vectors:
@vectors\n";
@opcodes = ();
@args = ();
@vectors = ();
}
opcodes_and_args: opcode
| arg
# opcode: "JUMP" | "REPEAT" | "LABEL"
opcode: "opcode"
{ push @opcodes, $item[1] }
# have problem distinguishing args from vectors hence the messy
# zero width negative lookahead assertion at start of regexp -
# otherwise arg could be arg: /\w+/
arg: /(?![10HLX\-]+)\w+/
{ push @args, $item[1] }
vector: /[10HLX\-]+/
{ push @vectors, $item[1] }
END_OF_GRAMMAR
while (<DATA>) {
$parse->main($_);
}
__DATA__
opcode arg opcode opcode opcode arg X XX 10101 LHHL LHL 10 LLH
HLLH11010110 XX
opcode opcode opcode arg X 1X 10101 LHHL LHL -- LLH HLLH11011110 XX
opcode arg opcode opcode opcode arg X XX 10101 LLLL HHL -- LLH
HLLH01010110 XX
opcode arg opcode opcode opcode 1 X0 10101 LHHL LHL -1 LLH
HLLH11110111 XX
opcode arg opcode X XX 10101 HHHH LHH -- LLH
HLLH11010010 XX
opcode arg opcode opcode opcode arg X XX 10101 LHHL LHL -- LLH
HLLH01010010 XX
Output produced by running this program:
C:\perlSrcs\parser>perl -w test_parser.pl
opcodes: opcode opcode opcode opcode, arguments: arg arg and vectors:
X XX 10101 LHHL LHL 10 LLH HLLH11010110 XX
opcodes: opcode opcode opcode, arguments: arg and vectors: X 1X 10101
LHHL LHL -- LLH HLLH11011110 XX
opcodes: opcode opcode opcode opcode, arguments: arg arg and vectors:
X XX 10101 LLLL HHL -- LLH HLLH01010110 XX
opcodes: opcode opcode opcode opcode, arguments: arg and vectors: 1 X0
10101 LHHL LHL -1 LLH HLLH11110111 XX
opcodes: opcode opcode, arguments: arg and vectors: X XX 10101 HHHH
LHH -- LLH HLLH11010010 XX
opcodes: opcode opcode opcode opcode, arguments: arg arg and vectors:
X XX 10101 LHHL LHL -- LLH HLLH01010010 XX
------------------------------
Date: Fri, 13 Jun 2003 21:29:44 +0100
From: "Julia deSilva" <jds@trumpetweb.co.uk>
Subject: Tad McClellan
Message-Id: <XlzGa.5944$oa7.4117@news-binary.blueyonder.co.uk>
I have this impression of you sitting on a white cloud firing thunderbolts
down to earth every-so-often, in the form of replies to comp.lang.perl.misc.
Do you have a life.
I play a little jazz trumpet in the style of Chet Baker (but not in the same
league). There was a jazz musician called Tad Dameron.
http://www.mindspring.com/~ccchaney/ddfa/taddamrn.html
------------------------------
Date: Sat, 14 Jun 2003 12:17:32 GMT
From: merlyn@stonehenge.com (Randal L. Schwartz)
To: tad@stonehenge.com
Subject: Re: Tad McClellan
Message-Id: <89f778edbb6deb91753987e1fd25b360@free.teranews.com>
>>>>> "Julia" == Julia deSilva <jds@trumpetweb.co.uk> writes:
Julia> I have this impression of you sitting on a white cloud firing
Julia> thunderbolts down to earth every-so-often, in the form of
Julia> replies to comp.lang.perl.misc.
Julia> Do you have a life.
When Tad's not operating Stonehenge for me, or teaching one of our
on-site or open-enrollment classes, he answers questions on
comp.lang.perl.misc, which is why I offered the position to him in the
first place. I liked the breadth of his knowledge, and his ability to
peer into the core of the issue and answer respectfully, both
essential skills in front of a classroom.
print "Just another Perl hacker,"
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
------------------------------
Date: 14 Jun 2003 05:28:42 -0700
From: grehom@ntlworld.com (Graham Smith)
Subject: Re: Tad McClellan
Message-Id: <98eb7f13.0306140428.5277d5e4@posting.google.com>
I'm sure he knows more about Perl than I do, but it is noticeable how
singularly unhelpful his comments are.
------------------------------
Date: Sat, 14 Jun 2003 22:47:43 +1000
From: Martien Verbruggen <mgjv@tradingpost.com.au>
Subject: Re: Tad McClellan
Message-Id: <slrnbem6bf.rlm.mgjv@martien.heliotrope.home>
On 14 Jun 2003 05:28:42 -0700,
Graham Smith <grehom@ntlworld.com> wrote:
> I'm sure he knows more about Perl than I do, but it is noticeable how
> singularly unhelpful his comments are.
If you really think that Tad's comments are unhelpful, then it is really
clear how much more he knows about Perl than you do.
Martien
--
|
Martien Verbruggen | We are born naked, wet and hungry. Then
| things get worse.
|
------------------------------
Date: 13 Jun 2003 21:26:44 -0700
From: evia@excel.com (Eric)
Subject: Re: Using a while loop to search/remove lines..
Message-Id: <9bdebd3.0306132026.2b7802e2@posting.google.com>
quantum_mechanic_1964@yahoo.com (Quantum Mechanic) wrote in message
> # put your numbers in a file, one per line
> my $num_file = shift; # or however else you set it
> open(NUM, $num_file) || die "Can't open file of numbers";
> my @nums = <NUM>;
>
> # or if you need to put them in the script (but I'd put them in a
> file):
> my @nums = qw( 123 456 789 );
>
> my $num_re = join '|', @nums;
>
> open(OUTPUT, ">MODIFIED_$file") || die "Can't open the output
> file!\n";
> open(INFO, $file) || die "WHERE IS IT ERIC!!? Fool!\n";
>
> while(<INFO>){
> $originalcount++;
> my $tpn = substr($_,196,5);
> if ( $tpn !~ /$num_re/o ) { # /o for one-time interpolation
> print OUTPUT "$_";
> $keep++;
> } else {
> $removecount++;
> }
> }
BINGO QM - that was it - the '/o' for one-time interpolation was the
missing link in my code - what was giving me nightmares and what I
needed to learn sir! THANKS
You've been a terrific help - I have saved your code and am running
it to look at how you do things.
THANK YOU!
> Or you could do it with more sophistication, and perhaps faster, by
> using a hash to store the lines by the numeric field, then deleting
> hash entries that correspond to your number list. However, if line
> order is important, you'll have to change this a bit:
>
>
> open(INFO, $file) || die "WHERE IS IT ERIC!!? Fool!\n";
>
> my %line_hash;
> while(<INFO>){
> $originalcount++;
> push @{$line_hash{substr($_,196,5)}}, $_; # handle duplicate keys
> with push
> }
>
> # put your numbers in a file, one per line
> my $num_file = shift; # or however else you set it
> open(NUM, $num_file) || die "Can't open file of numbers";
> my @nums = <NUM>;
>
> foreach my $num ( @nums ){
> delete $line_hash{$num} if exists $line_hash{$num};
> }
>
> print OUTPUT @{$_} foreach ( values %line_hash );
Yet another way QM! You're most helpful and very good at Perl!
Thanks!
Eric
------------------------------
Date: 14 Jun 2003 05:15:43 -0700
From: zzzouch@yahoo.com (David Sperling)
Subject: Re: variables printed are the same yet fail equality test
Message-Id: <eedb7d58.0306140415.15a77b06@posting.google.com>
I figured out what was going on. The data I thought was utf-8 was
actually unicode. When I put my data through the following code. I
found that my data was padded with 0's.
This is really tough to debug because the variables look the same in
the editor and once printed in perl.
With unicode and utf-8 'a' doesn't always equal 'a'.
my @a = unpack('C*', $value);
my $y = join ' ',@a;
print $y . "\n";
my @b = split / /, $y;
my $z = pack('C*', @b);
print $z . "\n";
Hope this helps anyone having the same problem.
Cheers,
David Sperling
------------------------------
Date: Sat, 14 Jun 2003 22:30:23 +1000
From: Martien Verbruggen <mgjv@tradingpost.com.au>
Subject: Re: Which value is tha largest(benchmarked)
Message-Id: <slrnbem5av.rlm.mgjv@martien.heliotrope.home>
On Sat, 14 Jun 2003 01:55:19 -0000,
David K. Wall <usenet@dwall.fastmail.fm> wrote:
> Martien Verbruggen <mgjv@tradingpost.com.au> wrote:
>> I don't think there are many machines where a loop that iterates
>> 1000000 times takes as little time as one that iterates 10 times.
>
> True, but the n in this case is the size of the array, not the number of
> iterations.
Just to clarify: The loop I was referring to in my comment was the loop
in the max subroutine, which would iterate the same number of times as
the number of elements in the array.
Martien
--
|
Martien Verbruggen | My friend has a baby. I'm writing down all
| the noises the baby makes so later I can ask
| him what he meant - Steven Wright
------------------------------
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 5120
***************************************
