[22084] in Perl-Users-Digest
Perl-Users Digest, Issue: 4306 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Dec 23 18:06:18 2002
Date: Mon, 23 Dec 2002 15:05:09 -0800 (PST)
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, 23 Dec 2002 Volume: 10 Number: 4306
Today's topics:
Re: Design Tools and Resources on one page . . . it is (Tad McClellan)
Re: File::Find module ; want to resume search from poin <goldbb2@earthlink.net>
Free Program <varat@ix.netcom.com>
I can't remove the \n please help me! <rduc@apogee-com.Fr>
Re: I can't remove the \n please help me! <mbudash@sonic.net>
Re: I can't remove the \n please help me! <usenet@dwall.fastmail.fm>
Re: I can't remove the \n please help me! (Jay Tilton)
Re: I can't remove the \n please help me! <krahnj@acm.org>
Lotus Notes OLE: Help on avoiding undefined value as HA <isresi1@xs4all.nl>
Program <varat@ix.netcom.com>
re splitting up a file <geoff.cox@blueyonder.co.uk>
Re: re splitting up a file <usenet@dwall.fastmail.fm>
Re: re splitting up a file <geoff.cox@blueyonder.co.uk>
regular expression help (Mark)
Re: regular expression help (Matt Knecht)
Re: regular expression help <goldbb2@earthlink.net>
replicating (cpan) modules across server installs (kyo23)
Re: replicating (cpan) modules across server installs (Anno Siegel)
Re: replicating (cpan) modules across server installs <bobx@linuxmail.org>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Mon, 23 Dec 2002 10:55:31 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: Design Tools and Resources on one page . . . it is fairly extensive!
Message-Id: <slrnb0eg03.d9m.tadmc@magna.augustmail.com>
[ TOFU repaired ]
gbd <asg779e@earthlink.net> wrote:
> "Tad McClellan" <tadmc@augustmail.com> wrote in message
> news:slrnb0c0cj.9q9.tadmc@magna.augustmail.com...
>> gbd <asg779e@earthlink.net> wrote:
>>
>> > I spent some time researching these sites
It is possible that your research is still incomplete though.
For instance, you seem to have missed this one:
"Quoting Style in Newsgroup Postings"
http://www.geocities.com/nnqweb/nquote.html
>> >and this page is the results
> of
>> > that research.
It is a rather nice list of links, apart from steering people
to a poor resource when it has been superceded by a better one.
>> comp.lang.perl is a non-existant newsgroup.
>>
>> It was rmgroup'd many years ago.
perldoc -q newsgroups
What are the Perl newsgroups on Usenet? Where do I post questions?
The now defunct comp.lang.perl newsgroup has been
superseded by the following groups:
...
> Then will somebody please tell those people that placed 234 postings on that
> "non-existent newsgroup", dated 12.05.02 to 12.22.02, that the group really
> does not exist!
There are lots of people that don't really know what they are
doing on Usenet. There are also lots of poorly-maintained news
servers that do not honor rmgroup commands.
A "resource" should probably attempt to clear up misunderstandings
rather than reinforce them!
Folks that know a lot about Perl are also likely to know
which newsgroups to participate in. There are not many folks
that know about Perl in comp.lang.perl, so you'll get better
answers in comp.lang.perl.misc.
> I could have been just imagining those postings, but I just
> went and checked... maybe i am still dreaming.
Or maybe you just don't know how Usenet is (supposed to be) administered.
> You perl guys
Since you put it that way, I guess that you do not count yourself
as a "Perl guy"?
It would seem reasonable then that you might just know less
about Perl stuff than they do.
If you listen to them, you may increase your knowledge of Perl stuff,
which would allow you to impart increased knowledge to the users
of your resource.
> are really,
> really smart...
Not necessarily, but we do know more about Perl than you do.
You've missed an opportunity to increase your knowledge, not
surprising given the attitude you display.
> REALLY!
Though we are likely not gullible enough to believe you there.
*plonk*
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Mon, 23 Dec 2002 16:56:01 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: File::Find module ; want to resume search from point of failure.
Message-Id: <3E078671.B21E662F@earthlink.net>
Mitchell Laks wrote:
>
> Hi -
>
> Dear Perl Gurus
>
> I am using File::Find to execute a command on the files in a directory
> (i call the command &wanted for cultural reasons :) ).
>
> However if an exception is raised, and my search gets aborted, and if
> i keep track of what file was acted upon when the search was
> cancelled, is there a way to resume the search and execution from the
> point of failure and avoid searching through all of the (530,000)
> files again from the beginning?
Yes, but that's not the best way to do it.
Better would be to use eval BLOCK to catch the exception, and thus not
die in the first place.
But if you *do* want to try and resume your search....
my $resume_search_at = ....;
sub wanted {
if( defined( $resume_search_at ) ) {
if( $resume_search_at eq $_ ) {
undef($resume_search_at);
} elsif( not -d _ ) {
return;
} else {
$File::Find::prune = 1 unless
$resume_search_at =~ m#^\Q$_/#;
return;
}
}
# process $_.
}
[untested]
> Thanks millions - i guess i want to be able to say is
>
> do the file::find algorithm on a directory tree - but begin at
> specified file xyz in the tree... instead of the beginning...
>
> Thanks,
>
> Mitchell
--
$..='(?:(?{local$^C=$^C|'.(1<<$_).'})|)'for+a..4;
$..='(?{print+substr"\n !,$^C,1 if $^C<26})(?!)';
$.=~s'!'haktrsreltanPJ,r coeueh"';BEGIN{${"\cH"}
|=(1<<21)}""=~$.;qw(Just another Perl hacker,\n);
------------------------------
Date: Mon, 23 Dec 2002 13:54:10 -0700
From: Zarathustra <varat@ix.netcom.com>
Subject: Free Program
Message-Id: <3E0777F2.4060303@ix.netcom.com>
This is a multi-part message in MIME format.
--------------020805010303020108070700
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit
I am writing an adventure game. It is pretty simple. I have gotten as
far as I can but I don't know how to pick up treasure and use items. I
will give this program away for free.
--------------020805010303020108070700
Content-Type: text/plain;
name="SimpleRPG.pl"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="SimpleRPG.pl"
#! usr/bin/perl -w
use strict;
use integer;
my @maze=(
[ qw( e sew we ws )],
[ qw(ne new sw ns ) ],
[ qw( ns - ns wn ) ],
[ qw(ne w ne w )],
);
my %direction = (n=> [ -1, 0], s=> [1, 0], e => [0, 1], w => [0, -1]);
my %full=( e => 'East', n => 'North', w=>'West', s =>'South');
my($curr_x, $curr_y, $x, $y)=(0,0,3,3);
my $move;
my $num;
my $n;
my $c;
my @p=(" ",10,1,0,7,6);
my @m;
my $mhp = $p[1];
my @weapon;
my @armor;
sub disp_loc {
my($cx, $cy)=@_;
print "You may move ";
while($maze [$cx] [$cy]=~/([nsew])/g) {
print "$full{$1} ";
}
print "($maze[$cx][$cy])\n";
}
sub move_to {
my($new, $xref, $yref)=@_;
$new=substr(lc($new),0,1);
if ($maze[$$xref] [$$yref]!~/$new/) {
print "Can't go that way $new!\n";
return;
}
$$xref += $direction{$new}[0];
$$yref += $direction{$new}[1];
}
sub xps {
my ($hp, $lv, $xp, $mxp) = @_;
print "You got $mxp XP for the battle \n";
$xp = $xp + $mxp;
if ($xp > 100) {
$lv++;
$xp = $xp - 100;
($hp, $mhp) = nlv ($hp, $mxp);
}
return $hp, $lv, $xp;
}
sub nlv {
my ($hp, $mhp) = @_;
my $num;
$num = (int(rand(10))+1);
$hp = $hp + $num;
$mhp = $mhp + $num;
return $hp, $mhp;
}
sub atk {
my ($hd, $ac) = @_;
my $roll;
my $hit;
my $thaco;
$roll = int(rand(20))+1;
$thaco = 19 - $hd;
if ($roll > ($thaco - $ac)) {
$hit=1;
print "Hit! \n";
} else {
print "Missed... \n";
$hit=0;
}
return $hit;
}
sub fight {
my $ht;
my ($md, $pd) = @_;
print "$$pd[0] is Fighting a $$md[0] \n";
print "You have $$pd[1] HP, it has $$md[2] HP\n";
$ht = atk ($$pd[2], $$md[3]);
if ( $ht == 1 ) {
$$md[2] = $$md[2] - (int(rand($$pd[5]))+1);
}
print "Now the $$md[0] attacks \n";
$ht = atk ($$md[1], $$pd[2]);
if ( $ht == 1 ) {
$$pd[1] = $$pd[1] - (int(rand($$md[3]))+1);
}
return $$md[2], $$pd[1];
}
sub choosmon {
my $x;
my $v;
my $rm;
my $hp;
my @mm = ();
my @ml = (
[ "Orc",1,0,6,15 ],
[ "Gobblin",1,0,4,10 ],
[ "Hobgobblin",2,0,6,25 ],
[ "Skelliton",1,0,4,10 ],
[ "Dragon!",4,0,7,100 ],
[ "Wolf",2,0,3,20 ],
);
$rm = int(rand(6));
for ($x=0; $x <= 5; $x++) {
$mm[$x] = $ml[$rm][$x];
}
$v=$mm[1];
for ($x=0; $x <= $v; $x++ ) {
$hp = $hp + int(rand(6))+1;
}
print "You see a $mm[0] \n";
$mm[2] = $hp;
return @mm;
}
sub run {
my ($hp)=@_;
print "Running\n";
$hp++;
return $hp;
}
print "What is your name?";
$p[0]=<STDIN>; chomp $p[0];
until ( $curr_x == $x and $curr_y ==$y ) {
disp_loc($curr_x, $curr_y);
print "Which way? ";
$move=<STDIN>; chomp $move;
exit if ($move=~/^q/);
move_to($move, \$curr_x, \$curr_y);
$num = int(rand(4))+1;
print " $num";
if ($num == 1) {
@m = choosmon (@m);
CBT: while ( $p[1] > 0 ) {
if ( $p[1] > $mhp ) {
$p[1] = $mhp;
}
print "You have $p[1]/$mhp HP it has $m[2] \n";
print "Do you want to f ight, r un d ie: ";
$c=<STDIN>; chomp $c;
if ( $c eq "f" ) {
($m[2], $p[1]) = fight(\@m, \@p);
}
if ($c eq "r" ) {
$p[1] = run($p[1]);
}
if ( $c eq "l" ) {
($p[2], $mhp) = nlv ($p[2], $mhp);
}
if ( $m[2] <= 0 ) {
print "You killed the $m[0] \n";
($p[1], $p[2], $p[3]) = xps ($p[1], $p[2], $p[3], $m[4]);
last CBT;
}
if ( $c eq "d" ) {$p[1] = 0;
}
}
if ( $p[1] <= 0 ) {
print "You are dead";
die; }
}
}
print "You made it!\n";
--------------020805010303020108070700--
------------------------------
Date: 23 Dec 2002 16:28:38 GMT
From: DUCLOS <rduc@apogee-com.Fr>
Subject: I can't remove the \n please help me!
Message-Id: <20021223-172838-605093@foorum.com>
Hi, i remove the lines with :9999 at the end, but i have a problem the \n don't
remove.
version: 1
dn:: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
facsimileTelephoneNumber: +33 155888302
mail: xx.xx@xx.com
ftcellularphone: +33 xxxxxxxx
ftcellularphone: +33xxxxxxx :9999
ftgender: M.
ftpersonnumber: xxxxxx
ftstatus: interne
objectClass: person
objectClass: organizationalPerson
objectClass: ftprivuser
objectClass: top
createTimestamp: 20000504081026Z
modifyTimestamp: 20020913122737Z
sn: Wronecki
telephoneNumber: +33 155888351
givenName: Frederic
I want to obtain this.
version: 1
dn:: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
facsimileTelephoneNumber: +33 155888302
mail: xx.xx@xx.com
ftcellularphone: +33 xxxxxxxx
ftgender: M.
ftpersonnumber: xxxxxx
ftstatus: interne
objectClass: person
objectClass: organizationalPerson
objectClass: ftprivuser
objectClass: top
createTimestamp: 20000504081026Z
modifyTimestamp: 20020913122737Z
sn: Wronecki
telephoneNumber: +33 155888351
givenName: Frederic
But I obtain this:
version: 1
dn:: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
facsimileTelephoneNumber: +33 155888302
mail: xx.xx@xx.com
ftcellularphone: +33 xxxxxxxx
ftgender: M.
ftpersonnumber: xxxxxx
ftstatus: interne
objectClass: person
objectClass: organizationalPerson
objectClass: ftprivuser
objectClass: top
createTimestamp: 20000504081026Z
modifyTimestamp: 20020913122737Z
sn: Wronecki
telephoneNumber: +33 155888351
givenName: Frederic
My source :
$file = "Developpement.ldif";
open (BEBE, $file) || die "can't open bebe: $!";
@lines = <BEBE>;
close(BEBE);
open (BEBE,'>Developpement.ldif')|| die " can't open newbebe: $!";
foreach $line (@lines){
$line =~ s/(.*?):9999//;
chomp($line);
print BEBE ($line,"\n");
}
close (BEBE);
Many thanks, it's very urgent.
--
Ce message a ete poste via la plateforme Web club-Internet.fr
This message has been posted by the Web platform club-Internet.fr
http://forums.club-internet.fr/
------------------------------
Date: Mon, 23 Dec 2002 16:53:46 GMT
From: Michael Budash <mbudash@sonic.net>
Subject: Re: I can't remove the \n please help me!
Message-Id: <mbudash-B2171A.08534523122002@typhoon.sonic.net>
In article <20021223-172838-605093@foorum.com>,
DUCLOS <rduc@apogee-com.Fr> wrote:
> Hi, i remove the lines with :9999 at the end, but i have a problem the \n
> don't
> remove.
>
> version: 1
> dn:: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
> facsimileTelephoneNumber: +33 155888302
> mail: xx.xx@xx.com
> ftcellularphone: +33 xxxxxxxx
> ftcellularphone: +33xxxxxxx :9999
> ftgender: M.
> ftpersonnumber: xxxxxx
> ftstatus: interne
> objectClass: person
> objectClass: organizationalPerson
> objectClass: ftprivuser
> objectClass: top
> createTimestamp: 20000504081026Z
> modifyTimestamp: 20020913122737Z
> sn: Wronecki
> telephoneNumber: +33 155888351
> givenName: Frederic
>
> I want to obtain this.
> version: 1
> dn:: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
> facsimileTelephoneNumber: +33 155888302
> mail: xx.xx@xx.com
> ftcellularphone: +33 xxxxxxxx
> ftgender: M.
> ftpersonnumber: xxxxxx
> ftstatus: interne
> objectClass: person
> objectClass: organizationalPerson
> objectClass: ftprivuser
> objectClass: top
> createTimestamp: 20000504081026Z
> modifyTimestamp: 20020913122737Z
> sn: Wronecki
> telephoneNumber: +33 155888351
> givenName: Frederic
>
>
> But I obtain this:
>
> version: 1
> dn:: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
> facsimileTelephoneNumber: +33 155888302
> mail: xx.xx@xx.com
> ftcellularphone: +33 xxxxxxxx
>
> ftgender: M.
> ftpersonnumber: xxxxxx
> ftstatus: interne
> objectClass: person
> objectClass: organizationalPerson
> objectClass: ftprivuser
> objectClass: top
> createTimestamp: 20000504081026Z
> modifyTimestamp: 20020913122737Z
> sn: Wronecki
> telephoneNumber: +33 155888351
> givenName: Frederic
>
> My source :
>
> $file = "Developpement.ldif";
>
> open (BEBE, $file) || die "can't open bebe: $!";
>
> @lines = <BEBE>;
>
> close(BEBE);
>
> open (BEBE,'>Developpement.ldif')|| die " can't open newbebe: $!";
>
>
> foreach $line (@lines){
>
instead of this:
> $line =~ s/(.*?):9999//;
> chomp($line);
try this:
next if ($line =~ /:9999$/);
> print BEBE ($line,"\n");
>
> }
>
> close (BEBE);
>
> Many thanks, it's very urgent.
------------------------------
Date: Mon, 23 Dec 2002 18:04:05 -0000
From: "David K. Wall" <usenet@dwall.fastmail.fm>
Subject: Re: I can't remove the \n please help me!
Message-Id: <Xns92ED84EF9882dkwwashere@216.168.3.30>
Michael Budash <mbudash@sonic.net> wrote on 23 Dec 2002:
> instead of this:
>
>> $line =~ s/(.*?):9999//;
>> chomp($line);
>
> try this:
>
> next if ($line =~ /:9999$/);
That's what the OP said was desired, but the examples seem to indicate
that ':9999' should be removed from the end of any string in which it
occurs.
$line =~ s/:9999$//;
English doesn't appear to be the OP's native language, so some
vagueness is understandable... and I might have misunderstood.
--
David K. Wall - usenet@dwall.fastmail.fm
"Oook."
------------------------------
Date: Mon, 23 Dec 2002 22:41:26 GMT
From: tiltonj@erols.com (Jay Tilton)
Subject: Re: I can't remove the \n please help me!
Message-Id: <3e07910a.141076007@news.erols.com>
DUCLOS <rduc@apogee-com.Fr> wrote:
: Hi, i remove the lines with :9999 at the end
perl -i -pe "$_ x= !/:9999$/" Developpement.ldif
------------------------------
Date: Mon, 23 Dec 2002 22:49:09 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: I can't remove the \n please help me!
Message-Id: <3E07928A.A5DB4DF1@acm.org>
DUCLOS wrote:
>
> Hi, i remove the lines with :9999 at the end, but i have a problem the \n don't
> remove.
>
> version: 1
> dn:: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
> facsimileTelephoneNumber: +33 155888302
> mail: xx.xx@xx.com
> ftcellularphone: +33 xxxxxxxx
> ftcellularphone: +33xxxxxxx :9999
> ftgender: M.
> ftpersonnumber: xxxxxx
> ftstatus: interne
> objectClass: person
> objectClass: organizationalPerson
> objectClass: ftprivuser
> objectClass: top
> createTimestamp: 20000504081026Z
> modifyTimestamp: 20020913122737Z
> sn: Wronecki
> telephoneNumber: +33 155888351
> givenName: Frederic
>
> I want to obtain this.
> version: 1
> dn:: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
> facsimileTelephoneNumber: +33 155888302
> mail: xx.xx@xx.com
> ftcellularphone: +33 xxxxxxxx
> ftgender: M.
> ftpersonnumber: xxxxxx
> ftstatus: interne
> objectClass: person
> objectClass: organizationalPerson
> objectClass: ftprivuser
> objectClass: top
> createTimestamp: 20000504081026Z
> modifyTimestamp: 20020913122737Z
> sn: Wronecki
> telephoneNumber: +33 155888351
> givenName: Frederic
>
> But I obtain this:
>
> version: 1
> dn:: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
> facsimileTelephoneNumber: +33 155888302
> mail: xx.xx@xx.com
> ftcellularphone: +33 xxxxxxxx
>
> ftgender: M.
> ftpersonnumber: xxxxxx
> ftstatus: interne
> objectClass: person
> objectClass: organizationalPerson
> objectClass: ftprivuser
> objectClass: top
> createTimestamp: 20000504081026Z
> modifyTimestamp: 20020913122737Z
> sn: Wronecki
> telephoneNumber: +33 155888351
> givenName: Frederic
>
> My source :
>
> $file = "Developpement.ldif";
>
> open (BEBE, $file) || die "can't open bebe: $!";
>
> @lines = <BEBE>;
>
> close(BEBE);
>
> open (BEBE,'>Developpement.ldif')|| die " can't open newbebe: $!";
>
> foreach $line (@lines){
>
> $line =~ s/(.*?):9999//;
> chomp($line);
> print BEBE ($line,"\n");
>
> }
>
> close (BEBE);
{
local ( $^I, @ARGV ) = ( '.bak', 'Developpement.ldif' );
/:9999$/ or print while <>;
}
__END__
John
--
use Perl;
program
fulfillment
------------------------------
Date: Mon, 23 Dec 2002 20:57:33 +0100
From: smasr <isresi1@xs4all.nl>
Subject: Lotus Notes OLE: Help on avoiding undefined value as HASH reference.
Message-Id: <3e076ad1$0$134$e4fe514c@dreader5.news.xs4all.nl>
Hi,
I am busy for several days now with a Perl script to extract views and
attachements from a Lotus Notes database.
Finally the scripts runs but i have still a few problems. One problem i
still have is:
explaination:
"Product" is a Notes view name and contains a product name.
I read it in a Perl scalar as shown in this code:
my $Product = $document->GetFirstItem('Product')->{Text};
All goes well but after looping trough 150 documents or so i suddenly get an
error:
"Can't use an undefined value as a HASH reference at line xx."
At some point there isn't a value in the 'Product' view and thats why i get
the error. I think.. I have commented the line out and ran the script
again. Then it stops after 170 documents with the same error but on the
next line where i am reading another a View variable into a scalar.
Is there a way to avoid this error? I don't mind if there is no value but i
don't want the script to stop.
Regards,
Smasr.
------------------------------
Date: Mon, 23 Dec 2002 13:57:09 -0700
From: Zarathustra <varat@ix.netcom.com>
Subject: Program
Message-Id: <3E0778A5.3030302@ix.netcom.com>
This is a multi-part message in MIME format.
--------------030605060301050009090603
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit
Here is my Program again just with my credits. If you improve it please
send me a copy.
--------------030605060301050009090603
Content-Type: text/plain;
name="SimpleRPG.pl"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="SimpleRPG.pl"
#! usr/bin/perl -w
Print" Simple Roll playing game by \n Joe Creaney joec@annuna.c0m";
use strict;
use integer;
my @maze=(
[ qw( e sew we ws )],
[ qw(ne new sw ns ) ],
[ qw( ns - ns wn ) ],
[ qw(ne w ne w )],
);
my %direction = (n=> [ -1, 0], s=> [1, 0], e => [0, 1], w => [0, -1]);
my %full=( e => 'East', n => 'North', w=>'West', s =>'South');
my($curr_x, $curr_y, $x, $y)=(0,0,3,3);
my $move;
my $num;
my $n;
my $c;
my @p=(" ",10,1,0,7,6);
my @m;
my $mhp = $p[1];
my @weapon;
my @armor;
sub disp_loc {
my($cx, $cy)=@_;
print "You may move ";
while($maze [$cx] [$cy]=~/([nsew])/g) {
print "$full{$1} ";
}
print "($maze[$cx][$cy])\n";
}
sub move_to {
my($new, $xref, $yref)=@_;
$new=substr(lc($new),0,1);
if ($maze[$$xref] [$$yref]!~/$new/) {
print "Can't go that way $new!\n";
return;
}
$$xref += $direction{$new}[0];
$$yref += $direction{$new}[1];
}
sub xps {
my ($hp, $lv, $xp, $mxp) = @_;
print "You got $mxp XP for the battle \n";
$xp = $xp + $mxp;
if ($xp > 100) {
$lv++;
$xp = $xp - 100;
($hp, $mhp) = nlv ($hp, $mxp);
}
return $hp, $lv, $xp;
}
sub nlv {
my ($hp, $mhp) = @_;
my $num;
$num = (int(rand(10))+1);
$hp = $hp + $num;
$mhp = $mhp + $num;
return $hp, $mhp;
}
sub atk {
my ($hd, $ac) = @_;
my $roll;
my $hit;
my $thaco;
$roll = int(rand(20))+1;
$thaco = 19 - $hd;
if ($roll > ($thaco - $ac)) {
$hit=1;
print "Hit! \n";
} else {
print "Missed... \n";
$hit=0;
}
return $hit;
}
sub fight {
my $ht;
my ($md, $pd) = @_;
print "$$pd[0] is Fighting a $$md[0] \n";
print "You have $$pd[1] HP, it has $$md[2] HP\n";
$ht = atk ($$pd[2], $$md[3]);
if ( $ht == 1 ) {
$$md[2] = $$md[2] - (int(rand($$pd[5]))+1);
}
print "Now the $$md[0] attacks \n";
$ht = atk ($$md[1], $$pd[2]);
if ( $ht == 1 ) {
$$pd[1] = $$pd[1] - (int(rand($$md[3]))+1);
}
return $$md[2], $$pd[1];
}
sub choosmon {
my $x;
my $v;
my $rm;
my $hp;
my @mm = ();
my @ml = (
[ "Orc",1,0,6,15 ],
[ "Gobblin",1,0,4,10 ],
[ "Hobgobblin",2,0,6,25 ],
[ "Skelliton",1,0,4,10 ],
[ "Dragon!",4,0,7,100 ],
[ "Wolf",2,0,3,20 ],
);
$rm = int(rand(6));
for ($x=0; $x <= 5; $x++) {
$mm[$x] = $ml[$rm][$x];
}
$v=$mm[1];
for ($x=0; $x <= $v; $x++ ) {
$hp = $hp + int(rand(6))+1;
}
print "You see a $mm[0] \n";
$mm[2] = $hp;
return @mm;
}
sub run {
my ($hp)=@_;
print "Running\n";
$hp++;
return $hp;
}
print "What is your name?";
$p[0]=<STDIN>; chomp $p[0];
until ( $curr_x == $x and $curr_y ==$y ) {
disp_loc($curr_x, $curr_y);
print "Which way? ";
$move=<STDIN>; chomp $move;
exit if ($move=~/^q/);
move_to($move, \$curr_x, \$curr_y);
$num = int(rand(4))+1;
print " $num";
if ($num == 1) {
@m = choosmon (@m);
CBT: while ( $p[1] > 0 ) {
if ( $p[1] > $mhp ) {
$p[1] = $mhp;
}
print "You have $p[1]/$mhp HP it has $m[2] \n";
print "Do you want to f ight, r un d ie: ";
$c=<STDIN>; chomp $c;
if ( $c eq "f" ) {
($m[2], $p[1]) = fight(\@m, \@p);
}
if ($c eq "r" ) {
$p[1] = run($p[1]);
}
if ( $c eq "l" ) {
($p[2], $mhp) = nlv ($p[2], $mhp);
}
if ( $m[2] <= 0 ) {
print "You killed the $m[0] \n";
($p[1], $p[2], $p[3]) = xps ($p[1], $p[2], $p[3], $m[4]);
last CBT;
}
if ( $c eq "d" ) {$p[1] = 0;
}
}
if ( $p[1] <= 0 ) {
print "You are dead";
die; }
}
}
print "You made it!\n";
--------------030605060301050009090603--
------------------------------
Date: Mon, 23 Dec 2002 17:57:10 GMT
From: Geoff Cox <geoff.cox@blueyonder.co.uk>
Subject: re splitting up a file
Message-Id: <r4je0vshfv0j4ll2th1boknt2mlbdf4q3l@4ax.com>
Hello,
I am using following to extract individual poems from a large
collection of poems. Each poem was separated from the next by 3 line
feeds and the title of each poem separated from the body of the poem
by 2 line feeds. Using MS Word I separated each poem by @@@ and each
title was enclosed by ~~~. Then used the the code below to extract
each poem and name each file with the title of the poem.
There must be many more elegant solutions ! Not clear how I could
detect 3 line feeds and use the titles of the poems as the file names
without using Word to put in the @@@ and the ~~~.
Any sugestions re improvements?
Geoff
Just to be clear the original collection was as follows
__________
title1
ahjshJS Jk
hjkhS Jks
hshJSJKsa
title2
hjhhjk
djahdhajkda
ahjdkadha
title3
jakdkajdkl
dkjakdjkla
djkadkla
djkadl
etc
------------------------------------------
open (IN,"poems");
$file = join " ", <IN>;
@split = split "@@@", $file;
for ($n=0;$n<90;$n++) {
$poem[$n] = $split[$n];
&title;
open (OUT, ">>$title[1].txt");
&removezzz;
print OUT $split[$n];
}
sub title {
my $name = $poem[$n];
@title = split "~~~", $name;
}
sub removezzz {
$split[$n] =~ s/[~{2}]/\n /g;
}
------------------------------
Date: Mon, 23 Dec 2002 19:27:26 -0000
From: "David K. Wall" <usenet@dwall.fastmail.fm>
Subject: Re: re splitting up a file
Message-Id: <Xns92ED9310F62Cdkwwashere@216.168.3.30>
Geoff Cox <geoff.cox@blueyonder.co.uk> wrote on 23 Dec 2002:
> I am using following to extract individual poems from a large
> collection of poems. Each poem was separated from the next by 3
> line feeds and the title of each poem separated from the body of
> the poem by 2 line feeds. Using MS Word I separated each poem by
> @@@ and each title was enclosed by ~~~. Then used the the code
> below to extract each poem and name each file with the title of
> the poem.
>
> There must be many more elegant solutions ! Not clear how I could
> detect 3 line feeds and use the titles of the poems as the file
> names without using Word to put in the @@@ and the ~~~.
>
> Any sugestions re improvements?
If you're certain about "\n\n\n" being the separator for poems (i.e.;
no triple-line-feeds inside a poem, no spaces in between the three
newlines), this might do:
use strict;
use warnings;
$/ = "\n\n\n";
open IN, 'poems' or die "Cannot open poems: $!";
while (<IN>) {
my $title = $1 if /^(.*?)\n\n/s;
if ($title =~ /^\s*$/) {
warn "Missing title at record $.:";
next;
}
open POEM, ">$title.txt" or die "Cannot open $title.txt: $!";
print POEM $_;
close POEM;
}
Spaces in filenames can be a pain, so you might want to put the line
$title =~ tr/ /-/;
just before you open() the POEM filehandle to change all the spaces
to dashes. Your call.
--
David K. Wall - usenet@dwall.fastmail.fm
"Oook."
------------------------------
Date: Mon, 23 Dec 2002 21:49:00 GMT
From: Geoff Cox <geoff.cox@blueyonder.co.uk>
Subject: Re: re splitting up a file
Message-Id: <q51f0vgcg0vtrnuh9odqkdqkapokfspged@4ax.com>
On Mon, 23 Dec 2002 19:27:26 -0000, "David K. Wall"
<usenet@dwall.fastmail.fm> wrote:
Thanks David - will have a try!
Cheers
Geoff
>Geoff Cox <geoff.cox@blueyonder.co.uk> wrote on 23 Dec 2002:
>
>> I am using following to extract individual poems from a large
>> collection of poems. Each poem was separated from the next by 3
>> line feeds and the title of each poem separated from the body of
>> the poem by 2 line feeds. Using MS Word I separated each poem by
>> @@@ and each title was enclosed by ~~~. Then used the the code
>> below to extract each poem and name each file with the title of
>> the poem.
>>
>> There must be many more elegant solutions ! Not clear how I could
>> detect 3 line feeds and use the titles of the poems as the file
>> names without using Word to put in the @@@ and the ~~~.
>>
>> Any sugestions re improvements?
>
>If you're certain about "\n\n\n" being the separator for poems (i.e.;
>no triple-line-feeds inside a poem, no spaces in between the three
>newlines), this might do:
>
> use strict;
> use warnings;
>
> $/ = "\n\n\n";
> open IN, 'poems' or die "Cannot open poems: $!";
> while (<IN>) {
> my $title = $1 if /^(.*?)\n\n/s;
> if ($title =~ /^\s*$/) {
> warn "Missing title at record $.:";
> next;
> }
> open POEM, ">$title.txt" or die "Cannot open $title.txt: $!";
> print POEM $_;
> close POEM;
> }
>
>Spaces in filenames can be a pain, so you might want to put the line
>
> $title =~ tr/ /-/;
>
>just before you open() the POEM filehandle to change all the spaces
>to dashes. Your call.
------------------------------
Date: 23 Dec 2002 12:25:43 -0800
From: mfaine@knology.net (Mark)
Subject: regular expression help
Message-Id: <329dd608.0212231225.383e4793@posting.google.com>
I admit I've never been good with regular expressions but this one I
imagine would challenge even a pro. In order to comply with a new
security directive passwords must meet the following guidelines:
eight characters exactly
The eight characters will contain at least one character each from at
least three of the following sets of characters:
At least one uppercase letter
At least one lowercase letters
At least one numbers
At least one special characters
I've tried various times, but as I said this one is hard:
My feeble attempts have gotten me this far:
/([A-Z]|[a-z]|[0-9]|(\W)){3,8}/
but this does not account for order and, well it doesn't accout for so
many things...
that's why I'm here, I can work out the simple ones but for this one I
have to ask for help from the experts. I know if I spent the next two
or three days working on this I might could get close or even figure
it out but time is not a luxury I have on this one and hey why
re-invent the wheel.
Thanks,
-Mark
------------------------------
Date: Mon, 23 Dec 2002 21:20:18 GMT
From: hex@voicenet.com (Matt Knecht)
Subject: Re: regular expression help
Message-Id: <slrnb0evg5.f91.hex@unix01.voicenet.com>
Mark <mfaine@knology.net> wrote:
>passwords must meet the following guidelines:
>
>eight characters exactly
>
>The eight characters will contain at least one character each from at
>least three of the following sets of characters:
>
>At least one uppercase letter
>At least one lowercase letters
>At least one numbers
>At least one special characters
Easier to write and maintain with seperate regexen IMHO:
die unless $passwd =~ /^.{8}$/; # length $passwd == 8
$num_sets++ if $passwd =~ /\p{IsUpper}/ # At least one uppercase
$num_sets++ if $passwd =~ /\p{IsLower}/ # At least one lowercase
$num_sets++ if $passwd =~ /\d/ # At least one digit
$num_sets++ if $passwd =~ /\p{IsPunct}/ # At least one punctuation
die unless $num_sets >= 3;
You can cram it into one regex. It'll look cool. The person you pass
the code onto will curse you and your lineage, however.
--
Matt Knecht <hex@voicenet.com>
------------------------------
Date: Mon, 23 Dec 2002 16:38:54 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: regular expression help
Message-Id: <3E07826E.B959EF3@earthlink.net>
Matt Knecht wrote:
>
> Mark <mfaine@knology.net> wrote:
> >passwords must meet the following guidelines:
> >
> >eight characters exactly
> >
> >The eight characters will contain at least one character each from at
> >least three of the following sets of characters:
> >
> >At least one uppercase letter
> >At least one lowercase letters
> >At least one numbers
> >At least one special characters
>
> Easier to write and maintain with seperate regexen IMHO:
>
> die unless $passwd =~ /^.{8}$/; # length $passwd == 8
> $num_sets++ if $passwd =~ /\p{IsUpper}/ # At least one uppercase
> $num_sets++ if $passwd =~ /\p{IsLower}/ # At least one lowercase
> $num_sets++ if $passwd =~ /\d/ # At least one digit
> $num_sets++ if $passwd =~ /\p{IsPunct}/ # At least one punctuation
Or perhaps:
my $num_sets = grep $passwd =~ /$_/,
qw/^.{8}\z \p{IsUpper} \p{IsLower} \d \p{IsPunct}/;
> die unless $num_sets >= 3;
>
> You can cram it into one regex. It'll look cool. The person you pass
> the code onto will curse you and your lineage, however.
--
$..='(?:(?{local$^C=$^C|'.(1<<$_).'})|)'for+a..4;
$..='(?{print+substr"\n !,$^C,1 if $^C<26})(?!)';
$.=~s'!'haktrsreltanPJ,r coeueh"';BEGIN{${"\cH"}
|=(1<<21)}""=~$.;qw(Just another Perl hacker,\n);
------------------------------
Date: 23 Dec 2002 13:59:06 -0800
From: kyo23@hotmail.com (kyo23)
Subject: replicating (cpan) modules across server installs
Message-Id: <6ffe7399.0212231359.4aee3927@posting.google.com>
Hello,
I have a question which I could not find an answer to in the faqs and
archives.
I run several servers and would like to have the same perl modules
installed on them all.
Assuming the hardware is the same on each server, is it generally safe
to do something as simple as making a tarball of the "master" servers
modules/includes dirs and then copying that to each "slave" server?
What other methods are in common use for doing such a thing? I would
prefer to use the method which is most commonly used. Assume that this
is to install a large-ish number of servers (50+) and that I cannot
do things like NFS mount a common dir, etc.
I want each box to have it's own identical install of perl modules.
Any ideas? Pointers? Thanks much!
------------------------------
Date: 23 Dec 2002 22:13:43 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: replicating (cpan) modules across server installs
Message-Id: <au81qn$sq8$1@mamenchi.zrz.TU-Berlin.DE>
According to kyo23 <kyo23@hotmail.com>:
> Hello,
>
> I have a question which I could not find an answer to in the faqs and
> archives.
>
> I run several servers and would like to have the same perl modules
> installed on them all.
>
> Assuming the hardware is the same on each server, is it generally safe
> to do something as simple as making a tarball of the "master" servers
> modules/includes dirs and then copying that to each "slave" server?
If the machines are really similar enough this might work.
> What other methods are in common use for doing such a thing? I would
> prefer to use the method which is most commonly used. Assume that this
> is to install a large-ish number of servers (50+) and that I cannot
> do things like NFS mount a common dir, etc.
CPAN has the option of making a "bundle" of your installation (or any
other set of modules). Installing a bundle (a single tar file) means
that the regular install process is run for each module. That is much
safer. I'd work in that direction.
Anno
------------------------------
Date: Mon, 23 Dec 2002 22:56:55 GMT
From: "Bob X" <bobx@linuxmail.org>
Subject: Re: replicating (cpan) modules across server installs
Message-Id: <XwMN9.7018$uV4.3673225@news2.news.adelphia.net>
"kyo23" <kyo23@hotmail.com> wrote in message
news:6ffe7399.0212231359.4aee3927@posting.google.com...
> Hello,
>
> I have a question which I could not find an answer to in the faqs and
> archives.
>
> I run several servers and would like to have the same perl modules
> installed on them all.
>
> Assuming the hardware is the same on each server, is it generally safe
> to do something as simple as making a tarball of the "master" servers
> modules/includes dirs and then copying that to each "slave" server?
>
> What other methods are in common use for doing such a thing? I would
> prefer to use the method which is most commonly used. Assume that this
> is to install a large-ish number of servers (50+) and that I cannot
> do things like NFS mount a common dir, etc.
>
> I want each box to have it's own identical install of perl modules.
>
> Any ideas? Pointers? Thanks much!
Mr. Schwartz just did a couple articles in Linux Mag that show how to create
mini-cpans. Maybe you could modify that.
Bob
------------------------------
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 4306
***************************************
