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
Bad File Descriptor
2 direct replies — Read more / Contribute
by Milti
on Sep 30, 2016 at 17:17

    I have a cgi which calls a MySQL database. It runs perfectly on Windows Server 2003 with Apache 1.3. However on Windows Server with Apache 2.2 I get an Internal Server Error as follows:Bad file descriptor; don't know how to spawn child process: E:/Dirctory Name/cgiprogram.pl is not executable; ensure interpreted scripts have "#! first line.

    Here's the beginning of the code:

    #!C:/Perl/bin/perl -w use DBI; use CGI ':standard'; print "Content-type: text/html\n\n"; # constants my $dbh = DBI->connect('dbi:mysql:jobs_db','jobseeker','jobseekerpassw +d') or die "Connection Error: $DBI::errstr\n"; $sth = $dbh->prepare ("DELETE FROM jobs WHERE DateAdded < DATE_SUB(NOW +(), INTERVAL 30 DAY)"); $sth->execute (); my $pagesize = 5; # variables my $AccountID=param('AccountID'); my $locn= param('Country'); my $Function = param('Specialty'); my $reqpage = param('reqpage') || 1; if ($Function eq ""||$locn eq "Select") { print "The FORM is INCOMPLETE. Please Go Back And Fill In All Fields." +; } else { # connect to database my $dbh = get_dbh();

    Why doesn't this run on the new server? Any insight will be sincerely appreciated.

POE / Win32 / select ?
1 direct reply — Read more / Contribute
by soliplaya
on Sep 30, 2016 at 17:04
    Dear Monks (and maybe rcaputo in particular),
    Platform: osname=MSWin32, osvers=6.3, archname=MSWin32-x86-multi-thread uname='Win32 strawberry-perl-no64 5.18.4.1 #1 Thu Oct 2 16:30:08 +2014 i386'
    This code :
    log_msg(0,"$pfx: starting child with command [$trigger]") +if $DEBUG; eval { $kid = POE::Wheel::Run->new( 'CloseEvent' => 'kidclose', 'Program' => $trigger, 'StderrEvent' => 'kidstderr', 'StdoutEvent' => 'kidstdout', 'ErrorEvent' => 'errorstate', ); };
    results in a program crash (after 5 seconds), and in the following error in the Windows Application Event log :

    Application Failure perl.exe 5.18.4.1 in encoding.dll 0.0.0.0 at offset 0000374

    (in several versions of Perl, ActiveState and Strawberry). In the logfile of the program calling the above, there is this :
    [2016/09/30-21:53:09] [I] process(): starting child with command [E:\M +IRA\strawberry\perl\bin\perl C:/EFS/bin/(myWheel).pl --debug 2 (...) + "E:\MIRA\Migration\medfolio_test\NxExport\output\Alles/FOLDER_414860 +93_177671_4/OVERVIEW.xml"] [2016/09/30-21:53:14] [E] select: at E:/MIRA/strawberry/perl/site/lib +/IO/Pipely.pm line 127.
    Which would correspond to this section in IO::Pipely.pm :
    120: my $hits = select( my $out_read = $in_read, 121: my $out_write = $in_write, 122: undef, 123: 5 124: ); 125: unless ($hits) { 126: next if ($! and ($! == EINPROGRESS) or ($! == EWOULDBLOCK)); 127: die "select: $!" unless $hits; 128: }
    (which (timeout value) "5" above seems to be the time between the 2 log messages above)(and indeed if I change this value in Pipely.pm, the crash happens correspondingly later). The above happens on a Windows 2003 R2 Server. It is quite troubling, because the same calling program and the same "Wheel" program, running on the same data, under the same version of perl (and of POE), on another machine (Windows XP SP3), works perfectly fine. To add to the puzzle : another older version of the same calling program, using the same Wheel starting code as shown above, on the same Win2003 server, works perfectly fine too, since years. The only link that I can think of, with the Event error mentioning "encoding.dll", is that the Wheel program at some point opens a file with UTF-16 encoding, like this :
    my $fh; unless (open($fh,'<:encoding(UTF-16)',$ov_file)) { ...
    but again, under Windows XP, this works fine, with the same file opened and then parsed. (and before it does that, the Wheel prints some log messages, which normally appear in the same application log above, but in this case do not). Humbly awaiting any idea or suggestion, cause I don't know where to look anymore.
Print a big string formatted and in multiple lines
1 direct reply — Read more / Contribute
by alen129
on Sep 30, 2016 at 13:42
    I have this code in my page print $query->p ("iCAD Detail   : $Detail\n"); and this is stored in $Detail variable:
    'Sep 30 2016 8:32AM - [2] [Notification] [CHP]-Problem changed from IN +FO-Information to CLOSURE of a Road by CHP\nSep 30 2016 8:32AM - [1] +#2 NB LN CLOSED FROM EL RIVINO TO SANTA ANA\n'
    As you can see it's a mess and very unreadable. Now my question is how do I format it better so it does a newline right before it display the date? something like this:
    Sep 30 2016 8:32AM - [2] [Notification] [CHP]-Problem changed from INF +O-Information to CLOSURE of a Road by CHP\n
    Sep 30 2016 8:32AM - [1] #2 NB LN CLOSED FROM EL RIVINO TO SANTA ANA\n +'
    The values in $Detail are copied form a database entry.
Default DB connection details not found: Plack::Test & Dancer2
1 direct reply — Read more / Contribute
by stevieb
on Sep 30, 2016 at 12:54

    I'm beginning to write my tests for my Dancer2 application. It uses Dancer2::Plugin::Database. It works perfectly fine when running with perl or plackup from the command line, but when I try to execute the following sample/example test, it gives the below error. I just started with Plack::Test, so I'm hoping I'm missing something obvious that I haven't spotted yet. Can those who have experience with webapps have a quick look to see if I'm missing anything glaring?

    [App::EnvUI:30727] error @2016-09-30 10:44:11> Asked for default conne +ction (no name given) but no default connection details found in conf +ig in /usr/local/share/perl/5.18.2/Dancer2/Plugin.pm l. 526 Can't get a database connection without settings supplied! Please check you've supplied settings in config as per the Dancer::Plu +gin::Database documentation at /usr/local/share/perl/5.18.2/Dancer/Pl +ugin/Database/Core.pm line 206. Compilation failed in require at t/base.t line 4. BEGIN failed--compilation aborted at t/base.t line 4.

    Code:

    use strict; use warnings; use App::EnvUI; use HTTP::Request::Common; use Plack::Test; use Test::More; my $test = Plack::Test->create( App::EnvUI->to_app ); subtest 'Sample test' => sub { my $res = $test->request( GET '/' ); ok( $res->is_success, 'Successful request' ); is( $res->content, '{}', 'Empty response back' ); }; done_testing();

    My configuration file, config.yml, per the docs (which I know works fine in normal run mode):

    plugins: Database: driver: SQLite database: 'db/envui.db' dbi_params: RaiseError: 1 AutoCommit: 1
Converting MIME From header to is0-8859-1
No replies — Read more | Post response
by ultranerds
on Sep 30, 2016 at 09:05
    Hi,

    I'm writing a system that will parse an email sent into a catchall email address. It's all working ok, but I'm having some fun with the base64 and QuotedPrint emails. Instead of trying to work it out myself (based on the enc type passed in), I've decided to opt for an existing module to work it out for me, and normalise it.

    Here is a sample script I have:
    my @emails = split /\n/, q|foo <andy@bar.com> =?utf-8?B?UGF1c2UgRG9yw6ll?= <pausedoree@gggg.com> =?UTF-8?Q?Village_Bambous_=2D_Chambre_d=27_H=C3=B4tes?= <village.bambo +us@ddd.com> =?utf-8?B?YmVybmFyZCB2ZXJpdMOp?= <naturedetente@fdd.fr> =?ISO-8859-1?B?TGHrdGl0aWE=?= Picot <villagabrielle@ffsdfsd.net> =?iso-8859-1?Q?Ancie_chambres_d=27h=F4tes?= <ancie.ha@dfdd.fr>|; use utf8; use Encode qw(encode decode); foreach (@emails) { $_ = decode('MIME-Header', $_); print "FOO: $_\n"; print $IN->header; use Data::Dumper; print Dumper($_); print "FOO: " . utf8::is_utf8($_) . "\n"; if (utf8::is_utf8($_)) { print "content..\n"; $_ =~ s/([\200-\377]+)/from_utf8({ -string => $1, -cha +rset => 'ISO-8859-1'})/eg; } print Dumper($_); print "FOO: " . utf8::is_utf8($_) . "\n"; print "\n\n"; }


    Here is a sample output:
    FOO: foo <andy@bar.com> Content-type: text/html; charset=iso-8859-1 $VAR1 = 'foo <andy@bar.com>'; FOO: $VAR1 = 'foo <andy@bar.com>'; FOO: FOO: Pause Dorée <pausedoree@gggg.com> $VAR1 = "Pause Dor\x{e9}e <pausedoree\@gggg.com>"; FOO: 1 convert.. $VAR1 = "Pause Dor\x{e9}e <pausedoree\@gggg.com>"; FOO: 1 FOO: Village Bambous - Chambre d' Hôtes <village.bambous@ddd.com> $VAR1 = "Village Bambous - Chambre d' H\x{f4}tes <village.bambous\@ddd +.com>"; FOO: 1 convert.. $VAR1 = "Village Bambous - Chambre d' H\x{f4}tes <village.bambous\@ddd +.com>"; FOO: 1 FOO: bernard verité <naturedetente@fdd.fr> $VAR1 = "bernard verit\x{e9} <naturedetente\@fdd.fr>"; FOO: 1 convert.. $VAR1 = "bernard verit\x{e9} <naturedetente\@fdd.fr>"; FOO: 1 FOO: Laëtitia Picot <villagabrielle@ffsdfsd.net> $VAR1 = "La\x{eb}titia Picot <villagabrielle\@ffsdfsd.net>"; FOO: 1 convert.. $VAR1 = "La\x{eb}titia Picot <villagabrielle\@ffsdfsd.net>"; FOO: 1 FOO: Ancie chambres d'hôtes <ancie.ha@dfdd.fr> $VAR1 = "Ancie chambres d'h\x{f4}tes <ancie.ha\@dfdd.fr>"; FOO: 1 convert.. $VAR1 = "Ancie chambres d'h\x{f4}tes <ancie.ha\@dfdd.fr>"; FOO: 1
    I'm a bit confused as to what encoding the string is in now though, as utf8::is_utf8($_) still seems to be giving me a positive, as to it being a utf8 string?

    Basically, the end game is to have ANY encodings converted into iso-8859-1 format (I know I know, not ideal, but I'm dealing with a legacy system, and it would be months of work to convert the whole site into utf8)

    Thanks for any suggestions

    UPDATE: Interesting. The output of:

    $_ = decode('MIME-Header', $_);


    Seems to actually give back the string in internal encoding. If I encode it after using:
    if (utf8::is_utf8($the_from)) { $the_from = encode('iso-8859-1', $_); }
    That seems to do it. Does that look OK? I just don't want to bugger it up :)

    Cheers

    Andy
Hypothesis: some magic string optimalization in perl kills my server from time to time
1 direct reply — Read more / Contribute
by leszekdubiel
on Sep 30, 2016 at 08:34
    Hello Perl Monks!

    Writing Perl feels like riding a vintage VW bus. Things don’t work the way you expect, but you can always feel the love. (Learned from article)

    I have a program that parses big strings -- 30MB of data. It intensively uses "\G" to continue parsing from the poit it has matched previously. Normally that program runs 6 (six) seconds. But every few days it is running 4 hours (yes... four hours) and consumes all computation power on server.

    My program reads $big_string from file, encloses that string in parentheses (creating a new string), then passes reference to that newly created string to function "list_extr" which does parsing and returns deserialized data structure.

    Function "list_extr" gets reference to the big string it should parse. I have found that when called like this (interpolate, take reference):

    list_extr(\"($big_string)")

    or like this (combine with dot, get reference to whole combination):

    list_extr(  \( "(" . $big_string . ")" )      )

    or like this (interpolate, save in new variable, take ref to variable):

    my $s = "($big_string)"; list_extr(\$s)

    it is sometimes very, very slow.

    To solve the problem I have to pass that through spritnf:

    list_extr(\sprintf("%s", $big_string))

    This makes function "list_extr" work very fast (six seconds instead of a few hours).

    My goal is to get $big_string, add parentheses at the begining and end of that string, pass reference of newly created string (enclosed in parentheses) to function list_extr. I hope that's clear.

    I think the problem is with some string optimalizations in perl. When using string interpolated by perl it doesn't create new string, but somehow computes positions of parsing (pos $big_string, \G in regex) -- this takes a lot of computations. When using sprintf perl doesn't do optimalization, but creates new, plain, non interpolated, non combined, simple string. I think that optimalization is sometimes done, sometimes not -- this is why the problem occurs only once a few days. Below are parsing functions.

    I have found that this solution sometimes is fast, sometimes slow:

    list_extr(\( "(" . $big_string . ")" ));

    and this solution is ALWAYS slow:

    my $ttt = "(" . $big_string . ")"; list_extr(\$ttt);

    # \G(?:\s|#.*$)* -- means start from last position \G, # skip spaces and comments # till the # end of line # ([[:alpha:]](?:_?[[:alnum:]])*) -- my identifier # restrictions; start with letter, then # letters, underscores, digits; but # two underscores in a row not allowed, # underscore at the end not allowed sub list_extr { my ($a) = @_; ref $a eq 'SCALAR' or croak "wrong ref"; my @l; $$a =~ /\G(?:\s|#.*$)*\(/mgc or croak "parse err"; while ($$a =~ /\G(?:\s|#.*$)*([[:alpha:]](?:_?[[:alnum:]])*)(? +:\s|#.*$)*/mgc) { push @l, {'name' => $1, 'parm' => parm_extr($a)}; } $$a =~ /\G(?:\s|#.*$)*\)(?:\s|#.*$)*/mgc or croak "parse err"; return \@l; } sub parm_extr { my ($a) = @_; ref $a eq 'SCALAR' or croak "wrong ref"; my %p; $$a =~ /\G(?:\s|#.*$)*\(/mgc or croak "parse err"; while ($$a =~ /\G(?:\s|#.*$)*([[:alpha:]](?:_?[[:alnum:]])*)(? +:\s|#.*$)*/mgc) { my $n = $1; if ($$a =~ /\G([[:alpha:]](?:_?[[:alnum:]])*|"(?:[^\\" +[:cntrl:]]+|\\[\\"nt])*")/mgc) { $p{$n} = $1; } elsif ($$a =~ /\G(?=[-+.\d])/mgc) { $p{$n} = numb_extr($a); } elsif ($$a =~ /\G(?=\()/mgc) { $p{$n} = parm_extr($a); } else { croak "parse err"; } } $$a =~ /\G(?:\s|#.*$)*\)(?:\s|#.*$)*/mgc or croak "parse err"; return \%p; } sub numb_extr { my ($a) = @_; ref $a eq 'SCALAR' or croak "wrong ref"; $$a =~ /\G(?:\s|#.*$)*([-+]?\d*(\.\d*)?)/mgc or croak "parse e +rr"; my $n = $1; $n eq '0.0' and return 0; $n =~ /\A[-+](?!0.0\z)(?=[1-9]|0\.)\d+\.\d+(?<=[.\d][1-9]|\.0) +\z/ or croak "parse err"; length $n <= 15 + 2 or croak "numb too long"; $n = 0 + $n; # 1234567890.12345 abs $n > 99999999999999.9 and croak "numb out of range"; return 0 + $n; }

How to modify an attribute containing special characters in a xml file?
3 direct replies — Read more / Contribute
by ankit.tayal560
on Sep 30, 2016 at 06:12
    use strict; use warnings; use Data::Dumper; use XML::DOM; my $parser=new XML::DOM::Parser; my $doc = $parser->parsefile('C:\perl\perl_tests\package.xml')or die$! +; my $root=$doc->getDocumentElement(); my $string="Johnson Controls Automotive Electronics&#xA;Package: GMLAN + 3.1 - Single Channel&#xA;Micro: uPD70F3524&#xA;Compiler: Green Hills + 5.1.7-CBD1110030"; my @package=$root->getElementsByTagName("package"); foreach my $package(@package) { if($package->getAttribute("name")) { my $name=$package->getAttribute("name"); print("$name\n"); $package->setAttribute("name",$string); my $name_updated=$package->getAttribute("name"); print("$name_updated\n"); } } $doc->setXMLDecl($doc->createXMLDecl('1.0','UTF-8')); $doc->printToFile("C:/perl/perl_tests/package.xml"); XML FILE : <?xml version="1.0" encoding="UTF-8"?> <ecuconfig id="1" name="ECU: IPC_LS" FrameworkVersion="1.4.48.0" Compa +tibleVersion="1.4.0.0"> <package name="Johnson Controls Automotive Electronics Package: GMLAN +3.1 - Single Channel Micro: uPD70F3524 Compiler: Green Hills 5.1.7-CB +D1110030" path="C:\Vector\CBD1110030_D04_V85x\Generators\Components\" +> <delivery version="09.01.22.01.11.00.30.04.00.00"/> </package> <package> <delivery version="08.00.09.01.01.00.04.00.00.00"/> </package> </ecuconfig> MODIFIED XML FILE AFTER RUNNING THIS SCRIPT : <?xml version="1.0" encoding="UTF-8"?> <ecuconfig id="1" name="ECU: IPC_LS" FrameworkVersion="1.4.48.0" Compa +tibleVersion="1.4.0.0"> <package name="Johnson Controls Automotive Electronics&amp;#xA;Package +: GMLAN 3.1 - Single Channel&amp;#xA;Micro: uPD70F3524&amp;#xA;Compil +er: Green Hills 5.1.7-CBD1110030" path="C:\Vector\CBD1110030_D04_V85x +\Generators\Components\"> <delivery version="09.01.22.01.11.00.30.04.00.00"/> </package> <package> <delivery version="08.00.09.01.01.00.04.00.00.00"/> </package> </ecuconfig>

    I've written above script to change the name attribute of package element as shown in $string but it is giving me some weird modified xml file idk why.! pretty confused.! can someone help me out with this? although the printed results in the cmd prompt are correct according to my script.

Converting Binary to hex
4 direct replies — Read more / Contribute
by Himaja
on Sep 30, 2016 at 01:37

    Wide Character in oct when using the below code

    $binaddr = 100010; $hexaddr = sprintf("%x", oct("0b$binaddr"));
dies with no message
2 direct replies — Read more / Contribute
by kp2a
on Sep 29, 2016 at 16:49
    program dies first line afer use statement even a blank line with no message except line number how to debug? perl -c reports systax OK both calling and called program
eval system timeout child process
3 direct replies — Read more / Contribute
by dasibre
on Sep 29, 2016 at 15:22

    New to perl trying to fix zombie process bug.I have a script that makes a timed system call in an eval block.

    my $timeout = timed_system_call("/subprocess_a.rb", 3); if ($timeout == 0) { print "success\n"; } else { print "timed out\n"; } sub timed_system_call { my $command = shift; my $timeout = shift; # seconds my $alarm = 0; eval { local $SIG{ALRM} = sub {$alarm = 1; kill -15, $child_pid;}; alarm $timeout; system($command); alarm 0; }; die $command . " failed with " . $@ if $@ && $alarm != 1; #if alar +m is not 1, then something else caused exit e.g(ctrl-c) alarm 0; return $alarm; }
    I need to, ensure the system() call subprocess is killed after timeout, without killing the parent process. On timeout the program should continue to the else block.

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.