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
Using XPaths with XML::LibXML and XPathContext
2 direct replies — Read more / Contribute
by worik
on Jun 02, 2015 at 19:24

    I am trying to parse some simple XML in XML::LibXML and I have struck a problem. The domain is WebDAV.

    A PROPFIND request from a user can send some very simple XML, but in a variety of semantically identical but syntactically different forms.

    For a simple example:

    <?xml version="1.0" encoding="utf-8" ?> <propfind xmlns="DAV:"> <propname/> </propfind>
    <?xml version="1.0" encoding="utf-8" ?> <D:propfind xmlns:D="DAV:"> <D:propname/> </D:propfind>

    TO get the 'propfind' node valid XPaths are

    //propname
    //DAV:propname
    /propfind/propname
    /DAV:propfind/DAV:propname

    surely? But none of them work with XPathContext except in one special case (below) where there is no need for it anyway.

    Below are my test code and the results. In it I register 'D' as a prefix for 'DAV:' and so using a XPath with 'D' as prefix works where the XML uses it too. But that is not good enough for where the XML uses 'DAV:' as a default namespace 'D' as a prefix should work too. Surely?

    #!/usr/bin/perl -w use strict; use XML::LibXML; sub testfn { my $content = shift or die; my $xpath = shift or die; $|++; my $parser = XML::LibXML->new(); my $dom = $parser->parse_string($content); my @propfind = (); @propfind = $dom->findnodes($xpath); print ref($dom)."::findnodes('$xpath') (NOT XPathContext) ". scalar(@propfind)." nodes\n"; my $xc = XML::LibXML::XPathContext->new($dom); $xc->registerNs('D', 'DAV:'); @propfind = $xc->findnodes($xpath); print ref($xc)."::findnodes('$xpath') ".scalar(@propfind)." nodes\ +n"; } # Example from RFC4918 my $txt1 = '<?xml version="1.0" encoding="utf-8" ?> <D:propfind xmlns:D="DAV:"> <D:propname/> </D:propfind> '; my $txt2 = '<?xml version="1.0" encoding="utf-8" ?> <propfind xmlns="DAV:"> <propname/> </propfind> '; my $xpath1 = '/DAV:propfind/DAV:propname'; my $xpath2 = '/propfind/propname'; my $xpath3 = '/D:propfind/D:propname'; print "\$txt1\n".$txt1."\n"; print "\$txt1 \$xpath1 \n"; eval { &testfn($txt1, $xpath1); }; if($@){ print "Failed \$xpath $xpath1\n"; } print "\$txt1 \$xpath2 \n"; eval{ &testfn($txt1, $xpath2); }; if($@){ print "Failed \$xpath $xpath2\n"; } print "\$txt1 \$xpath3 \n"; eval{ &testfn($txt1, $xpath3); }; if($@){ print "Failed \$xpath $xpath3\n"; } print "\$txt2\n".$txt2."\n"; print "\$txt2 \$xpath1 \n"; eval{ &testfn($txt2, $xpath1); }; if($@){ print "Failed \$xpath $xpath1\n"; } print "\$txt2 \$xpath2 \n"; eval { &testfn($txt2, $xpath2); }; if($@){ print "Failed \$xpath $xpath2\n"; } print "\$txt2 \$xpath3 \n"; eval { &testfn($txt2, $xpath3); }; if($@){ print "Failed \$xpath $xpath3\n"; }

    The results:

    $txt1 <?xml version="1.0" encoding="utf-8" ?> <D:propfind xmlns:D="DAV:"> <D:propname/> </D:propfind> $txt1 $xpath1 Failed $xpath /DAV:propfind/DAV:propname $txt1 $xpath2 XML::LibXML::Document::findnodes('/propfind/propname') (NOT XPathConte +xt) 0 nodes XML::LibXML::XPathContext::findnodes('/propfind/propname') 0 nodes $txt1 $xpath3 XML::LibXML::Document::findnodes('/D:propfind/D:propname') (NOT XPathC +ontext) 1 nodes XML::LibXML::XPathContext::findnodes('/D:propfind/D:propname') 1 nodes $txt2 <?xml version="1.0" encoding="utf-8" ?> <propfind xmlns="DAV:"> <propname/> </propfind> $txt2 $xpath1 Failed $xpath /DAV:propfind/DAV:propname $txt2 $xpath2 XML::LibXML::Document::findnodes('/propfind/propname') (NOT XPathConte +xt) 0 nodes XML::LibXML::XPathContext::findnodes('/propfind/propname') 0 nodes $txt2 $xpath3 Failed $xpath /D:propfind/D:propname
Perl file rename
3 direct replies — Read more / Contribute
by keltan
on Jun 02, 2015 at 19:22

    HI

    I've got problem i need to write file renamer. I know that there are topics on this forum with answers but i need to write slightly different code and i hope you will help. Yes this is my homework but i dont need direct answers i appreciate tips.
    !/usr/bin/perl -w use strict; my $dirname; $dirname = 'D:\test'; my $test = $ARGV[0]; my $test1 = $ARGV[1]; my $pattern = qr/$test/; my $pattern1 = qr/$test1/; opendir(DIR, $dirname) or die "Can't opendir $dirname: $!"; while ( defined (my $file = readdir DIR) ) { next if $file =~ /^\.\.?$/; my $new = $file; $new =~ s/$pattern/$pattern1/; rename($file,$new) }
    What i need to write is a script which after this command: ./rename *.pl "s/^/old_/" will add to all files with extension .pl prefix old_ I've been trying few approaches but all failed. Funny thing is that in other languages i don't have that problem only PERL always beat me down.
Match two files using regex
4 direct replies — Read more / Contribute
by chemshifts
on Jun 02, 2015 at 13:34

    Hello, This question was posted and answered on StackOverflow: I have two files that I would like to match based on the first letter of the second column in File1 and the first letter of the third column in File2. For example:

    File1 1 H 35 1 C 22 2 H 20 2 C 30 File 2 A 1 HB2 MET 1 A 2 CA MET 1 A 3 HA ASP 2 A 4 CA ASP 2 Output 1 MET HB2 35 1 MET CA 22 2 ASP HA 20 2 ASP CA 30
    Below is my script:
    #!/usr/bin/perl use strict; use warnings; my %data; open (SHIFTS,"file1.txt") or die; open (PDB, "file2.txt") or die; while (my $line = <PDB>) { chomp $line; my @fields = split(/\t/,$line); $data{$fields[4]} = $fields[2]; } close PDB; while (my $line = <SHIFTS>) { chomp($line); my @columns = split(/\t/,$line); my $value = ($columns[1] =~ m/^.*?([A-Za-z])/ ); } if (my $value = $data{"$_"}) print "$columns[0]\t$fields[3]\t$value\t$data{$value}\n"; close SHIFTS; exit;

    I am not sure how to implement the match, my if statement above is not correct. Any advice would be greatly appreciated.

XML Parse
3 direct replies — Read more / Contribute
by tfeitor
on Jun 02, 2015 at 13:07
    Hi everyone, I'm new with Perl and tried to parse the following xml file. I try thing's like libXML and other thing's, but I couldn't get values like code_a / name. Can someone Help me with this. Thanks in Advance Tiago
    <?xml version="1.0"?> <soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envel +ope/"> <soapenv:Body> <dlwmin:getBookById xmlns:dlwmin="http://www.test.com/integration" + xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"> <result xmlns="http://www.test.com/integration/integration"> <status> <state>0</state> </status> <books> <num>12345</num> <book> <code_a>11111</code_a> <name>Come to the Dark Side 1st Ed</name> <otherVal>ABC</otherVal> <otherVal2>1999</otherVal2> </book> <book> <code_a>22222</code_a> <name>Come to the Dark Side 2nd Ed</name> <otherVal>ABC</otherVal> <otherVal2>2001</otherVal2> </book> <Title>Come to the Dark Side</Title> <typeOfBook>SciFi</typeOfBook> <writer>Darth Vader</writer> </books> </result> </dlwmin:getBookById> </soapenv:Body> </soapenv:Envelope>
    Like I said before I'm new with perl :) 4 hours, I need to parse a lot of files in a Production Env, I tried the code bellow:
    use strict; use warnings; use XML::LibXML; use XML::LibXML qw( ); my $parser = XML::LibXML->new(); my $doc = $parser->parse_file('out.xml'); for my $result ($doc->findnodes('/books/book')) { for my $interv ($result->findnodes('book')) { my $bk = $interv->find('code_a'); my $bk_name = $interv->find('name'); print("$bk - $bk_name"); } }
    and this one (I couldn't understand how to interate with the hash):
    use strict; use XML::Simple; use Data::Dumper; my $doc = XMLin('out.xml'); print Dumper($doc);
    antoher thing the xml was in one line. thanks
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
5 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

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.