http://qs321.pair.com?node_id=479

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
Extract information from several files in directory
4 direct replies — Read more / Contribute
by Sofie
on Nov 27, 2020 at 09:36

    Hi I am a beginner at Perl, trying to do some really simple things, but nothing seems simple.. I have a folder with a bunch of tab sep txt files. All the files have the same type of information, and I need to extract the information from one of the columns in each file and put in a new file. I have previously managed to do this with one file by readin gthe file into an array and iterating each row of the array, spliting it on tab and the taking the second column (where the data I want is) and printing this to a new file. But now I have several files. I started by using a while loop to open the directory and counting the number of files in the directory. But struggling to get to reading each file and extracting my data.. After lots of googling, there seems to be lots of different answers, but can't really understand them. I need something very simple so I can understand how it works.

    #!/usr/bin/perl -w use strict; #create file to write to open (LABNR, ">>Labnr_all.txt") or die "Could not open file"; #open the directory where files are located $dirname = 'Filer'; opendir (DIR, $dirname) or die "Could not open $dirname\n"; #count files $nrfiles = 0; while ($filename = readdir(DIR)){ $nrfiles ++ if $filename =~ /\.txt/; print "$filename\n" if -f $filename; #this is where I want to look into each file and extract the info... } print "The number of files in the folder: $nrfiles\n"; closedir(DIR)
Perl CGI HTTP2
2 direct replies — Read more / Contribute
by marcelv
on Nov 26, 2020 at 15:32

    Hi all,

    I currently have quite some scripts running on Perl 5.24 on a Microsoft Windows Server running IIS 10.0. On this server I use a certificate to for HTTPS connections. The scripts are all using the CGI.pm module to do CGI. As I do use Non-Parsed Headers (NPH), all my scripts start with the prefix "nph-" and have the following line to import the CGI module:
    use CGI qw/:standard -nph/;

    Now when a browser requests one of my scripts, these scripts are executed twice. I have made a Wireshark trace and I see the following happening:

    1. The browser does the TLS handshake
    2. The browser does a HTTP2 request to the script
    3. The server responds with HTTP_1_1_REQUIRED
    4. The browser does another request, but now uses HTTP/1.1
    5. The server sends a HTTP/1.1 response with the script output

    This is most evident when Firefox is used, as it does not remember it should use HTTP/1.1 for the request, where Chrome, Edge and Safari do remember.

    Now when I remove the "nph-" prefix from the script name (and do not change the contents), the following happens:

    1. The browser does the TLS handshake
    2. The browser does a HTTP2 request to the script
    3. The server sends the HTTP2 response with the script output

    Now I could change all my script names by removing the "nph-" prefix, but it seems that the scripts do not really do NPH anymore as the server is sending back a HTTP2 response, whereas with the "nph-" prefix the exact headers as generated by my script are received by the browser.

    Now my question: is it possible to HTTP2 via CGI using the CGI module or any other module?

    Marcel

Watch the value of hash key in perldebug
2 direct replies — Read more / Contribute
by frogsausage
on Nov 26, 2020 at 09:00

    Hello Monks, long time no see...!

    Here's my situation:

    • - I have a (very large) piece of code with many modules
    • - it is is read only

    I have a file that contains $hash{key}{key}{key} = "value".
    $hash is defined as our
    From the main code, it is read in a sub inside one of these modules.
    When eval'd in that sub, its content updates the value for $hash{key}{key}{key}

    I already figured out what was happening by reading the code, setting a fair number of breakpoints and using X var in the debugger.
    I believe I could have done it smarter and watching $hash{key}{key}{key} and voilą.

    I tried the following:

    DB<341> w $hash->{key}->{key}->{key}

    But it gives me this:

    Use of each() on hash after insertion without resetting hash iterator +results in undefined behavior, Perl interpreter: 0x677010 at /somepat +h/cpan/5.18.4/1/somebuild/lib/perl5/Devel/Symdump.pm line 108. at /somepath/cpan/5.18.4/1/somebuild/lib/perl5/Devel/Symdump.pm line +108. Devel::Symdump::_symdump(Devel::Symdump=HASH(0x9d20270), "main") c +alled at /somepath/cpan/5.18.4/1/somebuild/lib/perl5/Devel/Symdump.pm + line 43 Devel::Symdump::_doit(Devel::Symdump=HASH(0x9d20270), "main") call +ed at /somepath/cpan/5.18.4/1/somebuild/lib/perl5/Devel/Symdump.pm li +ne 37 Devel::Symdump::new("Devel::Symdump", "main") called at [REDACTED] + line 361 [REDACTED]

    Any idea?
    Thanks!

Regexp substitution using variables
7 direct replies — Read more / Contribute
by MikeTaylor
on Nov 25, 2020 at 14:20
    I have a string $value that I want to transform by regexp substitution. But the pattern, replacement and flags are known only at run-time. They are specified by $pattern, $replacement and $flags. So I want to do something like
    $value =~ s/$pattern/$replacement/$flags;
    but of course that doesn't work as intended. Or perhaps something like this, if I could only find the right class name:
    my $re = new Regexp($pattern); my $value = $re->substitute($value, replacement, $flags);
    There has to be way to do this ... right?
script hanging at thread start
6 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

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.