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

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
script hanging at thread start
3 direct replies — Read more / Contribute
by armcinto
on Nov 24, 2020 at 14:53

    Hi Monks,
    I'm stuck and need some direction. I have a new script that is frequently hanging and needs to be killed. The script reads in a file with a list of hostnames (4-5) and creates a thread for each hostname. I can see the print statement that each thread is created, but I don't see the first print statement in the runMain subroutine. Most of threads complete the entire script, but 1-2 will appear to never start. Not sure what else to try at this point to get more information. This is Strawberry Perl (64-bit) 5.28.1.1-64bit environment.

    sub runMain { print "Starting runMain on $_[0]\n"; if ($_[0] =~ /(\w.+\w\d+.+net),(\w+)/) { $Server = $1; $Type = $2; print "Connecting to $Server\n"; } } open (LIST, "list.txt"); for my $Serv (<LIST>) { print "Created thread for $Serv\n"; push @Threads, threads->new(sub {runMain($Serv)}); }


    Thanks,
    -A
CPAN PREFIX or INSTALL_BASE
3 direct replies — Read more / Contribute
by Bod
on Nov 24, 2020 at 08:11

    Thanks to bliako in Re^3: To Framework or not to Framework and others in the same threadnode, I am trying to install a module using SSH to shared hosting as this has been disabled in cPanel. I am using PuTTY to connect. The module I'm trying to install as a test is Image::Info because it is small and useful so makes a good test.

    The files are fetched OK and I can see them in the /home/shoples1/.cpan/build/ directory but install within CPAN finishes up with this error:

    Configuring S/SR/SREZIC/Image-Info-1.42.tar.gz with Makefile.PL Checking if your kit is complete... Looks good Only one of PREFIX or INSTALL_BASE can be given. Not both. No 'Makefile' created SREZIC/Image-Info-1.42.tar.gz /usr/bin/perl Makefile.PL PREFIX=/home/shoples1/perl/usr -- NOT OK Failed during this command: SREZIC/Image-Info-1.42.tar.gz : writemakefile NO -- No + 'Makefile' created
    From what I can tell, CPAN is trying to use two different and incompatible configuration methods but I have no idea how to tell it to only use one. From this information I have found conf makepl_arg but CPAN says:
    Unknown shell command 'conf'.

Expect receives no output, when requested via HTML
1 direct reply — Read more / Contribute
by Clive89
on Nov 24, 2020 at 07:55

    Hello Perl Monks,

    i'm new to perl and trying to build a webserver that executes commands on multiple remote devices. I'm using Expect.pm to establish the ssh connection, send the commands and retrieve the results. For each connection a subprocess is started as required (tainted). The code works as expected when executed in the console but when the sub is invoked via the html interface, the Expect.pm subroutines do not retrieve the response from the remote device. I'm assuming some right issue, but i don't know how to address it ... Any help is appreciated!

    Friendly Regards,

    Phil

    Remote Class - builds upon Expect.pm to establish a ssh connection.

    #!/usr/bin/perl -wT use lib "/daten/http/toolbox_dev/cgi-bin/bambi/pw/server"; # add +source folder to path. use warnings; use strict; use config; # load + configuration. use Expect; # load + expect routines. use process; # load + multi process routines. use tools; # use Data::Dumper; # ###################################### # The Remote Class is used to execute commands on hosts. ###################################### package Remote; my $user = "XXX"; my $pass = "XXX"; my $prompt = '^\w+#'; # regular expression that matches the +command prompt (currently rough). my $timeout = 10; # seconds before the connection is abo +rted. # start a ssh connection and handle login dialog. # :param 0: host to connect to. # :return: established ssh connection. sub open_ssh { my ($host) = @_; my $ssh_cmd = "ssh ".$user."@".$host; Debug::dlog("connecting to $host"); my $exp = Expect->spawn($ssh_cmd) or return; Debug::dlog("$exp spawned ssh"); $exp->restart_timeout_upon_receive(1); $exp->log_stdout(0); $exp->expect($timeout, ["yes/no", \&send_yes, $exp], ["assword", \&send_pass, $exp], [$prompt]); return $exp; } # send the user name to a host. # :param 0: established ssh connection. # :return: sub send_user { my ($exp) = @_; $exp->send("$user\n"); Debug::dlog("$exp send user"); $exp->exp_continue; } # send the password to the host. # :param 0: established ssh connection. # :return: sub send_pass { my ($exp) = @_; $exp->send("$pass\n"); Debug::dlog("$exp send password"); $exp->exp_continue; } # send yes to the host. # :param 0: established ssh connection. # :return: sub send_yes { my ($exp) = @_; $exp->send("yes\n"); Debug::dlog("$exp send yes"); $exp->exp_continue; } # execute a command on the host and retrieve its response.. # :param 0: established ssh connection. # :param 1: command to execute. # :return: response of the host. sub exec_cmd { my ($exp, $cmd) = @_; $exp->send("$cmd\n"); await_prompt($exp); my $response = $exp->before(); Debug::dlog("$exp executed $cmd, retrieved ".length($response)." c +hars"); return $response; } # wait for acknowlegment of the host (currently rough) # :param 0: established ssh connection. # :return: sub await_prompt { my ($exp) = @_; $exp->expect($timeout, [$prompt]); } # disconnect from the host. # :param 0: established ssh connection. # :return: sub quit { my ($exp) = @_; $exp->send("exit\n"); $exp->soft_close(); Debug::dlog("$exp disconnected"); } # executes multiple commands on a host and retrieve the responses. # :param 0: array of commands to execute. # :param 1: host to connect to. # :return: dictionary with the commands as keys and the responses + as values. sub exec_on { my ($cmds, $host) = @_; my $ssh = open_ssh($host); if($ssh) { my %cmd_resp = (); foreach my $cmd (@$cmds) { $cmd_resp{$cmd} = exec_cmd($ssh, $cmd); } quit($ssh); return \%cmd_resp; } else { Debug::dlog("failed to connect to $host"); return "Couldn't start SSH"; } } # executes multiple commands on multiple hosts and retrieve the respon +ses. # :param 0: array of commands to execute. # :param 1: array of hosts to connect to. # :return: dictionary with the host names as keys and the command + dictionary as value. sub exec_on_each { my ($cmds, $hosts) = @_; my %host_resp = (); foreach my $host (@$hosts) { $host_resp{$host} = exec_on($cmds, $host); } return \%host_resp; }

    Dispatcher Class - starts a subprocess and retrieves the return of a function via a pipe.

    #!/usr/bin/perl -wT ###################################### # The Dispatcher Class can execute a function in a sub process. # Pipes are used for IPC. The result of the function is serialized # in order to be transmitted as a string message. ###################################### package Dispatcher; use lib "/daten/http/toolbox_dev/cgi-bin/bambi/pw/server"; # add +source folder to path. use strict; use warnings; use Data::Dumper; # seri +alization routines use tools; # $Data::Dumper::Indent = 0; # $Data::Dumper::Maxdepth = 3; # $Data::Dumper::Purity = 0; # $Data::Dumper::Deepcopy = 1; # @Dispatcher::workers = (); # array that holds all worker +objects currently running. @Dispatcher::jobs = (); # array that holds all jobs to execute +. # appends multiple jobs to the dispatchers query. # :param 0: array of jobs. # :return: sub query_jobs { my ($jobs) = @_; push(@Dispatcher::jobs, @$jobs); } # appends a job to the dispatchers query. # :param 0: job # :return: sub query_job { my ($job) = @_; push(@Dispatcher::jobs, $job); } # executes all jobs in the query. # :return: the data returned from the workers. sub execute_jobs { foreach my $job (@Dispatcher::jobs) { assign_job($job); # assign a worker process to t +he job. } @Dispatcher::jobs = (); # clear list of jobs. return join_jobs(); } # assigns a job to a worker process. # :param 0: job. # :return: sub assign_job { my ($job) = @_; my $pid = open my $pipe => "-|"; # create worke +r process and connect it using a pipe. Debug::dlog("spawned process : $pid"); die "Failed to fork: $!" unless defined $pid; # check that c +reation was successfull. my $routine = $job->get_routine(); # get routine +to execute. my $params = $job->get_params(); # get paramete +rs to pass. unless ($pid) { # the followin +g code is only executed in the worker process: $ENV{"PATH"} = "/usr/bin"; # delete conte +xt. my $return = $routine->(@$params); # execute rout +ine. my $dump = Dumper($return); # serialize th +e returned object. print($dump); # print data s +tring to pipe. Debug::dlog("process ".$$." dumped ".length($dump)." chars"); exit; # terminate pr +ocess. } else { # only in pare +nt process: my $worker = new Worker($pipe, $pid); # construct ne +w worker object. push(@Dispatcher::workers, $worker); # save worker +object. } } # waits till all workers are finished and returns the generated data. # :return: data returned from workers. sub join_jobs { my @output; foreach my $worker (@Dispatcher::workers) { waitpid($worker->get_pid(), 0); + # wait till worker is done. Debug::dlog("process ".$worker->get_pid()." exited"); my $data = receive_data($worker->get_pipe()); + # receive the data. Debug::dlog("received $data from process ".$worker->get_pid()) +; push(@output, $data); + # save data. } @Dispatcher::workers = (); + # clear list of workers. return @output; } # receives the serialized data and recreate the original data structur +e. # :param 0: pipe to receive from. # :return: the original data structure. sub receive_data { my ($pipe) = @_; my @lines = <$pipe>; my $data_str = join('', @lines); my $sec_str = Tools::untaint($data_str); Debug::dlog("received ".length($sec_str)." chars");; my $VAR1 = ""; eval $sec_str; return $VAR1; } ###################################### # The Job class encapsulates a routine and its parameters ###################################### package Job; # the constructor is passed the routine reference and the parameter ar +ray. # :param 0: the object name (passed automatically). # :param 1: the routine to execute. # :param 2: the parameters to pass to it. # :return: job object. sub new { my $class = shift; my $self = { _routine => shift, _params => shift }; bless $self, $class; return $self; } # returns the routine reference. # :return: routine reference. sub get_routine { my ($self) = @_; return $self->{_routine}; } # returns the parameter array. # :return: parameters array. sub get_params { my ($self) = @_; return $self->{_params}; } ###################################### # The Worker class holds the data of the spawned subprocess. ###################################### package Worker; # the constructor is passed the pipe reference and the pid. # :param 0: the object name (passed automatically). # :param 1: the pipe object. # :param 2 the pid of the corresponding prcoess. # :return: worker object. sub new { my $class = shift; my $self = { _pipe => shift, _pid => shift }; bless $self, $class; return $self; } # returns the pipe reference. # :return: pipe. sub get_pipe { my ($self) = @_; return $self->{_pipe}; } # returns the pid. # :return: pid. sub get_pid { my ($self) = @_; return $self->{_pid}; }
perl script to execute a single command for multiple entries
3 direct replies — Read more / Contribute
by noviceuser
on Nov 24, 2020 at 00:47

    I need to delete multiple clients using command: p4 client -d <client-name>, so i want to write a perl script where i can read a file containing list of all the client names, and delete the same using the script.

Testing unexpected I/O failures
4 direct replies — Read more / Contribute
by kcott
on Nov 23, 2020 at 21:51

    I'm extending an application for $work and am seeking some advice on testing unexpected I/O failures.

    The application receives a lot of parameters and I perform sanity checks on these. There are three parameters of interest with respect to this SoPW, in brief:

    • directory: check it exists; is a directory; has appropriate permissions.
    • input file: check it exists; is a normal file; isn't empty; can be read.
    • output file: this really only needed a name format check; it doesn't need to exist and it's overwritten if it does (which can occur often and would generally be the normal case).

    The application works fine if good parameters are supplied. There's a total of nine (file-related) sanity checks; I've successfully tested all of these with bad parameters.

    The actual I/O is very straightforward; e.g.

    open my $in_fh, '<', $input_file_path ... open my $out_fh, '>', $output_file_path ...

    The error messages on failure are similarly standard:

    Can't open $input_file_path for reading: $! Can't open $output_file_path for writing: $!

    Given the sanity checks, I/O failure would be unexpected but still possible; for instance, between the sanity checks and an open call, a file could be deleted or renamed, it's permissions changed, a hardware failure could occur, and so on.

    I managed to test the write failure by running normally; manually removing the write permissions of the output file; and then running again with the same parameters.
    Yes, I remembered to put the write permissions back after this test. :-)

    So that just leaves me with testing the read failure; unfortunately, I can't think of a way to do that. Any ideas would be greatly appreciated.

    While I do like to test everything, if this last test can't be done it's not a huge problem. The code is very straightforward (I've probably written similar code thousands of times in the past); the syntax is fine (perl -c); and, I know it works with good parameters.

    — Ken

Can't locate conf.cgi in @INC
1 direct reply — Read more / Contribute
by CarlosN
on Nov 23, 2020 at 17:20
    Hello, I am installing a Perl autoresponder script in my cgi-bin with a script called install.cgi and I get this error:
    Software error: Can't locate conf.cgi in @INC (@INC contains: lib /usr/local/lib64/per +l5 /usr/local/share/perl5 /usr/lib64/perl5/vendor_perl /usr/share/per +l5/vendor_perl /usr/lib64/perl5 /usr/share/perl5) at install.cgi line + 14. For help, please send mail to the webmaster...
    My issue is that there actually is a directory called "lib" as stated above in the error message: " @INC contains: lib " and the necessary perl modules are located there. I even tried using:
    use FindBin; use lib "$FindBin::RealBin/..";
    and what that did is print the whole path to the parent dir within the error message, and install.cgi just won't execute. Any suggestions? Thanks, Carlos
To Framework or not to Framework
5 direct replies — Read more / Contribute
by Bod
on Nov 23, 2020 at 12:54

    Despite regularly visiting The Monastery in the past, especially when the Great God Google has pointed me this way, in the last week since I created an account I have learnt a great deal...one such thing is the existence of frameworks for building websites. Until yesterday this was something that sat on the 'one day' pile - but now I have to build a new website so I am seeking help in deciding whether to use a framework or whether to do it in a similar way to I've previously done it but with use strict; firmly in every script!

    My partner has been dabbling with artwork for some months and wants somewhere to showcase her work and to be able to take commissions and make sales of prints.

    Here is an example if you are interested

    So...the website will only be maintained by me thus ensuring that others can maintain the code is not a consideration. Functionally it is not too complex with a few database tables and a very basic CMS so Joolz (my partner) can upload images of artwork and change their descriptions, etc. There will be some image manipulation (probably using GD::Image) to resize thumbnails so they cannot be usefully copied and to add a watermark to larger images but that would be the same however the rest of the site is implememnted (wouldn't it?)

    Previous websites I have created have a standard library I have written to deal with form processing, image uploads, logging etc. They then have site specific subroutines for the boilerplate code common to multiple pages and to deal with database connections. All of this standard code is in *.pl files that are brought in with a require statement.

    I would love your input of whether it would be beneficial to go through the (steep?) learning curve of implementing this new site with a framework or whether it would be preferable to use the boilerplate methodology that I am used to albeit using *.pm modules for the common parts and bringing them in with a use statement. I feel that I do not know enough about the advantages and potential pitfalls of adopting a framework to be able to make a decision.

    I'm not asking for you to try and make a decision for me...but please...give me some pointers and shine a light into the dark corners where frameworks and other design considerations tend to lurk.

Pointers and References
6 direct replies — Read more / Contribute
by Leudwinus
on Nov 22, 2020 at 20:55

    Fellow Monks,

    I am still trying to wrap my head around pointers/references in Perl. I came up with the following program to help me better understand but was hoping you could please help me with some questions.

    use warnings; use strict; use v5.10; my $variable = 22; my $pointer = \$variable; say "The address of \$varible, which contains the value $variable,"; say "is $pointer"; $$pointer = 25; say "Look at that! \$variable now equals $variable"; sub sum_and_diff { my $a = shift @_; my $b = shift @_; my $res = \(shift @_); # why does the "\" work here? my $sum = $a + $b; $$res = $a - $b; return $sum; } my $b = 2; my $diff; # this is line 27 my $pointer_to_diff = \$diff; say "the sum of 5 and $b is ", &sum_and_diff(5, $b, $pointer_to_diff); say "and the difference is ", $pointer_to_diff; say "the sum of 9 and $b is ", &sum_and_diff(9, $b, \$diff); say "and the difference is ", $diff; # this is line 34

    (1) Does the backslash ("\") in the my $res line mean that $res contains the address of the third argument passed to the function? I think so but just wanted to confirm.

    (2) Does the "double dollar sign" ("$$") two lines later mean to put the value of the difference of $a and $b in the memory location that is $res?

    (3) Why do the lines using $pointer_to_diff work but the last two lines using \$diff and $diff not work? I thought that these lines were essentially equivalent and that $diff was defined in line 27. Instead, I get the following output:

    The address of $varible, which contains the value 22, is SCALAR(0x801e64540) Look at that! $variable now equals 25 the sum of 5 and 2 is 7 and the difference is 3 the sum of 9 and 2 is 11 Use of uninitialized value $diff in say at line 34. and the difference is

    Gratias tibi ago
    Leudwinus

    Edited to add: I thought using ${\$diff} in the last line would work but that too gave me the same error.

Multi-dimensional constants
6 direct replies — Read more / Contribute
by Ionic
on Nov 22, 2020 at 00:44

    I'm trying to create a read-only "multi-dimensional" constant using the built-in constant pragma. I know that there's the Readonly module (amongst others), but I'm trying to stick to basics.

    Using anonymous list references doesn't really work, because they can be modified, as documented:

    Even though a reference may be declared as a constant, the reference may point to data which may be changed, as this code shows.
    use constant ARRAY => [ 1,2,3,4 ]; print ARRAY->[1]; ARRAY->[1] = " be changed"; print ARRAY->[1];

    Okay, so I'll use some sort of indirection, I thought, and came up with something like this:

    use strict; use warnings; use Data::Dumper; use constant INVALID_DATA => ( q{invalid}, 0 ); use constant ADD_DATA => ( q{add}, 1 ); use constant REMOVE_DATA => ( q{remove}, 2 ); use constant MODES => ( \&ADD_DATA, \&REMOVE_DATA ); print {*STDERR} "Dumping MODES: " . Dumper ((MODES)); 1;
    … but, this doesn't quite do what I expected. Output:
    Dumping MODES: $VAR1 = sub { "DUMMY" }; $VAR2 = sub { "DUMMY" };
    I was under the impression that constants are really subs that I could take the reference of, but this doesn't seem to be the case.

    Alternatively, I've tried taking direct references, but this is... just merging the lists (which is obviously bad to begin with and what I wanted to avoid by using references) in a weird "reference all elements individually" way:

    use constant MODES => ( \ADD_DATA, \REMOVE_DATA );
    leading to
    Dumping MODES: $VAR1 = \'add'; $VAR2 = \1; $VAR3 = \'remove'; $VAR4 = \2;

    Is there any proper way to do this?

What's the right way to write a method which returns one line at a time from a file?
4 direct replies — Read more / Contribute
by Cody Fendant
on Nov 21, 2020 at 23:21

    I want to write a module such that I can do this with a certain file:

    use MyModule; my $reader = MyModule->new(); ### MyModule opens a file behind the scenes while(my $line = $reader->get_next_line()){ print "here's the next line: $line\n"; } ### stop when we get to the end of the file, obviously

    That is, keep the file handle open in the module and each time I call get_next_line() get one more line.

    Clearly I can't keep re-opening the file every time. Do I use a module like Tie::File?

    Thanks in advance.


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 imbibing at the Monastery: (4)
    As of 2020-11-25 00:43 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found

      Notices?