Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

Seekers of Perl Wisdom

( #479=superdoc: print w/ replies, xml ) Need Help??

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
I can crash perl
3 direct replies — Read more / Contribute
by mark4
on Mar 29, 2015 at 15:41

    I have a program that has been crashing perl (5.8.8) for about 3 years now. I FINALLY got around to debugging it. I looked and looked and I can't see anything wrong with my code. Orininally I thought this was promlem with running out of memory Because it will only crash if the data base it is working with is large. The system I am running this on is a Windows server 2008 Enterprise with 48BG installed. See the line(s) below with "# IT CRASHES SOMEWHERE IN HERE....." I also show a small output from the run.

    if ($sort_dirs) { my @tmp_1; my @tmp_2; my @tmp_3; my @tmp_4; my @tmp_5; my @tmp_6; my $void; print "Sorting directories...\n"; for ($i = 0; $i <= $last_dir; $i++) { #printf ("sort_dirs_debug1: %5d fp: %5d, lp: %5d %s\n", $i +, $first_pointer[$i], $last_pointer[$i], $the_dir[$i]); #define sort order #printf ("%s\n", $the_dir[$i]); #printf ("%s\n", uenc_path_file($the_dir[$i])); $tmp_1[$i] = join ('"|' , $deleted_file[$i] , uenc_path_file($the_dir[$i]) , $the_dir[$i] , $first_pointer[$i] , $last_pointer[$i] , $has_subdir[$i] , $has_iden[$i] ); } @tmp_2 = sort { lc($a) cmp lc($b) } @tmp_1; print "Putting sorted list back...\n"; for($i = 0; $i <= $last_dir; $i++) { ( $deleted_file[$i] , $void , $the_dir[$i] , $first_pointer[$i] , $last_pointer[$i] , $has_subdir[$i] , $has_iden[$i] ) = split (/\"\|/, $tmp_2[$i], 7); #printf ("sort_dirs_debug2: %5d fp: %5d, lp: %5d %s\n", $i +, $first_pointer[$i], $last_pointer[$i], $the_dir[$i]); } # This just makes the file list sequential with the sorted dir +ectories. print "Starting full file sort...\n"; $i = 0; for ($dir_pointer = 0; $dir_pointer <= $last_dir; $dir_pointer +++) { print "i:$i, dir:$dir_pointer $first_pointer[$dir_pointer] + $last_pointer[$dir_pointer]\n"; $start = $first_pointer[$dir_pointer]; $first_pointer[$dir_pointer] = $i; for($file_pointer = $start; $file_pointer <= $last_pointer +[$dir_pointer]; $file_pointer++) { $tmp_1[$i] = $uenc_file_name[$file_pointer]; # IT CRAS +HES SOMEWHERE IN HERE..... $tmp_2[$i] = $dir_and_file_name[$file_pointer]; $tmp_3[$i] = $date_time_mod[$file_pointer]; $tmp_4[$i] = $file_size[$file_pointer]; $tmp_5[$i] = $encpd[$file_pointer]; $tmp_6[$i] = $deleted_file[$file_pointer]; $tmp_7[$i] = $has_iden[$file_pointer]; $i++; } $last_pointer[$dir_pointer] = $i - 1; } print "Putting full file sort back...\n"; for($i = 0; $i <= $last_file; $i++) { $uenc_file_name[$i] = $tmp_1[$i]; $dir_and_file_name[$i] = $tmp_2[$i]; $date_time_mod[$i] = $tmp_3[$i]; $file_size[$i] = $tmp_4[$i]; $encpd[$i] = $tmp_5[$i]; $deleted_file[$i] = $tmp_6[$i]; $has_iden[$i] = $tmp_7[$i]; $finf_valid[$i] = 0; } } # for($i = 0; $i <= $last_dir; $i++) { # printf ("debug4: %5d fp: %5d, lp: %5d %s\n", $i, $first_pointe +r[$i], $last_pointer[$i], $the_dir[$i]); # } print "Exiting get files...\n"; }

    program output:

    ...... i:1539990, dir:1111 1768215 1768216 i:1539992, dir:1112 1422703 1422702 i:1539992, dir:1113 1768217 1768217 i:1539993, dir:1114 1768218 1768218 i:1539994, dir:1115 1768219 1768219 i:1539995, dir:1116 1768220 1768220 i:1539996, dir:1117 1142520 1142535 i:1540012, dir:1118 1140894 1140925 i:1540044, dir:1119 1140926 1140940 i:1540059, dir:1120 1142370 1142399 i:1540089, dir:1121 1142400 1142519 i:1540209, dir:1122 1358128 1358218 i:1540300, dir:1123 1358064 1358127 i:1540364, dir:1124 1347195 1358063 <then crash>

    Problem signature:

    Problem signature: Problem Event Name: APPCRASH Application Name: perl.exe Application Version: Application Timestamp: 45b6a114 Fault Module Name: perl58.dll Fault Module Version: Fault Module Timestamp: 45b6a113 Exception Code: c0000005 Exception Offset: 00085bc1 OS Version: 6.1.7600. Locale ID: 1033 Additional Information 1: f538 Additional Information 2: f538d60ae007f756c6454955fe93e7d0 Additional Information 3: 24d2 Additional Information 4: 24d2d8331230585cafa9b0f2f2190f63 Read our privacy statement online: If the online privacy statement is not available, please read our priv +acy statement offline: C:\windows\system32\en-US\erofflps.txt
perl expect moudule to interact with Linux terminal
1 direct reply — Read more / Contribute
by kkbka
on Mar 29, 2015 at 14:12
    Hi, I am a newbie to the perl world. kindly help me with solution to solve my issue. Scenario: I am trying to login into localhost and want to print "pwd" command which is not working. Note/FYI: I have used "/bin/pwd" instead of "pwd" also. I am not able to get the output. Kindly help on this. Script is as below.
    #!/usr/bin/perl use Expect; $user = "root"; $pass = "redhat"; $hostname = "localhost"; $comm = "pwd"; $Expect::Log_Stdout = 1; $match = '# '; $session=Expect->spawn("ssh $user\@$hostname") or die "Error calling external program: $!\n"; $session->log_file( 'output.txt' ); unless($session->expect(1,"password: ")) {}; $session->send("$pass\n"); unless ($session->expect(1,'-re', $match)){print "\nNOT FOUND...\n"}; $session->send("$comm\r"); $session->log_file( 'output.txt' );
Print line from file only once even if occurrence of pattern is more than once in the line
3 direct replies — Read more / Contribute
by jayu_rao
on Mar 29, 2015 at 13:16
    Hi Monks,

    I have written a code that matches the occurrence of the words like Error / Fatal etc from a log file and printing it to a temporary file.

    However, the problem is that the words can occur more than once in a line like " ERROR - Critical error" or something like FATAL - Fatal error and this causes the lines to get printed more than once because of the patterns getting repeated more than once.

    Can someone help me in suggesting a way to print the lines only once per occurrence in a line with an example?



Can I ask Perl if an object will stringify?
4 direct replies — Read more / Contribute
by haukex
on Mar 29, 2015 at 13:16

    Hello everyone,

    I seek your wisdom on this question: Is there a way to ask Perl whether an object supports stringification, including via "magic autogeneration"? The only way I've found so far was by trying to eval the stringification, like in the code below. The specific case here is the "ICanStringify" class, where overload::Method($s,'""') is false, but the object still stringifies. Did I miss some function somewhere that can tell me whether that class will stringify?

    #!/usr/bin/perl use strict; use warnings; { package OnlyAString; use overload fallback=>0, '""'=>sub { ${shift()} } } { package ICanStringify; use overload fallback=>undef, '0+'=>sub { ${shift()} } } { package OnlyANumber; use overload fallback=>0, '0+'=>sub { ${shift()} } } bless my $s1=\do {my $x=111}, 'OnlyAString'; bless my $s2=\do {my $x=222}, 'ICanStringify'; bless my $s3=\do {my $x=333}, 'OnlyANumber'; can_str($s1); can_str($s2); can_str($s3); use overload (); sub can_str { my $s = shift; print "Object ", overload::StrVal($s), ":\n"; print " \"\" ", overload::Method($s,'""') ?"IS":"is NOT", " overloaded\n"; my $e = eval { "$s" }; print " stringification ", defined($e) ?"WORKED: $e\n":"DIDN'T work: $@\n"; }


    Object OnlyAString=SCALAR(0x3684370): "" IS overloaded stringification WORKED: 111 Object ICanStringify=SCALAR(0x3664210): "" is NOT overloaded stringification WORKED: 222 Object OnlyANumber=SCALAR(0x3679682): "" is NOT overloaded stringification DIDN'T work: Operation """": no method found, argu +ment in overloaded package OnlyANumber at line 28.

    The background is that I have a function that accepts only strings. Because passing a reference was a mistake I made a few times, I started warning if any references were passed to it, including objects. But then I realized that some objects stringify and that's useful, and that some objects die when you try to stringify them. I'd like to loosen the restrictions, and still warn on references and objects that don't stringify, but not on objects that stringify.

    Any wisdom on this topic would be greatly appreciated!

Perl reference array
4 direct replies — Read more / Contribute
by teun-arno
on Mar 28, 2015 at 16:57
    I have a question about the following :
    use Data::Dumper; # it seems that ', ,' in the third record is not producing a index in +the array. $arr= [ [1,2,3,4,5,6,7,8,9 ], #works as expected [1,2,3,'',5,6,7,'',9 ], #works as expected [1,2,3, ,5,6,7, ,9 ], #does not work as expected "empty fields " + are ignored ]; my $dd=Data::Dumper->new([$arr],[ qw(arr) ] )->Indent(1)->Quotekeys(0) +->Dump; print $dd; $str_arr=q`$arr= [ [1,2,3,4,5,6,7,8,9 ], [1,2,3,'',5,6,7,'',9 ], [1,2,3, ,5,6,7, ,9 ], ];` ; print "\n\n"; print $str_arr ; $str_arr=~ s/,\s*,/,'',/g; # filling in the empty fields print $str_arr ; $arr = undef; $arr = eval $str_arr; my $dd=Data::Dumper->new([$arr],[ qw(arr) ] )->Indent(1)->Quotekeys(0) +->Dump; print $dd; # this seems to work, next question is : The original $arr is send to +a subroutine. # How to stringify that in the subroutine without hardcoding this. ( a +s I have done in the above ) ! #
    Thanks for your time dear perl monks.
Archive::Tar is working with perl-5.8.7 but giving Out Of Memory error with perl-5.20.1
2 direct replies — Read more / Contribute
by Sushant_K
on Mar 28, 2015 at 14:44
    Hello Monk, I am facing an issue with Archive::Tar module(version 1.96). I am trying to use 'Archive::Tar->new()' on one tar.gz file the compressed size of which is 31 MB and if extracted size is 151 MB. I have written a sample small program for this. It works well with perl version 5.8.7 however for perl version 5.20.1 it gives out of memory error. Following is my program-
    use Archive::Tar; my $bundle = "C:\\My_Sample.tar.gz"; my $tar_engine = Archive::Tar->new($bundle, 1); if($tar_engine == undef) { print "\nCant get tar object\n"; } else { my @filelist = $tar_engine->list_files(); if(!$tar_engine->extract(@filelist)) { my $ret = 1; print "\nError in extraction.\n"; } } print "\nCompleted Successfully\n";
    For perl-5.20.1, it gives out of memory error when Archive::Tar->new() is called. I am trying this out on Windows. Can anyone help me out ? Please let me know you require any more information.
Character in 'b' format wrapped in unpack
4 direct replies — Read more / Contribute
by BrowserUk
on Mar 28, 2015 at 11:14

    What does the error message mean?

    $x = "\x55\xAA\x55\xAA";; substr( $x, $_, 1 ) = chr( ord( substr( $x, $_, 1 )) << 1 ) for 0 .. 3 +; print unpack 'b*', $x;; Character in 'b' format wrapped in unpack at (eval 34) line 1, <STDIN> + line 26. Character in 'b' format wrapped in unpack at (eval 34) line 1, <STDIN> + line 26. 01010101001010100101010100101010

    Note: The error comes from the unpack line, not the cobbled together bit-string shift left.

    Did the shifting manage to create a wide character?

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority". I'm with torvalds on this
    In the absence of evidence, opinion is indistinguishable from prejudice. Agile (and TDD) debunked
beginner's question regarding objects
3 direct replies — Read more / Contribute
by McSvenster
on Mar 28, 2015 at 08:16

    Dearest wise monks

    I am just starting with oo perl, read your excellent introductions on referencing, but still there's not enough light coming out of my brain :-)

    I am populating an object with the attributes 'head', 'opinion', 'result' like this:

    my $item = Item->new("something","another thing","the essence");

    When I dump the object (with Data::Dumper) I get:

    $VAR1 = bless( { 'head' => 'something', 'opinion' => 'another thing', 'result' => 'the essence' }, 'Item' );

    How can I get the whole contents of $item (all between the curly brackets)? I know how to get the single elements... but not the whole object.

    The aim is to index it with elasticsearch:

    $e->index( index => $index, type => $type, id => $id, body => { head => $head, opinion => $opinion, result => $result, } );

    and I want to replace the "body" with my item

    Thanks a lot in advance for any enlightenment!

Installing modules in Windows (Strawberry Perl) without administrator privileges
4 direct replies — Read more / Contribute
by hda
on Mar 28, 2015 at 03:58
    Wise monks,

    I have recently started working in a very conservative organization where people are not allowed to install things in their computers beyond what is deemed strictly necessary, which is sort of a curse for this long time Perl adept ;-) I am also a long time Linux user, so I am completely unfamiliar with the current Windows environment at $work. I could install Strawberry Perl thanks to the zipped package. However, I could not figure out how to install additional modules. The problem seems to stem from a permission problem, as CPAN fails to connect to the internet. I had the same problem downloading R packages, but I circumvented this by getting the individual .zip files and allowing R know where they are. I am wondering if there is a similar procedure I can implement with Strawberry Perl in this particular setting. Any hint will be appreciated!

    Thanks to all you, wise and gentle monks!

perl code not working after moved new host with latest perl version
5 direct replies — Read more / Contribute
by dpprabhuindia
on Mar 28, 2015 at 03:12

    I am new to perl, I am facing issue with perl script which does job to get data from command 'rrdtool fetch' to html output with graphs. Now it gives error as Uninitialized value, but same perl script os working on other host which has old perl version. This working perl version on RHEL5 machine

    perl -v This is perl, v5.8.8 built for i386-linux-thread-multi
    and This perl version on RHEL6 which is not working

    #!/usr/bin/perl if ($ENV{'REQUEST_METHOD'} eq "POST") read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } elsif ($ENV{'REQUEST_METHOD'} eq "GET") { $buffer = $ENV{'QUERY_STRING'}; } else { exit 1; } @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/^//g; $list{$name} = $value; } $url = "/aisin/cgi-bin/"; $end = time(); $begin = $end - ($list{period} ? $list{period} : 3456000); $dir = "/home/nagios/var/rrd/ts/$list{sid}"; $lin = $list{top}; opendir(DIR, $dir) || die("can't open directory $dir"); @files = grep(/.+\.rrd$/, readdir(DIR)); closedir(DIR); foreach $f (@files) { next if ( ($list{exceptundo} eq 'on' && $f =~ /UNDO/) || $f =~ /^dbd +ata/ ); next if ( ($list{excepttemp} eq 'on' && $f =~ /TEMP/) || $f =~ /^dbd +ata/ ); open(RRD, "rrdtool fetch $dir/$f AVERAGE -s $begin -e $end|") || next +; @f = (); $i = 0; while (<RRD>) { next if ((!/:/) || /nan +nan +nan/); @f = split; next if ($f[3] == 0); if ($i < 1) { $lsiz1 = $f[1]; $rfre1 = $f[2]; $rsiz1 = $f[3]; } else { $lsiz2 = $f[1]; $rfre2 = $f[2]; $rsiz2 = $f[3]; } $i++; } close(RRD); $count = @f; next if ($count == 0); $b = $f; $b =~ s/(.*)\.rrd/\1/; #printf "%s %.0f %.0f %.0f %.0f %.0f %.0f<br/>\n", $b, $lsiz1, $rfre1 +, $rsiz1, $lsiz2, $rfre2, $rsiz2; $amount{$b} = $lsiz2 - $lsiz1; $ratio{$b} = $amount{$b} / $rsiz2; } print "Content-type: text/html\n\n"; print "<html>\n"; print "<body>\n"; print "<center>\n"; print "<p>\n"; print "<H3>\n"; if ($list{period} <= 86400) { printf "last %d hours growth\n", $list{period} / 3600; } else { printf "last %d days growth\n", $list{period} / 86400; } print "</H3>\n"; print "<table border=1>\n"; printf "<tr><th>top %d amount<th>Mega<th>%%<th>top %d utilization<th>M +ega<th>%%\n", $lin, $lin; $i = 0; foreach $k (sort {$amount{$b}<=>$amount{$a}} (grep {$amount{$_}==$amou +nt{$_}} (keys %amount))) { #foreach $k (sort {$amount{$b}<=>$amount{$a}} (keys %amount)) { $k1[$i] = $k; $a1[$i] = $amount{$k}; $r1[$i] = $ratio{$k}; #printf "<tr><td>%s<td>%.2f\n", $k, $amount{$k} / 1024 / 1024 ; last if (++$i == $lin); } $i = 0; foreach $k (sort {$ratio{$b}<=>$ratio{$a}} (grep {$ratio{$_}==$ratio{$ +_}} (keys %ratio))) { #foreach $k (sort {$ratio{$b}<=>$ratio{$a}} (keys %ratio)) { $k2[$i] = $k; $a2[$i] = $amount{$k}; $r2[$i] = $ratio{$k}; #printf "<tr><td>%s<td>%.2f\n",$k, $ratio{$k} * 100; last if (++$i == $lin); } for ($i = 0; $i < $lin; $i++) { printf "<tr>\n"; printf "<td><a href=%s?sid=%s&period=%d&ts=%s>%s</a>", $url,$list{sid},$list{period},$k1[$i],$k1[$i]; printf "<td align=right>%.2f<td align=right>%.2f", $a1[$i] / 1024 / 1024, $r1[$i] * 100; printf "<td><a href=%s?sid=%s&period=%d&ts=%s>%s</a>", $url,$list{sid},$list{period},$k2[$i],$k2[$i]; printf "<td align=right>%.2f<td align=right>%.2f\n", $a2[$i] / 1024 / 1024, $r2[$i] * 100; } print "</table>\n"; print "</center>\n"; print "</body>\n"; print "</html>\n";

    pls help me to fix this issue with latest perl version machine. Thanks in advance for your help. dpprabhuindia

Add your question
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.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others perusing the Monastery: (7)
    As of 2015-03-30 02:39 GMT
    Find Nodes?
      Voting Booth?

      When putting a smiley right before a closing parenthesis, do you:

      Results (633 votes), past polls