Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much

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
Replacing an entire line if a substring is found
3 direct replies — Read more / Contribute
by victorz22
on Apr 25, 2017 at 22:09

    Hello Monks, I am trying to create a function that will replace an entire line in a scalar variable if a certain sub string is found. The variable contains a bunch of paths to different files and what I want to do is replace the entire line if that sub string is found. Thank you monks for your endless wisdom!

    The input data looks kinda like this ___DATA___ path/to/some/file path/to/some/other/file path/to/SUBTSTRING/file #replace entire line if SUBSTRING is found path/to/file
    sub scanForSubstringReplaceLine{ my($inputText, $subStringToScan, $lineReplacement) = @_; my $replacedText; $inputText =~ s/$subStringToScan/$lineReplacement/g; $replacedText = $inputText; return $replacedText; }
"executable suffixes" for -x on win32 (perlport)
3 direct replies — Read more / Contribute
by pryrt
on Apr 25, 2017 at 17:27

    Regarding the executable-test -x, perlport says:

    -x (or -X) determine if a file ends in one of the executable suffixes. -S is meaningless. (Win32)

    Where are the "executable suffixes" defined for Win32 perl (strawberry, in my case)? If anything, I would have expected $ENV{PATHEXT}, because that's the closest related idea to "executable" on windows (or possibly the assoc and ftype and their underlying registry entries -- though that's more complicated). However, I've got ".pl" in my PATHEXT variable and properly associated in the registry, but -x "$0" results in a false value (undef). I also tried with a .js file, which is in the Windows-default PATHEXT, but it shows up as non-executable as well. I've experimentally found that .com, .exe, .bat, and .cmd all show up as executable... but none of the others in the default PATHEXT=.COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC


    context: after reading Re^2: how do i run a shell command without waiting for the output, I looked at Proc::Background, and saw that commands were "checked by appending `.exe' to the name in case the name was passed without the `.exe' suffix". Since ".exe" isn't the only extension dropped on Win32 (PATHEXT defines the extension-omission properties for Win32, and .bat is frequently untyped as well), I wanted to suggest a bugfix to allow any extension from PATHEXT: change the hardcoded push(@extensions, '.exe'); to push @extensions, split(/;/, $ENV{PATHEXT} || '.exe');. However, while testing my change against various extensions (explicit or omitted-but-implied), I found that Proc::Background wasn't getting as far as using the @extensions array, since -x was failing. I found the quoted perlport description that Win32 -x has a list of extensions, but I haven't found the official documentation for what that list is (and really, if there's any hardcoded list embedded in the perl ports to Win32, I disagree with them on the same grounds that I disagree with Proc::Background)

    edit: add <readmore> tags...

using an array in place of a file when calling a hash
3 direct replies — Read more / Contribute
by bigip2000
on Apr 25, 2017 at 14:41

    I have this part of a script that calls a hash to apply to listoffiles. What it does it take the file mon2a and read the input and use the hash to organize it into a file that goes into /tmp/host. The file looks like this: CORP-INV-STAGE-NDM.txt It works just fine. I get a file that has /vol/volname,jobid in it when I cat CORP-INV-STAGE-NDM.txt. The problem is, I am trying to figure out how to use an array instead of a file like /tmp/mon2a. I need to know the format of how I should write the script so that it would use an array as input. At this point, it works only if I use the file. I've tried a foreach with an array but that doesn't seem to work. I do not need an answer that would make it run properly right away just a suggestion on how to get rid of

    open my $fh1, '<', "/tmp/host/mon2a" or die "unable to open file 'fil +e' for reading : $!";

    And the syntax of how to replace it with an array that contains the same information.

    my @list = (@lines); foreach (@lines) { my @fields = split /,/; if ( $fields[2] eq '1' || $fields[2] eq '0' ) { #@arr1 = do {"@fields[4]\n"}; push @list, $fields[4]; @list =uniq @list; print "$_\n" for @list; @listx = "$_\n" for @list; print "LETING US SEE @listx"; } } @listx; my %ndmhash; my @listoffiles = ("CORP-INV-STAGE-NDM"); for (@listoffiles) { { my $file = "/tmp/host/" . $_ . '.txt'; open(my $fh, '>', $file) or die "Cannot open file '$file' for writing: +$!"; my $name2 = $file; #$name2 =~ s/\CORP//g; #$name2 =~ s/*CORP-/ /g; $name2 =~ s/'$//; rename($file, $name2); $ndmhash{$_} = $fh; } } my $pattern = join '|', @listoffiles; $pattern = qr/$pattern/; open my $fh1, '<', "/tmp/host/mon2a" or die "unable to op +en file 'file' for reading : $!"; while (<$fh1>) { chomp; my @fields = split(',', $_); local $" = ','; if (($fields[2] eq '1' || $fields[2] eq '0') && /$pattern/) { print { $ndmhash{$fields[4]} } $fields[0], ',' +, $fields[32], ',', $fields[6], "\n" if /MONTHLY/ && !/,-,/ && !/SM3/ && !/FISH +/; print { $ndmhash{$fields[4]} } $fields[0], ',' +, $fields[34], ',', $fields[6], "\n" if /MONTHLY/ && !/,-,/ && /BASKET/; print { $ndmhash{$fields[4]} } $fields[0], ',' +, $fields[35], ',', $fields[6], "\n" if /MONTHLY/ && !/,-,/ && /FORM/; } } { close $ndmhash{$_} or die "Cannot close file '$_': $!"; }
Re-dimensioning an HTML table with Perl ?
12 direct replies — Read more / Contribute
by TheDonald
on Apr 25, 2017 at 13:08
    I'm staring down the abyss of something that I would rather not do manually. So it occurred to me that Perl is probably just the sort of thing for such a random requirement. What I need to do is "re-dimension" (what is the correct word ?) an HTML table. The table is currently 5x12, and I want to turn it into, say, 7x9. The thought of lifting and shifting dozens of cells by hand is filling me with dread ! I've no ideas where to start in terms of automating this, let alone how to code it (I've only recently joined the long road to Perl wisdom !).
DBI output into browser using CGI
6 direct replies — Read more / Contribute
by billycote
on Apr 25, 2017 at 10:53

    Hi folks. I have a little bit of code that takes in a couple of arguments and hooks up to a database using DBI. I want it to display back to a web page using CGI methods. It works great on the command line. If I copy the data back into an HTML page the browser looks exactly like I want it to. However.... when I try to pull it up directly from the browser the browser never gets beyond writing the header information. So my question is how can I make the browser wait until the whole HTML is there before trying to display it.

    Here's the pertinent parts of my code.

    #!/usr/bin/perl #use strict; use CGI; use DBI; use HTML::Template; $| = 1; open (STDERR,">/apps2/apache/cgi-bin/errorLog.txt"); my $q = CGI->new; my $sth; my $env; my $database; my $host; my $port; my $user; my $pw; print $q->header(-nph=>1); my $style = get_style(); print $q->start_html( -title => "XREF", -style => {-code => $style}, ); my $fields = "*"; my $symbol_in = $q->param('symbol'); my $site = $q->param('site'); print $q->h1 ("ACTIV INSTRUMENT TABLE DATA"); my $fields = "*"; #my @fields_in = $q->param('fields'); chomp $symbol_in; chomp $site; chomp $symbol_in; chomp $site; $symbol_in =~ s/\s//; foreach (@fields_in){ $_ =~ s/\s//; #if ($_ eq $type){ #next; #}else{ #$fields = join(',',$fields,split); #} $fields = join(',',$fields,split); } my $symbol = join('\',\'',split(/,/,$symbol_in)); &getConfig; my $dbh = DBI->connect("dbi:Oracle:sid=$database;host=$host", $user, $ +pw) or die "Can't connect to Oracle database: $DBI::errstr\n"; my $sql = qq{ SELECT $fields FROM t_activ_instrument where fps_subject + = '$symbol' }; my $sth = $dbh->prepare($sql); $sth->execute(); my $columns = join("<th>", @{ $sth->{NAME} }); my @row; while(@row = $sth->fetchrow_array) { print $q->table({-scope=>"col", -border=>2, -cellpadding => 5}, $q->th("$columns"), $q->Tr($q->td( join("<td>", @row), "\n")), ); }; $sth->finish; $dbh->disconnect; print $q->end_html; print "\r\n";
    Like I said outside the browser looks great. Inside the browser all I get is this (consolidated the style section):
    <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" ""> <html xmlns="" lang="en-US" xml:lang="en-U +S"> <head> <title>XREF</title> <style type="text/css"> <style> . . . </style> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1 +" /> </head> <body> <h1>ACTIV INSTRUMENT TABLE DATA</h1>
'submit' a series of form selections
3 direct replies — Read more / Contribute
by Anonymous Monk
on Apr 25, 2017 at 08:57
    i am using Perl to construct a web page with a number of dropdown menus. I only want to 'submit' the form once after all the selections have been made. Chrome will not let me paste my source code on this box so I apologize for its absence.
"my" declaration problem
6 direct replies — Read more / Contribute
by Hosen1989
on Apr 25, 2017 at 07:17

    Dear ALL,

    I was debug some old dirty script of mine (which without strict nor warnings ^_^), and faced this issue:

    As you can see in case(1), variable $me had been declared more than once, and to output of this script is: []

    #----------[ CASE(1) ]----------# my $v_place = 'home'; my $me = 'moving'; my $me = 'at home' if($v_place =~ m/^home/); my $me = 'at work' if($v_place =~ m/^work/); print "[$me]"; __END__ output: [] #-------------------------------#

    But after correct the declaration problem as in case(2), we got the correct output: [at home].

    #----------[ CASE(2) ]----------# my $v_place = 'home'; my $me = 'moving'; $me = 'at home' if($v_place =~ m/^home/); $me = 'at work' if($v_place =~ m/^work/); print "[$me]"; __END__ output: [at home] #-------------------------------#

    Now,can any monk explain me just what happen here?



How to pass an image object to a subroutine??
No replies — Read more | Post response
by dazz
on Apr 25, 2017 at 07:05
    Hi I want to call a subroutine ImageNotDark. I want to pass an Image::Magick object ($pic). By design, the object is not changed inside the subroutine. My problem is that I am not passing the image object correctly.
    # Convert to Image::Maggick image my $pic = Image::Magick->new(magick=>'jpg'); # create new image obj +ect $pic->BlobToImage($img); #convert the grabbed blob image to Image::Ma +gick object ## test point A #pass the $pic object to the subroutine and measure image darkness. my $test = ImageNotDark ($pic); #
    The code snippet at the start of the subroutine is as follows:
    sub ImageNotDark { # Argument is one reference to an image object. # ImageNotDark compares the image with a blank black canvas. If the c +omparison is # above the defined threshold, the image is bright enough to send (not + dark). # the return value is true if the images is bright enough. my $iutImage = Image::Magick->new; #the image tested for darkness $iutImage->Read(@_); # get the image under test (iut)
    So the debugger shows that $iutImage is not initialised. At test point A, I temporarily added code to save the $pic image to a file. I was able to confirm that $pic holds a valid image. So I am reasonably certain the problem is the way I call the subroutine and attempt to pass the image. Any tips would be much appreciated.

    SOLVED with the answer below from Haukex. I applied the option on the last line.
    You don't need to construct a new Image::Magick over the argument passed to the subroutine. The normal way to handle arguments is (see perlsub):
    sub ImageNotDark { my ($iutImage,$arg2,$arg3,...) = @_; # --OR-- my $iutImage = shift; my $arg2 = shift; ...
    Or, if your intention were to work with a copy of the image in the subroutine, you could simply do my $imgCopy = $_[0]->Clone(); inside the subroutine.
'Missing version identifier' error while connecting to Hive, using Thrift module of Perl
1 direct reply — Read more / Contribute
by Omnitrix
on Apr 25, 2017 at 07:03

    I tried to connect to Hive using Thrift::API::HiveClient2. Wrote the following:

    #!usr/bin/perl use strict; use warnings; use Thrift::API::HiveClient2; my $port = 12345; my $host = '123:456:789:987'; my $client = Thrift::API::HiveClient2->new( host => $host , port => $port, ); $client->connect() or die "Failed to connect\n"; my $query = "hive query;"; my $rh = $client->execute($query);

    An I am getting the following error->

    Thrift::TException error: Missing version identifier (code 0) (in cl +eanup) Thrift::TException error: Missing version identifier (code 0) at (eval + 144) line 31.

    My Hive client is HiveClient2. What am I missing?

Replacing a block of text inside two keys with another block of text
4 direct replies — Read more / Contribute
by victorz22
on Apr 24, 2017 at 17:13

    Hello Monks, I am trying to read in a file, search for a hash, replace all the text within two hash keys, and then write the changed data back into the file. I wrote a function called truncateText() to that uses the hash keys as the key words for the beginning and end of the block I need. My function to parse text between two keywords works but I am having difficulty replacing the data in the file. I haven't written the code yet to write back into the file because the data wasn't getting replaced accurately. Thank you so much monks for your endless wisdom.

    sub populateHash{ my $inputFile = 'input.txt'; my $fileContent = do { open(my $fileHandle, $inputFile ) or die "Could not open file +'$inputFile ' $!"; local $/; <$fileHandle>; }; my $hashData = truncateText($fileContent, "key1 => {", "key2 =>"); my $dataToReplace = truncateText($hashData, "END_SEARCH_PATHS", "E +ND_SEARCH_PATHS"); #Removes Comments works best if called multiple times $dataToReplace =~ s/\#.*//; $dataToReplace =~ s/\#.*//; $dataToReplace =~ s/\#.*//; $dataToReplace =~ s/\#.*//; #replacementData was gathered in another function and stored i +n a global variable $fileContent =~ s/$dataToReplace/$replacementData/g; print Dumper($fileContent); } sub truncateText{ #Truncates text by removing everything before and and after the pa +ssed in variables my($text, $beginString, $endString) = @_; my $truncatedText; if($text =~ /\Q$beginString\E(.*?)\Q$endString\E/s){ $truncatedText = $1; #print $truncatedText; } return $truncatedText; }

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 all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (9)
    As of 2017-04-29 14:30 GMT
    Find Nodes?
      Voting Booth?
      I'm a fool:

      Results (532 votes). Check out past polls.