[19153] in Perl-Users-Digest
Perl-Users Digest, Issue: 1348 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Jul 21 09:05:31 2001
Date: Sat, 21 Jul 2001 06: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: <995720708-v10-i1348@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Sat, 21 Jul 2001 Volume: 10 Number: 1348
Today's topics:
Re: Check if something is in the array <ken@me.com.au>
Re: Collin hates subject lines. <krahnj@acm.org>
Re: Collin hates subject lines. <pne-news-20010721@newton.digitalspace.net>
Re: Determing if a variable is a number? <jbritain@home.com>
eval & quoting <patelnavin@icenet.net>
FAQ: Where can I learn about linking C with Perl? [h2xs <faq@denver.pm.org>
FAQ: Where can I learn about object-oriented Perl progr <faq@denver.pm.org>
File Uploading <blnukem@hotmail.com>
Re: Insecure dependency in require error? <pne-news-20010721@newton.digitalspace.net>
Re: redirecting system() call output into variable <pne-news-20010721@newton.digitalspace.net>
Re: Repetitive if statements <greenbd@u.washington.edu>
Re: Repetitive if statements <joe+usenet@sunstarsys.com>
Re: Request Peformance Advice <krahnj@acm.org>
Re: Request Peformance Advice <krahnj@acm.org>
Re: special characters in regular expressions <krahnj@acm.org>
Re: SSLeay 1.7 installation help... PLEASE! <mckerrs@optushome.com.au>
Re: web-site statistical capture method? <usenet@obantec.com>
Re: Who can help me about the confused (..) operator? (Mark Jason Dominus)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 21 Jul 2001 18:40:31 +1000
From: "Ken Cotterill" <ken@me.com.au>
Subject: Re: Check if something is in the array
Message-Id: <jbb67.372$Kn3.29313@nostril.pacific.net.au>
If you can anchor the regular expression it will be faster.
e.g. /^$match/
If the regular expression $match does not contain any metacharacters then
index() will be faster still.
Note, in a grep() context you'll need to add 1 because index() returns -1 if
no match is found.
i.e. grep { index($match) + 1 } @array
If you are looking for an exact match then the "eq" operator will be
fastest.
i.e $_ eq $match
I'm not sure how the grep() optimisation mentioned previously affects this.
Alex Mendes da Costa wrote in message <3B562D6C.965C81A5@yahoo.com>...
>
>How much quicker do you want?
>Yes grep is specially optimised for this sort of searching
>
My understanding was that the optimisation was achieved by making $_ a
reference to the list value rather than containing the list value itself.
Perhaps further optimisations are occurring behind the scenes.
I'd be interested if anyone has more details of this.
Use the Benchmark module to help tailor the code to your specific
application requirements.
Regards,
Ken.
"Andrew Hamm" <ahamm@sanderson.net.au> wrote in message
news:3b562f32@news.iprimus.com.au...
> Einstein wrote in message ...
> >Is this the best (quicker) way to check if something is in the array?
> >
> >if(grep { /$match/o } @array) {
> > print "Found!";
> >}else {
> > print "Not Found!";
> >}
> >
> >Bye,
> >Janko
>
> It's good. Fine. Anything else is a variation on the theme. Or you could
use
> a foreach loop.
>
> A foreach loop would allow you to terminate the search as soon as you find
> one element:
>
> my $found = 0;
> foreach (@array)
> {
> if(/$match/o)
> {
> $found = 1;
> last;
> }
> }
> print $found ? "Found!\n" : "Not Found!\n";
>
> On average, breaking out of the loop once you find the element you are
> searching for, will save half the time of the search.
>
> If the time taken for the search is too much, then you could use a hash to
> store the keys. Lookups through hashes is basically constant time, and
> there's no looping involved. So, instead of (or as well as) storing the
> element on the @array, put each element into a hash:
>
> $keys{$x} = 1;
>
> Then you can test for existence with:
>
> if(exists $keys{$x}) {
> print "found!"
> } else {
> print "not found!"
> }
>
> It's quite reasonable and common to store the data in an array, and also
> store it in a hash if finding random elements is important to you and you
> have a "large" array.
> --
> If you ever reach total enlightenment while drinking
> beer, I bet it makes beer shoot out your nose.
> - Deep Thought, Jack Handy
>
>
>
------------------------------
Date: Sat, 21 Jul 2001 07:50:07 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: Collin hates subject lines.
Message-Id: <3B59342E.1944EAC4@acm.org>
Collin E Borrlewyn wrote:
>
> I'm writing a signup script for part of a larger message board. Everything
> else works, but I've been having trouble with preferences. I've tracked the
> problem down to the following subroutine. (I don't know if the indentation
> will hold.)
>
> sub update_info(){
^^
You're saying you don't want to accept any arguments so @_ will be empty
(depending on how you call the sub.)
> open(DATA,"$userdir/$_[0]") || return 0;
> flock(DATA,2) unless $^O =~ /Win/;
> my($data,@sig) = <DATA>;
> close(DATA);
> my @data = split(/\t/,$data);
> chomp($data);
>
> my %data;
> foreach(@data){
> my @namval = split(/\*/,$_);
> $data{$namval[0]} = $namval[1];
> }
> $data{'SIG'} = join('',@sig);
> $data{$_[1]} = $data{$_[2]}; # Updates the element
>
> my $out = '';
> foreach(keys %data){
> $out .= "$_*$data{$_}\t" unless $_ eq 'SIG';
> }
> chop($out); # Remove final tab
>
> open(DATA,">$userdir/$_[0]") || return 0;
> flock(DATA,2) unless $^O =~ /Win/;
> print DATA $out."\n".$data{'SIG'};
> close(DATA) || return 0;
> return 1;
> }
>
> $userdir is a directory, usually ./uids and $_[0] is a file, the one I've
> been experimenting on is called '1005'
>
> The contents of this file are as follows:
> USERNAME*TestMan5<tab>PASSWORD*test<tab>EMAIL*test@test.test
> Signature goes here
> and on any
> further lines.
>
> Where <tab>'s are actual tab marks.
>
> Now, the idea is to send update_info() a user ID (1005, in $_[0]), an
> element name ('EMAIL', in $_[1]) and a new value ('testsuperman@test.test',
> in $_[2]) and have the information be altered and resaved.
>
> What ends up happening is that whatever element name I tell it to update, it
> instead simply empties (setting the elemnt to '' ?). I've checked closely,
> but can find no reason. Perhaps I'm doing something incorrectly? Maybe it's
> a quirk I don't know about?
sub update_info {
my ( $id, $field, $value ) = @_;
use Fcntl ':flock'; # import LOCK_* constants
open DATA,"< $userdir/$id" or return 0;
flock DATA, LOCK_EX unless $^O =~ /Win/;
my ( $data, @sig ) = <DATA>;
close DATA;
$data =~ s/$field\*(\S+)/$field*$value/;
open DATA, "> $userdir/$id" or return 0;
flock DATA, LOCK_EX unless $^O =~ /Win/;
print DATA $data, @sig;
close DATA or return 0;
return 1;
}
John
--
use Perl;
program
fulfillment
------------------------------
Date: Sat, 21 Jul 2001 13:10:42 +0200
From: Philip Newton <pne-news-20010721@newton.digitalspace.net>
Subject: Re: Collin hates subject lines.
Message-Id: <e6kiltkma9intjvitbvmp3gq368bnsjmfm@4ax.com>
On Sat, 21 Jul 2001 07:50:07 GMT, "John W. Krahn" <krahnj@acm.org>
wrote:
> Collin E Borrlewyn wrote:
> >
> > sub update_info(){
> ^^
> You're saying you don't want to accept any arguments so @_ will be empty
> (depending on how you call the sub.)
Unless he calls it as a method (which doesn't check prototypes),
prototype checking will prevent him from calling it any other way:
: Too many arguments for <sub> at <file> line <line>, at <position>
: Execution of file> aborted due to compilation errors.
Cheers,
Philip
--
Philip Newton <nospam.newton@gmx.li>
That really is my address; no need to remove anything to reply.
If you're not part of the solution, you're part of the precipitate.
------------------------------
Date: Sat, 21 Jul 2001 05:07:47 GMT
From: Jim Britain <jbritain@home.com>
Subject: Re: Determing if a variable is a number?
Message-Id: <n23iltsdbo4kkj1tsct4thqm63mmsg5i81@4ax.com>
On 20 Jul 2001 20:24:18 -0400, stanb@panix.com (Stan Brown) wrote:
>I'm writing a small PerlTK script to allow a user to edit some Oracle
>tables. The user will input data using PerlTK Entry widgets, and the script
>will then create the resultant SQL.
>
>Since numbers don't need to be quoted in SQL, and strings do, I need o
>figure out which of these variables are numbers.
>
>I looke in the Perl cookbook, and came up with a solutin using //, but it
>complains when I hand it a non numeric value.
>
>How can I make this work withou perl complaining?
Rethink what you are trying to do. There is no REQURIMENT that the
data not be quoted. The test, and multiple processing paths add a
level of complexity to the process that is unnecessary.
Often, and especially when numbers are coming from a form, or "entry",
we don't want them interpreted as numbers. We want to interpret and
respresent them as what was entered, and that was "string data".
Some software tends to do automaltic "things" if the data is a number
(different variable types, different representations, depending upon
if there's a decimel point, or not, etc..)
In databases in particular, we are much better off storing numbers as
string data, rather than some other representation. That way, what
comes out the other end, (next stage) is exactly what was put in..
------------------------------
Date: Sat, 21 Jul 2001 13:48:25 +0530
From: "Aman Patel" <patelnavin@icenet.net>
Subject: eval & quoting
Message-Id: <9jbdqu$kulhd$1@ID-93885.news.dfncis.de>
I dont know but this code doesnt evaluate the contents of $template
$fh = *STDOUT;
$template = '<p><h1>$title</h1></p>Choose your choice:';
eval {
print $fh << X__END_OF_TEMPLATE_FILE__X;
$template
X__END_OF_TEMPLATE_FILE__X
};
##check $@ of-course.
## The eval block should print the template variable (evaluated).
But this prints:
<p><h1>$title</h1></p>Choose your choice:
The $title doesnt get replaced by the appropriate value.. If i removed the
EVAL block than it comes out correct. I read the gory details about parsing
quoted structures, but it didnt seem to help.
I hope you guys have a explanation.
------------------------------
Date: Sat, 21 Jul 2001 12:18:25 GMT
From: PerlFAQ Server <faq@denver.pm.org>
Subject: FAQ: Where can I learn about linking C with Perl? [h2xs, xsubpp]
Message-Id: <lqe67.33$zH9.190772224@news.frii.net>
This message is one of several periodic postings to comp.lang.perl.misc
intended to make it easier for perl programmers to find answers to
common questions. The core of this message represents an excerpt
from the documentation provided with every Standard Distribution of
Perl.
+
Where can I learn about linking C with Perl? [h2xs, xsubpp]
If you want to call C from Perl, start with the perlxstut manpage,
moving on to the perlxs manpage, the xsubpp manpage, and the perlguts
manpage. If you want to call Perl from C, then read the perlembed
manpage, the perlcall manpage, and the perlguts manpage. Don't forget
that you can learn a lot from looking at how the authors of existing
extension modules wrote their code and solved their problems.
-
Documents such as this have been called "Answers to Frequently
Asked Questions" or FAQ for short. They represent an important
part of the Usenet tradition. They serve to reduce the volume of
redundant traffic on a news group by providing quality answers to
questions that keep coming up.
If you are some how irritated by seeing these postings you are free
to ignore them or add the sender to your killfile. If you find
errors or other problems with these postings please send corrections
or comments to the posting email address or to the maintainers as
directed in the perlfaq manual page.
Answers to questions about LOTS of stuff, mostly not related to
Perl, can be found by pointing your news client to
news:news.answers
or to the many thousands of other useful Usenet news groups.
Note that the FAQ text posted by this server may have been modified
from that distributed in the stable Perl release. It may have been
edited to reflect the additions, changes and corrections provided
by respondents, reviewers, and critics to previous postings of
these FAQ. Complete text of these FAQ are available on request.
The perlfaq manual page contains the following copyright notice.
AUTHOR AND COPYRIGHT
Copyright (c) 1997-1999 Tom Christiansen and Nathan
Torkington. All rights reserved.
This posting is provided in the hope that it will be useful but
does not represent a commitment or contract of any kind on the part
of the contributers, authors or their agents.
03.29
--
This space intentionally left blank
------------------------------
Date: Sat, 21 Jul 2001 06:18:14 GMT
From: PerlFAQ Server <faq@denver.pm.org>
Subject: FAQ: Where can I learn about object-oriented Perl programming?
Message-Id: <G8967.31$zH9.189635072@news.frii.net>
This message is one of several periodic postings to comp.lang.perl.misc
intended to make it easier for perl programmers to find answers to
common questions. The core of this message represents an excerpt
from the documentation provided with every Standard Distribution of
Perl.
+
Where can I learn about object-oriented Perl programming?
A good place to start is the perltoot manpage, and you can use the
perlobj manpage, the perlboot manpage, and the perlbot manpage for
reference. Perltoot didn't come out until the 5.004 release; you can get
a copy (in pod, html, or postscript) from
http://www.perl.com/CPAN/doc/FMTEYEWTK/ .
-
Documents such as this have been called "Answers to Frequently
Asked Questions" or FAQ for short. They represent an important
part of the Usenet tradition. They serve to reduce the volume of
redundant traffic on a news group by providing quality answers to
questions that keep coming up.
If you are some how irritated by seeing these postings you are free
to ignore them or add the sender to your killfile. If you find
errors or other problems with these postings please send corrections
or comments to the posting email address or to the maintainers as
directed in the perlfaq manual page.
Answers to questions about LOTS of stuff, mostly not related to
Perl, can be found by pointing your news client to
news:news.answers
or to the many thousands of other useful Usenet news groups.
Note that the FAQ text posted by this server may have been modified
from that distributed in the stable Perl release. It may have been
edited to reflect the additions, changes and corrections provided
by respondents, reviewers, and critics to previous postings of
these FAQ. Complete text of these FAQ are available on request.
The perlfaq manual page contains the following copyright notice.
AUTHOR AND COPYRIGHT
Copyright (c) 1997-1999 Tom Christiansen and Nathan
Torkington. All rights reserved.
This posting is provided in the hope that it will be useful but
does not represent a commitment or contract of any kind on the part
of the contributers, authors or their agents.
03.28
--
This space intentionally left blank
------------------------------
Date: Sat, 21 Jul 2001 10:28:02 GMT
From: "Blnukem" <blnukem@hotmail.com>
Subject: File Uploading
Message-Id: <SOc67.78632$qs5.15267894@news02.optonline.net>
Hi All
I'm trying to upload files to my server and it works well except I cant
seem to strip out the file path "c:\foo"
I tried using $file =~ s/^.*(\\|\/)//; And that does the trick except the
file size is 0 uploads nothing. Here is a sample of my code:
#!/usr/bin/perl
$upload_path = '../files/';
use CGI ':standard';
print "Content-type: text/html\n\n";
my $file = param ('uploadfile');
if ($file) {
open (UPLOAD, ">$upload_path/$file");
my ($data, $length, $chunk);
while ($chunk = read ($file, $data, 1024)) {
print UPLOAD $data;
$length += $chunk;
}
close (UPLOAD);
print "<p>You uploaded <b>$file</b>.";
}
------------------------------
Date: Sat, 21 Jul 2001 08:17:39 +0200
From: Philip Newton <pne-news-20010721@newton.digitalspace.net>
Subject: Re: Insecure dependency in require error?
Message-Id: <285ilt0dss4pqeilu5ig7orc8ahn0j9afn@4ax.com>
On Fri, 20 Jul 2001 19:48:14 +0000 (UTC), Hemant Shah
<shah@typhoon.xnet.com> wrote:
> Here is the one I do not know how to solve. How can I open a file to write?
By using open or sysopen with appropriate arguments :)
> Here is the code.
>
> delete @ENV{'IFS', 'CDPATH', 'ENV', 'PATH'};
> $HostName = `/bin/uname -n`;
> $ErrFilePath = "@{[ $ENV{FCICSGBLCODE} =~ /(.*)/ ]}/dbcob/dberrs.$HostName";
>
> open(ERRFILE, ">>$ErrFilePath");
>
> I get following error:
>
> Insecure dependency in open while running setuid
From `perldoc perlsec`:
: You may not use data derived from outside your program to affect
: something else outside your program--at least, not by accident.
: All command line arguments, environment variables, locale
: information (see the perllocale manpage), results of certain
: system calls (readdir, readlink, the gecos field of getpw*
: calls), and all file input are marked as "tainted". Tainted data
: may not be used directly or indirectly in any command that
: invokes a sub-shell, nor in any command that modifies files,
As I understand it, you tainted $HostName by filling it with the output
of a program. Either launder it (for example, by passing it through a
regex that lets only safe characters through, such as [a-zA-Z0-9.-]+ for
DNS type names), or use another method of obtaining the information (for
example, gethostby{name,addr} or possible Sys::Hostname).
Cheers,
Philip
--
Philip Newton <nospam.newton@gmx.li>
That really is my address; no need to remove anything to reply.
If you're not part of the solution, you're part of the precipitate.
------------------------------
Date: Sat, 21 Jul 2001 13:10:41 +0200
From: Philip Newton <pne-news-20010721@newton.digitalspace.net>
Subject: Re: redirecting system() call output into variable
Message-Id: <qpjiltk34nqflcob3gqojo5jtqghv4r4i2@4ax.com>
On Sat, 21 Jul 2001 03:49:00 GMT, Bob Walton <bwalton@rochester.rr.com>
wrote:
> Graham wrote:
> ...
> > I am using the system() call within perl (I am writing a simple menu
> > driven shell), but I wish to do something semantically the same as the
> > following:
> >
> > $output = system("command");
> >
> > Where the output of the command is placed into $output, and not just
> > printed on the terminal.
>
> See:
>
> perldoc perlop
Or even `perldoc -f system`, which has a sentence starting
: This is *NOT* what you want to use to capture the output from a
: command, for that you should use ...
Cheers,
Philip
--
Philip Newton <nospam.newton@gmx.li>
That really is my address; no need to remove anything to reply.
If you're not part of the solution, you're part of the precipitate.
------------------------------
Date: Fri, 20 Jul 2001 21:42:55 -0700
From: "Brian D. Green" <greenbd@u.washington.edu>
To: Jeff Boes <jboes@qtm.net>
Subject: Re: Repetitive if statements
Message-Id: <Pine.A41.4.33.0107202141170.82242-100000@dante40.u.washington.edu>
Thanks, Jeff! That did the trick.
Yours,
Brian Green http://students.washington.edu/greenbd/
O-----------------------------------------------------------------------O
|"I am not ashamed of the gospel, because it is the power of God for the|
| salvation of everyone who believes: first for the Jew, then for the |
| Gentile." --Romans 1:16, NIV |
O-----------------------------------------------------------------------O
On Fri, 20 Jul 2001, Jeff Boes wrote:
> Happy to help:
>
> my @strings = ("<img src='/legsim/img/sd.gif' height='18' width='180'>",
> "<img src='/legsim/img/da.gif' height='18' width='180'>",
> ... and so on
> );
> foreach ($q1,$q2,$q3,$q4,$q5,$q6,$q7) {
> $_ = $strings[$_];
> }
>
> which takes advantage of the fact that inside a 'foreach', $_ is an *alias* for
> the element of the list.
>
> At some point in time, "Brian D. Green" <greenbd@u.washington.edu> wrote:
>
> >Hello,
> >
> >I'm trying to write some code that will take the results of a survey and
> >translate each of the five possible values of the survey into a different
> >graphic. I've figured out something that works, but it seems very
> >repetitive and inefficient. Right now, I have it doing:
> >
> >if ($q1 == 1) {
> >$q1 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> >}
> >if ($q2 == 1) {
> >$q2 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> >}
> >if ($q3 == 1) {
> >$q3 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> >}
> >if ($q4 == 1) {
> >$q4 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> >}
> >if ($q5 == 1) {
> >$q5 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> >}
> >if ($q6 == 1) {
> >$q6 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> >}
> >if ($q7 == 1) {
> >$q7 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> >}
> >
> >if ($q1 == 2) {
> >$q1 = "<img src='/legsim/img/da.gif' height='18' width='180'>";
> >}
> >...and so on for each of the five values. Could someone suggest how I
> >might simplify it?
>
------------------------------
Date: 21 Jul 2001 06:14:07 -0400
From: Joe Schaefer <joe+usenet@sunstarsys.com>
Subject: Re: Repetitive if statements
Message-Id: <m3snfq613k.fsf@mumonkan.sunstarsys.com>
"Brian D. Green" <greenbd@u.washington.edu> writes:
> I'm trying to write some code that will take the results of a survey and
> translate each of the five possible values of the survey into a different
> graphic. I've figured out something that works, but it seems very
> repetitive and inefficient. Right now, I have it doing:
>
> if ($q1 == 1) {
> $q1 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> }
[...]
> if ($q7 == 1) {
> $q7 = "<img src='/legsim/img/sd.gif' height='18' width='180'>";
> }
>
> if ($q1 == 2) {
> $q1 = "<img src='/legsim/img/da.gif' height='18' width='180'>";
> }
> ...and so on for each of the five values. Could someone suggest how I
> might simplify it?
>
Looks to me like you want to convert the numbers in
my @q = ($q0, $q1, ..., $q7); # should be using $q[1] instead of $q1
over to text strings. Since it appears the conversion is based solely on
the *value* of each variable, normally you'd use a hash to do this.
However, if you are working with small integers, an array can serve
the same purpose:
my @pic; # "legal indices" are 1..5
@pic[1 .. 5] = qw(
/legisim/img/sd.gif
/legisim/img/da.gif
...
);
Then your code to convert the values in @q might look something like
{
# must enable warnings (-w) to catch bad data in @q
local $SIG{__WARN__} = sub { die "Bad arg: no \@pic for '$_'" };
@q = map qq <<img src="$pic[$_]" height="18" width="180">> => @q;
}
HTH
--
Joe Schaefer "When the end of the world comes, I want to be in Cincinnati.
Everything happens ten years later there."
--Mark Twain
------------------------------
Date: Sat, 21 Jul 2001 05:59:49 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: Request Peformance Advice
Message-Id: <3B591AA8.AF9C1D4E@acm.org>
Buck Turgidson wrote:
>
> I wrote my first real Perl with a lot if input from this group.
If you have learned anything from this group you would enable warnings
(which you did - good), use strict and allways test the return values of
open (you missed one.)
> It works great, but is very slow. I have a file containing database
> column names that are changing and I need to update a directory of
> hundreds of SQL modules and change the column names.
>
> I read the conversion mappings from the file into an array, and for
> each file in a directory, I apply each regex derived from the mappings
> array (about 60) to each line. It is very, very slow. I would like
> to speed it up a bit, and was hoping someone could suggest some
> efficiency improvements.
>
> <code>
>
> [snip code]
>
> </code>
#!/usr/bin/perl -w
use strict;
my $suffixlist = join '|', qw(sql);
my $convertfile = 'c:/mydir/convert.txt';
my $sourcedirname = 'c:/temp/sqlin';
my $outdirname = 'c:/temp/sqlout';
#--------------------------------------------------
# Load array with conversion pairs
# from conversion file
#
# file format: EMPLOYEENAME=EMPL_NAME
# Approximately 60 column conversions
#--------------------------------------------------
open CONVERT, $convertfile or die "Cannot read from $convertfile: $!";
my %convertpairs;
my @convertlookup;
while ( <CONVERT> ) {
chomp;
my ( $key, $val ) = split /=/;
$convertpairs{lc $key} = lc $val;
$convertpairs{uc $key} = uc $val;
$convertpairs{ucfirst lc $key} = ucfirst lc $val;
push @convertlookup, $key;
}
close CONVERT;
my $convertregex = join '|', @convertlookup;
#--------------------------------------------------
# Read input directory, apply all regexes in array
# to each line in each file.
#
#--------------------------------------------------
opendir DIR, $sourcedirname or die "Can't open $sourcedirname: $!";
my @files = grep /\.($suffixlist)$/i, readdir DIR;
closedir DIR;
my $fileswritten;
for ( @files ) {
print "$sourcedirname/$_\n";
my $filename = "$sourcedirname/$_";
open INFILE, "< $filename" or die "Can't open $filename: $!";;
my $outfilename = "$outdirname/$_";
open OUTFILE, "> $outfilename" or die "Can't open $filename: $!";;
print $outfilename;
$fileswritten++;
while ( <INFILE> ) {
s/($convertregex)/$convertpairs{$1}/g;
print OUTFILE;
}
close INFILE;
close OUTFILE;
}
print "\n Files written: $fileswritten\n";
__END__
John
--
use Perl;
program
fulfillment
------------------------------
Date: Sat, 21 Jul 2001 07:19:59 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: Request Peformance Advice
Message-Id: <3B592D20.84F4C2A6@acm.org>
"John W. Krahn" wrote:
>
> Buck Turgidson wrote:
> >
> > I wrote my first real Perl with a lot if input from this group.
>
> If you have learned anything from this group you would enable warnings
> (which you did - good), use strict and allways test the return values of
> open (you missed one.)
>
> > It works great, but is very slow. I have a file containing database
> > column names that are changing and I need to update a directory of
> > hundreds of SQL modules and change the column names.
> >
> > I read the conversion mappings from the file into an array, and for
> > each file in a directory, I apply each regex derived from the mappings
> > array (about 60) to each line. It is very, very slow. I would like
> > to speed it up a bit, and was hoping someone could suggest some
> > efficiency improvements.
> >
> > <code>
> >
> > [snip code]
> >
> > </code>
OOPS ... small change.
#!/usr/bin/perl -w
use strict;
my $suffixlist = join '|', qw(sql);
my $convertfile = 'c:/mydir/convert.txt';
my $sourcedirname = 'c:/temp/sqlin';
my $outdirname = 'c:/temp/sqlout';
#--------------------------------------------------
# Load array with conversion pairs
# from conversion file
#
# file format: EMPLOYEENAME=EMPL_NAME
# Approximately 60 column conversions
#--------------------------------------------------
open CONVERT, $convertfile or die "Cannot read from $convertfile: $!";
my %convertpairs;
while ( <CONVERT> ) {
chomp;
my ( $key, $val ) = split /=/;
$convertpairs{lc $key} = lc $val;
$convertpairs{uc $key} = uc $val;
$convertpairs{ucfirst lc $key} = ucfirst lc $val;
}
close CONVERT;
my $convertregex = join '|', keys %convertpairs;
#--------------------------------------------------
# Read input directory, apply all regexes in array
# to each line in each file.
#
#--------------------------------------------------
opendir DIR, $sourcedirname or die "Can't open $sourcedirname: $!";
my @files = grep /\.($suffixlist)$/i, readdir DIR;
closedir DIR;
my $fileswritten;
for ( @files ) {
print "$sourcedirname/$_\n";
my $filename = "$sourcedirname/$_";
open INFILE, "< $filename" or die "Can't open $filename: $!";;
my $outfilename = "$outdirname/$_";
open OUTFILE, "> $outfilename" or die "Can't open $filename: $!";;
print $outfilename;
$fileswritten++;
while ( <INFILE> ) {
s/($convertregex)/$convertpairs{$1}/g;
print OUTFILE;
}
close INFILE;
close OUTFILE;
}
print "\n Files written: $fileswritten\n";
__END__
John
--
use Perl;
program
fulfillment
------------------------------
Date: Sat, 21 Jul 2001 04:40:54 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: special characters in regular expressions
Message-Id: <3B59082A.1024CC25@acm.org>
Shang-Lin Chen wrote:
>
> I'm trying to write a function that will remove the tags from an SGML
> file. Many of the tags in my file contain quotation marks, i.e.
>
> <!Doctype refentry "-//OASIS//DTD DocBook V3.1//EN">
> or
> <arg choice="req">.
>
> I tried to remove the tags using the line:
> $file =~ s/<\W*\w*\W*>//g;
> which removed all tags except for the ones containing quotation marks.
> How can I remove all the tags?
It has nothing to do with the quotation marks (well almost nothing.) The
pattern <\W*\w*\W*> will match either <> or <\W+> or <\w+> or <\W+\w+>
or <\w+\W+> or <\W+\w+\W+> but the pattern in example one is:
<!Doctype refentry "-//OASIS//DTD DocBook V3.1//EN">
| | | | | | | | | | || || | |\
\ | | | | | | | | | || || | \ \
| | | | | | | | \ | / | \ \ \ \ \
/<\W\w+ \W \w+ \W+ \w+\W+\w+\W \w+\W\w+\W\w\W+\w+\W>/x
John
--
use Perl;
program
fulfillment
------------------------------
Date: Sat, 21 Jul 2001 05:41:31 GMT
From: "Bards" <mckerrs@optushome.com.au>
Subject: Re: SSLeay 1.7 installation help... PLEASE!
Message-Id: <fC867.1035$t9.3161@news1.belrs1.nsw.optushome.com.au>
I had similar issues, I upgraded to 5.6 and it 'went away'.
HTH.
Brian.
"Corey" <spbid@netscape.net> wrote in message
news:fcbdbb38.0107201545.4004e3bb@posting.google.com...
> Hello,
>
> I am tryiny to build/install SSLeay 1.7, on my UNIX FreeBSD server.
> After running ./Makefile.PL -t, it detects my OpenSSL 9.5a fine, but
> after a few lines of the build process this is the error messge I am
> getting...
>
> .....PERL_DL_NONLAZY=1 /usr/bin/perl -Iblib/arch -Iblib/lib
> -I/usr/libdata/perl/5.00503/mach -I/usr/libdata/perl/5.00503 test.pl
> 1..16
>
> Can't locate Errno.pm in @INC (@INC contains: blib/arch blib/lib
> /usr/libdata/perl/5.00503/mach /usr/libdata/perl/5.00503
> /usr/libdata/perl/5.00503/mach /usr/libdata/perl/5.00503
> /usr/local/lib/perl5/site_perl/5.005/i386-freebsd
> /usr/local/lib/perl5/site_perl/5.005 .) at blib/lib/Net/SSLeay.pm line
> 21.
> BEGIN failed--compilation aborted at blib/lib/Net/SSLeay.pm line 21.
> BEGIN failed--compilation aborted at test.pl line 19.
> not ok 1
> *** Error code 2
>
>
> could anyone steer me in the right direction as to what I am doing
> wrong??
>
> Thanks
> Corey
------------------------------
Date: Sat, 21 Jul 2001 11:21:35 +0100
From: "obantec support" <usenet@obantec.com>
Subject: Re: web-site statistical capture method?
Message-Id: <9jbl4q$cmo$1@neptunium.btinternet.com>
"Mike" <michael_of_neb@yahoo.com> wrote in message
news:5a10590e.0107201403.513e7b8a@posting.google.com...
> Does anybody have a written-in-perl web-site statistical capture
> method?
>
> Either a known combination of modules or an off-the-shelf perl mong
> would be okay, so this message goes out to the perl community in
> general.
>
> The idea is to get the statistics on a client's site concerning most
> of
> the various differentiations of such things as the origination ip of
> the
> browser, which search engine thay may have come from, what type of
> browser they are using, and the like. Much of this information is
> collected by the typical logfile that should be supplied by the
> client's
> hosting company, but that is not what we want.
>
> This is something that we would like to provide to our clients as a
> service,
> collecting the information ourselves and passing some combination of
> the raw
> information, the statistical information and the graphical
> representations of
> the data on to the client.
>
> Historical and real-time/on-the-fly statistical analysis are
> eventually required, but whatever gets the ball rolling would be cool.
>
> Since we want to provide the service ourselves, of course using
> somebody
> else's service is out-of-the-question.
>
> As far as I can tell, all that is required is a small cgi perl
> combination
> javascript method installed on any given page that gets a single pixel
> gif
> for the page by going to our collection site to get it, and then
> simply
> drops off at this site the salient information from the hit on the
> client.
>
> The data is then stored in some way that further differentiates it
> among
> the various clients, and allows selective statistics to be maintained
> and
> displayed. This would be the perl part.
>
> The whole thing aught to be pretty simple.
>
> Mike
AXS does a good job of collecting the sort of stats you are looking for.
http://www.xav.com/scripts/axs/
My old demo site at www.obantec.co.uk uses it . follow link to cgi then site
stats to see real info.
It uses both java and 1 pixel methods for logging.
HTH
Mark
------------------------------
Date: Sat, 21 Jul 2001 04:55:03 GMT
From: mjd@plover.com (Mark Jason Dominus)
Subject: Re: Who can help me about the confused (..) operator?
Message-Id: <3b590b27.3bbc$25f@news.op.net>
In article <050glt41plvq4pa3s8t2f2h0m1l06pnua0@4ax.com>,
MMX166+2.1G HD <no@mail.addr> wrote:
>Terrible range operator (..) which in the scalar context...I had read
>the perldoc many times, but I can't understand it at all. Can any
>kindly angel help me about this operator (in the scalar context)?
Try this:
@colors = qw(red crimson orange yellow charteuse
green aqua blue indigo violet);
for $i (@colors) {
if ($i eq 'orange' .. $i eq 'green') {
print "$i\n";
}
}
Then try this:
@blah = (1, 2, 3, 'START', 4, 5, 6, 'END', 7, 8,
'START', 9, 'END', 10, 'START', 'END', 11, 12, 13,
'START', 14, 15, 16, 'END');
for $i (@blah) {
if ($i eq 'START' .. $i eq 'END') {
print "$i\n";
}
}
--
@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 1348
***************************************