[32512] in Perl-Users-Digest
Perl-Users Digest, Issue: 3777 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Sep 13 09:09:21 2012
Date: Thu, 13 Sep 2012 06:09:07 -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 Thu, 13 Sep 2012 Volume: 11 Number: 3777
Today's topics:
Re: an array of of arrays in Perl, behavior different i <peter@makholm.net>
Re: an array of of arrays in Perl, behavior different i <rweikusat@mssgmbh.com>
an array of of arrays in Perl, behavior different in St <removeps-groups@yahoo.com>
Re: C++ calling perl script - Not able to get the stack <peter@makholm.net>
C++ calling perl script - Not able to get the stack arg <yogishaj@gmail.com>
hash of arrays <removeps-groups@yahoo.com>
Re: Setting backreference inside of a string <peter@makholm.net>
Re: Setting backreference inside of a string <ben@morrow.me.uk>
Re: Setting backreference inside of a string <derykus@gmail.com>
Re: Setting backreference inside of a string <jwcarlton@gmail.com>
Re: Setting backreference inside of a string <derykus@gmail.com>
Re: Setting backreference inside of a string <jwcarlton@gmail.com>
Re: Setting backreference inside of a string <willem@turtle.stack.nl>
Re: Setting backreference inside of a string <ben@morrow.me.uk>
Test::More with suexec <rodbass63@gmail.com>
Re: Test::More with suexec <ben@morrow.me.uk>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 13 Sep 2012 10:27:54 +0200
From: Peter Makholm <peter@makholm.net>
Subject: Re: an array of of arrays in Perl, behavior different in Strawberry and Linux perl
Message-Id: <871ui61g51.fsf@vps1.hacking.dk>
removeps groups <removeps-groups@yahoo.com> writes:
> Using Strawberry Perl "This is perl 5, version 16, subversion 1 (v5.16.1) built for MSWin32-x86-multi-thread", the following program compiles and prints out the things noted below.
>
> use strict;
> use warnings;
> my $myarray = [[1,11], [2,22]];
> push(@$myarray[1], 222);
The expression '@$myarray[1]' evaluates to an array slice containing a
single array ref.
In Perl 5.14 the definition of push was changed to accept an array
reference as the first argument, previously the first argument could
only be an real array.
This explains the difference in behaviour between your Strawberry Perl,
which is quite new and the perl on your Linux system which is horribly
old (11 years 5 months old to be exact). Get a newer Linux system.
(I wouldn't expect Linux distributions older than January 2012 to
include a perl newer than 5.12)
> Questions:
>
> (1) Is Strawberry Perl wrong to run the first snippet, or is Linux
> Perl wrong to not run it?
Your Strawberry Perl behaves as it ought to with a modern perl. Your
Linux perl behavies as intended in the previous decade.
> (2) I don't understand the use of $, @, {}, \ to get things working.
> Is there some logic to it?
Yes. Have you read the perlref and perlreftut manual pages?
//Makholm
------------------------------
Date: Thu, 13 Sep 2012 11:43:00 +0100
From: Rainer Weikusat <rweikusat@mssgmbh.com>
Subject: Re: an array of of arrays in Perl, behavior different in Strawberry and Linux perl
Message-Id: <87pq5qjj9n.fsf@sapphire.mobileactivedefense.com>
Peter Makholm <peter@makholm.net> writes:
> removeps groups <removeps-groups@yahoo.com> writes:
[...]
>> (1) Is Strawberry Perl wrong to run the first snippet, or is Linux
>> Perl wrong to not run it?
>
> Your Strawberry Perl behaves as it ought to with a modern perl. Your
> Linux perl behavies as intended in the previous decade.
This was introduced with perl 5.14.0, released on 2011/05/14. The
corresponding 'changes' documentation paragraph starts with
,----
| Warning: This feature is considered experimental, as the exact
| behaviour may change in a future version of Perl.
`----
http://perldoc.perl.org/perl5140delta.html#Syntactical-Enhancements
Consequently, this would be more correctly described as 'You are using
an experimental feature introduced a litte more than a year
ago. Unless you're prepared to (and capable of) using "roll-your-own"
versions of perl everywhere where you might need to use perl, you
should probably not yet write code depdendent on this at the moment.'
------------------------------
Date: Wed, 12 Sep 2012 21:56:32 -0700 (PDT)
From: removeps groups <removeps-groups@yahoo.com>
Subject: an array of of arrays in Perl, behavior different in Strawberry and Linux perl
Message-Id: <59984fbb-75b1-47a2-b7fb-2712ed1a3bbe@googlegroups.com>
Using Strawberry Perl "This is perl 5, version 16, subversion 1 (v5.16.1) built for MSWin32-x86-multi-thread", the following program compiles and prints out the things noted below.
use strict;
use warnings;
my $myarray = [[1,11], [2,22]];
push(@$myarray[1], 222);
print "MYDEBUG $$myarray[1][0]\n"; # prints 2
print "MYDEBUG $$myarray[1][1]\n"; # prints 22
print "MYDEBUG $$myarray[1][2]\n"; # prints 222
print "MYDEBUG @{$$myarray[1]}\n"; # prints 2 22 222
But on Linux perl "This is perl, v5.6.1 built for i686-linux", the above program results in a compile error
Type of arg 1 to push must be array (not array slice) at array.pl line 4, near "222)"
To get the above program to work in Linux perl, through trial and error, I found this is the script that works:
use strict;
use warnings;
my @tmpmyarray = ([1,11], [2,22]);
my $myarray = \@tmpmyarray;
push(@{$$myarray[1]}, 222);
print "MYDEBUG $$myarray[1][0]\n"; # prints 2
print "MYDEBUG $$myarray[1][1]\n"; # prints 22
print "MYDEBUG $$myarray[1][2]\n"; # prints 222
print "MYDEBUG @{$$myarray[1]}\n"; # prints 2 22 222
This script also works on Strawberry Perl.
Questions:
(1) Is Strawberry Perl wrong to run the first snippet, or is Linux Perl wrong to not run it?
(2) I don't understand the use of $, @, {}, \ to get things working. Is there some logic to it?
------------------------------
Date: Thu, 13 Sep 2012 13:30:45 +0200
From: Peter Makholm <peter@makholm.net>
Subject: Re: C++ calling perl script - Not able to get the stack arguments pushed rom XPUSH in perl script
Message-Id: <87wqzyyxay.fsf@vps1.hacking.dk>
Yogi <yogishaj@gmail.com> writes:
> I have the below sample program which pushes the arguments to Perl
> stack and then calls "eval_sv".
Just tried to make some guesses at your identical StackOverflow
question.
http://stackoverflow.com/questions/12403729/c-calling-perl-code-eval-sv-not-passing-arguments-to-script/12405016
The gist is that that you try to pass values by passing them on the Perl
stack, but this is only relevant if you are asking Perl the call a perl
subroutine.
Your code is roughly comparable to a script doing:
#!/usr/bin/perl
@_ = (10, 20);
eval 'my $a = shift; my $b = shift; my $z = 100; print $a; print $b; print $z;'
__END__
A bit simplified. @_ is really not the stack, but calling a subroutine
moves stuff from the stack into @_.
//Makholm
------------------------------
Date: Thu, 13 Sep 2012 03:28:02 -0700 (PDT)
From: Yogi <yogishaj@gmail.com>
Subject: C++ calling perl script - Not able to get the stack arguments pushed rom XPUSH in perl script
Message-Id: <443fb047-51fe-4b64-9af9-8cb993651c48@googlegroups.com>
I have the below sample program which pushes the arguments to Perl stack an=
d then calls "eval_sv". The sample perl statements get executed but i'm not=
able to retrieve the variables passed from C++ as Perl arguments. Please l=
et me know what i am missing in the below program
Output of the program
Hello World
Test
100Testing complete
This line doesn't print the value of $a and $b
string three =3D "print 'Test\n'; my $z =3D 100; print $a; print $b; print =
$z;";
Here is my code:
#include <EXTERN.h>
#include <perl.h>
#include <string>
using namespace std;
string perlScript;
static PerlInterpreter *my_perl;
SV* my_eval_sv(I32 croak_on_error)
{
STRLEN n_a;
char *p1 =3D new char [perlScript.size()+1];
strcpy(p1, perlScript.c_str());
const char *p =3D p1;
int len =3D strlen(p);
dSP;
ENTER ;
SAVETMPS ;
PUSHMARK(SP) ;
int a, b;
a =3D 10;
b =3D 20;
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(a)));
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(b)));
/* Done with pushing pointers to Perl stack */
PUTBACK;
SV* sv1 =3D newSVpv(p, 0); =20
eval_sv(sv1, G_EVAL | G_KEEPERR);
SvREFCNT_dec(sv1);
SPAGAIN;
sv1 =3D POPs;
PUTBACK;
FREETMPS;
LEAVE;
if (croak_on_error && SvTRUE(ERRSV))
croak(SvPVx(ERRSV, n_a)); =20
}
main (int argc, char **argv, char **env)
{
char *embedding[] =3D { "", "-e", "0" };
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl =3D perl_alloc();
perl_construct(my_perl);
perl_parse(my_perl, NULL, 3, embedding, NULL);
PL_exit_flags |=3D PERL_EXIT_DESTRUCT_END;
/*string perlBeginScript;
static const char * perlEndScript =3D "\
\n\
}\n\
";
if(perlBeginScript.length()=3D=3D0)
{
perlBeginScript=3D"EmbeddedPerl";
}
perlScript =3D "sub ";
perlScript +=3D perlBeginScript;
perlScript +=3D "{\n"; */
string one =3D "print 'Hello World\n'; ";
string two =3D "my $a =3D shift; my $b =3D shift; ";
string three=3D "print 'Test\n'; my $z =3D 100; print $a; print $b; pri=
nt $z;";
string four =3D "print 'Testing complete\n';";
perlScript +=3D one ;
perlScript +=3D two;
perlScript +=3D three;
perlScript +=3D four;
//perlScript +=3D perlEndScript;
/* Done with perl script to be executed */
my_eval_sv(TRUE);
PL_perl_destruct_level =3D 1;
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();=20
}
------------------------------
Date: Wed, 12 Sep 2012 21:57:23 -0700 (PDT)
From: removeps groups <removeps-groups@yahoo.com>
Subject: hash of arrays
Message-Id: <a554e6ff-8d52-46ee-b97b-7cb1edaf8ab1@googlegroups.com>
My perl script reads lines of a file, or rows of a database. The first col=
umn is the key (the id, an integer), and for each distinct key an entry sho=
uld be added into the hashmap. The second column is a string (the name). =
The third and fourth columns will go into the first and second array of the=
key-value, respectively. So if the file is (the 4 columns are tab-separat=
ed):
1 First Id 2 3
1 First Id 2 4
2 Second Id 3 4
the hash will contain two items. The first item has key 1. The value has =
one string with value "First Id", two arrays, and the first array is (2,2) =
and the second is (3,4). The second item has key 2. The value has one str=
ing with value "Second Id", two arrays, (3) and (4). In Java the structure=
would be Map<Integer, Triplet<String, List<Integer>, List<Integer>>>.
To model this data structure in perl I had to do stuff like the following, =
which works on Strawberry Perl and Linux Perl:
my %data; # map of id to [ Name, ArrayOfInt, ArrayOfInt ]
my $value =3D $data{$id};
my @tmpvalue =3D ($name, [], []);
$value =3D \@tmpvalue;
$data{$id} =3D $value;
push(@{$$value[1]}, $firstInt);
I don't know why the particular combination of $ @ {} \ works, but it does.=
Questions are:
(1) Is this the most efficient way?
(2) Why does it work?
The full script is below
#!/usr/bin/perl
use strict;
use warnings;
my %data; # map of id to [ Name, ArrayOfInt, ArrayOfInt ]
open sqlData, "hash-rows.txt" || die $!;
while (<sqlData>)
{
chomp $_;
my @row =3D split '\t', $_;
my $id =3D $row[0];
my $name =3D $row[1];
my $firstInt =3D $row[2];
my $secondInt =3D $row[3];
my $value =3D $data{$id};
if (not defined $value)
{
my @tmpvalue =3D ($name, [], []);
$value =3D \@tmpvalue;
$data{$id} =3D $value;
}
push(@{$$value[1]}, $firstInt);
push(@{$$value[2]}, $secondInt);
}
foreach my $id (keys %data)
{
my $value =3D $data{$id};
my $name =3D $$value[0];
my @firstInts =3D @{$$value[1]};
my @secondInts =3D @{$$value[2]};
print "ENTRY\n id=3D$id\n name=3D$name\n firstInts=3D(@firstInts)\n secon=
dInts=3D(@secondInts)\n";
}
ENTRY
id=3D1
name=3DFirst
firstInts=3D(Id Id)
secondInts=3D(2 2)
ENTRY
id=3D2
name=3DSecond
firstInts=3D(Id)
secondInts=3D(3)
------------------------------
Date: Tue, 11 Sep 2012 14:14:52 +0200
From: Peter Makholm <peter@makholm.net>
Subject: Re: Setting backreference inside of a string
Message-Id: <87har421tv.fsf@vps1.hacking.dk>
Wolf Behrenhoff <NoSpamPleaseButThisIsValid3@gmx.net> writes:
> For example like this:
>
> $ perl -E '$r=q("${1}eer");($_="hello")=~s/(ll)/$r/ee; say'
> helleero
So, after matching 'll' and asigning it to $1 it is replaced by
eval( eval '$r' )
Start by computing the inner eval we get
eval ( '"$1eer"')
Remembering that $1 was "ll" this evaluates to
"lleer"
//Makholm
------------------------------
Date: Tue, 11 Sep 2012 15:54:36 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: Setting backreference inside of a string
Message-Id: <cuv3i9-pu41.ln1@anubis.morrow.me.uk>
Quoth Peter Makholm <peter@makholm.net>:
> Wolf Behrenhoff <NoSpamPleaseButThisIsValid3@gmx.net> writes:
>
> > For example like this:
> >
> > $ perl -E '$r=q("${1}eer");($_="hello")=~s/(ll)/$r/ee; say'
> > helleero
>
> So, after matching 'll' and asigning it to $1 it is replaced by
>
> eval( eval '$r' )
There aren't really two layers of eval: you've just created one by
adding superflous quotes. The RHS of that s/// is equivalent to
eval $r
Personally I would always rather avoid /ee, since presumably these RHS
expressions are user-specified so /ee opens you up to
$r = 'system "rm -rf /"; "${1}eer"';
A better solution would be to run through the replacement string and
perform the variable substitutions manually.
Ben
------------------------------
Date: Tue, 11 Sep 2012 13:50:20 -0700 (PDT)
From: "C.DeRykus" <derykus@gmail.com>
Subject: Re: Setting backreference inside of a string
Message-Id: <53a265e6-6a98-4fef-8218-0f973ae06eaa@googlegroups.com>
On Monday, September 10, 2012 2:36:22 AM UTC-7, Jason C wrote:
> On Monday, September 10, 2012 3:57:47 AM UTC-4, Peter Makholm wrote:
>
> > > $text = "Yes dear!"; $pattern = "(D|d)ear"; $replace = "$1eer";
>
> > > $text =~ s/$pattern/$replace/gi;
>
> >
>
> > Using this code I get "Yes eer!" in $text...
>
>
>
> Could be a minor variation in what I posted vs. my actual code. I didn't post the whole thing because I thought it was unnecessarily complicated, but it's technically:
>
>
>
> my $sth = $dbh->prepare("SELECT * FROM table");
>
> $sth->execute();
>
>
>
> while (($pattern, $replace) = $sth->fetchrow_array()) {
>
> $text =~ s/(\b*)$pattern(er|in|ing|s|ed|y|\b)/$1$replace$+/gi;
>
> }
>
>
>
>
>
> > > Any suggestions on how to make $1 in $replace refer to the first group
>
> > > in $pattern?
>
> >
>
> > You need to look at the /e modifier to your substitution.
>
>
>
> Thanks for the tip. I've read a bit on the 'e' modifier now, but I'm not quite understanding how to use it for this application.
>
>
>
> In retrospect, what I think is happening is that the while() loop is treating $replace as if it is in a single quote instead of double. So instead of it reading like:
>
>
>
> $pattern = "(D|d)ear";
>
> $replace = "$1eer";
>
>
>
> it's reading:
>
>
>
> $pattern = '(D|d)ear';
>
> $replace = '$1eer';
>
>
>
> So the question may really be, how do I get it to read $replace as interpretive?
One way to avoid an 'ee' solution's drawbacks
is just pull the backref out of the pattern:
my $pattern = '(D|d)ear';
my $replace = 'eer';
$text =~ s/$pattern/$1$replace/gi;
--
Charles DeRykus
------------------------------
Date: Tue, 11 Sep 2012 19:55:15 -0700 (PDT)
From: Jason C <jwcarlton@gmail.com>
Subject: Re: Setting backreference inside of a string
Message-Id: <56e9bfa9-05d0-49f4-a14c-0e638bfc026a@googlegroups.com>
On Tuesday, September 11, 2012 4:50:20 PM UTC-4, C.DeRykus wrote:
> One way to avoid an 'ee' solution's drawbacks
> is just pull the backref out of the pattern:
>
> my $pattern = '(D|d)ear';
> my $replace = 'eer';
>
> $text =~ s/$pattern/$1$replace/gi;
That was my original thought, too, but I also have rows where the () isn't at the beginning. Eg:
$pattern = 'smart(\s)*ass';
$replace = 'smart$1butt';
I really would like to avoid using /ee, though, for the security reasons mentioned earlier.
Maybe something like:
$text = "Yes dear!";
$pattern = '(D|d)ear';
$replace = '$1eer';
# if $pattern doesn't contain a backreference
# create an empty one
if ($pattern !~ /\(.*?\)/g) {
$pattern = "()*?" . $pattern;
}
$replace =~ s/\$1/<marker>/g;
# now, $replace = '<marker>eer';
while ($text =~ /$pattern/g) {
$replace =~ s/<marker>/$1/g;
$text =~ s/$pattern/$replace/gi;
}
I haven't tested that, I'm just spit-balling the logic. Thoughts?
------------------------------
Date: Tue, 11 Sep 2012 21:08:31 -0700 (PDT)
From: "C.DeRykus" <derykus@gmail.com>
Subject: Re: Setting backreference inside of a string
Message-Id: <fda2e821-b4e8-4f49-ba86-e22e74d6386b@googlegroups.com>
On Tuesday, September 11, 2012 7:55:15 PM UTC-7, Jason C wrote:
> On Tuesday, September 11, 2012 4:50:20 PM UTC-4, C.DeRykus wrote:
>
>
>
> > One way to avoid an 'ee' solution's drawbacks
>
> > is just pull the backref out of the pattern:
>
> >
>
> > my $pattern = '(D|d)ear';
>
> > my $replace = 'eer';
>
> >
>
> > $text =~ s/$pattern/$1$replace/gi;
>
>
>
> That was my original thought, too, but I also have rows where the () isn't at the beginning. Eg:
>
>
>
> $pattern = 'smart(\s)*ass';
>
> $replace = 'smart$1butt';
>
>
>
> I really would like to avoid using /ee, though, for the security reasons mentioned earlier.
>
>
>
> Maybe something like:
>
>
>
> $text = "Yes dear!";
>
> $pattern = '(D|d)ear';
>
> $replace = '$1eer';
>
>
>
> # if $pattern doesn't contain a backreference
>
> # create an empty one
>
> if ($pattern !~ /\(.*?\)/g) {
>
> $pattern = "()*?" . $pattern;
>
> }
>
>
>
> $replace =~ s/\$1/<marker>/g;
>
> # now, $replace = '<marker>eer';
>
>
>
> while ($text =~ /$pattern/g) {
>
> $replace =~ s/<marker>/$1/g;
>
> $text =~ s/$pattern/$replace/gi;
>
> }
>
>
>
>
>
> I haven't tested that, I'm just spit-balling the logic. Thoughts?
I'm not sure I follow entirely but, IMO, separate regexes would be much easier and more maintainable
than trying to do this in a single regex.
Only if there's a huge bottleneck, would I bother,
trying to re-factor...
--
Charles DeRykus
------------------------------
Date: Tue, 11 Sep 2012 21:32:46 -0700 (PDT)
From: Jason C <jwcarlton@gmail.com>
Subject: Re: Setting backreference inside of a string
Message-Id: <207dfb99-5231-473f-b109-a03e6e939cc8@googlegroups.com>
On Wednesday, September 12, 2012 12:08:32 AM UTC-4, C.DeRykus wrote:
> I'm not sure I follow entirely but, IMO, separate regexes would be much easier and more maintainable
>
> than trying to do this in a single regex.
>
> Only if there's a huge bottleneck, would I bother,
> trying to re-factor...
You might have missed it before, but on the live site, $pattern and $replace are coming from a database. Like so:
my $sth = $dbh->prepare("SELECT * FROM table");
$sth->execute();
while (($pattern, $replace) = $sth->fetchrow_array()) {
$text =~ s/(\b*)$pattern(er|in|ing|s|ed|y|\b)/$1$replace$+/gi;
}
The first group in $pattern can actually be anywhere in the string, so one row might be:
(D|d)ear
while the next might be:
smart(\s*)ass
The issue comes in where $1 is defined as non-interpretive in the database, and I'm not sure how to make it interpretive in the replacement.
The while() loop that I presented in the last post is an attempt to replace the non-interpretive '$1' with '<marker>', then replace '<marker>' back with the interpretive "$1".
------------------------------
Date: Wed, 12 Sep 2012 09:55:48 +0000 (UTC)
From: Willem <willem@turtle.stack.nl>
Subject: Re: Setting backreference inside of a string
Message-Id: <slrnk50n13.1o1k.willem@turtle.stack.nl>
Jason C wrote:
) On Tuesday, September 11, 2012 4:50:20 PM UTC-4, C.DeRykus wrote:
)
)> One way to avoid an 'ee' solution's drawbacks
)> is just pull the backref out of the pattern:
)>
)> my $pattern = '(D|d)ear';
)> my $replace = 'eer';
)>
)> $text =~ s/$pattern/$1$replace/gi;
)
) That was my original thought, too, but I also have rows where the () isn't at the beginning. Eg:
)
) $pattern = 'smart(\s)*ass';
) $replace = 'smart$1butt';
)
) I really would like to avoid using /ee, though, for the security reasons mentioned earlier.
)
) Maybe something like:
)
) $text = "Yes dear!";
) $pattern = '(D|d)ear';
) $replace = '$1eer';
)
) # if $pattern doesn't contain a backreference
) # create an empty one
) if ($pattern !~ /\(.*?\)/g) {
) $pattern = "()*?" . $pattern;
) }
)
) $replace =~ s/\$1/<marker>/g;
) # now, $replace = '<marker>eer';
)
) while ($text =~ /$pattern/g) {
) $replace =~ s/<marker>/$1/g;
) $text =~ s/$pattern/$replace/gi;
) }
It would be easier to do the whole thing in a /e expression.
But not interpreting the database string, but just adding your own code.
Like this:
$test =~ s/$pattern/my $s1 = $1; (my $t = $replace) =~ s|\$1|$s1|g; $t/ge;
That should work.
If you want more than just $1, you need a slightly more complicated
expression, probably involving @- and @+.
(I've always wondered why there is no regex-match array perlvar...)
SaSW, Willem
--
Disclaimer: I am in no way responsible for any of the statements
made in the above text. For all I know I might be
drugged or something..
No I'm not paranoid. You all think I'm paranoid, don't you !
#EOT
------------------------------
Date: Wed, 12 Sep 2012 14:28:52 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: Setting backreference inside of a string
Message-Id: <k9f6i9-ajr2.ln1@anubis.morrow.me.uk>
Quoth Jason C <jwcarlton@gmail.com>:
>
> That was my original thought, too, but I also have rows where the ()
> isn't at the beginning. Eg:
>
> $pattern = 'smart(\s)*ass';
> $replace = 'smart$1butt';
>
> I really would like to avoid using /ee, though, for the security reasons
> mentioned earlier.
>
> Maybe something like:
<snip>
>
> $replace =~ s/\$1/<marker>/g;
> # now, $replace = '<marker>eer';
>
> while ($text =~ /$pattern/g) {
> $replace =~ s/<marker>/$1/g;
> $text =~ s/$pattern/$replace/gi;
> }
>
> I haven't tested that, I'm just spit-balling the logic. Thoughts?
That, IMHO, is basically the right approach, but you don't want to use a
fixed string like "<marker>" because it might appear in the source text.
Instead, you want something like this:
sub dosubst {
my ($repl, $one) = @_;
$repl =~ s/\$(?:\{1\}|1)/$one/g;
$repl;
}
$text =~ s/$pattern/dosubst $replace, $1/gie;
This assumes the replacement only uses $1. If you want to use arbitrary
captures, it gets a little more difficult, since perl doesn't provide an
array-of-all-the-captures variable. You would need to pass $text, \@-
and \@+ into dosubst, and pull the captures out as required.
Ben
------------------------------
Date: Tue, 11 Sep 2012 12:45:30 -0700 (PDT)
From: Nene <rodbass63@gmail.com>
Subject: Test::More with suexec
Message-Id: <94730e3d-cfa8-4955-b325-957a7cfa6580@googlegroups.com>
I'm trying to create a test with Test::More.
The command I"m issuing in the perl script is /usr/sbin/suexec -V, which will output:
-D AP_DOC_ROOT="/home"
-D AP_GID_MIN=500
-D AP_HTTPD_USER="apache"
-D AP_LOG_EXEC="/var/log/httpd/suexec_log"
-D AP_SAFE_PATH="/usr/local/bin:/usr/bin:/bin"
-D AP_UID_MIN=500
-D AP_USERDIR_SUFFIX="Sites/default/htdocs"
But my test is not working:
#!/usr/bin/perl
use warnings;
use strict;
use Test::More 'no_plan';
like(`/usr/sbin/suexec -V`, qr/apache/, "suexec is configured");
I"m getting:
not ok 1 - suexec is configured
# Failed test 'suexec is configured'
# at ./x.t line 6.
# ''
# doesn't match '(?-xism:apache)'
1..1
# Looks like you failed 1 test of 1.
Does anybody have a clue, I'm thinking it's the way suexec -V outputs is the culprit?
------------------------------
Date: Tue, 11 Sep 2012 23:31:11 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: Test::More with suexec
Message-Id: <fmq4i9-jhb1.ln1@anubis.morrow.me.uk>
Quoth Nene <rodbass63@gmail.com>:
> I'm trying to create a test with Test::More.
>
> The command I"m issuing in the perl script is /usr/sbin/suexec -V, which
> will output:
>
> -D AP_DOC_ROOT="/home"
> -D AP_GID_MIN=500
> -D AP_HTTPD_USER="apache"
> -D AP_LOG_EXEC="/var/log/httpd/suexec_log"
> -D AP_SAFE_PATH="/usr/local/bin:/usr/bin:/bin"
> -D AP_UID_MIN=500
> -D AP_USERDIR_SUFFIX="Sites/default/htdocs"
>
> But my test is not working:
>
> #!/usr/bin/perl
> use warnings;
> use strict;
>
> use Test::More 'no_plan';
>
> like(`/usr/sbin/suexec -V`, qr/apache/, "suexec is configured");
>
> I"m getting:
>
> not ok 1 - suexec is configured
> # Failed test 'suexec is configured'
> # at ./x.t line 6.
> # ''
> # doesn't match '(?-xism:apache)'
> 1..1
> # Looks like you failed 1 test of 1.
>
> Does anybody have a clue, I'm thinking it's the way suexec -V outputs is
> the culprit?
Likely suexec is sending that output to stderr rather than stdout, so
you want `/usr/sbin/suexec 2>&1` instead.
Ben
------------------------------
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 3777
***************************************
