[33062] in Perl-Users-Digest
Perl-Users Digest, Issue: 4338 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Dec 30 14:09:24 2014
Date: Tue, 30 Dec 2014 11:09:06 -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 Tue, 30 Dec 2014 Volume: 11 Number: 4338
Today's topics:
Re: Both substitute and filter <rweikusat@mobileactivedefense.com>
Re: Both substitute and filter <gravitalsun@hotmail.foo>
Re: Both substitute and filter (Seymour J.)
Re: fields separation <gravitalsun@hotmail.foo>
Re: fields separation <rweikusat@mobileactivedefense.com>
Re: fields separation <gravitalsun@hotmail.foo>
Re: fields separation <gravitalsun@hotmail.foo>
Re: fields separation <rweikusat@mobileactivedefense.com>
Re: fields separation <gravitalsun@hotmail.foo>
Re: fields separation sammyjeep@163.com
Re: fields separation <m@rtij.nl.invlalid>
Re: fields separation <rweikusat@mobileactivedefense.com>
Re: fields separation <gravitalsun@hotmail.foo>
Re: fields separation <rweikusat@mobileactivedefense.com>
Script help aglait@gmail.com
Re: Script help <gravitalsun@hotmail.foo>
Twelve Drummers Drumming <see.my.sig@for.my.address>
Re: Twelve Drummers Drumming <gravitalsun@hotmail.foo>
Re: Twelve Drummers Drumming <maus@mail.com>
Re: Twelve Drummers Drumming <rweikusat@mobileactivedefense.com>
Re: Twelve Drummers Drumming <rweikusat@mobileactivedefense.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 28 Dec 2014 18:22:33 +0000
From: Rainer Weikusat <rweikusat@mobileactivedefense.com>
Subject: Re: Both substitute and filter
Message-Id: <87tx0ftz12.fsf@doppelsaurus.mobileactivedefense.com>
Georg Bauhaus <bauhaus@futureapps.invalid> writes:
> On 22.12.14 23:33, Rainer Weikusat wrote:
>> Georg Bauhaus <bauhaus@futureapps.invalid> writes:
>>
>> [...]
>>
>>> my @foo = ();
>>>
>>> is a concise way of reporting the initial value to the (presumed)
>>> average programmer.
>>
>> It isn't:
>>
>> my @foo = ();
>>
>> is a Perl expression statement and it doesn't have any 'natural' meaning
>> outside of the semantics assigned to it by the language.
>
> A 'natural' meaning, being technically as incorrect as common sense can be,
> is one which the "(presumed) average programmer" will associate with the
> above.
Unless you've conducted a set of suitable studies, your conjectures
about 'average programmers' are as good as anyone elses, eg, you're
obviously assuming that the 'average programmer working with Perl code'
doesn't know what
my @foo
means but does know what
= ()
means and that he's aware of the fact that whoever wrote the code meant
this to be an annotation and not something whose execution was supposed
to have an effect. I'm assuming that 'the average programmer working
with Perl code' will either understand all of
my @foo = ();
and realize that this doesn't do anything beyond
my @foo;
or mistakenly assume that it was meant to have some kind of effect
beyond his understanding.
BTW, 'average XYZ' is a statistical fiction, half of any real population
will be 'below average' and the other half 'above average'.
------------------------------
Date: Sun, 28 Dec 2014 23:15:51 +0200
From: George Mpouras <gravitalsun@hotmail.foo>
Subject: Re: Both substitute and filter
Message-Id: <m7pruc$sf7$1@news.grnet.gr>
>
> my @foo = ();
>
> and realize that this doesn't do anything beyond
>
> my @foo;
>
> or mistakenly assume that it was meant to have some kind of effect
> beyond his understanding.
>
> BTW, 'average XYZ' is a statistical fiction, half of any real population
> will be 'below average' and the other half 'above average'.
>
once I have read a two pages technical paper for the differences of htm
vs html
------------------------------
Date: Mon, 29 Dec 2014 09:18:02 -0500
From: Shmuel (Seymour J.) Metz <spamtrap@library.lspace.org.invalid>
Subject: Re: Both substitute and filter
Message-Id: <54a1629a$8$fuzhry+tra$mr2ice@news.patriot.net>
In <87tx0ftz12.fsf@doppelsaurus.mobileactivedefense.com>, on
12/28/2014
at 06:22 PM, Rainer Weikusat <rweikusat@mobileactivedefense.com>
said:
>BTW, 'average XYZ' is a statistical fiction, half of any real
>population will be 'below average' and the other half 'above
>average'.
UL. The term average usually refers to the mean rather than the median
or mode, and distributions are often not Gaussian. Look at the
ditribution of income in the US; far more than 50% of the population
make less than an average income.
--
Shmuel (Seymour J.) Metz, SysProg and JOAT <http://patriot.net/~shmuel>
Unsolicited bulk E-mail subject to legal action. I reserve the
right to publicly post or ridicule any abusive E-mail. Reply to
domain Patriot dot net user shmuel+news to contact me. Do not
reply to spamtrap@library.lspace.org
------------------------------
Date: Mon, 29 Dec 2014 01:49:47 +0200
From: George Mpouras <gravitalsun@hotmail.foo>
Subject: Re: fields separation
Message-Id: <m7q4v0$kt1$1@mouse.otenet.gr>
The following regex solution instead of using the $gather on/off
switch, remember whats it is broken and try to re-use it.
sub Find_fields
{
my ($fh, $sep, $buffsize)=($_[0],quotemeta $_[1],$_[2]);
my $leftbehind = '';
while (read $fh, my $rawdata, $buffsize)
{
$rawdata =~tr/\x0A\x0D//d;
next if $rawdata eq '';
my @fields = "$leftbehind$rawdata" =~/(.*?)$sep/g;
if (@fields)
{
$leftbehind = $';#'
# call the Callback function
map {print "*$_*\n" } @fields
}
else
{
$leftbehind .= $rawdata
}
}
# call the Callback function
print "*$leftbehind*\n" if length $leftbehind
}
I compare both solutions and now for the "long fields" input data
rraaaaaa<
*>uuibbb<*>1
2222u23<*
> cc44c
yyuuc<*>dyyddddd<*>
<
*
>
eeeeee
<*
> <
*>
eyeee888
<*>
ffeef88f
<*
>
111111111111111111<*>
222222222222222222<*>
333333333333333333<*>
444444444444444444<*>555555555555555555
the solution that remember the broken text is 150% faster than the state one
#!/usr/bin/perl
use strict;
use warnings;
use Benchmark;
use constant BLOCK=>64;
open FILE, '<:raw', 'fields_long.txt' or die $!;
Benchmark::cmpthese(5_000,{
rainier => sub{ find_fields_Rainer(\*FILE, '<*>') },
george => sub{ find_fields_George(\*FILE, '<*>', 64) }, });
close FILE;
sub find_fields_Rainer
{
my ($fh, $sep, $ls, $ns, $re, $field, $in)=@_;
my @fields;
seek($fh, 0, 0);
$ls = $re = substr($sep, -1, 1);
$re = '\\\\' if $re eq '\\';
$re = '^([^'.$re.'\n]+)';
$ns = length($sep);
while (length($in) || sysread($fh, $in, BLOCK) > 0) {
$in =~ s/$re// and $field .= $1, next;
$in =~ s/^\n+// and next;
$field .= $ls;
if (substr($field, -$ns) eq $sep) {
#push(@fields, substr($field, 0, -$ns));
$field = '';
}
substr($in, 0, 1, '')
}
#push(@fields, $field) if length($field);
#map {print "*$_*\n"} @fields;
#return @fields
}
sub find_fields_George
{
my ($fh, $sep, $buffsize)=($_[0],quotemeta $_[1],$_[2]);
my $leftbehind = '';
seek $fh, 0, 0;
while (read $fh, my $rawdata, $buffsize)
{
$rawdata =~tr/\x0A\x0D//d;
next if $rawdata eq '';
my @fields = "$leftbehind$rawdata" =~/(.*?)$sep/g;
if (@fields)
{
$leftbehind = $';#'
# call the Callback function
#map {print "*$_*\n" } @fields
}
else
{
$leftbehind .= $rawdata
}
}
# call the Callback function
#print "*$leftbehind*\n" if length $leftbehind
}
------------------------------
Date: Mon, 29 Dec 2014 00:25:37 +0000
From: Rainer Weikusat <rweikusat@mobileactivedefense.com>
Subject: Re: fields separation
Message-Id: <874msf9u9q.fsf@doppelsaurus.mobileactivedefense.com>
George Mpouras <gravitalsun@hotmail.foo> writes:
[...]
> the solution that remember the broken text is 150% faster than the state one
Yes. And this is "250%" more boring than Theresa May's haircut. Give me
some code. Provided that I'm determined enough to waste my time on that,
I'll give you some faster code in return. Especially if I'm free to do
generally stupid things which happen to be sensible for certain,
artficial examples.
------------------------------
Date: Mon, 29 Dec 2014 20:41:57 +0200
From: George Mpouras <gravitalsun@hotmail.foo>
Subject: Re: fields separation
Message-Id: <m7s79s$8he$1@mouse.otenet.gr>
On 29/12/2014 02:25, Rainer Weikusat wrote:
> George Mpouras <gravitalsun@hotmail.foo> writes:
>
> [...]
>
>> the solution that remember the broken text is 150% faster than the state one
>
> Yes. And this is "250%" more boring than Theresa May's haircut. Give me
> some code. Provided that I'm determined enough to waste my time on that,
> I'll give you some faster code in return. Especially if I'm free to do
> generally stupid things which happen to be sensible for certain,
> artficial examples.
>
No problem. I like to "spent" some time at interesting code snippets
like this. It is more fun than sudoku or chess for me, also nany times
they fit nice to real world problems.
This was only a very small abstraction problem to dynamic graph
documents with gravity between the nodes , ( e.g.
http://mbostock.github.io/d3/talk/20111116/force-collapsible.html ) that
the description is beyond this thread
------------------------------
Date: Mon, 29 Dec 2014 20:44:23 +0200
From: George Mpouras <gravitalsun@hotmail.foo>
Subject: Re: fields separation
Message-Id: <m7s7ee$8he$2@mouse.otenet.gr>
# a simple usage example, e.g.
# extract strings from windows binaries
open FILE, '<:raw', 'c:/windows/notepad.exe' or die $!;
Find_fields(\*FILE, '[^a-zA-Z0-9 _,-=]', \&DoSomething, 1024);
close FILE;
# Find_fields( FILEHANDLE, REGEX, CALLBACKCODE, CHUNKSIZE )
sub Find_fields
{
my ($fh, $sep, $callback, $buffsize)=@_;
my $leftbehind = '';
while (read $fh, my $rawdata, $buffsize)
{
$rawdata =~tr/\x0A\x0D//d;
next if $rawdata eq '';
my @fields = "$leftbehind$rawdata" =~/(.*?)$sep/g;
if (@fields)
{
$leftbehind = $';#'
$callback->($_) foreach @fields
}
else
{
$leftbehind .= $rawdata
}
}
$callback->($leftbehind) if length $leftbehind
}
sub DoSomething {
print "$_[0]\n" unless $_[0]=~/^\s*$/ || length $_[0] <= 5
}
------------------------------
Date: Mon, 29 Dec 2014 19:24:46 +0000
From: Rainer Weikusat <rweikusat@mobileactivedefense.com>
Subject: Re: fields separation
Message-Id: <87mw66s1hd.fsf@doppelsaurus.mobileactivedefense.com>
George Mpouras <gravitalsun@hotmail.foo> writes:
> # a simple usage example, e.g.
> # extract strings from windows binaries
>
>
>
> open FILE, '<:raw', 'c:/windows/notepad.exe' or die $!;
> Find_fields(\*FILE, '[^a-zA-Z0-9 _,-=]', \&DoSomething, 1024);
> close FILE;
>
>
> # Find_fields( FILEHANDLE, REGEX, CALLBACKCODE, CHUNKSIZE )
> sub Find_fields
> {
> my ($fh, $sep, $callback, $buffsize)=@_;
> my $leftbehind = '';
>
> while (read $fh, my $rawdata, $buffsize)
> {
> $rawdata =~tr/\x0A\x0D//d;
> next if $rawdata eq '';
> my @fields = "$leftbehind$rawdata" =~/(.*?)$sep/g;
>
> if (@fields)
> {
> $leftbehind = $';#'
> $callback->($_) foreach @fields
> }
> else
> {
> $leftbehind .= $rawdata
> }
> }
>
> $callback->($leftbehind) if length $leftbehind
> }
Dear entity who confuse life with a competition which can be won by
changing the rules in helpful ways, in case you're accumulating a
generally limitless amount of input in memory, as above, this whole
looping around becomes a pointless exercise. You can as well just do
(untested)
sysread($fh, $data, 2 ** 64);
$data =~ tr/\n/d;
@fields = split(/\Q$sep/, $data);
but since that's so freaking obvious, nobody could possibly have assumed
that you were actually asking for that.
------------------------------
Date: Mon, 29 Dec 2014 22:18:17 +0200
From: George Mpouras <gravitalsun@hotmail.foo>
Subject: Re: fields separation
Message-Id: <m7scug$ap7$1@mouse.otenet.gr>
>
> but since that's so freaking obvious, nobody could possibly have assumed
> that you were actually asking for that.
>
I did not ask for that !
------------------------------
Date: Tue, 30 Dec 2014 02:30:18 -0800 (PST)
From: sammyjeep@163.com
Subject: Re: fields separation
Message-Id: <b5a72fbb-2e64-4bb4-865d-08eeb98ba662@googlegroups.com>
=E5=9C=A8 2014=E5=B9=B412=E6=9C=8823=E6=97=A5=E6=98=9F=E6=9C=9F=E4=BA=8CUTC=
+8=E4=B8=8A=E5=8D=887=E6=97=B636=E5=88=8656=E7=A7=92=EF=BC=8CGeorge Mpouras=
=E5=86=99=E9=81=93=EF=BC=9A
> Find fields using any separator e.g <*> if the input text is
>=20
> aaaa<
> *>bb<*>1
#!/usr/bin/perl
open FH, "1.txt";
seek FH, 0, 2;
$p =3D tell FH;
seek FH, 0, 0;
read FH, $buff, ($p+1);
printf "%s\n", $buff;
$buff=3D~s/<(\s*\n*\s*){1,}\*(\s*\n*\s*){1,}>/<*>/g;
$buff=3D~s/([^<>\*\s]+)(\s*\n+\s*){1,}([^<>\*\s]+)/$1$3/g;
@F=3Dsplit('<\*>', $buff );
map {printf "[Map]%s\n", $_ if ( $_ !~ m/^\s*\n\s*$/ && $_ !~ m/^$/ ) } @F;=
=20
close FH;
------------------------------
Date: Tue, 30 Dec 2014 13:25:00 +0100
From: Martijn Lievaart <m@rtij.nl.invlalid>
Subject: Re: fields separation
Message-Id: <s5ianb-fjh.ln1@news.rtij.nl>
On Tue, 23 Dec 2014 01:36:40 +0200, George Mpouras wrote:
Yourexample does not match your spec. Your expected output does not match
the output from your example program. What exactly is it what you want to
do?
M4
------------------------------
Date: Tue, 30 Dec 2014 13:20:07 +0000
From: Rainer Weikusat <rweikusat@mobileactivedefense.com>
Subject: Re: fields separation
Message-Id: <87zja52s1k.fsf@doppelsaurus.mobileactivedefense.com>
sammyjeep@163.com writes:
> 在 2014年12月23日星期二UTC+8上午7时36分56秒，George Mpouras写道：
>> Find fields using any separator e.g <*> if the input text is
>>
>> aaaa<
>> *>bb<*>1
>
> #!/usr/bin/perl
>
> open FH, "1.txt";
> seek FH, 0, 2;
> $p = tell FH;
> seek FH, 0, 0;
> read FH, $buff, ($p+1);
This can be replaced with something like
sysread(FH, $buff, -s(FH))
or, if you're using the 'STREAMS'-layer anyway,
{ local $/; $buff = <FH> }
(in a short script, undef $/ might be ok, too)
> $buff=~s/<(\s*\n*\s*){1,}\*(\s*\n*\s*){1,}>/<*>/g;
This obviously won't work with separators other than <*>. Further, in a regex
\s*\n*\s*
only the first \s* will ever match anything because \s matches \n,
[rw@doppelsaurus]~#perl -e '$a = " \n "; $a =~ /(\s*)(\n*)(\s*)/;
printf("|%s|, |%s|, |%s|\n", $1, $2, $3);'
|
|, ||, ||
> $buff=~s/([^<>\*\s]+)(\s*\n+\s*){1,}([^<>\*\s]+)/$1$3/g;
> @F=split('<\*>', $buff );
Instead of the multi-stage separator translation, matching on a
separator including the \ns is also possible provided that reading all
input into memory prior to doing anything is ok,
perl -e 'undef $/; print(map { $_ =~ tr/\n//d; $_, "\n" } split(/<\n*\*\n*>\n*/, <>))'
On a sufficiently 'modern' Perl, this can also be written as
perl -e 'undef $/; print(map { $_ =~ tr/\n//dr, "\n" } split(/<\n*\*\n*>\n*/, <>))'
Lastly, at least on UNIX(*), a mentally somewhat sane person interested
in results and not in pattern matching automata would probably consider
something like this before anyting else
tr -d '\n' <t | sed 's/<\*>/\n/g'
(input is assumed to come from a file named 't').
------------------------------
Date: Tue, 30 Dec 2014 19:47:44 +0200
From: George Mpouras <gravitalsun@hotmail.foo>
Subject: Re: fields separation
Message-Id: <m7uog9$1ub$1@mouse.otenet.gr>
On 30/12/2014 14:25, Martijn Lievaart wrote:
> On Tue, 23 Dec 2014 01:36:40 +0200, George Mpouras wrote:
>
> Yourexample does not match your spec. Your expected output does not match
> the output from your example program. What exactly is it what you want to
> do?
>
> M4
>
the interesting part was how to make a specific perl code as fast as
possible, but I think it can not go any further than the last post, so
let it go.
------------------------------
Date: Tue, 30 Dec 2014 18:35:19 +0000
From: Rainer Weikusat <rweikusat@mobileactivedefense.com>
Subject: Re: fields separation
Message-Id: <877fx9t28o.fsf@doppelsaurus.mobileactivedefense.com>
George Mpouras <gravitalsun@hotmail.foo> writes:
> On 30/12/2014 14:25, Martijn Lievaart wrote:
>> On Tue, 23 Dec 2014 01:36:40 +0200, George Mpouras wrote:
>>
>> Yourexample does not match your spec. Your expected output does not match
>> the output from your example program. What exactly is it what you want to
>> do?
>>
>> M4
>>
>
> the interesting part was how to make a specific perl code as fast as
> possible, but I think it can not go any further than the last post, so
> let it go.
You never provided a complete description of the problem this code was
supposed to solve and the actual problem kept changing its spots in line
with whatever was necessary to make you latest 'silly hack' shine.
Here's a hint why you're latest still sucks except when making suitable
assumptions about what the input data will be:
---------
use Benchmark qw(cmpthese);
my $t = 'A' x 16;
my @a = ($t) x 512;
push(@a, 'bb');
cmpthese(-3,
{
half => sub {
my $x;
for (@a / 2 .. $#a) {
$x .= $a[$_];
$x =~ /(.*?)bb/ and last;
}
},
quarter => sub {
my $x;
for (3 * @a / 4 .. $#a) {
$x .= $a[$_];
$x =~ /(.*?)bb/ and last;
}
},
all => sub {
my $x;
for (0 .. $#a) {
$x .= $a[$_];
$x =~ /(.*?)bb/ and last;
}
}});
---------
You'll have to interpret that yourself this time.
------------------------------
Date: Mon, 29 Dec 2014 19:49:08 -0800 (PST)
From: aglait@gmail.com
Subject: Script help
Message-Id: <95dd5bbe-58a4-45a8-be1a-c67e2bc81581@googlegroups.com>
Hi !
I have the Idea to make a perl script (better than in bash) to make some configuration on linux.
I think to have some files like param.txt with some lines like:
param_one = ZZZ XX CCCC VV
param_two = ZZZZZZZZZ
param_three = X
so need to check if param_one is in some_file.conf and if it is there test the value .. if it is not .. add to some_file.conf ... I think it should be easy ... right ??
Thanks for any help ..
;)
------------------------------
Date: Tue, 30 Dec 2014 20:50:11 +0200
From: George Mpouras <gravitalsun@hotmail.foo>
Subject: Re: Script help
Message-Id: <m7us5c$3b8$1@mouse.otenet.gr>
On 30/12/2014 05:49, aglait@gmail.com wrote:
> Hi !
> I have the Idea to make a perl script (better than in bash) to make some configuration on linux.
> I think to have some files like param.txt with some lines like:
> param_one = ZZZ XX CCCC VV
> param_two = ZZZZZZZZZ
> param_three = X
>
> so need to check if param_one is in some_file.conf and if it is there test the value .. if it is not .. add to some_file.conf ... I think it should be easy ... right ??
>
> Thanks for any help ..
>
> ;)
>
create the files
param1.txt
p1 = AA
p2 = aa
p3 = AC
param2.txt
p2 = aa
p3 = BB
p4 = BC
param3.txt
p2 = BA
p4 = BB
p6 = CA
and run the following code for fun !
use strict;
use warnings;
use feature qw/say/;
my %DB;
read_properties('param1.txt', 'param2.txt', 'param3.txt');
say query_file('p1');
say query_file('p2');
say query_file('p3');
say query_file('p4');
say query_value('p1');
say query_value('p2');
say query_value('p3');
sub read_properties {
foreach my $file (@_) {
open FILE, '<', $file or die $!;
while (<FILE>) {
my ($key,$val) = $_ =~ /^\s*(.*?)\s*=\s*(.*?)\s*$/ or next;
push @{$DB{__FILES}->{$key}}, $file;
$DB{$key} ->{__VALUES}->{$val}=1
}
close FILE}
}
sub query_file {&query}
sub query_value {&query}
sub query {
(my $who = ((caller 1)[3]))=~s/^.*:://;
if ($who eq 'query_file') {
exists $DB{__FILES}->{$_[0]} ?
return join ', ', @{$DB{__FILES}->{$_[0]}} :
return 'NOT_EXIST_IN_ANY_FILE'
}
elsif ($who eq 'query_value') {
exists $DB{$_[0]} ?
return join ', ', keys %{$DB{$_[0]} ->{__VALUES}} :
return 'NOT_EXISTING_PROPERTY'
}
else {
die "Method $who does not exist\n"
}
}
------------------------------
Date: Sat, 27 Dec 2014 13:35:58 -0800
From: Robbie Hatley <see.my.sig@for.my.address>
Subject: Twelve Drummers Drumming
Message-Id: <gJGdna3Ii66guwLJnZ2dnUVZ57ydnZ2d@giganews.com>
#! /usr/bin/perl
use v5.14;
use strict;
use warnings;
$::ordinals[ 1] = "first";
$::ordinals[ 2] = "second";
$::ordinals[ 3] = "third";
$::ordinals[ 4] = "fourth";
$::ordinals[ 5] = "fifth";
$::ordinals[ 6] = "sixth";
$::ordinals[ 7] = "seventh";
$::ordinals[ 8] = "eight";
$::ordinals[ 9] = "ninth";
$::ordinals[10] = "tenth";
$::ordinals[11] = "eleventh";
$::ordinals[12] = "twelfth";
$::gifts[ 1] = "a partridge in a pear tree.\n";
$::gifts[ 2] = "two turtle doves,\nand ";
$::gifts[ 3] = "three French hens, ";
$::gifts[ 4] = "four calling birds, ";
$::gifts[ 5] = "five golden rings,\n";
$::gifts[ 6] = "six geese a-laying, ";
$::gifts[ 7] = "seven swans a-swimming,\n";
$::gifts[ 8] = "eight maids a-milking, ";
$::gifts[ 9] = "nine ladies dancing, ";
$::gifts[10] = "ten lords a leaping,\n";
$::gifts[11] = "eleven pipers piping, ";
$::gifts[12] = "twelve drummers drumming, ";
for ( my $day = 1 ; $day < 13 ; ++$day )
{
print("On the $::ordinals[$day] day of Christmas my true love gave to me\n");
for ( my $gift = $day ; $gift > 0 ; --$gift )
{
print($::gifts[$gift]);
}
print("\n");
}
say "\nCheers,";
say "Robbie Hatley";
say "Midway City, CA, USA";
say "\154o\156e\167o\154f\100w\145ll\56c\157m";
------------------------------
Date: Sun, 28 Dec 2014 01:19:55 +0200
From: George Mpouras <gravitalsun@hotmail.foo>
Subject: Re: Twelve Drummers Drumming
Message-Id: <m7neqt$6ta$1@news.grnet.gr>
#! /usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
$_=[
['first' , "a partridge in a pear tree.\n"],
['second' , "two turtle doves,\nand "],
['third' , "three French hens, "],
['fourth' , "four calling birds, "],
['fifth' , "five golden rings,\n"],
['sixth' , "six geese a-laying, "],
['seventh' , "seven swans a-swimming,\n"],
['eight' , "eight maids a-milking, "],
['ninth' , "nine ladies dancing, "],
['tenth' , "ten lords a leaping,\n"],
['eleventh', "eleven pipers piping, "],
['twelfth' , "twelve drummers drumming, "]];
for (my $day=0; $day<12; ++$day)
{
say "On the $_->[$day][0] day of Christmas my true love gave to me";
for (my $gift = $day; $gift >= 0; --$gift)
{
print $_->[$gift][1]
}
say ''
}
say "\nCheers,";
say "Robbie Hatley";
say "Midway City, CA, USA";
say "\154o\156e\167o\154f\100w\145ll\56c\157m";
------------------------------
Date: 28 Dec 2014 10:55:05 GMT
From: greymausg <maus@mail.com>
Subject: Re: Twelve Drummers Drumming
Message-Id: <slrnm9vlrq.13k.maus@gmaus.info>
On 2014-12-27, Robbie Hatley <see.my.sig@for.my.address> wrote:
> #! /usr/bin/perl
>
> $::gifts[10] = "ten lords a leaping,\n";
> $::gifts[11] = "eleven pipers piping, ";
> $::gifts[12] = "twelve drummers drumming, ";
>
> for ( my $day = 1 ; $day < 13 ; ++$day )
> {
> print("On the $::ordinals[$day] day of Christmas my true love gave to me\n");
> for ( my $gift = $day ; $gift > 0 ; --$gift )
> {
> print($::gifts[$gift]);
> }
> print("\n");
> }
>
> say "\nCheers,";
> say "Robbie Hatley";
> say "Midway City, CA, USA";
> say "\154o\156e\167o\154f\100w\145ll\56c\157m";
>
Thanks!
--
maus
.
.
...
------------------------------
Date: Sun, 28 Dec 2014 18:51:48 +0000
From: Rainer Weikusat <rweikusat@mobileactivedefense.com>
Subject: Re: Twelve Drummers Drumming
Message-Id: <87h9wfboaj.fsf@doppelsaurus.mobileactivedefense.com>
Robbie Hatley <see.my.sig@for.my.address> writes:
> #! /usr/bin/perl
>
> use v5.14;
> use strict;
> use warnings;
>
> $::ordinals[ 1] = "first";
> $::ordinals[ 2] = "second";
[...]
> $::gifts[ 1] = "a partridge in a pear tree.\n";
> $::gifts[ 2] = "two turtle doves,\nand ";
[...]
Instead of the (somewhat silly) $::-prefix, you can also declare the
arrays, either as
our (@ordinals, @gifts);
or
my @ordindals = qw(first second third ...);
my @gifts = ...;
Unless you specifically want to use objects referred to by the symbol
table of the package for some reason, you'd IMHO be better advised to
use my than our.
------------------------------
Date: Sun, 28 Dec 2014 19:20:13 +0000
From: Rainer Weikusat <rweikusat@mobileactivedefense.com>
Subject: Re: Twelve Drummers Drumming
Message-Id: <87d273bmz6.fsf@doppelsaurus.mobileactivedefense.com>
Robbie Hatley <see.my.sig@for.my.address> writes:
> #! /usr/bin/perl
>
> use v5.14;
> use strict;
> use warnings;
>
> $::ordinals[ 1] = "first";
> $::ordinals[ 2] = "second";
[...]
> for ( my $day = 1 ; $day < 13 ; ++$day )
> {
> print("On the $::ordinals[$day] day of Christmas my true love gave to me\n");
> for ( my $gift = $day ; $gift > 0 ; --$gift )
> {
> print($::gifts[$gift]);
> }
> print("\n");
> }
Here's another more focussed on 'let the computer do the boring stuff'
------------------
#! /usr/bin/perl
use v5.14;
use strict;
use warnings;
my @ordinals = qw(first second third fourth fifth sixth
seventh eighth ninth tenth eleventh
twelfth);
my @gifts = ("a partridge in a pear tree.\n",
"two turtle doves,\nand ",
"three French hens, ",
"four calling birds, ",
"five golden rings,\n",
"six geese a-laying, ",
"seven swans a-swimming,\n",
"eight maids a-milking, ",
"nine ladies dancing, ",
"ten lords a leaping,\n",
"eleven pipers piping, ",
"twelve drummers drumming, ");
print(map { ("On the $ordinals[$_] day of Christmas my true love gave to me\n",
@gifts[reverse(0 .. $_)], "\n") } 0 .. $#ordinals);
------------------
The final statement can also be written as
-----
my $nth;
print(map { ("On the $_ day of Christmas my true love gave to me\n",
@gifts[reverse(0 .. $nth++)], "\n") } @ordinals);
-----
------------------------------
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:
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
Back issues are available via anonymous ftp from
ftp://cil-www.oce.orst.edu/pub/perl/old-digests.
#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 V11 Issue 4338
***************************************
