Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

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
Excel or Perl for simple statistics?
3 direct replies — Read more / Contribute
by Anonymous Monk
on Jan 20, 2018 at 08:22
    Dear Monks,
    I want to do a few basic statistics (mean and stdev) and since I have lots of data I figured I would do it with Perl (using the Statistics::Basic module). However, I notice some quite interesting discrepancies as opposed to if I calculated the same values using Excel's formulas. Particularly I think the stdev is a problem, since in one test run I did, I got 0.401 with Excel and 0.41 with the Perl module, which does affect my calculations later on.
    Do you have any comment on that?
POST API in Perl using LWP::UserAgent with authentication providing errors
2 direct replies — Read more / Contribute
by ssara
on Jan 20, 2018 at 06:32

    Hello, I am trying to use POST method in perl to send information to an API. I would like to call the below api which requires following inputs:



    Currency: (optional) The currency symbol of the balance to return e.g. 'DOT' (not required if 'CurrencyId' supplied)

    CurrencyId: (optional) The Cryptopia currency identifier of the balance to return e.g. '2' (not required if 'Currency' supplied).

    Request Structure:


    API_KEY: Your Cryptopia api key

    URI: the request uri. e.g.

    HASHED_POST_PARAMS: Base64 encoded MD5 hash of the post parameters

    NONCE: unique indicator for each request.

    Below is my code snippet:

    use LWP::UserAgent; use JSON; use Digest::MD5 qw(md5); use Digest::SHA qw(hmac_sha256_base64); use MIME::Base64; my $api_key ='PUBLIC KEY'; my $api_private_key ='PRIVATE KEY'; my $ua = LWP::UserAgent->new; my $url = ""; my %req = ( Currency => "PAC" ); my $nonce = int(rand(1000000)); my $post_data = encode_json(\%req); my $post_data_enc = encode_base64(md5($post_data)); my $req_signature = sprintf("%sPOST%s%s%s", $api_key, lc(urlencode($ur +l)), $nonce, $post_data_enc); # Sign request signature with private key. my $req_signature_hmac = hmac_sha256_base64($req_signature, decode_bas +e64($api_private_key)); # Generate value for 'Authorization' header field. my $auth_header_value = sprintf("amx %s:%s:%s", $api_key, $req_signatu +re_hmac, $nonce); my $response = $ua->post($url, Content => $post_data, 'Content-Type' => 'application/json', 'charset' => 'utf-8', Authorization => $auth_header_value ); die "Request failed: ", $response->content unless $response->is_succes +s(); print $response->content, $/; sub urlencode { my $s = shift; $s =~ s/ /+/g; $s =~ s/([^A-Za-z0-9\+-])/sprintf("%%%02X", ord($1))/seg; return $s; }

    This code gives the following error: {"Success":false,"Error":"Signature does not match request parameters."}.

    I have also checked the PUBLIC and PRIVATE key and it works when i use a java or php code. But when I am doing with perl it just provides me error. Please can you help me on providing pointers.

    Thank You in advance. POST_MAX not working
4 direct replies — Read more / Contribute
by adjuvant
on Jan 19, 2018 at 15:37

    I've been searching the web and playing with my code for a while now and can't find a solution to this problem.

    I would like to limit uploads to my site with CGI. I'm setting $CGI::POST_MAX = 1024 * 1024 * 20; for a 20 Mb limit, but when I test it with a 900 Mb file, the upload goes through just fine. I've tried every modification I can think of including moving the $CGI::POST_MAX statement around, changing use CGI; to use CGI qw( :standard ); and updating using CPAN. I now have version 4.38 of installed. I would welcome any ideas to be able to protect my server from DDoS attacks.

    Here is my code snippet:

    #!/usr/bin/perl -T my $version = "0.1"; use strict; use warnings; use CGI; use CGI::Carp qw/fatalsToBrowser/; $CGI::POST_MAX = 1024 * 1024 * 20; # maximum upload filesize is 20M $| = 1; my $q = CGI->new; print $q->header; print $q->start_html(-title=>"mysite", -style=>{-src=>'/plasma/style.css'}); print $q->start_multipart_form(-method=>'POST', -action=>'/cgi-bin/start_analysis.cgi') +; print $q->filefield(-name=>"uf_core", -size=>20); print "\tFile type: "; print $q->popup_menu(-name=>"urt", -values=>['fasta','genbank'], -default=>'fasta'); print "<br><br>"; print qq{<input type="file" name="uf_qry" size="20" multiple="true" /> +}; print "<br>"; print $q->submit(-value=>"ANALYZE!"); print $q->end_multipart_form; print $q->end_html;
How to strip comments and whitespace from a regex defined with /x?
5 direct replies — Read more / Contribute
by jh
on Jan 19, 2018 at 14:27

    I would like to print out some previously-defined regular expressions in a compact format. The main thing I want to do is strip out the whitespace and comments from those defined with the /x modifier. So if I have two functionally identical regexes:

    our $rgx_plain = qr/^([a-z]+)\d*$/; our $rgx_fancy = qr/ ^ # beginning of string ( # begin cap $1 [a-z]+ # one or more letters ) # end cap $1 \d* # optional digits $ # end of string /x;

    then I'd like to make a function clean_regex such that

    say $rgx_plain; say clean_regex($rgx_fancy);

    both print the same thing. Ideally clean_regex is a no-op on regexes defined without the /x modifier, such that

    say clean_regex($rgx_plain);

    also prints the same thing. I have hacked together something gross and terrible but I was hoping for something better, presumably asking the Regexp compiler what it has once it's done throwing away comments and whitespace.


LWP::UserAgent POST example
2 direct replies — Read more / Contribute
by ssara
on Jan 19, 2018 at 12:44

    Hello, I am trying to use POST method to send information to an API.Please can you provide me an example on how to use it.

    I would like to call the below api which requires following inputs:


    Input Parameters are:-

    Market: The market symbol of the trade e.g. 'DOT/BTC' (not required if 'TradePairId' supplied)

    TradePairId: The Cryptopia tradepair identifier of trade e.g. '100' (not required if 'Market' supplied)

    Type: the type of trade e.g. 'Buy' or 'Sell'

    Rate: the rate or price to pay for the coins e.g. 0.00000034

    Amount: the amount of coins to buy e.g. 123.00000000

    Please can you tell me how I can call this api from perl ?

    Thank You in advance!!

Send an email attachment
2 direct replies — Read more / Contribute
by AmyB
on Jan 19, 2018 at 12:35
    I'm attempting to modify an existing mailsend program to be able to send a file attachment and need some new ideas. I'm not proficient in PERL at all, so please reply in detail.
    #!/usr/bin/perl -w use strict; # for stronger code my $numargs = $#ARGV + 1; if (($numargs > 3) || ($numargs < 1)) { print "usage : <logfile> [subject] -t\n"; print "syntax : <logfile> is required. [subject] is optional. [-t] specifies to send a copy to maileater\n"; print "example: /tmp/test.log\n"; print "example: /tmp/test.log Test!\n"; print "example: /tmp/test.log Test! -t\n"; exit; } use Net::SMTP; # net SMTP module my($smtp) = Net::SMTP->new('inesg2.alliance.lan',Debug => 1); $smtp->mail(''); my $host = `uname -a | cut -d " " -f2`; # my $emseater = ''; my $emseater = ''; my $sendto = ''; my $subject; chomp ($host); my $logfile = $ARGV[0]; chomp ($logfile); if ($numargs > 1) { $subject = $ARGV[1]; } else { $subject = join ": ", $host, $logfile; } my $message = `cat $ARGV[0]`; $smtp->data(); $smtp->datasend("Subject: ". $subject . "\n\n"); $smtp->datasend($message); if ((($numargs == 3) | ($numargs == 4)) && ($ARGV[2] eq "-t")) { $smtp->to($emseater); my $emsfile= '/home/unixadmin/emsmksysb.txt'; # $smtp->datasend("MIME-Version: 1.0\n"); # $smtp->datasend("Content-Type: application/text; name=$emsfile +\n"); $smtp->datasend("Content-Disposition: attachment; filename=\"$ +emsfile\"\n"); # print $smtp ; ## system("ls -l"); ## $smtp->datasend("Content-type: text/plain; name=\"$emsfile\"\+ +n"); } else { $smtp->to($sendto); } $smtp->dataend(); $smtp->quit; The basic part of the PERL that is changing is the if ((($numargs == 3 +) section. I've done basic debugging to know it's getting into that + section. My current debug output is the following:>perl '/home/unixadmin/emsmks +ysb.txt' 'junk' -t Net::SMTP>>> Net::SMTP(2.29) Net::SMTP>>> Net::Cmd(2.26) Net::SMTP>>> Exporter(5.58) Net::SMTP>>> IO::Socket::INET(1.29) Net::SMTP>>> IO::Socket(1.29) Net::SMTP>>> IO::Handle(1.25) Net::SMTP=GLOB(0x201fd5d8)<<< 220 ESMTP Pro +xy Server Ready Net::SMTP=GLOB(0x201fd5d8)>>> EHLO localhost.localdomain Net::SMTP=GLOB(0x201fd5d8)<<< Hello x1a [], pleased to meet you Net::SMTP=GLOB(0x201fd5d8)<<< 250-ENHANCEDSTATUSCODES Net::SMTP=GLOB(0x201fd5d8)<<< 250-PIPELINING Net::SMTP=GLOB(0x201fd5d8)<<< 250-8BITMIME Net::SMTP=GLOB(0x201fd5d8)<<< 250 STARTTLS Net::SMTP=GLOB(0x201fd5d8)>>> MAIL FROM:< +m> Net::SMTP=GLOB(0x201fd5d8)<<< 250 2.1.0 Sender ok Net::SMTP=GLOB(0x201fd5d8)>>> DATA Net::SMTP=GLOB(0x201fd5d8)<<< 503 5.5.1 Need RCPT (recipient) Net::SMTP=GLOB(0x201fd5d8)>>> Subject: junk Net::SMTP=GLOB(0x201fd5d8)>>> this is a test of the attachment system +under EMS. Net::SMTP=GLOB(0x201fd5d8)>>> . Net::SMTP=GLOB(0x201fd5d8)<<< 500 5.5.1 Command unrecognized: "Subject +: junk" Net::SMTP=GLOB(0x201fd5d8)>>> RCPT TO:<> Net::SMTP=GLOB(0x201fd5d8)<<< 500 5.5.1 Command unrecognized: "" Net::SMTP=GLOB(0x201fd5d8)>>> Content-Disposition: attachment; filenam +e="/home/unixadmin/emsmksysb.txt" Net::SMTP=GLOB(0x201fd5d8)>>> . Net::SMTP=GLOB(0x201fd5d8)<<< 500 5.5.1 Command unrecognized: "this is + a test of the attachment system under EMS. " Net::SMTP=GLOB(0x201fd5d8)>>> QUIT Net::SMTP=GLOB(0x201fd5d8)<<< 500 5.5.1 Command unrecognized: "."
    Any help would be great?
Returning columns with SQL::Statement error
3 direct replies — Read more / Contribute
by LalakisOeisagwmenos
on Jan 19, 2018 at 10:28

    Hello, I am sorry for bothering you but trying to execute the paradigm of SQL::Statement::Structure on a Strawberry perl v5.21.1 I had the following error.

    Can't call method "name" on unblessed reference
    The code is the following:
    use SQL::Statement; use Data::Dumper; my $sql = "SELECT a,aa FROM b JOIN c WHERE c=? AND e=7 ORDER BY f D +ESC LIMIT 5,2"; my $parser = SQL::Parser->new(); $parser->{RaiseError}=1; $parser->{PrintError}=0; # $parser->parse("LOAD 'MyLib::MySyntax' "); my $stmt = SQL::Statement->new($sql,$parser); printf "Command %s\n",$stmt->command; printf "Num of Placeholders %s\n",scalar $stmt->params; printf "Tables %s\n",join( ',', map {$_->name} $stmt->tab +les() ); printf "Where operator %s\n",join( ',', $stmt->where->op() ); printf "Limit %s\n",$stmt->limit(); printf "Offset %s\n",$stmt->offset(); printf "Columns %s\n",join( ',', map {$_->name} $stmt->col +umn_defs() );

    Can't call method "name" on unblessed reference at c:\Users\PasvantidisR\Documents\scripts\perl\ line 17.

    Command SELECT
    Num of Placeholders 1
    Tables b,c
    Where operator AND
    Limit 2
    Offset 5

    Can you please help? Thank you Lalakis Oeisagwmenos
Splitting a long row with multiple delimiters.
6 direct replies — Read more / Contribute
by dipit
on Jan 19, 2018 at 07:50

    eab12345 id=00000 pgrp=abcdefgh groups=abcdefgh home=/home/eab12345 shell=/usr/bin/ksh gecos=AB/C/Y0000/ABC/XYZ RTYUI, LMNOP *CONTRACTOR* (AS 00000) auditclasses=general,files,TCPIP login=true su=true rlogin=true daemon=true admin=false sugroups=ALL admgroups= tpath=nosak ttys=ALL expires=0 auth1=SYSTEM auth2=NONE umask=00 registry=AD SYSTEM=AD logintimes= loginretries=5 pwdwarntime=5 account_locked=false minage=0 maxage=13 maxexpired=0 minalpha=1 minother=1 mindiff=1 maxrepeats=2 minlen=8 histexpire=13 histsize=8 pwdchecks= dictionlist=/abc/def/ghi/jkl default_roles= fsize=-1 cpu=-1 data=-1 stack=65536 core=000000 rss=65536 nofiles=2000 time_last_login=1512632113 time_last_unsuccessful_login=1505304923 tty_last_login=ssh tty_last_unsuccessful_login=ssh host_last_login= host_last_unsuccessful_login= unsuccessful_login_count=0 roles=

    The above is a single row and i want to split values on the basis of <whitespaces>. Suppose the first key : eab12345 has null value but ended with white space. Similarly id=00000 ended with <whitespace>. But Gecos field contain spaces in between its values and if i split, i lose its whole value, For EX: gecos=AB/C/Y0000/ABC/XYZ RTYUI, LMNOP *CONTRACTOR* (AS 00000) contain <whitespaces> in its values. I cannot split using white spaces or else its value got merged with some other value. IS there any way i can have all the "key=values" in my array?(Doesn't matter values can be null or anything, in case its null there will be a whitespace, EX: admgroups= ) please help guys!

Data extraction with specific keywords
5 direct replies — Read more / Contribute
by neeraj_kr
on Jan 19, 2018 at 01:31

    I am trying to write a Perl code to extract specific keywords from a large data file. I have created an array where those specific keywords were stored. I was trying to read that large file line by line and extract matching keywords and want to store them in a new file. I am pasting my code here as it's not working properly. Help will be appreciated. Thank you.

    $a=`head -1 $ARGV[0]`; @arr=split(/\t/,$a); $col=$#arr; $c=0; @arr1 = ("91:", "86:", "184:", "430:", "391:", "254:", "121:", "192:", + "404:", "12:", "87:", "638:", "417:", "129:", "549:", "548:", "122:" +, "443:", "378:", "365:", "665:", "148:", "185:", "88:", "629:", "6 +37:", "149:", "625:", "635:", "627:", "650:", "468:", "92:", "618:", +"212:", "85:", "628:", "171:", "649:", "15:", "61:", "169:", "104:", +"202:", "523:", "60:", "672:", "291:", "658:", "59:", "547:", "491:", + "234:", "411:", "620:", "581:", "414:", "14:", "412:", "416:", "345: +", "626:", "457:", "72:", "384:", "371:", "9:", "580:", "436:", "356: +", "385:", "58:", "669:", "388:", "386:", "390:", "636:", "619:", "16 +:", "413:", "17:", "524:", "579:", "624:", "90:", "471:", "410:", "55 +1:", "289:", "387:", "531:", "64:", "166:", "211:", "467:", "415:", " +232:", "550:", "362:", "375:", "401:", "359:", "372:", "398:", "360:" +, "364:", "399:", "403:", "373:", "377:", "18:", "118:", "585:", "427 +:", "424:", "586:", "469:", "425:", "429:", "13:", "423:", "500:", "6 +2:", "109:", "19:", "539:", "499:", "532:", "400:", "63:", "361:", "3 +74:", "73:", "449:", "175:", "426:", "89:", "507:", "397:", "389:", " +582:", "475:", "20:", "22:", "541:", "492:", "503:", "555:", "595:", +"596:", "450:", "23:", "611:", "509:", "3:", "485:", "24:", "438:", " +442:", "440:", "484:", "117:", "32:", "437:", "31:", "663:", "339:", +"535:", "21:", "470:", "439:", "525:", "172:", "40:", "65:", "487:", +"50:", "517:", "597:", "545:", "516:", "402:", "347:", "614:", "540:" +, "613:", "346:", "67:", "363:", "583:", "376:", "428:", "71:", "615: +", "332:", "271:", "5:", "508:", "74:"); #print "$m\n"; print $arr[2],"\n"; for($i=1;$i<=$#arr+1;$i++) { foreach $ar(@arr1) { if ($arr[$i] == $ar) { $c[$j]=$i; $j++; # print $j; } #print $arr[1],"\n"; } } open(fh,"$ARGV[0]"); while(<fh>) { chomp $_; @arr2=split(/\,/,$_); foreach $ar(@c) { # print $arr2[$ar],"\t"; } #print "\n"; } close(fh);
substitution with regex
3 direct replies — Read more / Contribute
by drose2211
on Jan 18, 2018 at 20:03

    I am attempting to use regex on a text file that will match two numbers that represent temperature in Celsius. I attempted to put the numbers in two separate capture groups and then put them inside a formula to convert to Fahrenheit. I would then set two variables equal to two separate formulas with each using one of the capture groups. The point of this is to take a line like this:

    KSMO 181551Z 00000KT 10SM CLR 14/08 A3009 RMK AO2 SLP189 T01440083

    and take the "14/08" to convert it to Fahrenheit and substitute it back into the line. When I run my code I receive these errors:

    Odd number of elements in anonymous hash at line 11.

    Use of uninitialized value $1 in anonymous hash ({}) at line 11.

    Odd number of elements in anonymous hash at line 12.

    Use of uninitialized value $2 in anonymous hash ({}) at line 12.

    readline() on closed filehandle IN at line 13.

    I am wondering what I am missing. Is it an issue with my regex or somewhere else? Any help would be appreciated.

    #usr/bin/perl use strict; use warnings; open IN,'<',"part2.txt"; open OUT,'>',"airport_fahrenheit.txt"; my $x; my $fahrenheit1 = (9 *{$1}/5) + 32; my $fahrenheit2 = (9 *{$2}/5) + 32; foreach $x (<IN>){ ( $x =~ s/(\d\d)\/(\d\d)/$fahrenheit1\/$fahrenheit2/g ); print OUT "$x"; } close IN; close OUT;

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
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others wandering the Monastery: (2)
    As of 2018-01-23 04:59 GMT
    Find Nodes?
      Voting Booth?
      How did you see in the new year?

      Results (238 votes). Check out past polls.