[15775] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 3188 Volume: 9

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun May 28 00:10:33 2000

Date: Sat, 27 May 2000 21:10:12 -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: <959487012-v9-i3188@ruby.oce.orst.edu>
Content-Type: text

Perl-Users Digest           Sat, 27 May 2000     Volume: 9 Number: 3188

Today's topics:
        PerLotto 0.1.a3 <y-o-y@home.com>
    Re: PerLotto 0.1.a3 <y-o-y@home.com>
        Reading and writing with +>> <streaking_pyro@my-deja.com>
    Re: Reading and writing with +>> <bwalton@rochester.rr.com>
        remove leading space with regex <cure@texas.net>
        simple regexp question <eggrock@skypoint.com>
    Re: simple regexp question (Matthew Zimmerman)
    Re: simple regexp question <news**NO_SPAM**@psychogenic.com>
    Re: simple regexp question <news**NO_SPAM**@psychogenic.com>
    Re: simple regexp question (Sam Holden)
        The "fortune" I just got, re vms >> unix   :-) (David Combs)
        Translate foreign characters to English (Ben Hambidge)
        What's wrong with my eval'ed coderef regexp thingy?? <mdz4c@node16.unix.Virginia.EDU>
    Re: What's wrong with my eval'ed coderef regexp thingy? <bwalton@rochester.rr.com>
    Re: What's wrong with my eval'ed coderef regexp thingy? (Neil Kandalgaonkar)
        Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Sun, 28 May 2000 02:54:07 GMT
From: Andy <y-o-y@home.com>
Subject: PerLotto 0.1.a3
Message-Id: <jT%X4.212237$Tn4.1908497@news1.rdc2.pa.home.com>

Re-hi!

If you play a lot of lotto tickets and want to enter your games into a 
file to let Perl verify you're a winner then this script is for you. You 
need to create a file called "games" in the same folder as this script 
and type all lotto ticket games into it. Similar to:

1,2,3,4,5,6
1,2,3,4,5,7
1,2,3,4,7,8
1,2,4,7,8,9
1,7,8,9,10,11
7,8,9,10,11,12

In this version just use the space as a delimiter. Some error checking 
routines are implemented.

If you want to add a comment, such as the ticket #, start a line with 
'/' followed by any note. I use "/Ticket# 30330399303" (etc.) to 
separate my tickets. Empty lines are also allowed.

This code is no reflection on the folks who have advised me. I'm more or 
less grabbing at straws in these beginning stages. Right or wrong, 
TMTOWTDI, or so I've read. So close, yet so far. :-)

# PerLotto 0.1a3 My first "real" Perl script.
# May 27, 2000 by Andy Burns
#
# Lotto games checker
#
# History:
#
# May 27, 2000
# Version 0.1a3: Incorporated as much Gwyn help as I understood.
#                Added "Hits" to final output.
#                Attempted to improve style.
#                Still to do: print alignment and plenty of other stuff.
#                Spent a lot of time reading Perl Doc.
# May 26, 2000
# Version 0.1a2: (UNRELEASED)
#                Fixed typos and block indenting.
#                Added Error check for non-digits in games.
#                Changed array name @lotto to @winners for sensibility.
#                Changed array name @wins to @game for sensibility.
#                Changed main 'for' to 'foreach'
#                Allowed comment lines '/' and blank lines in 'games' 
file.
#
# May 25, 2000
# Version 0.1a1: Initial release

print("Enter winning numbers separated by spaces: ");
$input = <STDIN>;
chomp;
@winners = (split ' ', $input);

@winners = sort {$a <=> $b} @winners;
print"Winning numbers: @winners\n\n";
open(IN, 'games');
##open(STDOUT, '>gameslog');

while ($line = <IN>) {
       if ($line =~ m/^\//|$line =~ m/^$/) {
        print "$line";
        next;
       }

  chomp;
  @game = (split ' ', $line);
  $picks = 0;

## Check for duplicate numbers in a game

LOOP1: for (my $i = 0; $i < @game; $i++) {
        for (my $j = $i + 1; $j < @game; $j++) {
          if ($game[$i] == $game[$j]) {
                  print "ALERT:  Duplicate number \"$game[$i]\" in game 
below.\n";
                  last LOOP1;
            }
        }
       }

## Check for non-digit in game

 foreach (@game) {
   print "ALERT: Non-numeric entry \"$_\" in game below.\n" if /\D/;
 }

## Check for correct number of entries per game

 print "ALERT: Too few numbers in game below.\n" if ($#game < $#winners);
 print "ALERT: Too many numbers in game below.\n" if ($#game > 
$#winners);

 undef(@picked);

## Main
 foreach $y (@winners) {
   foreach $x (@game) {
       $picks++ if ($y == $x);
       push @picked, $x if ($y == $x);
   }
 }

 $, = " ";
 print "@game";
 print " --$picks";
 if ($#picked > -1) {
    print "  HITS: @picked\n";
 }
 else {
 print "\n";
 }
}


Enjoy!

Andy


------------------------------

Date: Sun, 28 May 2000 03:05:47 GMT
From: Andy <y-o-y@home.com>
Subject: Re: PerLotto 0.1.a3
Message-Id: <f20Y4.212246$Tn4.1908571@news1.rdc2.pa.home.com>

In article <jT%X4.212237$Tn4.1908497@news1.rdc2.pa.home.com>, Andy 
<y-o-y@home.com> wrote:

> Re-hi!
> 
> If you play a lot of lotto tickets and want to enter your games into a 
> file to let Perl verify you're a winner then this script is for you. You 
> need to create a file called "games" in the same folder as this script 
> and type all lotto ticket games into it. Similar to:

Oops... (commas are a throwback from another script language).

1 2 3 4 5 6
1 2 3 4 5 7
1 2 3 4 7 8
1 2 3 7 8 9
1 2 7 8 9 10
1 7 8 9 10 11
7 8 9 10 11 12

SORRY!

Andy


------------------------------

Date: Sun, 28 May 2000 01:54:46 GMT
From: R.Joseph <streaking_pyro@my-deja.com>
Subject: Reading and writing with +>>
Message-Id: <8gpu91$ri2$1@nnrp1.deja.com>

 Heres a problem I find very odd; that, or I am just stupid.  I open a
file with +>> (which is append mode with read and write privilges):

open (FILE,"+>>$my_file") or die;

Ok, all is good and dandy.  So now, I want to read in the file to check
some stuff:

my @in_data = <FILE>;
# Check stuff here...

OK, no prob...again, ok.  Now, here is what throws me.  Now I want to
write to the file, yet I can't!!

print FILE "Hi there\n";

Why doesn't this work!!  I have no clue what I am doing wrong.  Thanks
for the help!

--
R.Joseph


Sent via Deja.com http://www.deja.com/
Before you buy.


------------------------------

Date: Sun, 28 May 2000 02:37:50 GMT
From: Bob Walton <bwalton@rochester.rr.com>
Subject: Re: Reading and writing with +>>
Message-Id: <3930857E.9D7077E8@rochester.rr.com>

"R.Joseph" wrote:
> 
>  Heres a problem I find very odd; that, or I am just stupid.  I open a
> file with +>> (which is append mode with read and write privilges):
> 
> open (FILE,"+>>$my_file") or die;
> 
> Ok, all is good and dandy.  So now, I want to read in the file to check
> some stuff:
> 
> my @in_data = <FILE>;
> # Check stuff here...
> 
> OK, no prob...again, ok.  Now, here is what throws me.  Now I want to
> write to the file, yet I can't!!
> 
> print FILE "Hi there\n";
> 
> Why doesn't this work!!  I have no clue what I am doing wrong.  Thanks
> for the help!
> 
> --
> R.Joseph
 ...
I verify the behavior you observed on Windoze 98 SE, Activestate Perl
build 613.  Under Linux 6.1, Perl 5.005_03, it works as you expect it to
(that is, it appends "Hi there\n" to the file with no seek required). 
The fix:

   seek FILE,0,2;

before the print (asuming you want to write at the end of the file).

From perlfunc under the seek function:  "Due to the rules and rigors of
ANSI C, on some systems you have to do a seek whenever you switch
between reading and writing."
--
Bob Walton


------------------------------

Date: Sat, 27 May 2000 22:00:36 -0700
From: Cure <cure@texas.net>
Subject: remove leading space with regex
Message-Id: <3930A7F4.C6A3A27E@texas.net>


s/(?!\A)^ //mg;
 $_ contains the string "a\n b\n c\n d\n";

 the regex is supposed to remove the LEADING space at the beginning of
each "line" except the first "line"

but its not working
help!



------------------------------

Date: Sat, 27 May 2000 19:09:47 -0500
From: "Barry Grupe" <eggrock@skypoint.com>
Subject: simple regexp question
Message-Id: <8gpol9$8ul$1@shadow.skypoint.net>

I'd like to test for a valid domain name, where domain may equal the
following:
domain.xxx
subdomain.domain.xxx
subdomains.ad.nauseum.at.domain.xxx

(My ignorance of DNS may show here, but it's irrelevant to the question ;)
Domain Naming Rules:
Domains must begin with an alpha char, may contain alphanumeric, '-' and
'.'.
Domains must end with a '.' followed by 2-3 alpha chars (but no more!).
A '-' may not be the char immediately before a '.'.
No adjacent '.'s.

So, if:
chomp($a    = <STDIN>);
$a    =~ s/[^a-zA-Z0-9\-\.]//g; #this may be unnecessary?
$a    =~ tr/A-Z/a-z/;
if($a    =~ /what?/) {
    #do fun perl stuff
}

After many permutations, I've come to the conclusion that the answer may be
full of ||'s, but if it can be done without, that would be, well, Good
Stuff. I don't quite comprehend enough to quite get it done.

Happy hacking everybody, hope your Memorial weekend is safe and
entertaining.

s/\/\\/\\\//g; #turn those frowns upside down!




------------------------------

Date: 28 May 2000 01:34:14 GMT
From: mdz4c@node16.unix.Virginia.EDU (Matthew Zimmerman)
Subject: Re: simple regexp question
Message-Id: <8gpt2m$3lv$1@murdoch.acc.Virginia.EDU>

In article <8gpol9$8ul$1@shadow.skypoint.net>,
Barry Grupe <eggrock@skypoint.com> wrote:
>I'd like to test for a valid domain name, where domain may equal the
>following:
>domain.xxx
>subdomain.domain.xxx
>subdomains.ad.nauseum.at.domain.xxx
>
>(My ignorance of DNS may show here, but it's irrelevant to the question ;)
>Domain Naming Rules:
>Domains must begin with an alpha char, may contain alphanumeric, '-' and
>'.'.
>Domains must end with a '.' followed by 2-3 alpha chars (but no more!).
>A '-' may not be the char immediately before a '.'.
>No adjacent '.'s.

Here's an implementation that does exactly what you specify:

---
#!/usr/bin/perl5 -w

$alpha = '[a-z]';
$valid = '[a-z0-9-]';

while (<DATA>) {
    chomp;
    if( /^$alpha$valid*(?:\.$valid+)*\.$alpha{2,3}$/ ) {
       print "($_) matches!\n";
    } else {
       print "($_) doesn't match :(\n";
    }
}

__DATA__
tooshort
not.too.short.abc
1starts.with.number.abc
first1.field.ends.with.number.abc
last.field.has.number.1ab
last.field.ends.with.number.ab1
middle.domain.1starts.with.number.abc
last.field.has.too.few.letters.a
last.field.has.enough.letters.ab
last.field.has.too.many.letters.abcd
---

However, you should decide whether that's what you really want. 
Perhaps a better way of validating domain names is using DNS to actually
look them up?

Good luck!

Cheers, 
Matt
-- 
-- 
Matthew Zimmerman ------------  http://www.people.virginia.edu/~mdz4c
Interdisciplinary Biophysics Program --------- University of Virginia
| "You got to be very careful if you don't know where you're going, |


------------------------------

Date: Sun, 28 May 2000 02:34:35 GMT
From: "Pat!" <news**NO_SPAM**@psychogenic.com>
Subject: Re: simple regexp question
Message-Id: <39308566.99DDBEAB@psychogenic.com>

Hello.

Barry Grupe wrote:
[snip]
> Domain Naming Rules:

If you just decompose this into steps, it's pretty simple...

> Domains must begin with an alpha char,

So, since you've already lowercased everything, we say our regex starts with
	[a-z] -- a single character between a and z (incl.).

> may contain alphanumeric, '-' and
> '.'. followed by more chars and . or -

[a-z.-]+

> Domains must end with a '.' followed by 2-3 alpha chars (but no more!).

\.[a-z]{2,3}

Now we build the entire regexp and anchor it at the beginning and end:
^[a-z][a-z.-]+\.[a-z]{2,3}$

> A '-' may not be the char immediately before a '.'.
> No adjacent '.'s.

This part ends up yielding an complex regexp... so why not test for the weirdness separately?

like this:
if($a    =~ /^[a-z][a-z.-]+\.[a-z]{2,3}$/) {
    
	#test for the two exceptions: -. and ..
	die "Yukky domain name $a" if ($a =~ /[.-]\./);

	#do fun perl stuff
}

HTH
Pat.


> s/\/\\/\\\//g; #turn those frowns upside down!

  s|/\|\/|g; -- Using an alternate delimiter makes it so much clearer ;)


------------------------------

Date: Sun, 28 May 2000 02:38:57 GMT
From: "Pat!" <news**NO_SPAM**@psychogenic.com>
Subject: Re: simple regexp question
Message-Id: <3930866D.82DFDE9F@psychogenic.com>

Hello.

Barry Grupe wrote:
[snip]
> Domain Naming Rules:

If you just decompose this into steps, it's pretty simple...

> Domains must begin with an alpha char,

So, since you've already lowercased everything, we say our regex starts with
        [a-z] -- a single character between a and z (incl.).

> may contain alphanumeric, '-' and
> '.'. followed by more chars and . or -

[a-z.-]+

> Domains must end with a '.' followed by 2-3 alpha chars (but no more!).

\.[a-z]{2,3}

Now we build the entire regexp and anchor it at the beginning and end:
^[a-z][a-z.-]+\.[a-z]{2,3}$

> A '-' may not be the char immediately before a '.'.
> No adjacent '.'s.

This part ends up yielding an complex regexp... so why not test for the weirdness separately?

like this:
if($a    =~ /^[a-z][a-z.-]+\.[a-z]{2,3}$/) {
    
        #test for the two exceptions: -. and ..
        die "Yukky domain name $a" if ($a =~ /[.-]\./);

        #do fun perl stuff
}

HTH
Pat.


> s/\/\\/\\\//g; #turn those frowns upside down!

  s|/\|\/|g; -- Using an alternate delimiter makes it so much clearer ;)


------------------------------

Date: 28 May 2000 02:54:40 GMT
From: sholden@pgrad.cs.usyd.edu.au (Sam Holden)
Subject: Re: simple regexp question
Message-Id: <slrn8j12jg.kf4.sholden@pgrad.cs.usyd.edu.au>

On Sun, 28 May 2000 02:34:35 GMT, Pat! <news**NO_SPAM**@psychogenic.com> wrote:
>Barry Grupe wrote:
>
>> may contain alphanumeric, '-' and
>> '.'. followed by more chars and . or -
>
>[a-z.-]+

[a-z0-9.-]+

is I'm sure what you meant.

Then again the word 'may' could indicate a * rather than +, but that would
require me reading some more and I'm too lazy ;)

-- 
Sam

I guess I really am an optimist. A paranoid optimist, true, but an
optimist nonetheless. 
	-- Larry Wall


------------------------------

Date: 28 May 2000 01:10:15 GMT
From: dkcombs@netcom.com (David Combs)
Subject: The "fortune" I just got, re vms >> unix   :-)
Message-Id: <8gprln$33j$1@slb3.atl.mindspring.net>

Just got this fortune when I logged into my netcom shell-acct.

Thought you might enjoy it.

(Didn't DEC get bought by some pc company a few years ago?
   No wonder!)

---

 
        One of the questions that comes up all the time is: How
enthusiastic is our support for UNIX?
        Unix was written on our machines and for our machines many
years ago.  Today, much of UNIX being done is done on our machines.
Ten percent of our VAXs are going for UNIX use.  UNIX is a simple
language, easy to understand, easy to get started with.  It's great for
students, great for somewhat casual users, and it's great for
interchanging programs between different machines.  And so, because of
its popularity in these markets, we support it.  We have good UNIX on
VAX and good UNIX on PDP-11s.
        It is our belief, however, that serious professional users will
run out of things they can do with UNIX. They'll want a real system and
will end up doing VMS when they get to be serious about programming.
        With UNIX, if you're looking for something, you can easily and
quickly check that small manual and find out that it's not there.  With
VMS, no matter what you look for -- it's literally a five-foot shelf of
documentation -- if you look long enough it's there.  That's the
difference -- the beauty of UNIX is it's simple; and the beauty of VMS
is that it's all there.
                -- Ken Olsen, President of DEC, 1984
============================ ENDING .LOGIN.
{netcom18.netcom.com:271} 



David



------------------------------

Date: Sun, 28 May 2000 01:50:54 GMT
From: newsmay2000@ordinate.co.uk (Ben Hambidge)
Subject: Translate foreign characters to English
Message-Id: <39307ac4.55804127@news.freeserve.net>

I need to do a comparison to match words, but I want to be able to
ignore diacritics on the letters.

So if someone types into a web form a name or word including foreign
(esp European) characters, I want to convert that string to the ASCII
equivalent using standard English characters in order to see if the
word exists in my array.

Is there any easy way to do this? Do different codepages that the user
may  have on their browser make a difference?

tia,
Ben


------------------------------

Date: Sat, 27 May 2000 20:16:18 -0400
From: Matthew Zimmerman <mdz4c@node16.unix.Virginia.EDU>
Subject: What's wrong with my eval'ed coderef regexp thingy??
Message-Id: <Pine.A41.4.05.10005272010040.119590-100000@node16.unix.Virginia.EDU>

Hi everyone. I have a rather weird (and unfortunately, long) problem to deal
with. I have a very large file (say, 70 MB or so) that contains data in 
the form of

---
RECORD a=5343   b=4343 c=4343
       d=334 e=5343 f=6343
RECORD  b=5298 a=324  c=87873
       d=343  f=5998  e=48758
---

Records can span multiple lines and the tags need not be in order.    
I want to parse each record and print it out in a new format, namely
with the numbers in a space delimited format in order. This
code works to solve this problem:
  
---
 1 #!/usr/bin/perl5 -w
 2 use strict;
 3 
 4 my(@tag) = qw(a b c d e f);
 5 
 6 my $record = 0;
 7 my %record = ();
 8 while(<DATA>) {
 9    if( /^RECORD/ && $record++) {
10        print join ' ', @record{@tag}; 
11        print "\n";
12        %record = ();
13    }
14
15    foreach my $tag (@tag) {
16        $record{$tag}=$1 if /$tag=(\d+)/;
17    }
18 }
19 print join ' ', @record{@tag};
20 print "\n";
21
22 __DATA__
23 RECORD a=5343   b=4343 c=4343
24       d=334 e=5343 f=6343
25 RECORD  a=5298 b=324  c=87873
26        d=343  e=5998  f=48758
27 RECORD d=1232 a=87433428 b=878743
28         c=878743 e=8854   f=878574
---

I get:

---
5343 4343 4343 334 5343 6343
5298 324 87873 343 5998 48758
87433428 878743 878743 1232 8854 878574
---

which is what I want. 

That's all well and good, but when the size of the <DATA> or the number of
elements in @tag gets very large, it slows down considerably. I realize   
this is because the regular expression in line 16 is recompiled for each
tag and for each line of input. 

My idea of a workaround for this is this. I'll create a hash where the 
key is the name of the tag and the value is a code reference with an 
eval'ed regexp that (theoretically) should only compile once. Insert
this code in between lines 4 and 5 in the listing above: 

---
4A my %match_function;
4B foreach (@tag) {
4C     $match_function{$_} = 
4C         eval "sub { /$_=(\\d+)/oi }";
4E }
---

and replace line 16 with:

---
16         $record{$tag} = $1 if $match_function{$tag}->();
---

Seems like a good idea, save for the fact that it doesn't work. All I
get is a bunch of 

---
Use of uninitialized value at regexp2.pl line 15, <DATA> chunk 1.
Use of uninitialized value at regexp2.pl line 15, <DATA> chunk 1.
Use of uninitialized value at regexp2.pl line 15, <DATA> chunk 1.
---

(and so on and so on).

So I gather that the eval'ed code isn't loading up $1, but I wonder why.
What am I missing? Can I fix this so it works? Or is there a better way to
go about solving my problem? (You should know I am using v5.004_04, and
since this not my own computer, upgrading is _not_ an option.) Thanks in
advance for your consideration!

Matt

-- 
Matthew Zimmerman ------------  http://www.people.virginia.edu/~mdz4c
Interdisciplinary Biophysics Program --------- University of Virginia
| "You got to be very careful if you don't know where you're going, |
| because you might not get there."                   -- Yogi Berra |



------------------------------

Date: Sun, 28 May 2000 01:57:47 GMT
From: Bob Walton <bwalton@rochester.rr.com>
Subject: Re: What's wrong with my eval'ed coderef regexp thingy??
Message-Id: <39307C1B.73280FF0@rochester.rr.com>

Matthew Zimmerman wrote:
 ...
> 4A my %match_function;
> 4B foreach (@tag) {
> 4C     $match_function{$_} =
> 4C         eval "sub { /$_=(\\d+)/oi }";
> 4E }
> ---
> 
> and replace line 16 with:
> 
> ---
> 16         $record{$tag} = $1 if $match_function{$tag}->();
> ---
> 
> Seems like a good idea, save for the fact that it doesn't work. All I
> get is a bunch of
> 
> ---
> Use of uninitialized value at regexp2.pl line 15, <DATA> chunk 1.
> Use of uninitialized value at regexp2.pl line 15, <DATA> chunk 1.
> Use of uninitialized value at regexp2.pl line 15, <DATA> chunk 1.
> ---
> 
> (and so on and so on).
> 
> So I gather that the eval'ed code isn't loading up $1, but I wonder why.
> What am I missing? Can I fix this so it works? Or is there a better way to
> go about solving my problem? (You should know I am using v5.004_04, and
> since this not my own computer, upgrading is _not_ an option.) Thanks in
> advance for your consideration!
> 
> Matt
> 
> --
> Matthew Zimmerman ------------  http://www.people.virginia.edu/~mdz4c

Yes, looks like the $1 variable doesn't make it through the sub return
process (not surprising, given this statement in perlre:  "The numbered
variables ($1, $2, $3, etc.) and the related punctuation set (<$+, $&,
$`, and $') are all dynamically scoped until the end of the enclosing
block or until the next successful match, whichever comes first.").

Why not use something like:

    s/(\w+)=(\d+)/$record{$1}=$2/ge;

in place of the entire "foreach my $tag..." loop?  That would have the
advantage of only scanning each input line once, rather than once per
possible tag, which is probably the *real* source of the slowdown you
mentioned.  This does assume your "tags" will always be matched by \w+ .
Non-tags (like g=42 added to your example data) will get stored in the
%record hash, but still won't be output because you pick up the output
values you want via a hash slice, so that should be OK too.

The entire program then looks like:

#!/usr/bin/perl5 -w
use strict;
my(@tag) = qw(a b c d e f);
my %match_function;
my $record = 0;
my %record = ();
while(<DATA>) {
   if( /^RECORD/ && $record++) {
      print join ' ', @record{@tag}; 
      print "\n";
      %record = ();
   }
   s/(\w+)=(\d+)/$record{$1}=$2/ge; #revised code
}
print join ' ', @record{@tag};
print "\n";
__DATA__
RECORD a=5343   b=4343 c=4343
      d=334 e=5343 f=6343
RECORD  a=5298 b=324  c=87873
       d=343  e=5998  f=48758
RECORD d=1232 a=87433428 b=878743
        c=878743 e=8854   f=878574

-- 
Bob Walton


------------------------------

Date: 28 May 2000 02:46:17 GMT
From: nj_kanda@alcor.concordia.ca (Neil Kandalgaonkar)
Subject: Re: What's wrong with my eval'ed coderef regexp thingy??
Message-Id: <8gq19p$fqf$1@newsflash.concordia.ca>

In article <Pine.A41.4.05.10005272010040.119590-100000@node16.unix.Virginia.EDU>,
Matthew Zimmerman  <mdz4c@node16.unix.Virginia.EDU> wrote:

>My idea of a workaround for this is this. I'll create a hash where the 
>key is the name of the tag and the value is a code reference with an 
>eval'ed regexp that (theoretically) should only compile once. Insert
>this code in between lines 4 and 5 in the listing above: 
>
>---
>4A my %match_function;
>4B foreach (@tag) {
>4C     $match_function{$_} = 
>4e         eval "sub { /$_=(\\d+)/oi }";
>4E }
>---


You could do closures:

  my %closure;
  foreach my $t (@tag) {
     $closure{$t} = sub { $_[0] =~ /$t=(\d+)/i; return $1 if $1 };
  }

(Aside: I had to do the return $1 if $1, even though I thought $1 was
global. $1 did not seem to be set in the caller's scope. Anyone
know why?)

Anyway, each of those lexical $t's was preserved since a reference 
exists outside the foreach scope, namely in %closure. 
  
  foreach my $t (@tag) {
     if (my $result = $closure{$t}->($thingy))  # etc...
  }

(Aside 2: I can't use /o on the closure'd regex, since then perl
will simply make all the closures use the same value as  
$tag[0]. There is a *slight* speed penalty IIRC, since perl has to 
check if the closured $t has changed, but if it hasn't, but it
doesn't recompile the regex).

>(You should know I am using v5.004_04, and
>since this not my own computer, upgrading is _not_ an option.) Thanks in
>advance for your consideration!
  
The canonical way is to use qr// to store patterns. Unfortunately
you don't have that in 5.004.

Here is a completely different way which might work better 
for you:

#!/usr/bin/perl -w
 
use strict;
 
local $/ = 'RECORD';   # a "line" is now terminated by RECORD, not \n
my @tag = qw(a b c d e f);
 
while (<DATA>) {
 
  chomp;            # removes $/ , which is RECORD
  s/^\s+|\s+$//g;
  next unless $_;   # at least the first "line" is blank,
                    # since file starts with RECORD
 
  my %param = map lc, split /=|\s+/;  
  print "@param{@tag}\n";
 
}

 
__DATA__
RECORD a=5343   b=4343 c=4343
       d=334 e=5343 f=6343
RECORD  a=5298 b=324  c=87873
        d=343  e=5998  f=48758
RECORD d=1232 a=87433428 b=878743
         c=878743 e=8854   f=878574                     

   
-- 
Neil Kandalgaonkar
neil@brevity.org


------------------------------

Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 16 Sep 99)
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: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.

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 V9 Issue 3188
**************************************


home help back first fref pref prev next nref lref last post