Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

The Monastery Gates

( #131=superdoc: print w/replies, xml ) Need Help??

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
Sorting and ranking
5 direct replies — Read more / Contribute
by Anonymous Monk
on Jan 21, 2018 at 06:32
    Hi Monks
    I would like your wisdom regarding why my code below does not work:
    Task : from the given hash, rank the keys based on the values, also taking into account that if 2 or more keys have the same value, the get the same ranking.
    my %data = ( 'car' => 180, 'motorcycle' => 150, 'skate' => 150, 'bird' => 120, ); my @keys = keys %data; my @sorted[ sort { $data{$keys[$b]} <=> $data{$keys[$a]} } 0..$#keys ] + = 1..@keys; my $rank = 1; my @ranks = (); foreach $count (0..$#sorted) { $rank = $count + 1 if ($count > 0 && $sorted[$count] != $sorted[$c +ount - 1]); push @ranks, $rank; } print join ",", @ranks;

    The code prints 1,2,3,4, while it should print 1,2,2,3 since motorcycle and skate have the same value. Also, could you tell me how I can also print the key next to its ranking (motorcycle, skate etc)?
    Many thanks!
Generate list of possibilities from incomplete input
3 direct replies — Read more / Contribute
by Pascal666
on Jan 20, 2018 at 19:25

    Given a string containing 9 hexadecimal characters, I need to generate a list of all possible 10 character hexadecimal strings that contain the given 9 characters in order. The list need not be in any specific order.

    I think the complete list will have 16x10=160 items, but 9 of those will be duplicates. Don't worry about removing the duplicates, but if your solution doesn't include them that is fine too.

    Obviously, this can be done with a couple nested loops and string concatenation. Somehow, that just doesn't feel like the best way to me though.

    For example, given 0ae4bb830, the list would include:

    00ae4bb830 10ae4bb830 20ae4bb830 30ae4bb830 40ae4bb830 50ae4bb830 60ae4bb830 70ae4bb830 80ae4bb830 90ae4bb830 a0ae4bb830 b0ae4bb830 c0ae4bb830 d0ae4bb830 e0ae4bb830 f0ae4bb830 00ae4bb830* 01ae4bb830 02ae4bb830 03ae4bb830 04ae4bb830 ...
    *Duplicate
What does Test::LeakTrace do?
1 direct reply — Read more / Contribute
by TerryBerry
on Jan 20, 2018 at 16:53

    Could you nice folks clarify what Test::LeakTrace does and what problems it finds? I wonder if I misunderstand because it's giving me errors for very, very simple code. Or maybe there are some very simple things about Perl I've been doing wrong all these years. You decide (then tell me).

    Consider this code:

    #!/usr/bin/perl -w use strict; use Test::LeakTrace; # test for leak leaktrace { require './AlmostEmpty.pm'; };
    AlmostEmpty.pm is, well, almost empty:
    1;
    Here's the output from running the script:
    leaked SCALAR(0x558ad5e37f40) from ./dev.pl line 7.

    It seems weird to me to get any kind of memory leak for such a very basic script.

    Here's my perl version:

    This is perl 5, version 26, subversion 0 (v5.26.0) built for x86_64-li +nux-gnu-thread-multi (with 56 registered patches, see perl -V for more detail)

    I'm running on Ubuntu Linux 17.10.

Multiple params
3 direct replies — Read more / Contribute
by htmanning
on Jan 20, 2018 at 15:05
    Monks,

    I'm missing something here. I have a link with 2 params, (cell and target_dir).

    use CGI qw(:standard); use CGI 'param'; $store = new CGI; $cell = $store->param('cell'); $target_dir = $store->param('target_dir');

    The link looks like this: http://domain.com/script.pl?cell=123&target_dir=/usr/me/attachments/

    All I get from the script is the target_dir. I'm not getting the cell returned. What am I doing wrong?

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?
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.

    Thanks!

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 : mailsend.pl <logfile> [subject] -t\n"; print "syntax : <logfile> is required. [subject] is optional. [-t] specifies to send a copy to maileater\n"; print "example: mailsend.pl /tmp/test.log\n"; print "example: mailsend.pl /tmp/test.log Test!\n"; print "example: mailsend.pl /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('aixreport@countryfinancial.com'); my $host = `uname -a | cut -d " " -f2`; # my $emseater = 't_ca_mailtrigqa@countryfinancial.com'; my $emseater = 'amy.blass@countryfinancial.com'; my $sendto = 'amy.blass@countryfinancial.com'; 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: root@x1aix500.countrylan.net/>perl mailsend.pl '/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 mail1.countryfinancial.com ESMTP Pro +xy Server Ready Net::SMTP=GLOB(0x201fd5d8)>>> EHLO localhost.localdomain Net::SMTP=GLOB(0x201fd5d8)<<< 250-mail1.countryfinancial.com Hello x1a +ix500.countrylan.net [10.78.196.91], 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:<aixreport@countryfinancial.co +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:<amy.blass@countryfinancial.com> 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() );
    Output

    Can't call method "name" on unblessed reference at c:\Users\PasvantidisR\Documents\scripts\perl\test_sql_statement.pl 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
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);
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
2 direct replies — 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 https://stackoverflow.com/questions/48290475/getting-attachment-from-request-in-perl
Problem with SOAP call using SOAP::Lite and wsdl
1 direct reply — Read more / Contribute
by Anonymous Monk
on Jan 18, 2018 at 04:15

    I'm trying to do a SOAP call to http://www.webservicex.net/ConvertSpeed.asmx

    My code as follows :

    use SOAP::Lite; my $client = SOAP::Lite->new; $client = $client->service( "http://www.webservicex.net/ConvertSpee +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("http://www.webservicex.net/ConvertSpeed.asmx"), 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.

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (3)
As of 2018-01-21 21:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    How did you see in the new year?










    Results (230 votes). Check out past polls.

    Notices?