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

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
Perl6 OpenBSD
2 direct replies — Read more / Contribute
by girarde
on Oct 13, 2015 at 20:02
    I'm told P6 is released. Is anybody doing anything with in on OpenBSD?
Increase a value inside MySQL query using perl
4 direct replies — Read more / Contribute
by AhmedABdo
on Oct 13, 2015 at 19:10
    I am connecting perl with database using DBI, I have a query.
    My query is if the table.ID equal to 5, set the first one to 10, then the second one 11 and the third one 12 and so on by increasing the value of max one each time and set it to table.ID when the query is true.. till the end.
    I need something like for loop, I did this code, but it does not work.
    Any idea how to rewrite or fix it.
    use strict; use warnings; use DBI; my $max=10; #connect to the databases my $dbh=DBI->connect ('dbi:mysql:database', ' ', ' ') || die "Could not connect to database: $DBI::errstr"; my $add_max="update table set table.ID=".$max." where table.ID=5"; my $run=$dbh->prepare($add_max); $run->execute() or die "SQL Error: $DBI::errstr\n"; while(my @row =$run->fetchrow()){ $max++; } Input ID Name 4 AAA 5 BBB 8 CCC 5 GGG 13 TTT 14 RRR 5 YYY output should be ID Name 4 AAA 10 BBB 8 CCC 11 GGG 13 TTT 14 RRR 12 YYY
Subroutine not being found when being called from within its own module.
2 direct replies — Read more / Contribute
by curucahm
on Oct 13, 2015 at 18:26

    I'm having an issue with a script I'm trying to write, I am writing a CLI menu system, where the menu definitions are being stored in an XML file. I am trying to pass a subroutine to the script to run, but I keep getting an Undefined subroutine, even though it exists within the same module its being processed from. Can someone determine what I'm doing wrong? Why is MenuNA being undefined?

    script I'm running from (ScriptLibsMenu):

    #!/usr/bin/perl use strict; use lib ("/home/jsmith/lib"); use ScriptLibs::Menu; my $DEBUG='1'; my $MENUFILE='/home/jsmith/etc/MENU.example.main'; my $MENU=''; MenuGen($DEBUG,"$MENUFILE");

    Module I'm calling (

    package ScriptLibs::Menu; # VERSION: 1444685500 #use Time::localtime; #use File::Basename; use strict; use warnings; #################### subroutine header begin #################### =head1 NAME: ScriptLibs::Utils =head1 SYNOPSIS: use ScriptsList::Func_DEBUG; Func_DEBUG("DEBUGCONTROL","DEBUGMESSAGELEVEL","DEBUGMESSAGE"); =head1 DESCRIPTION: DEBUG Utility used with Scripts =head1 USAGE: =cut #################### subroutine header end #################### BEGIN { use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = '1444685500'; @ISA = qw(Exporter); #Give a hoot don't pollute, do not export more than needed by defa +ult @EXPORT = qw(MenuGen MenuNA); @EXPORT_OK = qw(all); # %EXPORT_TAGS = (all => [qw(test_one test_two)]); %EXPORT_TAGS = ( Functions => [ qw(MenuGen MenuNA) ], Variables => [ qw($FUNCNAME $HOSTNAME $LOGDATE $VE +RSION) ], ); } use File::Basename; use IO::File; use XML::Simple qw(:strict); my $CLEAR=`clear`; my $clear=`clear`; my $DEBUG=''; my $SRCNAME=''; my $ETCPATH=''; my $FUNCNAME=''; my $TAILLINE=''; my $LIBNAME="ScriptLibs::Menu"; my $MENUBOB='1'; use ScriptLibs::Debug('Func_DEBUG'); use ScriptLibs::ScrIO('Func_Error','Func_Entry','Func_Pause'); use ScriptLibs::Usage('Func_Usage'); sub MenuNA { #NOTE: Not Available my $FUNCNAME='MenuNA'; Func_Pause("Menu Option is not available in this release"); } #END MenuNA; sub Func_MenuReturn { #NOTE: Exits the script my $FUNCNAME='Func_MenuReturn'; print "FUNCNAME=$FUNCNAME"; $MENUBOB='2'; } #END MenuNA; sub Func_MenuExit { #NOTE: Exits the script my $FUNCNAME='Func_MenuExit'; exit; } #END Func_MenuExit; sub Func_MenuLogout { #NOTE: Exits the script my $FUNCNAME='Func_MenuLogout'; my $SCRIPTNAMETEMP=$0; my $SCRIPTNAME=basename($SCRIPTNAMETEMP); my $PSEARCH1=''; my $PTY=''; my $PSEARCH2=''; #print "SCRIPTNAME=$SCRIPTNAME\n"; my @PS1=split(/\n/, `/bin/ps -ef | /bin/grep $SCRIPTNAME`); foreach my $line (@PS1) { chomp $line; #print "line=$line\n"; if ( $line =~ /sh -c \/bin\/ps -ef/ && $line =~/$SCRIPTNAME/ ) + { my @ARRAY=split(/\s+/, $line); $PSEARCH1=$ARRAY[2]; $PTY=$ARRAY[5]; last; } else { next; } } #print "PSEARCH1=$PSEARCH1\n"; foreach my $line2 (@PS1) { chomp $line2; my @ARRAY2=split(/\s+/, $line2); if ( $ARRAY2[1] =~ /$PSEARCH1/ && $ARRAY2[5] =~/$PTY/ ) { #print "line2=$line2\n"; $PSEARCH2=$ARRAY2[2]; last; } else { next; } } #print "PSEARCH2=$PSEARCH2\n"; my @PS2=split(/\n/, `/bin/ps -ef | /bin/grep $PTY`); foreach my $line3 (@PS2) { chomp $line3; #print "line3=$line3\n"; my @ARRAY3=split(/\s+/, $line3); if ( $ARRAY3[1] =~ /^$PSEARCH2$/ && $ARRAY3[5] =~ /$PTY/ ) { my $YESNO=Func_Entry("$DEBUG","Are you sure you wish to lo +gout?","(Y/N)","N","menu"); chomp $YESNO; if ( uc($YESNO) =~ /^Y/ ) { `/usr/bin/kill -9 $PSEARCH2`; } last; } else { next; } } } #END Func_MenuLogout; sub MenuGen { #NOTE: Generates a Menu my $FUNCNAME='MenuGen'; my $MENUFILE=''; my $MENU=''; my %COMMANDS; my %HELPS; my $CURSOR; if ($_[0]) { $DEBUG=$_[0]; chomp $DEBUG; } if ($DEBUG) { Func_DEBUG("$DEBUG","1","$FUNCNAME"); } #DEBUG if ($_[1]) { $MENUFILE=$_[1]; chomp $MENUFILE; } else { Func_Error("1","Must supply a menufile to $FUNCNAME"); } if ( -e "$MENUFILE" ) { #print "MENUFILE=$MENUFILE\n"; $MENU=XMLin($MENUFILE, forcearray => [ qw(OPTION SELECT TEXT C +OMMAND HELP) ], keyattr => [] ); #use Data::Dumper; #print Dumper($MENU); my $MENUBOB='1'; while ($MENUBOB eq '1') { print "$CLEAR"; print "$MENU->{TITLE}\n"; foreach my $SUB ($MENU->{SUBTITLE}) { chomp $SUB; if ( $SUB =~ /ARRAY/ ) { foreach my $BOB (@$SUB) { print " $BOB\n"; } } else { print " $SUB\n"; } } #END foreach my $SUB ($MENU->{SUBTITLE}) print "\n"; foreach my $MENOPT ($MENU->{OPTION}) { chomp $MENOPT; my $SELECT=''; my $TEXT=''; my $POPHELP=''; my $POPCOMM=''; foreach my $BOB (@$MENOPT) { foreach my $BOB2 (keys (%$BOB)) { chomp $BOB2; #print "BOB2=$BOB2 $$BOB{$BOB2}->[0]\n"; if ( $BOB2 =~ /SELECT/ ) { $SELECT=$$BOB{$BOB2}->[0]; chomp $SELECT; next; } elsif ( $BOB2 =~ /TEXT/ ) { $TEXT=$$BOB{$BOB2}->[0]; chomp $TEXT; next; } elsif ( $BOB2 =~ /HELP/ ) { $POPHELP=$$BOB{$BOB2}->[0]; chomp $TEXT; next; } elsif ( $BOB2 =~ /COMMAND/ ) { $POPCOMM=$$BOB{$BOB2}->[0]; chomp $TEXT; next; } else { } } #END foreach my $BOB2 (keys (%$BOB)) if ( $SELECT =~ /^H/ ) { print "\n $SELECT - $TEXT\n"; $COMMANDS{"$SELECT"}="\\\&$POPCOMM"; $HELPS{"$SELECT"}="$POPHELP"; } elsif ( $SELECT =~ /^X/ ) { print " $SELECT - $TEXT\n\n"; $COMMANDS{"$SELECT"}="$POPCOMM"; $HELPS{"$SELECT"}="$POPHELP"; } else { print " $SELECT - $TEXT\n"; $COMMANDS{"$SELECT"}="\\\&$POPCOMM"; $HELPS{"$SELECT"}="$POPHELP"; } } #END foreach my $BOB (@$MENOPT) } #END foreach my $MENOPT ($MENU->{OPTION}) $CURSOR=$MENU->{'CURSOR'}; my $ENTRY=Func_Entry("$DEBUG","Enter your selection","$CU +RSOR","X","menu"); chomp $ENTRY; if ($ENTRY =~ /^[0-9]/ ) { print "$COMMANDS{$ENTRY}\n"; if ( $COMMANDS{$ENTRY} =~ /SUBMENU/ ) { my @ARRAY=split(/\s+/, $COMMANDS{$ENTRY}); my $SUBMENUFILE=$ARRAY[1]; $SUBMENUFILE=~s/^SUBMENU //; MenuGen($DEBUG,"$SUBMENUFILE"); } else { my $RUNNCOMMAND=$COMMANDS{$ENTRY}; my $RUNBOB=\&$RUNNCOMMAND; &$RUNBOB(); } } elsif ( $ENTRY =~ /^H/i ) { my $HELPME=$ENTRY; $HELPME=~s/^[Hh]//; Func_Usage("$HELPS{$HELPME}"); } elsif ( $ENTRY =~ /^x/i || $ENTRY =~ /^q/i ) { my $RUNNCOMMAND=$COMMANDS{'X'}; #print "RUNNCOMMAND=$RUNNCOMMAND\n";; if ( $RUNNCOMMAND =~ /return/i ) { $MENUBOB='2'; } elsif ( $RUNNCOMMAND =~ /exit/i ) { exit; } elsif ( $RUNNCOMMAND =~ /logout/i ) { Func_MenuLogout(); } else { } } else { Func_Error('2',"You have entered an invalid option"); } } #END while ($BOB eq '1') } else { Func_Error("1","Menu definitiion file $MENUFILE does not exist +"); } } #END MenuGen #n pod documentation begin ################### ## Below is the stub of documentation for your module. ## You better edit it! #=head1 NAME #Test - Blank Module #=head1 SYNOPSIS # use Test; # blah blah blah #=head1 DESCRIPTION # #Stub documentation for this module was created by ExtUtils::ModuleMak +er. #It looks like the author of the extension was negligent enough #to leave the stub unedited. #Blah blah blah. # #=head1 USAGE #=head1 BUGS #=head1 SUPPORT #=head1 HISTORY #0.01 Fri Aug 29 10:12:08 2008 # - original version; created by ExtUtils::ModuleMaker 0.51 # #=head1 AUTHOR # James M Smith #=head1 COPYRIGHT #This program is free software; you can redistribute #it and/or modify it under the same terms as Perl itself. #The full text of the license can be found in the #LICENSE file included with this module. #=head1 SEE ALSO #perl(1). #=cut #################### main pod documentation end ################### 1; # The preceding line will help the module return a true value

    The XML file (MAIN.example.main)

    <MENU> <TITLE>Configuration Wizard </TITLE> <SUBTITLE>Enter a menu option to begin</SUBTITLE> <OPTION> <SELECT>1</SELECT> <TEXT>Configure System Administrator Password</TEXT> <COMMAND>1</COMMAND> <HELP>PASSWD CHANGE \n Change the Administrator password</HELP> </OPTION> <OPTION> <SELECT>2</SELECT> <TEXT>Configure Network Parameters</TEXT> <COMMAND>SUBMENU /home/jsmith/etc/MENU.example.NetConfig</COMMAND +> <HELP>Set the IP, netmask, gateway, and configure various network + services</HELP> </OPTION> <OPTION> <SELECT>3</SELECT> <TEXT>Test TCP Network Settings</TEXT> <COMMAND>11</COMMAND> <HELP>Ping, nslookup, etc</HELP> </OPTION> <OPTION> <SELECT>4</SELECT> <TEXT>Manage Processes</TEXT> <COMMAND>11</COMMAND> <HELP>Start, Stop KO</HELP> </OPTION> <OPTION> <SELECT>5</SELECT> <TEXT>Manage Physical Server</TEXT> <COMMAND>Reboot</COMMAND> <HELP>Reboot, Power cycle, manage physical drives</HELP> </OPTION> <OPTION> <SELECT>6</SELECT> <TEXT>Shell (sh)</TEXT> <COMMAND>MenuNA</COMMAND> <HELP>Not available at this time.</HELP> </OPTION> <OPTION> <SELECT>H#</SELECT> <TEXT>Help(number) for more details</TEXT> <COMMAND>11</COMMAND> </OPTION> <OPTION> <SELECT>X</SELECT> <TEXT>Exit</TEXT> <COMMAND>Logout</COMMAND> </OPTION> <CURSOR>MAIN</CURSOR> </MENU>

    The error that I'm receiving:

    Configuration Wizard Enter a menu option to begin 1 - Configure System Administrator Password 2 - Configure Network Parameters 3 - Test TCP Network Settings 4 - Manage Processes 5 - Manage Physical Server 6 - Shell (sh) H# - Help(number) for more details X - Exit Enter your selection: MAIN> 6 \&MenuNA Undefined subroutine &main::\&MenuNA called at /home/jsmith/lib/Script +Libs/ line 261, <> line 1.
Perl on Windows: automate WPF applications, similar to Win32::GUI ?
1 direct reply — Read more / Contribute
by localJoe
on Oct 13, 2015 at 17:32
    Dear PerlMonks,


    I am working on Windows. Is there a module similar to Win32::GUI but will work with WPF (Windows Presentation Foundation) applications?

    Win32::GUI works great for older style Win32 applications but ... it does not work well with WPF-type applications, as it does not see the child controls within an WPF application.

    If possible, I wish to use Perl to automate the UI in a WPF application.



Net::SSH Protocol Error
1 direct reply — Read more / Contribute
by perlssh
on Oct 13, 2015 at 15:56

    I upgraded my SSH Server to Openssh 7.1p1 to overcome security vulnerabilities. But now my perl scripts using Net::SSH have stopped working and they give a Protocol Error as follow:

    Protocol error: expected packet type 91, got 80 at /auto/share/perl/5.8.6/lib/site_perl/5.8.6/Net/SSH/Perl/ line 222 /

    Here is the complete debug trace:
    : Reading configuration data /etc/ssh_config : Allocated local port 1023. : Connecting to, port 22. : Remote version string: SSH-2.0-OpenSSH_7.1 : Remote protocol version 2.0, remote software version OpenSSH_7.1 : Net::SSH::Perl Version 1.42, protocol version 2.0. : No compat match: OpenSSH_7.1 : Connection established. : Sent key-exchange init (KEXINIT), wait response. : Algorithms, c->s: 3des-cbc hmac-sha1 none : Algorithms, s->c: 3des-cbc hmac-sha1 none : Entering Diffie-Hellman Group 1 key exchange. : Sent DH public key, waiting for reply. : Received host key, type 'ssh-rsa'. : Host '' is known and matches the host key. : Computing shared secret key. : Verifying server signature. : Send NEWKEYS. : Waiting for NEWKEYS message. : Enabling encryption/MAC/compression. : Sending request for user-authentication service. : Service accepted: ssh-userauth. : Trying empty user-authentication request. : Authentication methods that can continue: publickey,password,keyboar +d-interactive. : Next method to try is publickey. : Next method to try is password. : Trying password authentication. : Login completed, opening dummy shell channel. : channel 0: new [client-session] : Requesting channel_open for channel 0. Protocol error: expected packet type 91, got 80 at /auto/share/perl/5. +8.6/lib/site_perl/5.8.6/Net/SSH/Perl/ line 222 /

    Can someone please help how to resolve this error?

JSON::XS and blessings
1 direct reply — Read more / Contribute
by cshavit
on Oct 13, 2015 at 15:41
    Dear Monks, I have perl code running on apache. And the weirdest problem.

    Consider this code snippet:

    use JSON::XS; # # # my $json = "{\"has_more\": true}"; my $d = decode_json($json); my $e = encode_json($d);

    You'd expect $e to equal $json. And if you ran it from a shell, it would be true.

    I have two apache virtual hosts, running by the same Apache server on Ubunto. One of the servers always runs the code correctly. The other always dies on encode_json() with

    "encountered object '1', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled (or TO_JSON/FREEZE method missing)"

    The problem does not happen if I use JSON::PP.

    Could you please help me with fixing it? Even a hint.

Seeking a fast sum_of_ranks_between function
2 direct replies — Read more / Contribute
by msh210
on Oct 13, 2015 at 15:20

    The sum_of_ranks_between function from Statistics::Data::Rank is very slow on large data sets.1 Is there a faster way to do the same thing, i.e. find the sum of ranks of a subset where ranking is across a pooled set? I don't need the other functions from that module (except new, of course), and need the sum_of_ranks_between function only in its sum_of_ranks_between(lab=>...) form.

    1 I have two subsets, each with about a million data points.

How to copy a remote file to local system through SCP ?
1 direct reply — Read more / Contribute
by nayaksan
on Oct 13, 2015 at 14:22
    Hi Monk,

    I want to copy a remote file to my local system through SCP. My remote file is in a path "/apps/wls/csam/output/response/a.xml"

    For that i have login into the remote server with boatid and password.

    It only allowed me to access any files in "/apps" folder.

    But to access the "a.xml". I have to change the user with command "sudo -i -u wls"

    then supply the password of wls user. Then only it allowed me to go into "/wls/csam/output/response/a.xml".

    So please suggest me a suitable code to copy the a.xml to my local system for the above scenarios.



Warning about playing with matches
2 direct replies — Read more / Contribute
by ExReg
on Oct 13, 2015 at 14:03

    This is not so much a question as it is an observation of what happens when you try parsing with regexes. I continued flogging the dead horse I started on last week until there was frankly nothing but a bloody mess with flecks of horse meat and hair here and there. I wanted to see the wreck I had been warned about, but could not find any actual detailed expressions of the matter, so I wanted to see how deep into the abyss I could go and still come back unharmed. I don’t think I succeeded. I will probably never be the same after this.

    I originally had five simple matching expressions for e. Four were recursive:

    1. e =~ u 2. e =~ uae 3. e =~ edefe 4. e =~ ebe 5. e =~ ec

    So I can write

    e =~ u|uae|edefe|ebe|ec

    This is recursive, so I use 1 and plug it into e in expressions 2-4 above to get

    11 u 12 uau 13 udufu 14 ubu 15 uc

    These 11 – 15 can then be substituted into 1 – 5 above to get

    111 u 112 uau 113 udufu 114 ubu 115 uc 121 u 122 uauau 123 uauduaufuau 124 uaubuau 125 uauc 131 u 132 uaudufu 133 udufududufufudufu 134 udufubudufu 135 udufuc 141 u 142 uaubu 143 ubudubufubu 144 ubububu 145 ubuc 151 u 152 uauc 153 ucducfuc 154 ucbuc 155 ucc

    These 111 – 155 can then be substituted into 1 – 5 above to get

    These 1111 – 1555 can then be substituted into 1 – 5 above to get

    There is no need to go any further than this since every needed combination of the numbers 1 to 5 appears. We can simply make longer matches of the above by sticking a + at the end of the whole group. This group, with all the levels combined, would look like:

    (I sorted them and removed duplicates. I also wrote a quick script to produce all these substitutions)

    I do not know what the practical limits are for the length of a regular expression, and this may or may not exceed it; but it certainly may be said that this is abusing regular expressions. I have tried it on several test expressions, and it seems to work, but I can see that it is very big and angry looking, and I don’t think I want to get it mad at me.

    By the way, the letters in the expression above are shorthand for the following expressions already defined in the C# language specification

    e $expression u $unary_expression a $assignment_operator d ? f : b (?:\|\||&&|$bar|\^|$ampersand|$expression_equality_operator|$expr +ession_relational_operator|$expression_shift_operator|$plus|$minus|\* +|\/|%) c is $built_in_type

    so the actual regex above would be much more hideous yet with these put in. Optional spacing would make it even worse. One thing that needs fixing is that expressions with the number 1 in them probably should not be included in the +. For example, the very first alternation, u, should not have the + applied to it; uuuuu is not a valid expression. I am sure there are other problems lurking. All this is for a set of five regexes, four recursive for a given expression. Make it ten regexes, and I wouldn’t have the bandwidth to even discuss the answer.

    All this to just define an regular expression that matches a C# expression.

    P.S., I tried spoiler tags to hide some of the length of this, but it did not work well with such large chunks.

Net::SFTP::Foreign does not support both passphrase and password?
2 direct replies — Read more / Contribute
by khandielas
on Oct 13, 2015 at 12:32

    Hi, Monks, good day.

    I wonder anybody tried Net::SFTP::Foreign with priv key with passphrase and also password before?

    Here is a good thread about how to support both key and password authentication. salva gave a lot of explanations.But in this case, no passphrase was mentioned. Does Net::SFTP::Foreign support identity file and user password?

    In my case, if I pass passphrase in the hash, it will give me error: Invalid option 'password' or bad combination of options at ..../ line .... Here is the code sample:

    my $sftp = Net::SFTP::Foreign->new( $sftp_host, more => [ '-o', "IdentityFile=$ssh_key_path", '-o', 'PreferredAuthentications=keyboard-interactive,pas +sword,publickey', '-vvv' ], user => $sftp_user, password => $sftp_password, passphrase => $sftp_passphrase, timeout => 10, port => $port, stderr_fh => $my_err );

    I can manually log into remote server with passphrase and password typed in when being asked.

    Thank you very much.

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!
  • 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 the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others chilling in the Monastery: (2)
    As of 2015-10-14 03:18 GMT
    Find Nodes?
      Voting Booth?

      Does Humor Belong in Programming?

      Results (320 votes), past polls