[32011] in Perl-Users-Digest
Perl-Users Digest, Issue: 3275 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Feb 3 16:09:23 2011
Date: Thu, 3 Feb 2011 13:09:07 -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 Thu, 3 Feb 2011 Volume: 11 Number: 3275
Today's topics:
Re: access anonymous variable <tzz@lifelogs.com>
changing values in certain blocks <alfonso.baldaserra@gmail.com>
Re: changing values in certain blocks <alfonso.baldaserra@gmail.com>
Re: changing values in certain blocks <jumper99@gmx.de>
Re: dynamically naming arrays <cartercc@gmail.com>
Re: How to draw thin lines with Image::Magick? <josef.moellers@ts.fujitsu.com>
Re: matching string literals sln@netherlands.com
Re: matching string literals sln@netherlands.com
upload module to CPAN (http client) <loofort@gmail.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 03 Feb 2011 10:02:50 -0600
From: Ted Zlatanov <tzz@lifelogs.com>
Subject: Re: access anonymous variable
Message-Id: <87fws5nm1h.fsf@lifelogs.com>
On Tue, 01 Feb 2011 22:35:55 +0200 George Mpouras <nospam.gravitalsun@hotmail.com.nospam> wrote:
GM> I was doing some experiments after a discussion with my colleague
GM> about iterators and how they can protect their variables. I thought I
GM> could find a way for direct access private variable of an anonymous
GM> subroutine but maybe it is impossible after all. They are completely
GM> invisible.
GM> use Data::Dumper;
GM> $Data::Dumper::Deparse=1;
GM> print STDOUT Data::Dumper::Dumper(\%{__PACKAGE__.'::'});
The example I gave shows how to have a scope that keeps a private
variable whose value is preserved between subroutine calls, which is
usually what an iterator needs. If you explain your actual need, it
would help us answer your question better.
Ted
------------------------------
Date: Thu, 3 Feb 2011 10:19:12 -0800 (PST)
From: alfonsobaldaserra <alfonso.baldaserra@gmail.com>
Subject: changing values in certain blocks
Message-Id: <7be47dce-8a79-408f-949e-397fe4857f54@r19g2000prm.googlegroups.com>
hello again,
i have a bunch of nagios configuration files. the contents are as
follows
define service {
host_name chakra.example.com
service_description Disk Monitor
use disk_service
max_check_attempts 5
check_interval 5
retry_interval 1
notification_interval 60
contacts nagiosadmin
_xiwizard windows_server
register 1
}
define service {
host_name chakra.example.com
service_description Ping
use ping_service
max_check_attempts 5
check_interval 5
retry_interval 1
notification_interval 60
contacts nagiosadmin
_xiwizard windows_server
register 1
}
define service {
host_name chakra.example.com
service_description SNMP
use processes_service
check_command check_snmp_process!community!
snmp!0
max_check_attempts 5
check_interval 5
retry_interval 1
check_period xi_timeperiod_24x7
notification_interval 60
notification_period xi_timeperiod_24x7
contacts nagiosadmin
_xiwizard windows_server
register 1
}
the value of check_interval for every file is 5. i want to change
that to 60 but only for "Disk Monitor" blocks which could be anywhere
in the file. in this post that is at the top. i tried but failed so
i thought i might get some ideas from here :)
as always any pointers are appreciated. thank you
------------------------------
Date: Thu, 3 Feb 2011 10:57:56 -0800 (PST)
From: alfonsobaldaserra <alfonso.baldaserra@gmail.com>
Subject: Re: changing values in certain blocks
Message-Id: <20f5d5a1-65a4-43ac-8455-b5b1ff5e03a5@n2g2000pre.googlegroups.com>
i think i figured a working way to achieve this:
#!/usr/bin/perl
use strict;
use warnings;
use File::Copy;
$|++;
my $file = shift;
my $new = "${file}\.new";
open my $conf, "<", $file or die "$!\n";
local $/ = undef;
my $eggs = <$conf>;
close $conf;
$eggs =~ s/(.*disk_service.*?check_interval\s*)5(.*)/${1}60${2}/s;
open my $conf2, ">", $new;
print $conf2 $eggs;
close $conf2;
move $file, "${file}\.old";
move $new, $file;
__END__
i am not quite satisfied with $eggs substitution part, i believe there
should be a better way to do this. thanks.
------------------------------
Date: 3 Feb 2011 20:33:55 GMT
From: "Helmut Schneider" <jumper99@gmx.de>
Subject: Re: changing values in certain blocks
Message-Id: <xn0h9xvsrq0f0s000@news.individual.net>
alfonsobaldaserra wrote:
> i have a bunch of nagios configuration files. the contents are as
> follows
>
> define service {
> host_name chakra.example.com
> service_description Disk Monitor
> use disk_service
> max_check_attempts 5
> check_interval 5
> retry_interval 1
> notification_interval 60
> contacts nagiosadmin
> _xiwizard windows_server
> register 1
> }
>
> define service {
> host_name chakra.example.com
> service_description Ping
> use ping_service
> max_check_attempts 5
> check_interval 5
> retry_interval 1
> notification_interval 60
> contacts nagiosadmin
> _xiwizard windows_server
> register 1
> }
>
> define service {
> host_name chakra.example.com
> service_description SNMP
> use processes_service
> check_command check_snmp_process!community!
> snmp!0
> max_check_attempts 5
> check_interval 5
> retry_interval 1
> check_period xi_timeperiod_24x7
> notification_interval 60
> notification_period xi_timeperiod_24x7
> contacts nagiosadmin
> _xiwizard windows_server
> register 1
> }
>
> the value of check_interval for every file is 5. i want to change
> that to 60 but only for "Disk Monitor" blocks which could be anywhere
> in the file. in this post that is at the top. i tried but failed so
> i thought i might get some ideas from here :)
>
> as always any pointers are appreciated. thank you
Actually, you rather should include "check_interval 60" in the
"disk_service" template and remove it from the individual service
definition...
Helmut
------------------------------
Date: Wed, 2 Feb 2011 04:57:14 -0800 (PST)
From: ccc31807 <cartercc@gmail.com>
Subject: Re: dynamically naming arrays
Message-Id: <0edabba5-3f8e-499e-876b-05042339f950@d16g2000yqd.googlegroups.com>
Thanks for pointing this out to me, CC.
On Feb 1, 6:25=A0pm, Tad McClellan <ta...@seesig.invalid> wrote:
> ccc31807 <carte...@gmail.com> wrote:
> > =A0 =A0 =A0 =A0 =A0 =A0 $table =3D~ s/ //g;
> > =A0 =A0 =A0 =A0 =A0 =A0 $keys =3D~ s/ //g;
>
> Regexes are good for processing strings of characters,
> tranliteration is good for processing characters.
>
> You are processing characters.
>
> =A0 =A0 $table =3D~ tr/ //d;
> =A0 =A0 $keys =A0=3D~ tr/ //d;
>
> has the same effect and will run faster too...
>
> --
> Tad McClellan
> email: perl -le "print scalar reverse qq/moc.liamg\100cm.j.dat/"
> The above message is a Usenet post.
> I don't recall having given anyone permission to use it on a Web site.
------------------------------
Date: Wed, 02 Feb 2011 10:16:27 +0100
From: Josef Moellers <josef.moellers@ts.fujitsu.com>
Subject: Re: How to draw thin lines with Image::Magick?
Message-Id: <iib7db$tek$1@nntp.fujitsu-siemens.com>
Am 2.2.2011 schrub Steve M.:
> On Tue, 01 Feb 2011 16:17:15 +0100, Josef Moellers wrote:
>
>> Am 1.2.2011 schrub Steve M.:
>>
>>>
>>> Well...
>>>
>
>
>>> $img -> Draw (
>>> stroke => 'black',
>>> primitive => 'line',
>>> strokewidth => '1',
>>> points => '1,10 20,10',
>>> antialias => 'false',
>>> );
>>>
>>> should work.
>>
>>
>> Thanks but ... the line is still 2 pixels wide.
>>
>
>
>>
>> Josef
>>
>> NB My perl is 5.10.1, my perlmagick is "ImageMagick 6.5.7-8 2010-12-02
>> Q16 http://www.imagemagick.org"
>
>
> Hmmm...... That code worked with my Perl (5.10.1) and ImageMagick....
>
> Well, if you didn't care about fiddling with anti-alias nonsense, I
> suppose you could:
>
> for( 1..20 ){
> $img->Set("pixel[$_,10]"=>'black');
> }
>
>
> Not efficient perhaps.
It wouldn't have been a problem, I stumbled across this when I tried to
draw a small 22x22 "dia" shape.
But it helped me find my problem. It's somewhere between the keyboard
and the chair: I was fooled by gimp!
When I tried to draw this pixel-by-pixel line, I found that when I
looked at it with gimp, gimp would show two different coordinates when I
moved the cursor from one side of the line to the other, which I
definitely thought could not be the case with "Set(pixel ...)"!
So I tried to select one pixel and ... indeed the line is only one pixel
wide! A 22x22 image with 22 vertical lines shows this to be correct.
Even with $img->Draw(...) the line is only one pixel wide!
Thanks for all the help and suggestions.
Josef
--
These are my personal views and not those of Fujitsu Technology Solutions!
Josef Möllers (Pinguinpfleger bei FTS)
If failure had no penalty success would not be a prize (T. Pratchett)
Company Details: http://de.ts.fujitsu.com/imprint.html
------------------------------
Date: Wed, 02 Feb 2011 12:50:33 -0800
From: sln@netherlands.com
Subject: Re: matching string literals
Message-Id: <173jk61t05ph0p9n6867cl1rah9n0shka6@4ax.com>
On Tue, 01 Feb 2011 15:57:04 -0800, sln@netherlands.com wrote:
>On Tue, 1 Feb 2011 15:45:55 -0800 (PST), Morfys <morfysster@gmail.com> wrote:
>
>>Hello,
>>
>>I would like to able to match strings with several uninterpreted
>>characters (for instance, "/", "-", "(", and "=").
>>
>>Ideally, I would like to not have to escape each of these characters
>>with a "\", as I have many different strings with many special
>>characters to try to match.
>>
>>Is there any way to force the search of a string literally?
>>
>>I have tried m/\Q $string \E/, but the issue is that $string can
>>contain "/", which perl interprets rather than taking it literally.
>>
>>Thank you in advance.
>
>Try m{\Q $string \E}.
>As a side note, $string has spaces around it that is literal in the
>regex unless m//x
>
To correct myself, '/' has no special meaning inside of regex's,
its taken as a literal.
The problem is that as you see it, '/' is being used as a delimeter
that Perl, when you say m//, uses to parse out the regex.
Either s/// or m//. Any character can be used as the delimeter.
Example:
m/ $string / parses out ' $string '
m# $string /# parses out ' $string /'
m/ $string/ / syntax error, one too many delimeters '/'
The regex is parsed, variable interpolation is done,
then the regex is evaluated for proper syntax.
But, it is parsed first. So any character in $string used as a
delimeter before parsing is not considered a parsing character
because parsing is already done.
You can use different characters for the delimeter, but some
delimeter characters have special meaning to the parser.
See perlop manpage for m// and also quote like operators.
quotemeta EXPR:
-----------------
This documentation (perlfunc man page), says:
"Returns the value of EXPR with all non-"word" characters backslashed."
e.g. NOT /[A-Za-z_0-9]/
Why do they do this? To take away special escape characters and
the possibility of quantifier construct-punctuation.
Unfortunately, they ruin the entire string if you actually want
any of these (especially the escape character) in there. The net result
is that everything in the string is innoculated, but this throws
out the baby with the bathwater.
The best thing to do is learn what the perl special characters are,
ie: its metacharacters, then do your own escaping where needed.
----------
Quotemeta does this:
(my $tmp_str = $string) =~ s/(^\W)/\\$1/g;
Since quotemeta() escapes all non-word characters, you could exclude
some chararacters from being escaped with a negative class.
s/([^\W\\])/\\$1/g;
For instance [^\W\\] will escaped all non-words but won't escape
'\' itself. So, you could run your $string through this:
(my $tmp_str = $string) =~ s/([^\W\\])/\\$1/g;
Add any other characters to the negative class you don't want to be escaped.
You could also create a custom character property class using the
\p{} or \P{} construct. In that class you could just define the metachars
then use that to escape just those characters.
Like,
(my $tmp_str = $string) =~ s/(\p{InMyclass})/\\$1/g;
or possibly without the '\' escape character itself,
(my $tmp_str = $string) =~ s/([^\P{InMyclass}\\])/\\$1/g;$string =~ /
More often then not, if searching for a literal '\n' or other literal
control characters, the '\' is not desired to be escaped.
---------
Here is some code you could test out that illustrates these options...
Wether or not the \p{} construct invokes some mega unicode database
I'm not sure of, or if there is a performance hit. If it is, its just
a one time event.
Cheers,
-sln
---------
use warnings;
use strict;
sub InMeta {
# {}[]()^$.|*+?\
return <<END;
7b
7d
5b
5d
28
29
5e
24
2e
7c
2a
2b
3f
5c
END
}
my $rx = q!{}[]()^$.|*+?\<--meta, word-->ABCabc123_, newline \n!;
# Compressed:
# (my $rx_quoted_meta1 = $rx) =~ s/(\p{InMeta})/\\$1/g;
# (my $rx_quoted_meta2 = $rx) =~ s/([^\P{InMeta}\\])/\\$1/g;
# (my $rx_quoted_all1 = $rx) =~ s/(\W)/\\$1/g;
# (my $rx_quoted_all2 = $rx) =~ s/([^\w\\])/\\$1/g;
(my $rx_quoted_meta1 = $rx) =~ s/
(
\p{InMeta} # Custom meta class
)
/\\$1/xg;
(my $rx_quoted_meta2 = $rx) =~ s/
(
[^ # Negative class
\P{InMeta} # not meta class (result = include meta chars)
\\ # '\' escapes (exclude)
]
)
/\\$1/xg;
(my $rx_quoted_all1 = $rx) =~ s/(\W)/\\$1/xg;
(my $rx_quoted_all2 = $rx) =~ s/
(
[^ # Negative class
\w # words (exclude)
\\ # '\' escapes (exclude)
]
)
/\\$1/xg;
my $rx_Q = quotemeta $rx;
print "Original:\n$rx\n\n";
print "Quoted meta:\n$rx_quoted_meta1\n\n";
print "** Quoted meta, not \\:\n$rx_quoted_meta2\n\n";
print "Quoted all, not words:\n$rx_quoted_all1\n\n";
print "Quotemeta function:\n$rx_Q\n\n";
print "Quoted all, not words, not \\:\n$rx_quoted_all2\n\n";
__END__
Original:
{}[]()^$.|*+?\<--meta, word-->ABCabc123_, newline \n
Quoted meta:
\{\}\[\]\(\)\^\$\.\|\*\+\?\\<--meta, word-->ABCabc123_, newline \\n
** Quoted meta, not \:
\{\}\[\]\(\)\^\$\.\|\*\+\?\<--meta, word-->ABCabc123_, newline \n
Quoted all, not words:
\{\}\[\]\(\)\^\$\.\|\*\+\?\\\<\-\-meta\,\ word\-\-\>ABCabc123_\,\ newline\ \\n
Quotemeta function:
\{\}\[\]\(\)\^\$\.\|\*\+\?\\\<\-\-meta\,\ word\-\-\>ABCabc123_\,\ newline\ \\n
Quoted all, not words, not \:
\{\}\[\]\(\)\^\$\.\|\*\+\?\\<\-\-meta\, word\-\-\>ABCabc123_\, newline \n
------------------------------
Date: Wed, 02 Feb 2011 12:54:06 -0800
From: sln@netherlands.com
Subject: Re: matching string literals
Message-Id: <pugjk6d0dop1a66jhi1rshn3og3s7jhoa7@4ax.com>
On Wed, 02 Feb 2011 12:50:33 -0800, sln@netherlands.com wrote:
>On Tue, 01 Feb 2011 15:57:04 -0800, sln@netherlands.com wrote:
>
>----------
>
>Quotemeta does this:
> (my $tmp_str = $string) =~ s/(^\W)/\\$1/g;
^^^^^^
(my $tmp_str = $string) =~ s/(\W)/\\$1/g;
or
(my $tmp_str = $string) =~ s/([^\w])/\\$1/g;
Typo's.
-sln
------------------------------
Date: Thu, 3 Feb 2011 07:46:12 -0800 (PST)
From: Loofort <loofort@gmail.com>
Subject: upload module to CPAN (http client)
Message-Id: <5964fa37-8869-43cd-a69e-37d1506d3e19@r19g2000prm.googlegroups.com>
Hello all.
I'm developing perl http and ftp clients and want to upload it to
CPAN. It's my very first time. http://perldoc.perl.org/perlnewmod.html
told that it is good idea to discuss module with folk before upload.
So please point me to the right direction if I'm doing something
wrong. Here is short description :
- it works under linux
- based on EV and Coro
- support http/1.1, https, socks5
- several times faster than Coro::LWP
I think to prefix packages with "CTX" - meaning "context" since http
(and specially ftp) works in context - pass the cookies, understand
relative links, keep alive connections etc.
Here is file distribution:
CTX/
HTTP.pm - CTX::HTTP - based on CTX::EV::HTTP and used Coro
FTP.pm - CTX::FTP (similar to CTX::HTTP)
EV/
HTTP.pm - CTX::EV::HTTP based on EV event loop, get
CTX::EV::Socket (or Socks5 ) as connection constructor (cc)
FTP.pm - CTX::EV::FTP similar to CTX::EV::HTTP
FTP/
Command.pm
Data.pm
Socket.pm - CTX::EV::Socket - cc
Socks5.pm - CTX::EV::Socks5, get CTX::EV::Socket or
CTX::EV::Socks5 as cc
The simple example bellow makes 100 requests simultaneously :
use strict;
use CTX::HTTP;
async {
my $http = CTX::HTTP->new();
my $resp = $http->get('http://www.example.com/');
print "response code: ".$resp->code."\n";
} foreach (1..100);
EV::loop;
------------------------------
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 3275
***************************************
