If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
Parse for a list in a long string
4 direct replies — Read more / Contribute
by vitoco
on Jun 02, 2015 at 13:00

    I want to get a list of items from a long text string with a given format. The format is pretty simple, but the number of items in the list is variable, also it is the number of lists in the same string. Of course, there are many other things in the string that must be discarded.

    I tried a single regular expression to capture the items to an array, but I can get only the first or the last element or each identified list...

    This is a test code:

    #!perl use strict; use warnings; while (<DATA>) { chomp; s!\s+! !g; my $txt = $_; print "$_\n"; my @items = (); print "FOUND: @items\n" if (@items = ($txt =~ m!\btest \w+(?:(?: is) +? \w+)?(?: ?, ?(\w+)(?:(?: is)? \w+)?)+!ig)); } __DATA__ this line has nothing, nothing, nothing... 1 , 2, 3, 4 is four, 5, 6 test 00,11 is one,22, 33 is three,44,55 is + the best, and this is not a test 111, 222, 333 as random words to + finish this should be a test, but nothing must be returned 4444, 7777, 9999 i +s garbage

    In this example, the lists starts with the string "test", the elements are delimited by a comma, each element could be followed by an optional "is" and another word (must be discarded), and the first element of the list is not important and must be ignored. The given data has 3 lines, and only the 2nd one has two lists, the 1st and 3rd have none. The expected result is:

    FOUND: 11 22 33 44 55 222 333

    What I got is:

    FOUND: 55 333

    If I remove the last plus sign, I get:

    FOUND: 11 222

    If I remove the "g" modifier, I get only one list (with one item):

    FOUND: 55

    What am I missing?

    Thanks!!!

problem with interpolation in an email delivered by mailx
3 direct replies — Read more / Contribute
by tommysmuffins
on Jun 02, 2015 at 12:40

    I have the following subroutine:

    sub email_warning { my $threshhold_value = $ARGV[0]; my $current_load_avg = &run_sar(); my $email_body = "15 minute load average of $current_load_avg has +equaled or exceeded the threshhold you specified: $threshhold_value"; open (MAIL, "|mailx -s \"15 minute load average warning\" wentwort +h\@localhost"); # print $email_body; print MAIL $email_body; close MAIL; }

    The email body I receive contains only the part of $email_body up to and including the $current_load_avg variable. e.g. "15 minute load average of 4.01" and nothing after that. I'm guessing it has to do with mailx, because if I print the $email_body scalar, it looks fine. I'm perplexed.

    UPDATE: OK, this is resolved. Toolic was right, printing $current_load_avg as a test printed it on a line by itself.

    As it happens, that troublesome newline character was the only thing making the email send successful. When I chomped it, all the generated emails had null message bodies. I had to add a "\n" to the

    print MAIL $email_body;

    statement.

    Thanks everyone for the help.
Annotations for Perl
6 direct replies — Read more / Contribute
by hurricup
on Jun 02, 2015 at 12:15

    Hello Perl coders!

    Got a problem and possible solution, need a feedback from community.

    As you may know, I'm currently working on Perl5 plugin for Intellij IDEA, and work is going fine, it works and can do a lot of useful things. But i've encountered a problem.

    In order to link sub usage and it's definition or declaration, i need to know, in which namespace to look. And it's not a problem when you are using obvious calls:

    somesub(); # just looking current namespace Foo::Bar::somesub(); # obviously, looking in Foo::Bar # and now you can even do this: my Foo::Bar $object; $object->somesub(); # will understand that it's a Foo::Bar's sub

    But, what to do when it's used like:

    Foo::Bar->new()->some_geter()->somethingelse();

    Of course, it's possible to constantly work on smart algorythms, which will be able to analyse previous sub in "dereference" chain and try to guess, what was returned.

    But it's an endless work as a Perl itself and resourse-consuming.

    I belive that the best way here is to introduce a Java-like annotations:

    #@Returns Foo::Bar sub somefunc{ ... }

    Here, IDE parser can easily find out, that somefunc returns Foo::Bar object. And from the Perl's perspective, it's still just a comment.

    Currently thinking about following annotations:

    • #@override - marks that method overrides something from one of the parents
    • #@deprecated - marks that method is deprecated
    • #@returns Package::Name - marks that method returns an object of Package::Name
    • #@returns [Package::Name] - array of objects
    • #@returns {Package::Name} - hash with objects as values

    There are lot of useful IDE hints could be, like #@defined, #@undefinable and so on, but these above i really need.

    I thought about using attributes, but not sure it's such good idea, and, btw, it would be easy to convert such form of annotations to another one if Perl devs introduce something useful for this.

    Really need a feedback and ideas.

Devel::Cover HTML report process killed
1 direct reply — Read more / Contribute
by santosh044
on Jun 02, 2015 at 08:44
    I have test suite with over 200+ selenium test cases where in each I capture the coverage using Devel::Cover. After all the test cases are run, when I try to generate the HTML report using 'cover cover_db -report html' the process is killed after consuming all the memory nearly 16 GB with error out of memory. Any idea how to resolve this? Any help would be great
Perl OLE Excel Sort By Color
2 direct replies — Read more / Contribute
by martinslmn
on Jun 02, 2015 at 08:10
    Hi All, I am trying to sort Excel Sheet by colors. I am using OLE. I have generated the following Macro. But I am having hard time converting it into Perl.
    ActiveWorkbook.Worksheets("ami_emr_appointments").Sort.SortFields.Clea +r ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range( _ "A2:A4680"), xlSortOnCellColor, xlAscending, , xlSortNormal).S +ortOnValue.Color _ = RGB(255, 0, 0) ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range( _ "A2:A4680"), xlSortOnCellColor, xlAscending, , xlSortNormal).S +ortOnValue.Color _ = RGB(255, 255, 0) ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range( _ "B2:B4680"), xlSortOnCellColor, xlAscending, , xlSortNormal).S +ortOnValue.Color _ = RGB(255, 255, 0) ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range( _ "C2:C4680"), xlSortOnCellColor, xlAscending, , xlSortNormal).S +ortOnValue.Color _ = RGB(255, 255, 0) ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range( _ "B2:B4680"), xlSortOnCellColor, xlAscending, , xlSortNormal).S +ortOnValue.Color _ = RGB(255, 255, 0) With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A1:W4680") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With
    Can you please help by pointing me in the right direction? Previously I was using manual sorting on Excel 2003 using the following code. It takes a long time to complete. As latest versions of Excel supports Sort by Colour, I would like to move to it. This will give you an idea on what I am looking for.
    sub sortByColor() { my $filename = $_[0]; my $no_of_columns = $_[1]; say "Activate $filename"; say "No Of COlumns = $no_of_columns"; $excel->{DisplayAlerts}=0; $excel->Windows($filename)->Activate; $workbook = $excel->Activewindow; $sheet1=$workbook-> Activesheet; my $rows= $sheet1->UsedRange->Rows->{'Count'}; my $cols= $sheet1->UsedRange->Columns->{'Count'}; my $red_count = 0; my $sorted_count = 0; foreach my $row ( 2 .. $rows ) { #next unless defined $sheet1->Cells($row,1)->{'Value'}; my $Range = $sheet1->Range("A$row:A$row"); if ($Range->Interior()->ColorIndex() == 3) { $sheet1->rows($row . ":" . $row)->cut(); my $rngIns=$sheet1->Range(($red_count+2) . ":" . ($red_cou +nt+2)); $rngIns->EntireRow->Insert; $sheet1->rows(($red_count+2) . ":" . ($red_count+2))->Sele +ct(); $sheet1->paste(); $red_count = $red_count + 1; $sorted_count = $sorted_count + 1; } } my $column =""; foreach my $col ( 1 .. $no_of_columns) { $column = colIdToString($col); foreach my $row ( ($sorted_count+2) .. $rows ) { #next unless defined $sheet1->Cells($row,$col)->{'Value'}; my $Range = $sheet1->Range("$column$row:$column$row"); if ($Range->Interior()->ColorIndex() == 6 ) { $sheet1->rows($row . ":" . $row)->cut(); my $rngIns=$sheet1->Range(($sorted_count + 2) . ":" . +($sorted_count+2)); $rngIns->EntireRow->Insert; $sheet1->rows(($sorted_count + 2) . ":" . ($sorted_cou +nt+2))->Select(); $sheet1->paste(); $sorted_count = $sorted_count + 1; } } } }
    Thanks
dbd-mysql permission denied
2 direct replies — Read more / Contribute
by bennY
on Jun 02, 2015 at 07:29
    Hello, i have a strange problem with spamassassin related to the Perl SQL Module. Everything worked like a charm until i decided to install a new Perl Module which was required for an additional spamassassin module.. and now i'm getting this when running spamassassin in debug mode:
    Jun 2 13:03:41.779 [2653] warn: config: failed to load user (xxx@xxx. +de) scores from SQL database: install_driver(mysql) failed: Can't loc +ate DBD/mysql.pm: lib/DBD/mysql.pm: Permission denied at (eval 1204) +line 3, <GEN17> line 2. Jun 2 13:03:41.780 [2653] warn: Jun 2 13:03:41.780 [2653] warn: at /usr/share/perl5/Mail/SpamAssassi +n/Conf/SQL.pm line 138. Jun 2 13:03:41.780 [2653] warn: spamd: service unavailable: Error fet +ching user preferences via SQL
    I installed the required Perl Module with these commands:
    cpan cpan App::cpanminus cpanm Mail::DKIM
    Any Idea what happened ? The System is Debian Jessie (64Bit) Thank you! Greetings bennY
svn sync with perlscript
3 direct replies — Read more / Contribute
by karthik.raju
on Jun 02, 2015 at 07:16

    Hi All, In one of my project, we need to automate the svnsync process between two repositories through Perl script.

    And when we run the perl script with the following code then it is working fine.

    system('svnsync sync https://xxxxxx64.xxx-xxx.com/svn/repo2/');

    But when we are trying to call the same script from pre-commit.bat hook it is not working,

    can any one help on this.

    Thanks in advance.

    -Karthik

need help Not printing the output
2 direct replies — Read more / Contribute
by ulakshmi
on Jun 02, 2015 at 05:26
    ($rc,$outputHash)= $::device2->SEOS->Subscriber->Active(INPUT => \%INP +UTS, SUB_REC_APP => \%SUB_ATTRS_APP_DUAL, SUB_REC_EXP => \%SUB_ATTRS_EXP_DUAL, SUB_REC_EXT => \@SUB_ATTRS_EXT); $::test->checkPoint($rc, "CHECKPOINT for verifying subscriber +attributes."); $circuitHash{$sub} = $outputHash->{"Circuit"}; $internalCircuitHash{$sub} = $outputHash->{"Internal Circuit"} +; my %ipHostEntryArrayReferenceHash; $ipHostEntryArrayReferenceHash{$sub} = $outputHash->{"IP host +entries installed by DHCP"}; $ipAddressHash{$sub} = (split /\s+/, $ipHostEntryArrayReferenc +eHash{$sub}->[0])[0]; $outputHash->{"Framed-IPV6-Prefix"} =~ /^(.*)\s+\(applied/; $framedIpv6PrefixHash{$sub} = $1; $pdPrefixArrayReferenceHash{$sub} = $outputHash->{"ipv6host en +tries installed by PD"}; $pdPrefixHash{$sub} = $pdPrefixArrayReferenceHash{$sub}->[0]; $::test->log_info("Circuit: $circuitHash{$sub}."); $::test->log_info("Internal Circuit: $internalCircuitHash{$sub +}."); $::test->log_info("IP address: $ipAddressHash{$sub}"); $::test->log_info("Framed-IPV6-Prefix: $framedIpv6PrefixHash{$ +sub}."); $::test->log_info("ipv6PrefixHash: $pdPrefixHash{$sub}."); #} if ($subscriberMetaData{protocolstack}->{$sub} eq "IPV4") { $::test->log_info("\n#---------------------------------------- +-----------------------------------"); $::test->log_info("Extracting & verifying attributes for subsc +riber $sub for v4."); $::test->log_info("#------------------------------------------ +---------------------------------"); my %INPUTS=(CONTEXT => $::CONTEXT, USERNAME => $sub); }
Add a segment in a JPG image with Image::MetaData::JPEG
2 direct replies — Read more / Contribute
by neoldschool
on Jun 02, 2015 at 05:20

    HI ! I want to add an APP segment in a jpg image with the Image::MetaData::JPEG module.

    The following code add an APP2 segment inside the jpg, but it seems to be empty as it only add \0xffe200002 in the file, which means: an APP2 segment (\0xffe2) of length 2 (\0x0002) (the marker plus the length's length = 2, basically an empty segment).

    perl run.pl test.jpg
    use strict; use warnings; use Image::MetaData::JPEG; use Image::MetaData::JPEG::Record; use Image::MetaData::JPEG::data::Tables qw(:JPEGgrammar :Endianness :RecordTypes); use Data::Dumper; #read the image filname from the command line arguments my $file = new Image::MetaData::JPEG($ARGV[0]); #add MP header information in the APP2 segment in the image my $buffer; my $segref = new Image::MetaData::JPEG::Segment('APP2', $buffer, 'NOPA +RSE'); my $head = "MPF0"; my $recref = $segref->store_record('MP_HEADER', $LONG, \$head, 1); print Dumper $segref; $file->insert_segments($segref); #save $file->save('tmp1.jpg');

    Output

    $VAR1 = bless( { 'dataref' => \'', 'endianness' => undef, 'error' => undef, 'records' => [ bless( { 'values' => [ 1297106480 ], 'extra' => undef, 'key' => 'MP_HEADER', 'type' => 4 }, 'Image::MetaData::JPEG::Reco +rd' ) ], 'name' => 'APP2' }, 'Image::MetaData::JPEG::Segment' );

    How can I add a segement in a JPG with this module, how to use the insert_segments function properly ? especially the $buffer variable. thanks !
greedy subexpression between two nongreedy ones
6 direct replies — Read more / Contribute
by raygun
on Jun 02, 2015 at 00:32

    I am performing a substitution on strings that fall between two anchors. A certain substring -- say, "cd" -- may or may not appear as part of the string I'm matching. If it does, I need to capture it.

    In my examples below, the anchors are commas, but in reality they are complex regular expressions, so that I can't just use [^,]* to avoid steamrolling over them.

    In essence, the substitution will be some variation on

    s/,.*(cd)?.*,/=$1=/

    Making the two .* subexpressions nongreedy while keeping the (cd)? greedy would seem to express exactly what I'm trying to do, except for the slight inconvenience that it doesn't work:

    echo ,abcdefg,abcdefg | perl -pe 's/,.*?(cd)?.*?,/=$1=/'

    I want a captured "cd" between the two equal signs, but the $1 remains empty. The problem seems to be that .*? is apparently not merely nongreedy but also unaccommodating: It won't even consume enough to allow the following greedy subexpression to match. It's not clear to me why a nongreedy expression would consume enough to match a required subexpression (i.e. if I omitted the ? after (cd)), but not an optional but greedy one.

    I can make the expression capture the "cd" if I make my first subexpression a little more explicit:

    echo ,abcdefg,abcdefg, | perl -pe 's/,(?:(?!cd).)*(cd)?.*?,/=$1=/'

    This gives me the desired output of "=cd=abcdefg,". But this fails if the part between the anchors does not contains a "cd":

    echo ,abcefg,abcdefg, | perl -pe 's/,(?:(?!cd).)*(cd)?.*?,/=$1=/'

    Here, the desired output is "==abcdefg,", but the greedy subexpression ignores the anchor boundary and goes into the section of the string following it to find a "cd".

    I've tried various other things but not yet found something that works. How do I get the $1 to be populated with a "cd" if it appears in the string, and remain empty if it doesn't, while staying between the anchors?


Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.