Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Seekers of Perl Wisdom

by gods
on Sep 07, 1999 at 20:28 UTC ( #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
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 +'
Default DB connection details not found: Plack::Test & Dancer2
No replies — Read more | Post response
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
3 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.
Loop through array or filehandle
3 direct replies — Read more / Contribute
by markdibley
on Sep 29, 2016 at 09:57
    Hello

    I have a subroutine that loops through some data in a file until it has found the correct outcome and then stops. I simply pass a filehandle reference to the subroutine to do it.

    However, I now have a new source of data that gives it to me in a smaller string. To apply the some routine I just need to split the data by \n and could pass the array reference to the subroutine.

    But is there a way to write a subroutine that takes either a filehandle ref or array ref to loop through?

    I am looking for a way that does not involve reading the whole file into a string (although I admit this may because I am old and started programming computers that had never heard of GB memory).

    Is it possible?
Inconsistent errors when trying to establish SSL-connection
2 direct replies — Read more / Contribute
by ddominnik
on Sep 29, 2016 at 09:01

    I'm writing a Perl application to test the REST API of a JIRA server we're using. Somehow I can't seem to be able to establish an SSL connection to the server. I have the following code

    use strict; use warnings; use LWP; use JIRA::REST; my $browser = LWP::UserAgent->new; $browser->proxy(['http','https'],'http://myproxy:8080'); $browser->agent("Mozilla/5.0 (Windows NT 6.1; WOW64; rv:38.0) Gecko/20 +100101 Firefox/38.0"); my %client = ('useragent' => $browser); my $clientref = \%client; my $jira = JIRA::REST->new('https://myurl:8443/jira', 'myuser', 'mypas +s', $clientref); print $jira->GET("/issue/myissue");
    I had to edit some parts because of confidentiality.
    When I try to run this simple script I get the following error message:
    Can't connect to myurl:8443 (certificate verify failed) LWP::Protocol::https::Socket: SSL connect attempt failed error:1409008 +6:SSL routines:SSL3_GET_SERVER_CERTIFICATE:certificate verify failed +at /home/myhome/perl5/lib/perl5/LWP/Protocol/http.pm

    The strange thing is, that this error message is not consistent. F.e. just a few minutes ago it gave me this error without editing anything in the script

    JIRA::REST Error[500 - Internal Server Error]: SSL negotiation failed: error:1406D0CB:SSL routines:GET_SERVER_HELLO:p +eer error no cipher at /home/myhome/perl5/lib/perl5/LWP/Protocol/http +.pm

    I assume that my script isn't able to fetch the certificate from the server, but how do I edit my script to make it at least connect for now?
    I've tried debugging with the analyze-ssl.pl, but it doesnt work either, as the script doesn't accept the syntax of my proxy. I've tried reprogramming it, but without success.


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 having an uproarious good time at the Monastery: (11)
    As of 2016-09-30 18:35 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Extraterrestrials haven't visited the Earth yet because:







      Results (571 votes). Check out past polls.