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

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
install_driver(ODBC) mac mojave 10.14.2
2 direct replies — Read more / Contribute
by raventheone
on Jan 16, 2019 at 12:09

    hello all

    i have the problem that i am not able to get a simple perl script doing a database connection and query. here the error i get:

    install_driver(ODBC) failed: Can't locate DBD/ in @INC (you may need to install the DBD::ODBC module) (@INC contains: /Library/Perl/5.18/darwin-thread-multi-2level /Library/Perl/5.18 /Network/Library/Perl/5.18/darwin-thread-multi-2level /Network/Library/Perl/5.18 /Library/Perl/Updates/5.18.2/darwin-thread-multi-2level /Library/Perl/Updates/5.18.2 /System/Library/Perl/5.18/darwin-thread-multi-2level /System/Library/Perl/5.18 /System/Library/Perl/Extras/5.18/darwin-thread-multi-2level /System/Library/Perl/Extras/5.18 .) at (eval 4) line 3. Perhaps the DBD::ODBC perl module hasn't been fully installed, or perhaps the capitalisation of 'ODBC' isn't right. Available drivers: DBM, ExampleP, File, Gofer, Proxy, SQLite, Sponge. at line 10.

    i am running mac os mojave 10.14.2

    the db connection works using "Azure Data Studio"

    any help is deeply appreciated

Unable to match Net::Telnet Prompt on CentOS. However, the same prompt works fine on FC20
3 direct replies — Read more / Contribute
by shoundic
on Jan 16, 2019 at 05:45

    I've a script which works fine on FC20. But, when I try to execute the same script on CentOS(CentOS Linux release 7.5.1804 (Core)), it hangs. On further, investigation it was revealed that, it is not able to match the prompt given. Please note it is able to match host prompt but not application prompt. Here is a brief detail of the issue

    Code of the wrapper function which is used to create object of Net::Telnet-

    package api::Telnet; use strict; use warnings; use Net::Telnet; use Exporter; use Carp; our @ISA = qw (Exporter); our @EXPORT = qw ( &open_pty &close_pty ); # Constant global variables use constant SSH_TIMEOUT => 1800; sub spwan_pty { my (@cmd) = @_; my ($pid, $tty, $tty_fd); # Create a new pseudo terminal use IO::Pty (); my $pty = new IO::Pty or die $!; # Execute the program in another process # Child process unless ($pid = fork) { die "problem spawning program: $!\n" unless defined $pid; # Disassociate process from existing controlling terminal use POSIX (); POSIX::setsid or die "setsid failed: $!"; # Associate process with new controlling terminal $pty->make_slave_controlling_terminal; $pty->set_raw(); $tty = $pty->slave(); $tty_fd = $tty->fileno; close $pty; # Make stdio use the new controlling terminal open STDIN, "<&$tty_fd" or die $!; open STDOUT, ">&$tty_fd" or die $!; open STDERR, ">&STDOUT" or die $!; close $tty; exec @cmd or die "problem executing $cmd[0]\n"; } # end child process $pty; } sub open_pty { my (%args) = @_; # Start ssh program. my $pty = &spwan_pty("ssh", "-l", $args{user_name}, "-e", "none", "-F", "/dev/null", "-o", "PreferredAuthentications=password", "-o", "NumberOfPasswordPrompts=1", "-o", "StrictHostKeyChecking=no", "-o", "UserKnownHostsFile=/dev/null", $args{ip_addr} ); # Create a Net::Telnet object to perform I/0 on ssh's tty my $ssh = new Net::Telnet ( -fhopen => $pty, -prompt => $args{prompt}, -telnetmode => 0, -cmd_remove_mode => 1, -timeout => SSH_TIMEOUT, -output_record_separator => "\r", #-errmode => sub { print "Telnet FAIL\n"; } ); # Wait for the password prompt and send password. $ssh->waitfor(-match => '/password: ?$/i', -errmode => "return") or die "problem connecting to \"$args{ip_addr}\": ", $ssh->las +tline; $ssh->print($args{user_pswd}); # Wait for the shell prompt. my (undef, $match) = $ssh->waitfor( -match => $ssh->prompt, -match => '/^Permission denied/m', -errmode => "return" ) or return $ssh->error("login failed: expected shell prompt ", "d +oesn't match actual\n"); return $ssh->error("login failed: bad login-name or password\n") i +f $match =~ /^Permission denied/m; # logging $ssh->input_log($args{log_file}); $ssh->cmd("ifconfig"); $ssh->cmd("date"); return $ssh; } sub close_pty { my ($tty) = shift; $tty->close(); } 1;

    Once Net:Telnet object is obtained, it is used to spawn an interactive application. Here is the code snippet of the same-

    my $host_prompt = '/[\$%#>] $/'; my $util_prompt = '/(\s)*Command: (\s)*/i'; my $owner = &open_pty ( user_name => "<user_name>", user_pswd => "<password>", ip_addr => "", prompt => $host_prompt, log_file => 'Log/Owner' ); $owner->cmd ( String => "cd <navigate to application path>", Prompt => + $host_prompt ); $owner->cmd ( String => "<Launch the application>", Prompt => $util_pr +ompt ); $owner->cmd ( String => "<Execute command>", Prompt => $util_prompt );

    The code successfully creates a Net::Telnet object and spawn the application, but it is unable to match the prompt of the application, due to which it hungs and the script is unable to proceed forward. Here is the log generated-

    em1: flags=4163<UP,BROADCAST,RUNNING,MULTICAST> mtu 1500 inet netmask broadcast inet6 xxxx::xxxx:xxxx:xxxx:xxxx prefixlen 64 scopeid 0x20<li +nk> ether xx:xx:xx:xx:xx:xx txqueuelen 1000 (Ethernet) RX packets 393842 bytes 40650026 (38.7 MiB) RX errors 0 dropped 0 overruns 0 frame 0 TX packets 138388 bytes 15595013 (14.8 MiB) TX errors 0 dropped 0 overruns 0 carrier 0 collisions 0 device interrupt 16 memory 0x92f00000-92f20000 lo: flags=73<UP,LOOPBACK,RUNNING> mtu 65536 inet netmask inet6 ::1 prefixlen 128 scopeid 0x10<host> loop txqueuelen 1000 (Local Loopback) RX packets 5296 bytes 928222 (906.4 KiB) RX errors 0 dropped 0 overruns 0 frame 0 TX packets 5296 bytes 928222 (906.4 KiB) TX errors 0 dropped 0 overruns 0 carrier 0 collisions 0 virbr0: flags=4099<UP,BROADCAST,MULTICAST> mtu 1500 inet netmask broadcast xxx.x ether xx:xx:xx:xx:xx:xx txqueuelen 1000 (Ethernet) RX packets 0 bytes 0 (0.0 B) RX errors 0 dropped 0 overruns 0 frame 0 TX packets 0 bytes 0 (0.0 B) TX errors 0 dropped 0 overruns 0 carrier 0 collisions 0 [root@hyd1658 ~]# Wed Jan 16 15:29:54 IST 2019 . . . . Command:

    Please Note: The same code works on FC20, but fails on CentOS

    Could anyone please pinpoint the issue or suggest a remedy for the same

Reading a hash structure stored in a file
5 direct replies — Read more / Contribute
by sam1990
on Jan 15, 2019 at 15:08

    Hello, I have a file that has a hash stored in it. I am trying to read that hash as it is using eval but I am getting following error: Global symbol "%hash1" requires explicit package name (did you forget to declare "my %hash1"?) at line (print Dumper(\%hash1);) 14. Execution of aborted due to compilation errors. Please help me understand the issue here, thank you : my %hash1 = (hello => 1, hi =>2 ); #!/home/utils/perl5/perlbrew/perls/5.24.2-021/bin/perl use strict; use warnings; use Path::Tiny qw( path ); use Data::Dumper; my $file = ''; open(my $fh, '<', $file) or die "Could not open file $file"; eval($fh); close $fh; print Dumper(\%hash1);
Invoke the Perl string interpolation engine on a string contained in a scalar variable.
2 direct replies — Read more / Contribute
by ibm1620
on Jan 15, 2019 at 12:49
    I want to be able to take arbitrary lines containing variables that are defined in the program, and interpolate them.
    #!/usr/bin/env perl use 5.010; use warnings; use strict; my $var1 = "abel"; my $var2 = "baker"; my $var3 = "charlie"; while (my $line = <DATA>) { chomp $line; say "Before interpolation: $line"; say "After interpolation: " . perform_interpolation($line); say ''; } sub perform_interpolation { my $text = shift; # now what? } __DATA__ I'd like to see this one: $var1. How about \$var3? You shouldn't interpolate \$var3 (but it would be ni +ce if you'd remove the backslash) Try a concatenation: $var1$var2
    I've seen String::Interpolate mentioned in my searches, but unless I'm misunderstanding something, I'd have to know in advance what variables I'd be interpolating

    What I'm trying to do is create a program template where a comment block right after the shebang line (possibly containing scalar variables like $program or other constants or environment variables) can be rendered to produce a usage statement.

    The perform_interpolation() subroutine would be part of the template and wouldn't know specifically what variables the programmer might want to interpolate for the usage statement.

    Can String::Interpolate do this? Or is there a simpler way?

Comparing multiple strings
4 direct replies — Read more / Contribute
by bigup401
on Jan 15, 2019 at 11:26

    How can i Compare multiple strings in faster way

    $name = "john"; $t1 = "john"; $t2 = "john"; if ($name ne $t1 || $t2) { do something }
SIGALRM in perl
1 direct reply — Read more / Contribute
by anjultyagi
on Jan 15, 2019 at 06:24

    Hi Expert, I am using the PERL language with the PostgreSQL database and in a couple of database function, we are using the plperl as language. We are basically calling the SOAP API in the function, however yesterday we faced the issue where PARL had sent the SIGALRM signal and my database got crashed. Can you please review and help me to resolve the issue, either by a code change or a configuration change.

    CREATE OR REPLACE FUNCTION sendclaimcoversheet( text, text) RETURNS integer AS $BODY$ use strict; use warnings; use SOAP::Lite; use Try::Tiny; use Time::Piece; my $first = $_[0]; my $second = $_[1]; try { my $host = `hostname`; my $rv = spi_exec_query("select * from getsprocurl('sendclaimc +oversheet','".$host."')"); my $url = $rv->{rows}[0]->{ret_url}; elog(NOTICE, 'Host Name ' . $host . ' URL '. $url ); my $soap = SOAP::Lite->new(); my $service = $soap->service($url); my $response = $service->sendClaimCoversheet($first, $second +); return $response; } catch { my $ex = $_; return 'SOAPFAULT: ' . localtime->strftime('%m/%d/%Y') . ' ' . + $ex; } $BODY$ LANGUAGE plperlu VOLATILE STRICT COST 100; ALTER FUNCTION sendclaimcoversheet(text, text) OWNER TO postgres;
Win32::GUI and threads issue
3 direct replies — Read more / Contribute
by Garden Dwarf
on Jan 15, 2019 at 05:20

    Hello Monks!

    I am trying to create a Win32 application (with Strawberry Perl (v5.14.4) on Win10) displaying graphic computations. In order to optimize the process, I want to divide the management of my virtual buffer into small pieces computed by individual threads, then compile the results and copy the virtual buffer on the screen.

    My problem is the combination of Win32::GUI and threads (I have also tried forkmanager without success). Threads without Win32 is ok, Win32 without threads is ok, but using both is not. Here is a simple sample code to illustrate the issue (you can enable/disable the use of Win32 with the variable $use_win or change the amount of threads with the variable $t_amount):

    #!/bin/perl use Win32::GUI(); use threads; use strict; use warnings; use Data::Dumper; my $use_win=1; # Create Win32 GUI interface (1) or not (0) my $t_amount=4; # Amount of threads to create my $textbox; my $win; my $draw; if($use_win){ # Initialize window $win=new Win32::GUI::Window( -left => 0, -top => 0, -width => 300, -height => 300, -name => "Window", -text => "Test", ); $win->InvalidateRect(1); $textbox=$win->AddTextfield( -name => "Output", -left => 5, -top => 5, -width => 275, -height => 255, -text => ""); # Start application $draw=$win->AddTimer('draw',1000); $win->Show(); Win32::GUI::Dialog(); }else{ draw_Timer(); } sub Window_Terminate{-1} sub draw_Timer{ my @threads; my @ret; my $c; my $d; # Assign range of computation to fork processes foreach $c(1..$t_amount){ $d=$c-1; push(@threads,threads->new(\&draw,($d*10),($d*10+10))); } foreach my $thread(@threads){ @ret=$thread->join; foreach my $data(@ret){ $use_win?$textbox->Append("|".$data):print"|".$data; } $use_win?$textbox->Append("\n"):print"\n"; } } sub draw{ my $begin=shift; my $end=shift; my @tbl; my $cpt; for($cpt=$begin;$cpt<$end;$cpt++){ push(@tbl,$cpt); } return(@tbl); }

    Any help would be welcome. I have searched for previous posts without finding a solution. I also googled with no luck. Thanks in advance!

Using AUTOLOAD with Moo
4 direct replies — Read more / Contribute
by nysus
on Jan 14, 2019 at 20:04

    I'm pretty sure I've made a bad design decision but not sure what else I can do with Moo. I want a attribute to handle methods if they don't exist:

    package Mac::ApperlScript::App::Finder::Window ; use Moo; use Mac::AppleScript::Glue::Object; use namespace::autoclean; our $AUTOLOAD; has 'obj' => (is => 'ro', required => 1, isa => sub { die 'Improper object passed' unless ref $_[0] eq 'Mac::AppleScript::Glue::Object' }, writer => '_set_obj', ); sub AUTOLOAD { my $s = shift; my @al = split /::/, $AUTOLOAD; my $method = $al[-1]; return $s->obj->$method; }

    So I delegate all methods that don't exist to the obj attribute. The problem is that methods like DESTROY seem to get diverted to the AUTOLOAD subroutine. Is there a better way to achieve what I want to do?

    $PM = "Perl Monk's";
    $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest Vicar";
    $nysus = $PM . ' ' . $MCF;
    Click here if you love Perl Monks

Learning to use fork()
4 direct replies — Read more / Contribute
by ovedpo15
on Jan 14, 2019 at 17:46
    I'm trying to make my script more efficient so I decided to learn how to use fork.
    This question is more on how to write it nice and clean
    I have about 13 different calls that create files. Those calls are not depended and they can run parallel:
    create_file('A'); create_file('B'); create_file('C'); create_file('D'); create_file('E'); ...
    I understand how to create a fork and how to check if there is one and why it is important to use the wait function.
    But I don't know how to make it look nice, clean and readable. Should I create a special function which will be called every time I need to create X (for example 5) forks? How should I keep track of those forks? If for example, I have 13 things I can run parallel, should I use 13 forks (running on a strong machine)? Meaning how to determine how many forks to use?
    I would really love to see some real example with for example 13 different calls.
Case where '( shift @_ )[ 0, 0 ]' returns only one value?
5 direct replies — Read more / Contribute
by rsFalse
on Jan 14, 2019 at 15:58

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

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (5)
    As of 2019-01-20 01:29 GMT
    Find Nodes?
      Voting Booth?
      After Perl5, I'm mostly interested in:

      Results (344 votes). Check out past polls.