Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

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
Scriptsock does not exist??
1 direct reply — Read more / Contribute
by marknher
on Aug 04, 2020 at 19:26

    Hi Monks!

    I have a perl sript ticketing system that is admittedly old but works perfect for our company. Recently, we started getting ERROR 503 messages on our website and it goes away in about 30 minutes. I reached out to the server admins and they responded with the following

    While revising this case our administrators have noticed you script is using socket connections which not completely closed and error similar to arises:

    AH02833: ScriptSock /var/run/cgid.sock.23916 does not exist:

    since the script attempts to reference to previous non existing socket previously used and the error noticed arises. We can not offer debugging of the scripts although and you should check with your website developers what socket connections are used, how are these closed and why the processes reference to an old connection so they could avoid that for your script.

    I've Googled around about this and went through my scripts trying to figure out anything that has changed but I come up blank. Anyone have any clues on what this really means so that I can hunt down the problem and fix it?

    Thanks, Mark T.

Problems using Mail::Sendmail to include an attachment
1 direct reply — Read more / Contribute
by desertrat
on Aug 04, 2020 at 13:58
    I have what I thought would be a simple requirement. An online requests needs to generate an email message with a specifically formated .csv file attached. I am having trouble getting it to work though. If I run this I see that the base64 encoded string is created, but on the recieving end it's gone.
    #!/usr/bin/perl use strict; use MIME::Base64; use MIME::QUotedPrint; use Mail::Sendmail; my $s=<<eos; foo, bar, baz, name, email, important note TRUE,FALSE,TRUE, JoeUser, joeuser1\@there.com, This is the bosses kid eos my $req=encode_qp("I need to make a request for this important person! +"); my $cn = "Joe User"; my $estr=encode_base64($s); print $req."\n"; print $estr; my %msg =(from => 'valid email address',to=>'valid email address',subj +ect =>'test of attachment'); my $boundary= "==========".time()."=========="; $msg{'content-type'} = "multipart/mixed; boundary=\"$boundary\""; $msg{'body'}=<<eob; --$boundary Content-Type: text/plain Content-Transfer-Encoding: quoted-printable $req --$boundary Content-Type: text/csv Content-Tranfer-Encoding: base64 Content-Disposition: attachment; filename="account request for $cn.csv +" $estr --$boundary-- eob sendmail(%msg) or die "Sending failed Error: $Mail::Sendmail::error"; exit;
    On the recieving end the message is empty with an attachment icon with the filename (zero bytes long), and in the message source the body of the message looks like:
    MIME-Version: 1.0 --==========1596563290========== Content-Type: text/plain Content-Transfer-Encoding: quoted-printable --==========1596563290========== Content-Type: text/csv Content-Transfer-Encoding: base64 Content-Disposition: attachment; filename="account request for Joe Use +r.csv" --==========1596563290==========--
    Looking at everything I've found for this, it should work...what am I missing. (note if I just do this:
    #sending a plain text message, maybe sendmail is messed up?? my %msg2 =(from => 'avalidemailaddress',to=>'avalidemailaddress',subje +ct =>'plain email', body=>"just a quick note!"); sendmail(%msg2) or die "Sending failed Error: $Mail::Sendmail::error";
    It works as expected...
Shouldn't references be readonly?
3 direct replies — Read more / Contribute
by LanX
on Aug 04, 2020 at 13:18
    I stumbled over the fact that literal references are not readonly.

    Is that a bug or am I missing an obscure reason for this???

    DB<18> use Scalar::Util qw/readonly/ DB<19> p readonly 1 34283264 DB<20> p readonly undef 34283264 DB<21> p readonly {} # What? DB<22> p readonly [] # ... DB<23> p readonly bless([],"TEST") # ... DB<24> x [],{},bless([],"TEST") # all refs ARRAY(0x334ebd0) empty array HASH(0x334ec00) empty hash TEST=ARRAY(0x334eb70) empty array DB<25> x map { $_ = 1 } [],{},bless([],"TEST") # mutable! WHY??? 1 1 1 DB<26>

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

TK Listbox: scrolling with keys/mousewheel
1 direct reply — Read more / Contribute
by Ratazong
on Aug 04, 2020 at 03:57

    Dear monks

    I'm struggeling with creating a scrolled listbox in Tk: the code below works, however I'm not able to scroll with the arrow-keys nor with the mouse-wheel. Do I have to bind the events myself and code the related actions? Or am I just missing something?

    Thanks for your help! rata

    sub selectProjectDialog_newtest { $mw = shift; # store the main window my @project_choices = split(" ","Project1 Project2 Project3 Proje +ct4 Project11 Project12 Project13 Project14 ") ; my $projectSelection_tl= $mw->Toplevel( ); $projectSelection_tl->title("Select the project:"); $projectSelection_tl->Label(-text => 'Select the project Id:', + )->grid(-row => 5, -column => 10, -sticky => "w"); my $scrolled1 = $projectSelection_tl->Scrolled ("Listbox", -scrollbars => "se", -width => 50, -height => 4, -selectmode => "extended") ->grid(-row => 10, -column => 10, -columns +pan => 10, -rowspan => 10); $scrolled1->insert ("end", @project_choices); }

Effect of redirecting output to /dev/null on $? value
2 direct replies — Read more / Contribute
by Special_K
on Aug 02, 2020 at 20:14

    For reference, this is somewhat of a follow up question to a question I asked previously: https://perlmonks.org/?node_id=11120004

    What is the impact on the value of $? if the output of an application is redirected to /dev/null? This is running under RHEL7.

    For example, suppose I have a perl script that calls a compiled executable that seg faults:

    `my_executable_that_seg_faults`; my $exit_value = $? >> 8; my $signal_num = $? & 127; my $dumped_core = $? & 128; printf("return value is %d\n", $?); printf("exit_value = $exit_value\n"); printf("signal_num = $signal_num\n"); printf("dumped_core = $dumped_core\n");

    Running the above code produces the following output:

    return value is 11 exit_value = 0 signal_num = 11 dumped_core = 0

    This output is consistent with what I would expect based on information found here related to the $? variable: https://perldoc.perl.org/perlvar.html

    However if I change the executable call above to the following:

    `my_executable_that_seg_faults > /dev/null`;

    The following output is produced:

    return value is 35584 exit_value = 139 signal_num = 0 dumped_core = 0

    The above output is significantly different even though the application still seg faulted. Here are my questions:

    1. Why did the value of $? completely change when I added the output redirect to /dev/null but kept everything else the same?

    2. Does the value of $? in the second case still contain the same information but encoded differently?

    I created a different application with an intentional segmentation fault and called it using the above perl script. It produced the exact same output, suggesting that this behavior is not dependent on the behavior of the called application.

Net Websocket Server
2 direct replies — Read more / Contribute
by alvise
on Aug 01, 2020 at 15:59
    Good evening Monks, referring to Net::Websocket::Server Perl module, which is the difference between utf8 and binary ?
    on_connect => sub { my ($serv, $conn) = @_; $conn->on( }, utf8 => sub { }, binary => sub { },
    since whatever I send() to the server, it is always received as utf8, even if I declare type='binary' in the JavaScript socket declaration.

    Thanks in advance.

Mojo::DOM exception handling help
4 direct replies — Read more / Contribute
by Anonymous Monk
on Aug 01, 2020 at 13:11

    Hello wise Monks who are always wiser than I am. I have several thousand html files that I'm parsing using Mojo::DOM. I've encountered a few older files that are surprisingly missing one the fields I'm trying to extract. Not many by enough to cause my script to error out. Here's the code I have:

    my $dom1 = Mojo::DOM->new( $$temp_content ); my $abstr = $dom1->at('div.abstract-content > p')->text; print "Abstract is: $abstr \n\n";

    Here's the what I tried to do to catch the exception (when abstract is null)

    my $abstr = $dom1->at('div.abstract-content > p' || 'not provided')- +>text;

    Here's the error that I'm getting: Can't call method "text" on an undefined value at /Volumes/HD-PATU3/test.pl line 5.

    I've looked at the Mojo::DOM documentation and can't seem to find an answer. I've sure it's easy and being a nub I"m missing something simple. Thanks in advance for your wisdom and assistance

Getting code-ref of anonymous caller
1 direct reply — Read more / Contribute
by LanX
on Jul 31, 2020 at 11:13
    As the following demo shows is caller(1) reporting the name of the calling sub + package.

    In the case of a named subroutine one is able to get the code-ref of the caller by inspecting the STASH.

    But this doesn't work with anonymous subs.

    Caller claims they are part of the stash (here main::__ANON__ ) but accessing the associated code-ref fails. It most likely a newly autovivificated code-ref.

    Any better way to get the callers code-ref?

    First the output

    CURRENT SUB: CODE(0x24c9198) main::upper CODE(0x24c9198) CURRENT SUB: CODE(0x24e8568) main::__ANON__ CODE(0x24c0580) # <--- OOPS

    Here the demo:

    use strict; use warnings; use Data::Dump qw/pp dd/; use feature "current_sub","say"; sub lower { my %caller; package DB { @caller{ qw/ package filename line subroutine hasarg +s wantarray evaltext is_require hints bitmas +k hinthash / } = caller(1); }; my $caller_name = $caller{subroutine}; my $caller_ref =\&{$caller_name};; say $caller_name," ",$caller_ref; } # --- normal sub upper { say "CURRENT SUB: ",__SUB__; lower( "UPPER" ); } upper(); # --- ano sub my $ano = sub { say "CURRENT SUB: ",__SUB__; lower("ANNO"); }; $ano->();

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

Fork and creating a thread exits the process
6 direct replies — Read more / Contribute
by fluks
on Jul 31, 2020 at 07:44
    for my $c (@car_links) { my $pid = fork(); if ($pid == 0) { # Reserve for 30 min. total. for (1..6) { reserve_car($c, $username, $password); sleep 300; } exit; } push @known_cars, $c; write_url_to_known_cars($c, $fh); }
    for my $c (@car_links) { threads->create(sub { threads->detach; # Reserve for 30 min. total. for (1..6) { reserve_car($c, $username, $password); sleep 300; } }); push @known_cars, $c; write_url_to_known_cars($c, $fh); }

    Both of these exit after fork() and threads->create() on Windows 10 using Strawberry Perl 5.30.2.1 and ActiveState 5.26.3 and 5.28.1. What could be the reason and is it possible to fix this? Both versions work fine on Linux.

    I tried AnyEvent too, but I couldn't get it to work either and other event systems seem to need their on loops. The above code is already run in another loop, so I would like to stick with it.

Simple way to skip spaces and # comments
2 direct replies — Read more / Contribute
by leszekdubiel
on Jul 31, 2020 at 06:43

    I parse string using /gc and \G regexes. Current solution for skipping white characters and comments starting from # to the end of line is:

    $$a =~ /\G(?=(\s|#))(?:\s++|#.*+)++/gc;

    Look ahead ?= assertion is necessary, because zero-length matches cause problems. That solution unfortunatelly gives error:

    Complex regular subexpression recursion limit (32766) exceeded

    I have changes to such one:

    while ($$a =~ /\G(?:\s++|#.*+)/gc) {};

    but this is not elegant. I have changed "+" to "*" after "\s" and this also solves the problem, but I don't know why...

    $$a =~ /\G(?=(\s|#))(?:\s*+|#.*+)++/gc;

    Questions: (1) what is the better solution to strip white chars and commments (2) why * instead of + solves the problem?


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!
  • 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?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others contemplating the Monastery: (6)
    As of 2020-08-05 12:59 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Which rocket would you take to Mars?










      Results (35 votes). Check out past polls.

      Notices?