Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?

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
apply_all_roles method clobbering MooseX::Log::Log4perl
1 direct reply — Read more / Contribute
by nysus
on Jan 18, 2018 at 10:16

    I have the following:

    { package MyApp; use Moose; use Moose::Util qw( apply_all_roles ); with 'MooseX::Log::Log4perl'; sub BUILD { my $s = shift; # apply_all_roles($s, 'BarCollector'); # if you uncomment this li +ne, logging doesn't work anymore } sub print_something { my $self = shift; $self->log->info('This does not print when apply_all_roles is used +.'); } } { package BarCollector; use Moose::Role # does nothing } #! /usr/bin/env perl use File::HomeDir; use Log::Log4perl; BEGIN { Log::Log4perl->init_once(File::HomeDir->my_home . '/test.cfg') + }; use MyApp; my $app = MyApp->new(); $app->print_something; __END__ # test.cfg config file: log4perl.logger.MyApp=TRACE, LOG log4perl.appender.LOG=Log::Log4perl::Appender::ScreenColoredLevels log4perl.appender.LOG.layout=PatternLayout log4perl.appender.LOG.layout.ConversionPattern=%c - %m%n

    As noted in the comment, when the line that contains apply_all_roles is uncommented, log messages no longer work. There are no errors.

    Update: One other clue is that when I change the first line of the config file to: log4perl.rootLogger=TRACE, LOG

    I get output, though the category looks something like this: Moose.Meta.Class.__ANON__.SERIAL.1

    Any workaround to this?

    Update 2: Possible workaround?

    I discovered if I slap $s->log->trace('print this'); before the apply_all_roles method is called, everything works as expected. Is there a better way?

    $PM = "Perl Monk's";
    $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest";
    $nysus = $PM . ' ' . $MCF;
    Click here if you love Perl Monks

Getting attachments from request in perl
1 direct reply — Read more / Contribute
by Stetec
on Jan 18, 2018 at 09:36
    I want to use a form to submit fields of email so server can send it. I use Perl and Mason to handle this. I want a user to be able to add multiple attachments, however I am encountering a problem that I can not solve. This is my code simplified as much as possible and with added check for the attachments. ( After submit I want to stay at the same page, that is why there is a hidden check-box and condition in Init section, so that it does nothing when I visit the page for the first time. )
    <!DOCTYPE html> <html> %foreach (@messages) { <div class="alert"> <% $_ | h %> </div> %} <body> <form action="/Tools/SendEmail.html" name="form" enctype="multi +part/form-data" method=post> <input type="checkbox" id="submited_chck" name="submited" +checked hidden> <input type="file" name="attached_files" id="file_upload_b +tn" multiple> <input type="submit" value="Submit"> </form> </body> </html> <%args> @messages => () $submited => '' </%args> <%init> use strict; use warnings; use CGI; if($submited eq 'on') { my $req = new CGI; my @attachments = $req->param('attached_files'); unless (@attachments) { push @messages, "Attachments do not exist"; } } </%init>
    The problem is that if I do any request before submit and add any number of attachments it does not get the attachment from request and the error message is pushed into array and displayed. It does not push the error message only if I restart apache service and submit the form right after it. Any ideas what can cause this? I posted this also on stack overflow but no-one is able to help. Here is a link to it
Problem with SOAP call using SOAP::Lite and wsdl
No replies — Read more | Post response
by Anonymous Monk
on Jan 18, 2018 at 04:15

    I'm trying to do a SOAP call to

    My code as follows :

    use SOAP::Lite; my $client = SOAP::Lite->new; $client = $client->service( " +d.asmx?wsdl" ); my $soapResp = $client->call( "ConvertSpeed", 100, "kilometersPerhour" +, "milesPerhour" ); if ( $soapResp->fault ) { print $soapResp->faultstring; } else { print $soapResp->result; }

    This gives me the following error :

    A service address has not been specified either by using SOAP::Lite->proxy() or a service description)

    As far as I understand it the service address is obtained from the WSDL. I did however try using
    $client->proxy(""), but then I got the following error :

    Server did not recognize the value of HTTP Header SOAPAction: #ConvertSpeed

    Since the WSDL is supposed to handle the service address I removed the $client->proxy() bit and tried
    other stuff. I have been struggling with this for 2 days now so I can't recall everything I tried, but
    I did reduce method chaining a lot from my initial code to what I posted above. I also tried using
    $client->ConvertSpeed(100, "kilometersPerhour", "milesPerhour") directly as I have seen it done this way
    elsewhere, but it seems to not return anything.

    This is running on Perl 5.10 and version 0.714 of SOAP::Lite.
    I have also tested on Perl 5.22.1 and version 1.19.

    I have also confirmed that this SOAP call works in other languages.

3 direct replies — Read more / Contribute
by BillB
on Jan 17, 2018 at 16:48
    I installed the Perl build from active state on my 64 bit windows 7 machine. However I have to be able to connect to an Oracle 8I database using a 10g client. The 10g client can connect to the database with no problems, but when I try to use DBI it says that that version is no longer supported. I looked up the newest version that will support my database and it is version 1.20 I was able to download the 1.20 version for DBD::Oracle from CPAN but following the instructions I can't get it to replace the version used by my 64 bit version of Perl. Does anyone know how to do this. It is very frustrating. By the way version 1.20 will talk to all versions of the database, it just doesn't support the newest bells and whistles.
Memory utilization and hashes
9 direct replies — Read more / Contribute
by bfdi533
on Jan 17, 2018 at 15:53

    I have some code which reads from a file (sometimes 100+ GB) and has to combine rows to create a consolidated output. I used to process the entire file into a hash and then dump the hash at the end of the program.

    The problem with that was, of course, with the very large files, the hash would grow humongous and the program would consume all memory in the system causing it to crash.

    So, trying to solve this problem, I changed the code to output the data as it went, doing my best to make sure that I got all of the row data for consolidation and the did a delete on the hash, thinking I was clearing up memory. But, this does not appear to be the case. Example code:

    my $l; my @vals; my $json; while (<>) { $l = $_; chomp $l; @vals = split /;/, $l; if ($vals[0] =~ /Query/) { $pairs{$vals[1]}{$vals[2]} = $vals[3]; } elsif {$vals[0] =~ /Answer/) { $pairs{$vals[1}{$vals[2]} = $vals[3]; $json = encode_json $pairs{$vals[1]}; print $json."\n"; delete $pairs{$vals[1]}; } }
    Example data:
    Query;1;host; Answer;1;ip; Query;2;host; Query;3;host; Answer;2;ip; Answer;3;ip;

    Does delete actually remove the storage from the hash?

    Does the memory the hash is using actually get reduced after delete?

    Is there a better way to do this?

    Code updated above per the first reply.

service status query with wrong status
2 direct replies — Read more / Contribute
by ytjPerl
on Jan 17, 2018 at 09:43
    I have a perl script to query the status of my windows server 2012 R2 services. I am unable to get the correct status via running the script. the service status is 'running', but I got 'continue_pending'. I am still trying to figure out if the status I stat in @state_name are correct.
    use Win32::Service qw'GetStatus'; use strict; use POSIX; my @state_name = qw( Stopped START_PENDING STOP_PENDING Running CONTINUE_PENDING PAUSE_PENDING PAUSED ERROR ); my $filename = 'D:/log_script/recycle/StartupSvcList.txt'; open FILE, '<', $filename or die "cannot open"; while (<FILE>){ GetStatus("", $servicename, \%status); my $state_no = $status{'CurrentState'}; printf MYFILE " ServiceStatus: %s %s %s \n", "", $servicename, $st +ate_name[$state_no]; } close(MYFILE);


    Discipulus added a missing closing code tag

Attaching a balloon message to text on the Text widget
1 direct reply — Read more / Contribute
by Anonymous Monk
on Jan 17, 2018 at 05:22

    Hi Monks

    I am trying to attach a Balloon to a text (word) in a Text widget. I am not quite sure this is possible, as it seems to me that it is possible to attach it only to a widget. I am able to highlight the word (in this example in red), but how can I attach a Balloon to it? Any idea?

    use strict; use warnings; use Tk; use Tk::Text; use Tk::Balloon; my $mw = tkinit(); my $text = $mw->Text()->pack(); $text->insert('end',"This is a red text\n"); $text->tagAdd('red_text',"1.10","1.13"); $text->insert('end',"This is a black text\n"); $text->tagConfigure('red_text', -foreground => 'red'); my $balloon = $text->Balloon(); $balloon ->attach($text , -balloonmsg => "hello", -initwait=>10); $mw->MainLoop();
Upload to AWS S3 bucket
1 direct reply — Read more / Contribute
by sachinhere
on Jan 17, 2018 at 01:49

    Hi Monks,
    I have base64 pdf data that stored in database. The code that I am trying to write is
    to decode the base64 data from database write it into file with .pdf extension upload that file
    on amazon S3 and generate URL for pdf file. Everything seems fine but while hitting generated URL
    on browser I am getting an error "Failed to load PDF document".I am using Amazon::S3 and Muck::FS::S3::QueryStringAuthGenerator
    cpan modules for amazon upload and MIME::Base64 for decoding Base64 pdf data.
    below is the code snippet:

    my $s3 = Amazon::S3->new ( { aws_access_key_id => $aws_Access_key_id, aws_secret_access_key => $aws_secret_access_key } ); my $test_bucket = $s3->bucket("testbucket"); my $uploadFile_keyname = "r3u3298982938"; my $add_file_test = $test_bucket->add_key_filename("$uploadF +ile_keyname","$cUpload_file",{content_type=>'application/pdf'}) or die "Couldn't copy file to bucket" .$s3->errstr ."\n"; my $response = $test_bucket->list; for my $key(@{ $response->{keys}}) { if($key->{key} eq "$uploadFile_keyname") { my $urlenerator = Muck::FS::S3::QueryStringAuthGenerat +or->new($aws_Access_key_id,$aws_secret_access_key); $urlenerator->expires_in(36000000); $url = $urlenerator->get('testbucket',"$uploadFile_key +name"); } } return $url;
Net::Ping 2.63 Failing
2 direct replies — Read more / Contribute
by g_speran
on Jan 16, 2018 at 21:13
    C:\temp>perl -MNet::Ping -e "print $Net::Ping::VERSION"; 2.63 Fails with getaddrinfo(,,AF_INET) failed - nodename nor servname pr +ovided, or not known at C:\temp\ line 5. However, If I replace with version C:\temp>perl -MNet::Ping -e "print $Net::Ping::VERSION"; 2.43 It Is successful. C:\temp> Result: Ping: => #### UNPINGABLE #### Should this be raised as a bug? #!/usr/bin/perl use Net::Ping; $IP=""; $p = Net::Ping->new("icmp"); if ($p->ping($IP)) { $RESULT="Ping: $IP => alive"; } else{ $RESULT= "Ping: $IP => #### UNPINGABLE ####"; } $p->close(); print "Result: $RESULT\n";
Parks Puzzle
4 direct replies — Read more / Contribute
by aartist
on Jan 16, 2018 at 17:19
    I am trying to solve Parks Puzzle It's an android app. You have to plant a tree (or 2) in the grid horizontally, vertically and in adjacent cells of similar colors. It is a very addictive puzzle. There are several layers. I am thinking of writing a solver for fun. The interesting part from my perspective is coming up with the basic rules and let those rules drive the solution. I appreciate any guidelines, if you have solving this or similar puzzles pragmatically. I like to start with fundamental design/code and then apply my rules to solve it.

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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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
    [pryrt]: I think I actually like "finished 18", because really, it's been 18years since his birth, so he's finished 18 years. :-)
    [jedikaiti]: This is true

    How do I use this? | Other CB clients
    Other Users?
    Others avoiding work at the Monastery: (5)
    As of 2018-01-18 20:42 GMT
    Find Nodes?
      Voting Booth?
      How did you see in the new year?

      Results (214 votes). Check out past polls.