[25701] in Perl-Users-Digest
Perl-Users Digest, Issue: 7942 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Apr 4 21:05:28 2005
Date: Mon, 4 Apr 2005 18:05:10 -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 Mon, 4 Apr 2005 Volume: 10 Number: 7942
Today's topics:
Re: [BEGINNER} Question soup_or_power@yahoo.com
auto-deleted explcitily named temp files - possible? odigity@gmail.com
Re: auto-deleted explcitily named temp files - possible xhoster@gmail.com
Re: Generate random arrays? <abigail@abigail.nl>
Re: Help with a script.. <abigail@abigail.nl>
Perl Embed in C++ Problem -> Urgent, please help! sleepymish@gmail.com
Re: Perl Embed in C++ Problem -> Urgent, please help! <tadmc@augustmail.com>
Re: Perl Embed in C++ Problem -> Urgent, please help! sleepymish@gmail.com
Re: Perl User Name/Password issue <nobull@mail.com>
Re: Perl User Name/Password issue <tadmc@augustmail.com>
Please help package Search::VectorSpace; problem <sams@freeddns.org>
recursivity (julia)
Re: recursivity <noreply@gunnar.cc>
Re: recursivity <someone@example.com>
Re: recursivity <tadmc@augustmail.com>
Re: recursivity <someone@example.com>
Re: recursivity <postmaster@castleamber.com>
Re: speed issues with pattern matching and substitution <g_klinedinst@hotmail.com>
Re: speed issues with pattern matching and substitution <someone@example.com>
Re: speed issues with pattern matching and substitution <nobull@mail.com>
Re: speed issues with pattern matching and substitution <tadmc@augustmail.com>
Re: speed issues with pattern matching and substitution <g_klinedinst@hotmail.com>
use Cwd qw(abs_path) question <sverro@chello.se>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 4 Apr 2005 17:47:51 -0700
From: soup_or_power@yahoo.com
Subject: Re: [BEGINNER} Question
Message-Id: <1112662071.499676.304970@z14g2000cwz.googlegroups.com>
Mark Clements wrote:
> soup_or_power@yahoo.com wrote:
> > Can someone explain what's this code doing at a meta level? Thanks
> It helps if you choose a more descriptive subject line.
>
> > sub new {
> > my ($self, $hash) = @_;
> >
> > # ------------------------------------------------------
> > # Create new hash ref/obj ref (Copy Constructor)
> > # ------------------------------------------------------
> >
> > my $type = ref($self) || $self;
> > my $obj = ( ref $self ) ? &Storable::dclone( $self ) : { };
> > my $new = bless $obj, $type;
> >
> > # ------------------------------------------------------
> > # Initialize properties (copy $hash into $new)
> > # ------------------------------------------------------
> >
> > if ($hash && ref $hash) {
> > while ( my ($key, $value) = each %$hash ) {
> > $new->{$key} = $value if ! ref $value;
> > }
> > }
> >
> > return $new;
> > }
> >
> If by "meta level" you mean "what is the subroutine actually supposed
to
> do", it is defining a constructor method (though I have issues with
the
> way it is done). Check out
>
> man perltoot
> man perlobj
>
> It then populates the attributes of the newly created object with
> attribute names and values passed in in $hash, though it doesn't do
this
> for some reason (Perl itself doesn't care) if the value itself is a
> reference.
>
> Is this homework?
No this is not homework. I'm hired to do a perl project. There is lots
of code already developed. I've 2 years of Perl4.0 and am finding it
difficult to digest the posted code. I wonder why the object is being
cloned. In Java the objects are serialized to disk/network. Is this the
same kind of thing going on here? I'm lost. Thank you for your help.
------------------------------
Date: 4 Apr 2005 15:21:37 -0700
From: odigity@gmail.com
Subject: auto-deleted explcitily named temp files - possible?
Message-Id: <1112653297.419537.305590@z14g2000cwz.googlegroups.com>
OK, so I want to have my cake and eat it to.
I want to be able to control access to resources (in this case, CPUs)
by using named temp files. Imagine you have twenty dual-cpu hosts with
shared mount points, and several applications that each run in a
distributed fashion. I don't want two apps both running on host01 and
ignoring the fact that host02 is free.
So I came up with the idea that there would be a directory - say
/resource - where files would be created indicating that the cpu in
question is being used. For example, if an app starts and launches two
processes on host01, saturating both CPUs, it would create
/resource/host01.1 and /resource/host01.2, and then delete them when
finished. That way apps can efficiently use processor resources with
tempfiles as a super-simple communication mechanism.
One requirement is that the lockfile automatically get deleted no
matter what happened to the process. This is imperative, since if it
is possible for a process to exit and leave the lockfile behind, other
apps will continue to think that resource is in use and not use it.
Now, the usual trick for this is creating the file then immediately
unlinking it, but this technique leaves the file nameless, which
defeats the purpose of having the file open.
I can't find any other way to open a named file and guarantee that it
is deleted when the process exits. Any ideas?
------------------------------
Date: 04 Apr 2005 22:44:35 GMT
From: xhoster@gmail.com
Subject: Re: auto-deleted explcitily named temp files - possible?
Message-Id: <20050404184435.352$NX@newsreader.com>
odigity@gmail.com wrote:
...
> So I came up with the idea that there would be a directory - say
> /resource - where files would be created indicating that the cpu in
> question is being used. For example, if an app starts and launches two
> processes on host01, saturating both CPUs, it would create
> /resource/host01.1 and /resource/host01.2, and then delete them when
> finished. That way apps can efficiently use processor resources with
> tempfiles as a super-simple communication mechanism.
>
> One requirement is that the lockfile automatically get deleted no
> matter what happened to the process. This is imperative, since if it
> is possible for a process to exit and leave the lockfile behind, other
> apps will continue to think that resource is in use and not use it.
Each process should not only create the file, but also lock the file
using flock. Then whatever process is looking for a free CPU, should, if
it doesn't find one, go through all the files making sure they are
actually locked (by trying to flock them), and if it finds ones that aren't
already locked it knows that they have been abandoned by dead process.
Of course, this depends on flock working properly across the network.
Xho
--
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service $9.95/Month 30GB
------------------------------
Date: 05 Apr 2005 00:41:55 GMT
From: Abigail <abigail@abigail.nl>
Subject: Re: Generate random arrays?
Message-Id: <slrnd53nmj.u4c.abigail@alexandra.abigail.nl>
BCC (bcc@abcz.com) wrote on MMMMCCXXXIV September MCMXCIII in
<URL:news:Ax04e.1155$qD2.113@newssvr14.news.prodigy.com>:
,, Hi, I have a matrix that is 100x100x100, and wish to generate a list of
,, 1000 randomly chosen non-repeating x,y,z coordinates within the space.
,,
,, I can generate a list of non-repeating single digits using rand(), but
,, Im not sure how to take it to the next level...
Untested:
my %set;
$set {int rand 100, int rand 100, int rand 100} = 1 while keys %set < 1000;
my @coordinates = map {[split $;]} keys %set;
@coordinates will contain 1000 triples, each pair of triples unique.
Abigail
--
$_ = "\112\165\163\1648\141\156\157\164\150\145\1628\120\145"
. "\162\1548\110\141\143\153\145\162\0128\177" and &japh;
sub japh {print "@_" and return if pop; split /\d/ and &japh}
------------------------------
Date: 05 Apr 2005 00:54:02 GMT
From: Abigail <abigail@abigail.nl>
Subject: Re: Help with a script..
Message-Id: <slrnd53oda.u4c.abigail@alexandra.abigail.nl>
Felix Geerinckx (felix.geerinckx@gmail.com) wrote on MMMMCCXXXIV
September MCMXCIII in <URL:news:xn0e0lj3e1r1u3000@news.easynews.com>:
~~ On 04/04/2005, A. Sinan Unur wrote:
~~
~~ > clearguy02@yahoo.com wrote in news:1112576321.475302.71500
~~ > @z14g2000cwz.googlegroups.com:
~~ >
~~ > > $finalDate = sprintf ("20%02d-%02d-%02d %02d:%02d:00\n", $3,
~~ > > $months{$2}, $1, $4, $5);
~~ >
~~ > As I noted before, there is a Y2.1K bug in there. When doing the
~~ > right thing is just as easy as doing the wrong thing, why not do the
~~ > right thing?
~~ >
~~
~~ It's more than a Y2.1K bug:
~~
~~ $shortyear = '04';
~~
~~ could mean any of
~~
~~ $longyear = '1904';
~~ $longyear = '2004';
~~ $longyear = '2104';
~~
~~ etc.
Not in this case. The OP defined '04' to be 2004. Given that it's a
timestamp, 2104 isn't logical, as it's only 2005, and neither is 1904.
There was a shortage of computers in 1904.
Any computer generated timestamp having the year '04' was made in 2004.
Abigail
--
#!/opt/perl/bin/perl -- # Remove trailing newline!
BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/;
truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ
------------------------------
Date: 4 Apr 2005 14:20:43 -0700
From: sleepymish@gmail.com
Subject: Perl Embed in C++ Problem -> Urgent, please help!
Message-Id: <1112649643.265073.318390@l41g2000cwc.googlegroups.com>
Hi,
I recently followed the Perlembed example and did a C program w/ perl
embedded. It worked fine. Then suddenly I realize I need to use C++
STL, which I can't do w/ C. Now I'm trying to convert my c program into
c++, except I'm not sure how to compile it w/ perl anymore. Here's how
I compile perl w/ my c program before:
$ gcc -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include
-I/lib/perl5/5.8/cygwin/C
ORE -L/lib/perl5/5.8/cygwin/CORE -o p1v1 p1v1.c -lperl -lm
Now how would I compile a C++ program w/ perl embed? I tried the
following and it didn't work:
$ g++ -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include
-I/lib/perl5/5.8/cygwin/C
ORE -L/lib/perl5/5.8/cygwin/CORE -o p1v1 p1v1.cpo -lperl -lm
$ g++ -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include
-I/lib/perl5/5.8/cygwin/C
ORE -L/lib/perl5/5.8/cygwin/CORE -o p1v1 p1v1.cc -lperl -lm
Here's one sample errors:
$ gcc -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include
-I/lib/perl5/5.8/cygwin/C
ORE -L/lib/perl5/5.8/cygwin/CORE -o p1v1 p1v1.cc -lperl -lmcd
In file included from /lib/perl5/5.8/cygwin/CORE/perl.h:2838,
from p1v1.cc:4:
/usr/include/ieeefp.h:185: error: previous declaration of `int
isnan(double)'
with C++ linkage
/usr/include/math.h:125: error: conflicts with new declaration with C
linkage
/usr/include/ieeefp.h:186: error: previous declaration of `int
isinf(double)'
with C++ linkage
/usr/include/math.h:126: error: conflicts with new declaration with C
linkage
/usr/include/ieeefp.h:187: error: previous declaration of `int
finite(double)'
with C++ linkage
/usr/include/math.h:127: error: conflicts with new declaration with C
linkage
/usr/include/ieeefp.h:191: error: previous declaration of `int
isnanf(float)'
with C++ linkage
/usr/include/math.h:240: error: conflicts with new declaration with C
linkage
/usr/include/ieeefp.h:192: error: previous declaration of `int
isinff(float)'
with C++ linkage
/usr/include/math.h:241: error: conflicts with new declaration with C
linkage
/usr/include/ieeefp.h:193: error: previous declaration of `int
finitef(float)'
with C++ linkage
/usr/include/math.h:242: error: conflicts with new declaration with C
linkage
In file included from p1v1.cc:10:
helpers.h: In function `void wget_file(char*, char*)':
helpers.h:6: error: invalid conversion from `void*' to `char*'
helpers.h: In function `int get_v(int, char**, char**, char*, int*)':
helpers.h:74: error: invalid conversion from `void*' to `char*'
helpers.h:75: error: invalid conversion from `void*' to `char*'
helpers.h: In function `int get_AvgDocLen(int, int, char**, char**)':
helpers.h:345: error: invalid conversion from `void*' to `char*'
helpers.h:368: error: invalid conversion from `void*' to `char*'
helpers.h:370: error: invalid conversion from `void*' to `int*'
p1v1.cc: In function `int main(int, char**, char**)':
p1v1.cc:38: error: invalid conversion from `void*' to `char*'
p1v1.cc:40: error: invalid conversion from `void*' to `char*'
p1v1.cc:41: error: invalid conversion from `void*' to `int*'
Someone please help!
Oh yea I did try ken fox's libperl but got the following after I run:
perl Makefile.PL
make
Syntax error: Unterminated quoted string
make: *** [subdirs] Error 2
I looked in the makefile and can't find an unterminated quoted string.
Anybody has any ideas?
P.S. I posted in the moderated forum too, but that takes too long to
update. I'm hoping I will get result faster here. Sorry for the
duplication.
Michelle
------------------------------
Date: Mon, 4 Apr 2005 18:07:57 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: Perl Embed in C++ Problem -> Urgent, please help!
Message-Id: <slrnd53i6d.2d0.tadmc@magna.augustmail.com>
sleepymish@gmail.com <sleepymish@gmail.com> wrote:
> Subject: Perl Embed in C++ Problem -> Urgent, please help!
^^^^^^
^^^^^^
Putting "urgent" in your Subject is counter-productive, it
results in *less* people seeing your question.
ie. It hurts (not helps) your chances of getting help.
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 4 Apr 2005 17:22:03 -0700
From: sleepymish@gmail.com
Subject: Re: Perl Embed in C++ Problem -> Urgent, please help!
Message-Id: <1112660523.754719.321630@l41g2000cwc.googlegroups.com>
Thanks for the advice, but I can't edit that title now.
------------------------------
Date: Mon, 04 Apr 2005 21:18:46 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Perl User Name/Password issue
Message-Id: <d2s7fg$1b1$1@slavica.ukpost.com>
Shabbir Mala wrote:
> I need some urgent help on Net::Ftp object.
>
> I have written a perl script file which connects to server and
> downloads some files and quits. If i do a test on the test environment
> with around 10 users i have no issues. But on one of the production
> server something very funny is been observed. Some users after some
> random numbers of proper connections, are getting a 503 login incorrect
> error. This error is very random and doesnt happen in a cycle way. Say
> around 10-20 proper connections once incorrect login error.
>
> Can anybody help me on this, what could be the issue. Is there any
> maximum limit allowed on the HP-UX server for FTP connections? Is it
> that i am exceeding this limit and thats why i am getting this error?
Sounds utterly plausible (but not anything to do with Perl).
------------------------------
Date: Mon, 4 Apr 2005 17:54:55 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: Perl User Name/Password issue
Message-Id: <slrnd53hdv.2d0.tadmc@magna.augustmail.com>
Shabbir Mala <shabbirmala@gmail.com> wrote:
> I need some urgent help on Net::Ftp object.
^^^^^^
^^^^^^
Since your post took 3 days to get to me, you are probably
already dead, so there isn't much point in spending time
trying to answer your question (like I would have if it
hadn't been "urgent").
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 4 Apr 2005 17:58:00 -0700
From: "Ohm" <sams@freeddns.org>
Subject: Please help package Search::VectorSpace; problem
Message-Id: <1112662679.982208.296940@z14g2000cwz.googlegroups.com>
Iam tring to create a search tool using PDL andVectorSpace.
doc1.txt and doc2.txt are files with some text in it.
Appreciate any help here, as Iam not very good in Perl.
Error Iam getting is:
Making word list:
Use of uninitialized value in subroutine entry at
C:/Perl/site/lib/Search/Vector
Space.pm line 175, <DATA> line 584.
Finished with word list
Can't locate object method "set_threshold" via package
"Search::VectorSpace" at
search.pl line 13, <DATA> line 584.
======================================
#search.pl
use Search::VectorSpace;
#my @docs = get_documents_from_somewhere();
my @docs = {'doc1.txt', 'doc2.txt'};
my $engine = Search::VectorSpace->new( docs => \@docs );
$engine->build_index();
$engine->set_threshold( '0.01' );
while ( my $query = <> ) {
my %results = $engine->search( $query );
foreach my $result ( sort { $results{$b} <=> $results{$a} }
keys %results ) {
print "Relevance: ", $results{$result}, "\n";
print $result, "\n\n";
}
print "Next query?\n";
}
=======================================
package Search::VectorSpace;
use warnings;
use strict;
use Lingua::Stem;
use Carp;
use PDL;
our $VERSION = '0.02';
=head1 TITLE
Search::VectorSpace - a very basic vector-space search engine
=head1 SYNOPSIS
use Search::VectorSpace;
my @docs = ...;
my $engine = Search::VectorSpace->new( docs => \@docs, threshold =>
.04);
$engine->build_index();
while ( my $query = <> ) {
my %results = $engine->search( $query );
print join "\n", keys %results;
}
=head1 DESCRIPTION
This module takes a list of documents (in English) and builds a simple
in-memory
search engine using a vector space model. Documents are stored as PDL
objects,
and after the initial indexing phase, the search should be very fast.
This
implementation applies a rudimentary stop list to filter out very
common words, and
uses a cosine measure to calculate document similarity. All documents
above
a user-configurable similarity threshold are returned.
=head1 METHODS
=over
=item new docs => ARRAYREF [, threshold => VALUE ]
Object constructor. Argument hash must contain a key 'docs' whose
value is a reference
to an array of documents. The hash can also contain an optional
threshold setting,
between zero and one, to serve as a relevance cutoff for search
results.
=cut
sub new {
my ( $class, %params ) = @_;
croak 'Usage: Search::VectorSpace->new( docs => \@docs);' unless
exists ( $params{'docs'} ) and
ref( $params{'docs'} ) and
ref( $params{'docs'}) eq 'ARRAY';
my $self =
{
docs => $params{'docs'},
threshold => $params{'threshold'} || .001,
stop_list => load_stop_list(),
};
return bless $self, $class;
}
=item build_index
Creates the document vectors and stores them in memory, along with a
master
word list for the document collection.
=cut
sub build_index() {
my ( $self ) = @_;
print "Making word list:\n";
$self->make_word_list();
my @vecs;
foreach my $doc ( @{ $self->{'docs'} }) {
my $vec = $self->make_vector( $doc );
push @vecs, norm $vec;
}
$self->{'doc_vectors'} = \@vecs;
print "Finished with word list\n";
}
=item search QUERY
Returns all documents matching the QUERY string above the set relevance
threshold.
Unlike regular search engines, the query can be arbitrarily long, and
contain
pretty much anything. It gets mapped into a query vector just like the
documents
in the collection were.
Returns a hash in the form RESULT => RELEVANCE, where the relevance
value is between
zero and one.
=cut
sub search {
my ( $self, $query ) = @_;
my $qvec = $self->make_vector( $query );
my %result_list = $self->get_cosines( norm $qvec );
my %documents;
foreach my $index ( keys %result_list ) {
my $doc = $self->{'docs'}->[$index];
my $relevance = $result_list{$index};
$documents{$doc} = $relevance;
}
return %documents;
}
=item get_words STRING
Rudimentary parser, splits string on whitespace and removes
punctuation.
Returns a hash in the form WORD => NUMBER, where NUMBER is how many
times
the word was found.
=cut
sub get_words {
# Splits on whitespace and strips some punctuation
my ( $self, $text ) = @_;
my %doc_words;
my @words = map { stem($_) }
grep { !( exists $self->{'stop_list'}->{$_} ) }
map { lc($_) }
map { $_ =~/([a-z\-']+)/i}
split /\s+/, $text;
do { $_++ } for @doc_words{@words};
return %doc_words;
}
=item stem WORD
Convenience wrapper for Lingua::Stem::stem()
=cut
sub stem {
my ( $word) = @_;
my $stemref = Lingua::Stem::stem( $word );
return $stemref->[0];
}
sub make_word_list {
my ( $self ) = @_;
my %all_words;
foreach my $doc ( @{ $self->{docs} } ) {
my %words = $self->get_words( $doc );
foreach my $k ( keys %words ) {
#print "Word: $k\n";
$all_words{$k} += $words{$k};
}
}
# create a lookup hash of word to position
my %lookup;
my @sorted_words = sort keys %all_words;
@lookup{@sorted_words} = (1..$#sorted_words );
$self->{'word_index'} = \%lookup;
$self->{'word_list'} = \@sorted_words;
$self->{'word_count'} = scalar @sorted_words;
}
sub make_vector {
my ( $self, $doc ) = @_;
my %words = $self->get_words( $doc );
my $vector = zeroes $self->{'word_count'};
foreach my $w ( keys %words ) {
my $value = $words{$w};
my $offset = $self->{'word_index'}->{$w};
index( $vector, $offset ) .= $value;
}
return $vector;
}
sub get_cosines {
my ( $self, $query_vec ) = @_;
my %cosines;
my $index = 0;
foreach my $vec ( @{ $self->{'doc_vectors'} }) {
my $cosine = cosine( $vec, $query_vec );
$cosines{$index} = $cosine if $cosine > $self->{'threshold'};
$index++;
}
return %cosines;
}
# Assumes both incoming vectors are normalized
sub cosine {
my ( $vec1, $vec2 ) = @_;
my $cos = inner( $vec1, $vec2 ); # inner product
return $cos->sclr(); # converts PDL object to Perl scalar
}
sub load_stop_list {
my %stop_words;
while (<DATA>) {
chomp;
$stop_words{$_}++;
}
return \%stop_words;
}
1;
=back
=head1 AUTHOR
Maciej Ceglowski <maciej@ceglowski.com>
This program is free software, released under the GNU public license
=cut
__DATA__
i'm
web
don't
i've
we've
they've
she's
he's
it's
great
old
can't
tell
tells
busy
doesn't
you're
your's
didn't
they're
night
nights
anyone
isn't
i'll
actual
actually
presents
presenting
presenter
present
presented
presentation
we're
wouldn't
example
examples
i'd
haven't
etc
won't
myself
we've
they've
aren't
we'd
it'd
ain't
i'll
who've
-year-old
kind
kinds
builds
build
built
com
make
makes
making
made
you'll
couldn't
use
uses
used
using
take
takes
taking
taken
exactly
we'll
it'll
certainly
he'd
shown
they'd
wasn't
yeah
to-day
lya
a
ability
able
aboard
about
above
absolute
absolutely
across
act
acts
add
additional
additionally
after
afterwards
again
against
ago
ahead
aimless
aimlessly
al
albeit
align
all
allow
almost
along
alongside
already
also
alternate
alternately
although
always
am
amid
amidst
among
amongst
an
and
announce
announced
announcement
announces
another
anti
any
anything
appaling
appalingly
appear
appeared
appears
are
around
as
ask
asked
asking
asks
at
await
awaited
awaits
awaken
awakened
awakens
aware
away
b
back
backed
backing
backs
be
became
because
become
becomes
becoming
been
before
began
begin
begins
behind
being
believe
believed
between
both
brang
bring
brings
brought
but
by
c
call
called
calling
calls
can
cannot
carried
carries
carry
carrying
change
changed
changes
choose
chooses
chose
clearly
close
closed
closes
closing
come
comes
coming
consider
considerable
considering
could
couldn
d
dare
daren
day
days
despite
did
didn
do
does
doesn
doing
done
down
downward
downwards
e
each
eight
either
else
elsewhere
especially
even
eventually
ever
every
everybody
everyone
f
far
feel
felt
few
final
finally
find
five
for
found
four
fourth
from
get
gets
getting
gave
give
gives
go
goes
going
gone
good
got
h
had
has
have
he
held
her
here
heretofore
hereby
herewith
hers
herself
high
him
himself
his
hitherto
happen
happened
happens
hour
hours
how
however
i
ii
iii
iv
if
in
include
included
includes
including
inside
into
is
isn
it
its
itself
j
just
k
l
la
larger
largest
last
later
latest
le
least
leave
leaves
leaving
les
let
less
like
ll
m
made
main
mainly
make
makes
man
many
may
me
means
meant
meanwhile
men
might
missed
more
moreover
most
mostly
move
moved
moving
mr
mrs
much
must
mustn
my
need
needs
neither
never
new
newer
news
nine
no
non
none
nor
not
now
o
of
off
often
on
once
one
only
or
other
our
out
over
own
owns
p
particularly
per
percent
primarily
put
q
quickly
r
remain
remaining
respond
responded
responding
responds
return
ran
rather
run
running
runs
s
said
say
says
same
see
seek
seeking
seeks
seen
send
sent
set
sets
seven
several
she
should
shouldn
side
since
six
sixes
slow
slowed
slows
small
smaller
so
some
someone
something
somewhat
somewhere
soon
sought
spread
stay
stayed
still
substantially
such
suppose
t
take
takes
taken
th
than
that
the
their
them
themselves
then
there
thereby
therefore
these
they
thing
things
thi
this
those
though
thus
three
through
throughout
to
together
too
took
toward
towards
tried
tries
try
trying
two
u
unable
under
underneath
undid
undo
undoes
undone
undue
undoubtedly
unfortunately
unless
unnecessarily
unofficially
until
unusually
unsure
up
upon
upward
us
use
used
uses
using
usual
usually
v
ve
very
via
view
viewed
w
wait
waited
waits
want
wanted
wants
was
wasn
watched
watching
way
ways
we
went
were
what
whatever
when
whenever
where
whereever
whether
which
whichever
while
who
whoever
whom
whomsoever
whose
whosever
why
wide
wider
will
with
without
won
would
wouldn
wow
wows
www
x
xii
xiii
xiv
xv
xvi
xvii
xviii
xix
xx
y
year
you
your
yours
yourself
yourselves
------------------------------
Date: 4 Apr 2005 13:17:13 -0700
From: julia_2683@hotmail.com (julia)
Subject: recursivity
Message-Id: <65a243bc.0504041217.640aaac9@posting.google.com>
Hello,
I am trying to write a script that read files in a directory that I
can supply at the command line. (split.pl in). The script aborted...
Please help me find how to fix the problem.
Thanks
use strict;
my $input_dir = $ARGV[0] || '.' ;
MAIN:
opendir DIR, $dir || die "Couldnt open $dir - $!\n";
my @entries = readdir(DIR);
closedir (DIR);
foreach my $file (@entries) {
my $filename = "$dir/$file";
if ( -f $filename ){
open(F, "<$filename");
}
}
while (<F>) {
my @words = split(/\W*\s+\W*/, $_); # split
foreach my $num ( 0 .. $#words) {
open OUT, ">out_$filename.txt" and select OUT if 1..1;
{print $num+1, "\t$words[$num] -- file $filename\n"}
}
}
------------------------------
Date: Mon, 04 Apr 2005 22:29:10 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: recursivity
Message-Id: <3bdmf1F6hno8oU1@individual.net>
julia wrote:
> Please help me find how to fix the problem.
>
> use strict;
use warnings;
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Mon, 04 Apr 2005 22:39:57 GMT
From: "John W. Krahn" <someone@example.com>
Subject: Re: recursivity
Message-Id: <1nj4e.2$VF5.1@edtnps89>
julia wrote:
>
> I am trying to write a script that read files in a directory that I
> can supply at the command line. (split.pl in). The script aborted...
> Please help me find how to fix the problem.
> Thanks
>
>
> use strict;
> my $input_dir = $ARGV[0] || '.' ;
>
> MAIN:
>
> opendir DIR, $dir || die "Couldnt open $dir - $!\n";
Because of precedence that will never die. You need to either add parentheses
or use the lower precedence 'or' operator.
> my @entries = readdir(DIR);
> closedir (DIR);
>
> foreach my $file (@entries) {
> my $filename = "$dir/$file";
> if ( -f $filename ){
> open(F, "<$filename");
> }
> }
>
> while (<F>) {
> my @words = split(/\W*\s+\W*/, $_); # split
> foreach my $num ( 0 .. $#words) {
> open OUT, ">out_$filename.txt" and select OUT if 1..1;
> {print $num+1, "\t$words[$num] -- file $filename\n"}
>
> }
> }
This may work better (untested):
use warnings;
use strict;
my $input_dir = $ARGV[0] || '.';
opendir DIR, $dir or die "Couldnt open $dir - $!\n";
{ local @ARGV = grep -f, map "$dir/$_", readdir DIR;
while ( <> ) {
if ( $. == 1 ) {
open OUT, '>', "out_$ARGV.txt" or die "Cannot open out_$ARGV.txt:
$!";
select OUT;
}
my @words = split /\W*\s+\W*/;
for my $num ( 1 .. @words ) {
print "$num\t$words[$num-1] -- file $ARGV\n"
}
}
}
__END__
John
--
use Perl;
program
fulfillment
------------------------------
Date: Mon, 4 Apr 2005 18:02:57 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: recursivity
Message-Id: <slrnd53ht1.2d0.tadmc@magna.augustmail.com>
julia <julia_2683@hotmail.com> wrote:
> Subject: recursivity
There is no recursion anywhere in your code.
Did you mean to ask something about "recursivity", whatever
the heck that might mean?
> The script aborted...
I doubt that it got even that far, as it won't even compile.
> Please help me find how to fix the problem.
Declare and initialize the $dir variable.
> my @words = split(/\W*\s+\W*/, $_); # split
Useless comments should be avoided.
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Mon, 04 Apr 2005 23:23:42 GMT
From: "John W. Krahn" <someone@example.com>
Subject: Re: recursivity
Message-Id: <20k4e.15$VF5.11@edtnps89>
John W. Krahn wrote:
>
> This may work better (untested):
>
> use warnings;
> use strict;
> my $input_dir = $ARGV[0] || '.';
>
> opendir DIR, $dir or die "Couldnt open $dir - $!\n";
>
> { local @ARGV = grep -f, map "$dir/$_", readdir DIR;
>
> while ( <> ) {
> if ( $. == 1 ) {
> open OUT, '>', "out_$ARGV.txt" or die "Cannot open
> out_$ARGV.txt: $!";
> select OUT;
> }
> my @words = split /\W*\s+\W*/;
> for my $num ( 1 .. @words ) {
> print "$num\t$words[$num-1] -- file $ARGV\n"
> }
Oops, I forgot to reset $.
close ARGV if eof;
> }
> }
>
> __END__
John
--
use Perl;
program
fulfillment
------------------------------
Date: 5 Apr 2005 00:04:14 GMT
From: John Bokma <postmaster@castleamber.com>
Subject: Re: recursivity
Message-Id: <Xns962EC1DEF170castleamber@130.133.1.4>
John W. Krahn wrote:
> my $input_dir = $ARGV[0] || '.';
Now try 0 for a dir name...
Only use the || thing if you are 100% sure it can't cause weird accidents.
Imagine you have actually a dir called 0, and your script recursively
deletes all files...
--
John Small Perl scripts: http://johnbokma.com/perl/
Perl programmer available: http://castleamber.com/
Happy Customers: http://castleamber.com/testimonials.html
------------------------------
Date: 4 Apr 2005 11:16:52 -0700
From: "Greg K" <g_klinedinst@hotmail.com>
Subject: Re: speed issues with pattern matching and substitution
Message-Id: <1112638612.936522.304610@g14g2000cwa.googlegroups.com>
I am more of a lurker here than a Perl guru(someday I hope), but my
guess would be the three comparisons for a match of your key are what
is slowing you down:
>if (/(\W)$k(\W)/){
>$line =~ /(\W)($k)(\W)/
>$line =~ s/(\W)($k)(\W)/$1$tmp$3/;
I use a similar program for updating a bunch of files in a directory. I
wrote it so you could use two arrays which contain old and new values,
but I just modified it to use a hash instead. I know my code probably
isn't as concise as some people here can write, but you're welcome to
use if you like. It actually scans a directory listing for files which
match a regexp, then processes those.
[CodeA - Arrays]
#!/usr/local/bin/perl
use strict;
use warnings;
#directory info and file reg exp
my $dir = opendir DIR,"../old";
my @files = readdir(DIR);
my $fileregexp = "txt";
# number of files processed
my $count=0;
#arrays of stuff you want to change
my @old;
my @new;
## old will get interpreted as a regexp so make sure you escape chars
as needed
$old[0] = 'C';
$new[0] = 'Perl';
foreach my $filename (@files)
{
if( $filename =~ /$fileregexp/ )
{
$count++;
open IN, "<../old/$filename" || die "Unable to open files for
reading";
open OUT, ">../new/$filename"|| die "Unable to open files for
writing";
while ( <IN> )
{
for( my $t = 0; $t < ($#old + 1); $t++ )
{
s/$old[$t]/$new[$t]/g;
}
print OUT $_;
}
close IN;
close OUT;
print "../new/$filename created\n";
}
}
print "$count files modified\n";
[/CodeA]
[CodeB - Hash]
#!/usr/local/bin/perl
use strict;
use warnings;
#directory info and file reg exp
my $dir = opendir DIR,"../old";
my @files = readdir(DIR);
my $fileregexp = "txt";
# number of files processed
my $count=0;
## the key will be interpreted as a regexp so escape anything you need
to here, such as parens
my %changes = (
'C' => 'Perl'
);
my @keys = keys( %changes );
foreach my $filename ( @files )
{
if( $filename =~ /$fileregexp/ )
{
$count++;
open IN, "<../old/$filename" || die "Unable to open files for
reading";
open OUT, ">../new/$filename" || die "Unable to open files for
writing";
while( <IN> )
{
foreach my $k ( @keys )
{
s/$k/$changes{$k}/g;
}
print OUT $_;
}
close IN;
close OUT;
print "../new/$filename created\n";
}
}
print "$count files modified\n";
[/CodeB]
Data input file(essay.txt):
C is the best programming language.
There is more than one way to do it in C.
I like all the premade data structures in C.
Data output file(essay.txt):
Perl is the best programming language.
There is more than one way to do it in Perl.
I like all the premade data structures in Perl.
-Greg
------------------------------
Date: Mon, 04 Apr 2005 22:04:28 GMT
From: "John W. Krahn" <someone@example.com>
Subject: Re: speed issues with pattern matching and substitution
Message-Id: <MRi4e.171366$fc4.33754@edtnps89>
Arturi wrote:
>
> I wrote some perl lines that scans a file looking for some words and
> substitute them for their corresponding pairs, which are previously
> saved in a HASH.
> The code is working fine but I'm wondering what could I do to speed it
> up.
Use a profiling module or the Benchmark module to determine which parts of the
code are too slow.
> here the code extract:
> ----------------------------------------------------------------------
> %HASH #is being defined previously
>
> @keys= keys(%HASH);
> my $line = undef;
> my $tmp = undef;
>
> open(FILE,"< in.txt") || die "Can't open ";
> open(OUTPUT2,"< out.txt") || die "Can't open ";
>
> while (<FILE>) {
> $line = $_;
> foreach $k (@keys) {
> if (/(\W)$k(\W)/){
Why use \W which requires a character at either end of $k instead of \b which
doesn't? Why use capturing parentheses?
> #print "$_\n";
> $tmp = $HASH{$k};
> while ($line =~/(\W)($k)(\W)/){$line =~
> s/(\W)($k)(\W)/$1$tmp$3/;}
> }
More simply written as:
1 while $line =~ s/(\W)($k)(\W)/$1$tmp$3/;
But the only reason to do it like that is if the keys/values are overlapping
or recursive. Is there any reason that you can't just use the /g global option?
> }
> print OUTPUT2 $line;
> }
>
> ---------------------------------------------------------------------------
open FILE, '<', 'in.txt' or die "Can't open 'in.txt' $!";
open OUTPUT2, '>', 'out.txt' or die "Can't open 'out.txt' $!";
while ( my $line = <FILE> ) {
for my $k ( keys %HASH ) {
$line =~ s/\b($k)\b/$HASH{$k}/g;
# if you REALLY need it
# 1 while $line =~ s/\b($k)\b/$HASH{$k}/g;
}
print OUTPUT2 $line;
}
John
--
use Perl;
program
fulfillment
------------------------------
Date: Mon, 04 Apr 2005 23:05:48 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: speed issues with pattern matching and substitution
Message-Id: <d2sdnv$5an$1@slavica.ukpost.com>
Arturi wrote:
> I wrote some perl lines that scans a file looking for some words and
> substitute them for their corresponding pairs, which are previously
> saved in a HASH.
> The code is working fine but I'm wondering what could I do to speed it
> up.
> Does anybody have a hint?
You are writing something of the form:
if( some_condition() ) {
do_something();
}
Where do_something() will not do anything anyhow if some_condition() is
not met. As such it would be simpler just to write:
do_something();
Actually you've gone one step further and written:
if( some_condition() ) {
while( some_condition() ) {
do_something();
}
}
Where do_something() will not only not do anything if some_condition()
is not met but will also return false. As such it would be simpler just
to write:
while( do_something() ) {}
Now if we actually look a the something, in quesion it's a s///. Do you
really want to to be able to seach and replace again within the previous
replacements? Looking at your code I'd guess that wouldn't make sense.
And if that's the case then you could simply use s///g.
> here the code extract:
> ----------------------------------------------------------------------
> %HASH #is being defined previously
>
> @keys= keys(%HASH);
> my $line = undef;
> my $tmp = undef;
Nasty case of premature declaration you've got there.
> open(FILE,"< in.txt") || die "Can't open ";
> open(OUTPUT2,"< out.txt") || die "Can't open ";
>
> while (<FILE>) {
> $line = $_;
If you are worried abot speed why are you doing that?
> foreach $k (@keys) {
> if (/(\W)$k(\W)/){
> #print "$_\n";
> $tmp = $HASH{$k};
Awful name for a variable, $tmp.
> while ($line =~/(\W)($k)(\W)/){$line =~
> s/(\W)($k)(\W)/$1$tmp$3/;}
> }
> }
If you are concerned about speed you should take the comoposition and
compilatiion of the regex outside the loop.
my @patterns = map { qr/(\W)($_)(\W)/ } keys %HASH;
local *_; # Wise not to stomp on someone else's $_
while (<FILE>) {
my @values = values %HASH;
for my $pattern ( @patterns ) {
my $value = shift @values;
s/$pattern/$1$value$3/g;
}
# print or whatever
}
But my spider-sense is telling me that perhaps the keys of %HASH really
arbirary regexes but are just words and all you want is word
substitution. This is a classic bit of Perl.
while (<FILE>) {
s/(\w+)/$HASH{$1}||$1/eg;
# print or whatever
}
------------------------------
Date: Mon, 4 Apr 2005 18:41:15 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: speed issues with pattern matching and substitution
Message-Id: <slrnd53k4q.2d0.tadmc@magna.augustmail.com>
Greg K <g_klinedinst@hotmail.com> wrote:
> I am more of a lurker here than a Perl guru(someday I hope),
Use the FAQ Luke!
perldoc -q match
How do I efficiently match many regular expressions at once?
> but my
> guess
There is no need to guess:
perldoc -q profile
How do I profile my Perl programs?
> I use a similar program
I sure hope that does not mean the the code below is what
you have actually used.
If it is, then you just haven't found the bugs that are in it yet...
> #!/usr/local/bin/perl
> use strict;
> use warnings;
A most excellent start, BTW.
> my $dir = opendir DIR,"../old";
You should check the return value to see if you actually got
what you asked for, just like with open() below.
> $old[0] = 'C';
> $new[0] = 'Perl';
> open IN, "<../old/$filename" || die "Unable to open files for
> reading";
You should include the $! variable in your die message, it
contains the reason for the dying.
> for( my $t = 0; $t < ($#old + 1); $t++ )
Gak!
foreach my $t ( 0 .. $#old )
or at least:
for( my $t = 0; $t < @old; $t++ )
or even:
for( my $t = 0; $t <= $#old; $t++ )
> s/$old[$t]/$new[$t]/g;
If
$_ = 'Chuck likes C';
Then you _want_ it to be changed to:
Perlhuck likes Perl
??
Probably not, so maybe this instead:
s/\b$old[$t]\b/$new[$t]/g;
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 4 Apr 2005 17:13:17 -0700
From: "Greg K" <g_klinedinst@hotmail.com>
Subject: Re: speed issues with pattern matching and substitution
Message-Id: <1112659996.984963.48150@l41g2000cwc.googlegroups.com>
>Use the FAQ Luke!
> perldoc -q match
> How do I efficiently match many regular expressions at once?
Nice, didn't know about that. Thanks for the tip!
>I sure hope that does not mean the the code below is what
>you have actually used.
>If it is, then you just haven't found the bugs that are in it yet...
Actually, yes, I do use the following.
>for( my $t = 0; $t < @old; $t++ )
>for( my $t = 0; $t <= $#old; $t++ )
I would use either of these this one. Unfortunately I still have to
switch back and forth between languages frequently so I probably won't
switch to the ( 0 .. $#old ) notation any time soon.
>> s/$old[$t]/$new[$t]/g;
>If
> $_ = 'Chuck likes C';
>Then you _want_ it to be changed to:
> Perlhuck likes Perl
Actually, for my case it does what I want. I am matching long unique
strings so I don't have to worry about accidental matches(strings such
as "../group_name/participants.html", etc). I figured the OP can write
the regexp for their specific need.
Anyway, thx for the constructive criticism. I am going to keep reading
through the PerlFAQ.
------------------------------
Date: Tue, 05 Apr 2005 01:28:36 +0200
From: Sverre Furberg <sverro@chello.se>
Subject: use Cwd qw(abs_path) question
Message-Id: <37k4e.219$184.75@amstwist00>
Hi.
I was testing the use 'Cwd qw(abs_path)' function
in a script on my Windows 98 computer and found
(in my opinion) something strange.
use strict;
use warnings;
use Cwd qw(abs_path);
my $file = shift;
my $abs_path = abs_path($file);
print $abs_path, "\n";
__END__
If i run the script with 'a normal file' as argument like this:
C:\Temp>perl pwdtest.plx text.txt
I get:
C:\Temp\text.txt
with backslashes.
Now if i run the script with a directory as argument:
C:\Temp>perl pwdtest.plx testdir
I get:
C:/Temp/testdir
with frontslashes like in *nix.
Why is that?
It's not a problem but I'm curious.
Sverre
------------------------------
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 7942
***************************************
