Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine


( #480=superdoc: print w/replies, xml ) Need Help??

If you've discovered something amazing about Perl that you just need to share with everyone, this is the right place.

This section is also used for non-question discussions about Perl, and for any discussions that are not specifically programming related. For example, if you want to share or discuss opinions on hacker culture, the job market, or Perl 6 development, this is the place. (Note, however, that discussions about the PerlMonks web site belong in PerlMonks Discussion.)

Meditations is sometimes used as a sounding-board — a place to post initial drafts of perl tutorials, code modules, book reviews, articles, quizzes, etc. — so that the author can benefit from the collective insight of the monks before publishing the finished item to its proper place (be it Tutorials, Cool Uses for Perl, Reviews, or whatever). If you do this, it is generally considered appropriate to prefix your node title with "RFC:" (for "request for comments").

User Meditations
Is it still worth learning Perl as a first language?
5 direct replies — Read more / Contribute
by tm2383
on May 03, 2018 at 20:45

    I'm curious to know if Perl Monks believe that Perl is still worth learning as a primary programming language. I've used it in the past for some bioinformatics programming and really like the language. I'm interested in a change of career and wonder if it is worth the time investment really learning Perl in depth with the aim of becoming a Perl developer some time in the future. I know that there are a lot of 'trendier' programming languages out there like Python, PHP and Ruby. My logic behind learning Perl is that there are fewer people learning it compared to other languages. I assume that the market is awash with programmers using these other languages and that there might be a niche for perl programmer. Does anyone here work as a professional Perl programmer, either as an employee or a freelancer? Is there a future in Perl programming, or is a lot of the work migrating Perl to another platform? Are any start ups still using Perl frameworks like Catalyst?

RFC: 100 PDL Exercises (ported from numpy)
8 direct replies — Read more / Contribute
by mxb
on May 03, 2018 at 05:05

    I've been trying to slowly learn PDL over the last few months. While I'm aware of some available documentation (the PDL::* perldoc, The PDL Book, etc.) I've found the beginner documentation to be lacking. Therefore, I thought it would be a good idea to start 'porting' some numpy documentation to PDL for new users such as myself.

    I've started with 100 numpy exercises, and this is the work in progress port to Perl/PDL.

    As I'm still learning PDL, some solutions may be less than optimal, while others do not currently have solutions as they are outside my of level of competency. Therefore, I'm posting this WIP to PM to ask for comments and contributions.

    As with most of Perl, there is more than one way to do it for most of these. I've decided to keep the $var->function() syntax as much as possible to easily be able to chain operations.

    Thanks in advance!

    100 PDL Exercises

    1. Load the PDL library:
    use PDL;
    2. Print the PDL version:
    use PDL::Version; print $PDL::Version::VERSION;
    3. Create a null vector of size 10:
    my $z = zeros(10); print $z;
    4. How to find the memory size of any matrix?
    use PDL::Core ':Internal' my $z = zeros(10); my $size = howbig($z->get_datatype) * $z->nelem; print $size;
    5. How to get the documentation of the numpy add function from the command line?
    # To get top level PDL help perldoc PDL
    6. Create a null vector of size 10 and set the fifth value to 1:
    my $z = zeros(10); $z->slice(4) .= 1; print $z;

    or with PDL::NiceSlice loaded:

    my $z = zeros(10); $z(4) .= 1; print $z;

    Note: It will be assumed that PDL::NiceSlice will be loaded from now on.

    7. Create a vector with values ranging from 10 to 49:
    my $z = 10 + sequence(40); print $z;
    8. Reverse a vector (first element becomes last)
    my $z = sequence(10); $z = $z(-1:0); print $z;
    9. Create a 3x3 matrix with values from 0 to 8:
    my $z = sequence(3,3); print $z;
    10. Find indices of non-zero elements in the vector [1,2,0,0,4,0]:
    my $vec = pdl [1,2,0,0,4,0]; my $nz = $vec->which; print $nz;
    11. Create a 3x3 identity matrix:
    my $z = identity(3); print $z;
    12. Create a 3x3x3 matrix of random values:
    my $z = random(3,3,3); print $z;
    13. Create a 10x10 matrix of random values and find the minimum and maximum values:
    my $z = random(10,10); print $z->min, $z->max;
    14. Create a random vector of size 30 and find the mean value:
    my $z = random(30); print $z->avg;
    15. Create a 2D matrix with 1 on the border and 0 inside:
    my $z = ones(10,10); $z(1:8,1:8) .= 0; print $z;
    16. How to add a border (filled with 0's) around an existing matrix?
    my $a = random(8,8); my $x = zeros(2 + $a->dim(0), 2 + $a->dim(1)); $x(1:8,1:8) .= $a; print $x;
    17. What is the result of the following expression?
    18. Create a 5x5 matrix with values 1,2,3,4 just below the diagonal:
    my $z = identity(5) * (1 + sequence(5)); $z->where($z > 4) .= 0; $z = $z->transpose->rotate(1)->transpose; print $z;
    19. Create a 8x8 matrix and fill it with a checkerboard pattern:
    my $z = zeros(8,8); $z("0::2","0::2") .= 1 $z("1::2","1::2") .= 1 print $z;
    20. Consider a (6,7,8) shape matrix, what is the index (x,y,z) of the 100th element?
    my $z = random(6,7,8); my $hundreth = $z->clump($z->ndims)->(100); # TODO: find index of $hundreth in $z
    21. Create a checkerboard 8x8 matrix using the tile function:
    22. Normalize a 5x5 random matrix:
    my $z = random(5,5); $z = (($z - $z->min) / ($z->max - $z->min)); print $z;
    23. Create a custom dtype that describes a color as four unsigned bytes (RGBA):
    24. Multiply a 5x3 matrix by a 3x2 matrix (real matrix product):
    my $x = ones(3,5); my $y = ones(2,3); print $x x $y;
    25. Given a 1D matrix, negate all elements which are between 3 and 8, in place.
    my $z = sequence(10); $z->where($z <= 8 & $z>= 3) *= -1; print $z;
    26. What is the output of the following script?
    27. Consider an integer vector Z, which of these expressions are legal?
    my $z = sequence(long, 10); $z ** $z; 2 << $z >> 2; $z <- $z; 1j * $z; $z / 1 / 1; $z < $z > $z;
    28. What are the result of the following expressions?
    print pdl(0) / pdl(0); print pdl(0) // pdl(0); print float int pdl(NaN);
    29. How to round away from zero a float matrix?
    $z = 20 * random(10) - 10; $z->where($z < 0) .= - $z->where($z < 0)->abs->ceil; $z->where($z > 0) .= $z->where($z > 0)->ceil; print $z;
    30. How to find common values between two matrix?
    my $z1 = long 256 * random(10); my $z2 = long 256 * random(10); print intersect $z1, $z2;
    31. How to ignore all numpy warnings (not recommended)?
    n/a for PDL
    32. Is the following expressions true?
    33. How to get the dates of yesterday, today and tomorrow?
    # No built in PDL time/date functions my $yesterday = time() - (60 * 60 * 24); my $today = time(); my $tomorrow = time() + (60 * 60 * 24);
    34. How to get all the dates corresponding to the month of July 2016?
    35. How to compute ((A+B)*(-A/2)) in place?
    my $a = ones(3); my $b = 2 * ones(3); my $c = 3 * ones(3); print ($a + $b) * (- $a/2)
    36. Extract the integer part of a random matrix using 5 different methods:
    my $z = 10 * random(10); print $z->ceil; print $z->floor; print byte $z; print long $z; print longlong $z;
    37. Create a 5x5 matrix with row values ranging from 0 to 4:
    my $z = xvals zeros(5,5); print $z;
    38. Consider a generator function that generates 10 integers and use it to build an matrix:
    39. Create a vector of size 10 with values ranging from 0 to 1, both excluded:
    my $z = (sequence(12) / 11)->slice("1:10"); print $z;
    40. Create a random vector of size 10 and sort it:
    my $z = random(10)->qsort; print $z;
    41. How to sum a small matrix faster than np.sum?
    42. Consider two random matrices A and B, check if they are equal:
    my $a = random(10); my $b = random(10); print $a == $b;
    43. Make an array immutable (read-only):
    44. Consider a random 10x2 matrix representing cartesian coordinates, convert them to polar coordinates:
    use PDL::Complex; my $z = random(2,10); my $p = Cr2p($z); print $p;
    45. Create random vector of size 10 and replace the maximum value by 0:
    my $z = random(10); $z->where($z == $z->max) .= 0; print $z;
    46. Create a structured array with x and y coordinates covering the [0,1]x[0,1] area.
    47. Given two arrays, X and Y, construct the Cauchy matrix C (Cij =1/(xi - yj)):
    48. Print the minimum and maximum representable value for each data type:
    # This cannot be done directly, but you can extract the underlying # C type used for each PDL type: print byte->realctype; print short->realctype; print ushort->realctype; print long->realctype; print longlong->realctype; print indx->realctype; print float->realctype; print double->realctype;
    49. How to print all the values of an array?
    # Set maximum print limit to one million elements $PDL::toolongtoprint = 1_000_000; $z = zeros(1000,1000); print $z;
    50. Find the nearest value from a given value in an array:
    51. Create a structured array representing a position (x,y) and a color (r,g,b):
    52. Consider a random vector with shape (100,2) representing coordinates, find point by point distances:
    my $z = random(10,2); my ($x,$y) = ($z(:,0), $z(:,1)); my $d = (($x - $x->transpose)->ipow(2)) + (($y - $y->transpose)->ipow(2)); print $d;
    53. How to convert a float (32 bits) array into an integer (32 bits) in place?
    my $z = float 1000 * random(10); $z = long $z;
    54. Consider the following file:
    1,2,3,4,5 6,,,7,8 ,,9,10,11

    How to read it?

    my $z = rcols "data.csv", { COLSEP => ',' }, []; $z = $z->transpose; # optional (PDL is column major) print $z;
    55. What is the equivalent of enumerate for numpy arrays?
    56. Generate a generic 2D Gaussian-like array:
    my $z = grandom(10,10); # correct? print $z;
    57. How to randomly place p elements in a 2D array?
    my $p = 3; my $z = zeros(10,10); my $i = indx $z->nelem * random($p) $z->clump($z->ndims)->($i) .= 1; print $z;
    58. Subtract the mean of each row of a matrix:
    my $z = random(5, 10); $z = $z - $z->avgover->transpose; print $z;
    59. How to I sort an array by the nth column?
    60. How to tell if a given 2D array has null columns?
    61. Find the nearest value from a given value in an array:
    62. Considering two arrays with shape (1,3) and (3,1), how to compute their sum using an iterator?
    63. Create an array class that has a name attribute:
    64. Consider a given vector, how to add 1 to each element indexed by a second vector (be careful with repeated indices)?
    65. How to accumulate elements of a vector (X) to an array (F) based on an index list (I)?
    66. Considering a (w,h,3) image of (dtype=ubyte), compute the number of unique colors:
    my ($w, $h) = (16, 16); my $i = byte 256 * random($w, $h, 3); my $uniqcol = $i->uniq->nelem; print $uniqcol;
    67. Considering a four dimensions array, how to get sum over the last two axis at once?
    68. Considering a one-dimensional vector D, how to compute means of subsets of D using a vector S of same size describing subset indices?
    69. How to get the diagonal of a dot product?
    my $z1 = random(10, 10); my $z2 = random(10, 10); print $z1->inner($z2);
    70. Consider the vector [1, 2, 3, 4, 5], how to build a new vector with 3 consecutive zeros interleaved between each value ?
    my $z = pdl [1,2,3,4,5]; my $nz = 3; my $x = zeros($z->dim(0) * $nz); $x("0::$nz") .= $z; print $x;
    71. Consider an array of dimension (5,5,3), how to multiply it by an array with dimensions (5,5)?
    my $z1 = ones(5,5,3); my $z2 = 2 * ones(5,5); print $z1 * $z2;
    72. How to swap two rows of an array?
    my $z = sequence(5,5); $z(0:1,) .= $z(1:0,)->sever; print $z;
    73. Consider a set of 10 triplets describing 10 triangles (with shared vertices), find the set of unique line segments composing all the triangles:
    74. Given an array C that is a bincount, how to produce an array A such that np.bincount(A) == C?
    75. How to compute averages using a sliding window over an array?
    76. Consider a one-dimensional array Z, build a two-dimensional array whose first row is (Z[0],Z[1],Z[2]) and each subsequent row is shifted by 1 (last row should be (Z[-3],Z[-2],Z[-1])
    77. How to negate a boolean, or to change the sign of a float inplace?
    my $z = long 2 * random(10); $z = not $z; print $z; $z = -5 + sequence(10); $z = -1 * $z; print $z;
    78. Consider 2 sets of points P0,P1 describing lines (2d) and a point p, how to compute distance from p to each line i (P0[i],P1[i])?
    79. Consider 2 sets of points P0,P1 describing lines (2d) and a set of points P, how to compute distance from each point j (P[j]) to each line i (P0[i],P1[i])?
    80. Consider an arbitrary array, write a function that extract a subpart with a fixed shape and centered on a given element (pad with a fill value when necessary):
    81. Consider an array Z = [1,2,3,4,5,6,7,8,9,10,11,12,13,14], how to generate an array R = [[1,2,3,4], [2,3,4,5], [3,4,5,6], ..., [11,12,13,14]]:
    $z = 10 * random(15); $len = 4; my @r = (); push @r, $z($_:$_ + $len-1) for (0 .. $z->nelem - $len) $r = pdl @r; print $r;
    82. Compute a matrix rank:
    my $z = 10 * random(10,10); my ($u, $s, $v) = $z->svd; my $rank = $s->where($s > 1e-10); print $rank;
    83. How to find the most frequent value in an array?
    84. Extract all the contiguous 3x3 blocks from a random 10x10 matrix:
    my $z = long 5 * random(10,10); my $dim = 3; my (@out, $out); for my $i ( 0 .. $z->dim(0) - $dim - 1) { for my $j ( 0 .. $z->dim(1) - $dim - 1) { push @out, $z($i:$i+$dim,$j:$j+$dim); } } $out = pdl @out; print $out;
    85. Create a 2D array subclass such that Z[i,j] == Z[j,i]:
    86. Consider a set of p matrices wich shape (n,n) and a set of p vectors with shape (n,1). How to compute the sum of of the p matrix products at once? (result has shape (n,1))
    87. Consider a 16x16 array, how to get the block-sum (block size is 4x4)?
    88. How to implement the Game of Life using PDL arrays?
    89. How to get the n largest values of an array:
    my $z = 10 * random(20); my $n = 3; print $z->qsort->(-$n:);
    90. Given an arbitrary number of vectors, build the cartesian product (every combinations of every item)
    91. How to create a record array from a regular array?
    92. Consider a large vector Z, compute Z to the power of 3 using 3 different methods:
    my $z = random(5e7); $z ** 3; $z->ipow(3); $z->power(3,0);
    93. Consider two arrays A and B of shape (8,3) and (2,2). How to find rows of A that contain elements of each row of B regardless of the order of the elements in B?
    94. Considering a 10x3 matrix, extract rows with unequal values (e.g. [2,2,3]):
    95. Convert a vector of ints into a matrix binary representation:
    my $z = pdl [0,1,2,3,15,16,32,64,128]; my $bits = ($z->transpose & (2 ** xvals(9))); $bits->where($bits > 0) .= 1; print $bits;
    96. Given a two dimensional array, how to extract unique rows?
    my $z = long 2 * random(3,6); print $z->uniqvec;
    97. Considering 2 vectors A & B, write the einsum equivalent of inner, outer, sum, and mul function:
    98. Considering a path described by two vectors (X,Y), how to sample it using equidistant samples:
    99. Given an integer n and a 2D array X, select from X the rows which can be interpreted as draws from a multinomial distribution with n degrees, i.e., the rows which only contain integers and which sum to n:
    100. Compute bootstrapped 95% confidence intervals for the mean of a 1D array X (i.e., resample the elements of an array with replacement N times, compute the mean of each sample, and then compute percentiles over the means):

    edit: link to PDL for those who do not know what it is

Curious about Perl's strengths in 2018
13 direct replies — Read more / Contribute
by Crosis
on Apr 12, 2018 at 02:57

    First of all, forgive me if this isn't quite the right place. I am a new user and am not entirely sure about the rubric for this area of the site, though I'm pretty sure this is the right place.

    About a decade ago, when I was in my late teens and early twenties, I was very proficient in and eager to use Perl. Though it was a little idiosyncratic, it was certainly much less tedious to get things done in than C, which I had used earlier. Gradually I drifted away towards Python and now I use it for most things. I've since forgotten virtually everything I knew about Perl. I know that Python will still be obviously superior for, for example, most aspects of scientific computing (possibly excepting bioinformatics?) and machine learning, but where does Perl really shine these days? That goes equally for the more conventional Perl 5 as well as the newer Perl 6. Also, what are hot items on CPAN these days?

RFC: perl sub diff between two files
4 direct replies — Read more / Contribute
by bliako
on Mar 26, 2018 at 08:24
    Fellow Monks,

    Recently, I was in need to compare two versions of the same perl module containing many subs. I was interested to see the difference between the contents of subs with the same name. This happened because I forked the same code in two different machines and made changes in the modules in both machines.

    For this purpose I wrote the following basic script which I place here for public use but also for comments from the monastic community.

    The simple script makes use of two excellent modules, namely PPI and Text::WordDiff. PPI parses perl code and is capable of extracting subs and their contents. Text::WordDiff outlines (and color-codes) the differences between two blocks of text (the contents of identically-named subs in two files).

    Unix's diff is a fine tool in general, but code has a few idiosyngracies which make diffing sometimes impractical. For example when same-content subs have different order in their respective files.

    That said, I wanted a quick tool to check my two versions of the perl module, find enhancements in either file I made and produce a final version.

    Here is the script:

    #!/usr/bin/env perl use strict; use warnings; use PPI; use Text::WordDiff; if( scalar(@ARGV) != 2 ){ print usage($0) . "\n"; exit(0); } my ($infile1, $infile2) = @ARGV; my $doc = PPI::Document->new($infile1); if( ! defined($doc) ){ print STDERR "$0 : call to ".'PPI::Document->ne +w()'." has failed for input file '$infile2'.\n"; exit(1); } my (%subs1, %subs2, $asub); for $asub ( @{ $doc->find('PPI::Statement::Sub') || [] } ) { # loop over all subs in file unless ( $asub->forward ) { # store sub's contents in hash keyed on sub's name $subs1{ $asub->name } = $asub->content; } } $doc = PPI::Document->new($infile2); if( ! defined($doc) ){ print STDERR "$0 : call to ".'PPI::Document->ne +w()'." has failed for input file '$infile2'.\n"; exit(1); } for $asub ( @{ $doc->find('PPI::Statement::Sub') || [] } ) { # loop over all subs in file unless ( $asub->forward ) { # store sub's contents in hash keyed on sub's name $subs2{ $asub->name } = $asub->content; } } my ($k, $v1, $v2, $res, $anitem); my @dont_exist = (); my %allkeys = map { $_ => 1 } (keys %subs1, keys %subs2); foreach $k (sort keys %allkeys){ if( ! defined($v1=$subs1{$k}) ){ push(@dont_exist, "$k : Does not exist in '$infile1'\n"); next } elsif( ! defined($v2=$subs2{$k}) ){ push(@dont_exist, "$k : Does not exist in '$infile2'\n"); next } # sub (same name) exists in both files, diff sub's contents in fil +es: $res = Text::WordDiff::word_diff( \$v1, \$v2, ); # print diff results print "----- begin '$k' -----\n" . $res . "\n----- end '$k' ------\n" ; } # and also print the subs which exist in one file but not the other fi +le print join("", @dont_exist); exit(0); sub usage { return "Usage : ".$_[0]." file1 file2\nColor output guide:\n\tRED +: file1\n\tGREEN: file2\n" }


Termux for all your Perl-needs on Android
4 direct replies — Read more / Contribute
by morgon
on Mar 25, 2018 at 19:29

    I don't know how well known this is (it's probably quite old new for you) but recently I had the problem of wanting to run a Perl-script on a non-rooted Android-tablet and came across the fabulous Termux-project.

    Installing this app gives you a terminal-environment and with a simple

    pkg install perl

    you get a working 5.26.1 perl. Now add

    pkg install make pgk install clang

    and voila you have a fully functional cpan-client that allows you to install even xs-modules.

    Really nice...

Converting everything (MySql, perl, CGI, website) to UTF-8
1 direct reply — Read more / Contribute
by jfrm
on Mar 16, 2018 at 04:01

    In order to deal with Japanese orders, I recently had to convert my whole system to UTF-8. A day or 2's job I thought. 2.5 weeks later, I'm finally there. There is a lot of stuff on Perlmonks and the internet in general about this but it is hard to understand and even harder to implement. Most of the advice I read was along the lines of RTFM or did not give the whole story. It's pretty clear this is a common problem, too. I wanted to give something back to the community as perlmonks has helped me a lot, so I thought I would share some insights that I hope will be practical and useful.

    There is a lot out there telling you to used decode/encode and giving lectures on internal representation of UTF8 in Perl and wotnot. In the end I've only had to use decode in one place where data is coming in from elsewhere. If you get all the other stuff right, I believe you shouldn't need any or many instances of decode/encode.

    Our system involves a local website using MySQL, a live website, static webpages, generated webpages, various text files and CGI website forms. All of this needs work to make it work. Here are the things that I needed to do:

    Checklist of changes to make

    * Firstly, every script file is converted to UTF-8 format. Easy.

    * Every script to have this at the top: use utf8; This tells perl that the script itself is in UTF format. So a in the script will be interpreted as a UTF-8 . It's no good just putting this in the calling script as it only seems to extend for the scope of the script underneath; not any other scripts that are imported with require...

    * Ideally each database table must be turned to UTF-8 format. This turns out to be difficult and time-consuming because any tables with foreign keys won't convert unless you first delete the foreign keys. For those that won't easily convert, you can convert only the fields that might hold UTF-8 encoded characters to UTF-8 format. Also BLOB fields are a problem unless the whole table is UTF-8. I had to convert problem BLOB fields to TEXT fields and then convert them to UTF-8 format (a 2 step process, doing both in 1 step fails).

    * Rose::DB (or whatever database method you are using) needs to be told that incoming data from the Database is in UTF-8. For Rose:DB, add this to the connector in and then regenerate connect_options => {mysql_enable_utf8 => 1}

    * binmode(STDOUT, ":utf8"); # Put this at the top of a script - tells it to output UTF to stdout. Not sure if this is just needed only once in the opening script or in any requires, too?

    * Webpages must have this in the head section: <meta http-equiv="content-type" content="text/html; charset=UTF-8">

    * use CGI qw(-utf8); to treat incoming CGI parameters as UTF-8. Getting this working was subtle - test carefully.

    * When outputting a CGI webpage, the first thing to do is to output the http header and this needs to be told about UTF8 too: Personally I found that print header(-type=>'text/html', -cookie=>'', -charset=>'utf-8'); gave problems with cookies so ended up outputting it direct: print "Content-type: text/html; charset=utf-8\n$cookie\n\n";

    * use open ':encoding(utf8)'; # tells it to deal with all files in a UTF8 way. In fact, I was more careful with this and did not use it in general. Instead, I have specifically opened each file that needed it with open($fh, '<:encoding(UTF-8)', $filename);. Because some files that I have to deal with have not been given to me in UTF-8 format. Careful - this can fail if the $filename variable is not also in UTF8!

    Identifying Errors

    In doing this, you will make mistakes and see weird characters appearing in unexpected places. I developed my own personal understanding of how to deal with them. These are my own notes for practical situations so please bear with me, if the explanations are not exactly correct - it was about fixing stuff not being a perl rocket scientist.

    • You see displayed as '£'
      • If sign is coming from dbase and is stored correctly in dbase and webpage is correctly displaying UTF-8 characters from elsewhere (e.g. write japanese text into the perl script and print it), then the UTF-8 is not being retrieved from the database as UTF-8 (presumably being assumed to be Latin1).
      • The is within a UTF-8 encoded PERL script but use utf8; is not set at the top of the script.
      • The is displayed correctly in a form initially but when the form is saved/updated, the then displays as '£'. Use the -utf8 CGI pragma to treat incoming parameters as UTF-8: use CGI ('-utf8');
    • is displayed on a webpage as �
      • This happens when the http header Content Type is not UTF8 and the meta tag is similarly <meta http-equiv="Content-Type" content="text/html" />
    • or other characters are being displayed as a diamond with ? inside it
      • StackOverflow:...usually the sign of an invalid (non-UTF-8) character showing up in an output (like a page) that has been declared to be UTF-8. Can be fixed by putting the following at the top of script: binmode(STDOUT, ":utf8");
    • Error message: Wide character in print
      • Means a print statement (to STDOUT or a file) that is outputting Latin1 includes a UTF-8 character... To fix, add '>:encoding (UTF-8) to the open statement or #binmode(STDOUT, ":utf8");
RFC: Placeholder creation for SQL statements
5 direct replies — Read more / Contribute
by LanX
on Mar 08, 2018 at 18:33

    Using placeholders are a must in SQL!

    #prepare my $sth = $dbh->prepare('SELECT * FROM people WHERE lastname = ? AND f +irstname = ?'); #execute with list of bindvars $sth->execute( $lastname, $firstname );

    But it's a bit cumbersome to adjust the bind values if the order changes.

    It's even more work if you have to use an array of values like inside an IN ( ?, ?, ?) operation.

    I started to hack something to auto-generate placeholders, for a string passed inside a code-block:

    • $scalars from the closure are replaced with a placeholder ?
    • @arrays are replaced with a list of comma separated placeholders ?,?,?
    • underscored _var_names are ignored ( placeholders can't be everywhere)
    The second returned parameter is a list of var-refs in the correct order, such that the bind variables can be safely changed.

    Parsing the output of B::Deparse is even more fragile than I thought, the next version will walk the OP-Tree directly. (For instance parsing multiline SQL doesn't work yet.)

    I'm not yet sure how to combine this in the best way with DBI.

    This is a one days job in the sense of "release often".



    Hmmm ... I can probably avoid the hassle of parsing the OP-tree by tying the variables ...

    use strict; use warnings; use B::Deparse; use PadWalker qw/closed_over peek_sub set_closed_over/; use Data::Dump qw/pp/; # ========= Tests use Test::More; # lexicals for placeholders my $a = 'A'; my @list = qw/L I S T/; my $x = 'X'; # no placeholders for underscore vars my @_table = "any_table"; my $sql = sub { "SELECT * FROM @_table WHERE a = $a AND b IN (@list) A +ND c = $x" }; my @stm = holderplace($sql); is_deeply( \@stm, [ "SELECT * FROM any_table WHERE a = ? AND b IN (?, ?, ?, ? +) AND c = ?", [\"A", ["L", "I", "S", "T"], \"X"] ], "statement with placeholders plus bind variables" ); # change bind variables $a = 'AA'; @list = qw/LL II SS TT/; $x = 'XX'; is_deeply( \@stm, [ "SELECT * FROM any_table WHERE a = ? AND b IN (?, ?, ?, ? +) AND c = ?", [\"AA", ["LL", "II", "SS", "TT"], \"XX"] ], "statement with placeholders plus changed variables" ); done_testing(); # ========== Code sub holderplace { my ($lambda)=@_; my $h_vars = closed_over($lambda); my %new_vars; my @value_refs; for my $key ( keys %$h_vars) { my $sigil = substr $key,0,1; # exclude variables starting with _ next if $key =~ m/^\Q${sigil}\E_/; if ( '$' eq $sigil ) { $new_vars{$key} = \'?'; } elsif ( '@' eq $sigil ) { $new_vars{$key} = [ join ", ", ("?") x @{$h_vars->{$key} } ]; } else { next; # Error? } } # Create Statement with placeholders set_closed_over( $lambda, \%new_vars ); my $newstr = $lambda->(); # Variable refs in order of placeholders my @var_refs = map { $h_vars->{$_} } grep { $new_vars{$_} } @{ get_vars($lambda) }; return ("$newstr", \@var_refs ); } sub get_vars { # scans output of B::Deparse to get interpolated vars in order my ($lambda)=@_; # deparse sub body my $source = B::Deparse->new('-q')->coderef2text($lambda); # returns something like: # { # use warnings; # use strict; # 'SELECT * FROM ' . join($", @_table) . ' WHERE x = ' . $a . ' AN +D b IN (' . join($", @list) . ') ' . $x; # } # truncate {block} and use statements $source =~ s/^{\s*(use.*?;\s*)*//s; $source =~ s/;\s*}$//s; #warn $source; my %quotes = qw"[ ] ( ) < > { } / /"; $quotes{'#'}='#'; # single quotes like q(...) my $re_q = join "|", map { "q\\$_.*?\\$quotes{$_}" } keys %quotes; #warn pp my @parts = split /\s* (?: '(?:\\'|[^'])*?' | $re_q )\s*/msx, $so +urce; for my $part (@parts) { next unless $part =~ /^\..*\.?$/; if ( $part =~ /^\. join\(.*? (\@\w+)\)( \.)?$/) { $part = $1; # array } elsif ( $part =~ /^\. (\$\w+)( \.)?$/) { $part = $1; # scalar } } return \@parts; }

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Wikisyntax for the Monastery

challenge: Perl's art restauration
2 direct replies — Read more / Contribute
by Discipulus
on Mar 06, 2018 at 06:17
    Dear monks,

    I post this under meditation because this is not really a question by me, even if some question mark is in the text.

    Art needs restauration and restauration needs keen eyes and gentle hands. We have here at the monastery precious and invaluable masterpieces ruining as the time passes.

    The most incredible things I ever seen in Perl is 3-D Stereogram, Self replicating source. by the genial monk Toodles but unfortunately it just run on perl 5.8 (or as someone said in 5.10).

    Is some monk able to spot why this happens?

    Is someone able to make this masterpiece run as expected on modern perl versions? Infact it doesnt fail on 5.26 but doesnt produce the stereogram effect: only sparse lines.


    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
PERL postgresql yaml poker and thank you
2 direct replies — Read more / Contribute
by ShermW0829
on Feb 27, 2018 at 18:53

    Thank you to all who helped me get this started. Even though my name is on it that just means that I borrowed most of it from others. You will see your suggested way of doing things throughout this post.

    I will describe how I created the postgresql database. Any and all comments are welcome.

    I did not use these tables but I am strongly considering them.

    CREATE TABLE seven_stud_spread_stakes(bring_in int, fourth_street int +check(fourth_street >= bring_in), fifth_street int check(fifth_street + >= bring_in), sixth_street int check(sixth_street >= bring_in), seve +nth_street int check(seventh_street >= bring_in)); CREATE TABLE colorado_limit_stakes(small_blind int, big_blind int chec +k(big_blind >= small_blind), preflop int check(preflop <= 100), flop +int check(flop <= 100), turn int check(turn <= 100), river int check( +river >= big_blind)); CREATE TABLE spread_limit_stakes(small_blind int, big_blind int check( +big_blind >= small_blind), preflop int check(preflop >= small_blind), + flop int check(flop >= small_blind), turn int check(turn >= small_bl +ind), river int check(river >= small_blind)); CREATE TABLE seven_stud_stakes(bring_in int, fourth_street int check(f +ourth_street >= bring_in), fifth_street int check(fifth_street >= fou +rth_street), sixth_street int check(sixth_street >= fifth_street), se +venth_street int check(seventh_street >= sixth_street)); CREATE TABLE stakes(small_blind int, big_blind int check(big_blind >= +small_blind), preflop int check(preflop >= big_blind), flop int check +(flop >= preflop), turn int check(turn >= flop), river int check(rive +r >= turn)); INSERT INTO stakes VALUES(1, 3, 3, 3, 6, 9);

    I am using the following tables. Note that I am using v_limits since limit is a reserved word in postgresql.

    CREATE TABLE v_limits(v_limit TEXT PRIMARY KEY); CREATE TABLE states(abbreviation TEXT PRIMARY KEY, state TEXT); CREATE TABLE cities(city TEXT PRIMARY KEY); CREATE TABLE games(game TEXT PRIMARY KEY); CREATE TABLE hi_lows(hi_lo TEXT PRIMARY KEY); CREATE TABLE kills(kill TEXT PRIMAY KEY); CREATE TABLE stakes(stake TEXT PRIMARY KEY); CREATE TABLE venues(venue TEXT PRIMAY KEY); CREATE TABLE visits(id INT PRIMARY KEY, arrival_date DATE, departure_d +ate DATE, arrival_time TIME, departure_time TIME, venue TEXT REFERENC +ES venues(venue), city TEXT REFERENCES cities(city), state TEXT REFER +ENCES states(abbreviation), game TEXT REFERENCES games(game), stake T +EXT REFERENCES stakes(stake), kill TEXT REFERENCES kills(kill), hi_lo + TEXT REFERENCES hi_lows(hi_lo), v_limit REFERENCES v_limits(v_limit) +, buy_in MONEY, cash_out MONEY);

    This is the visit_configuration.yaml file I am using.

    arrival_date: 20180214 departure_date: 20180215 arrival_time: 1000 departure_time: 1800 venue: "Binion's" city: "Las Vegas" state: "NV" game: "hold'em" stake: "4-8" kill: "no-kill" hi_lo: "hi" limit: "fixed" buy_in: 200 cash_out: 400

    Next I will post the perl file I am using.

RFC: system calls on Unicode filesystem
3 direct replies — Read more / Contribute
by daxim
on Feb 27, 2018 at 07:37
    I'm about to email the pumpking for an intervention as a personal favour. Because I'm convinced that a half-arsed solution is better than no solution, it's due past time that the over 20 year old embarrassment gets fixed:
    Microsoft Windows [Version 10.0.16299.125]
     chcp 65001
    Aktive Codepage: 65001.
     type αω.bat
    @echo hiαω
     node -p "require('child_process').execSync('αω.bat').toString()"
     perl6 -e "run 'αω.bat'"
     php -r "system('αω.bat');"
     python -c "import subprocess;'αω.bat')"
     ruby -e "system 'αω.bat'"
     perl -Mutf8 -e "system 'αω.bat'"
    Der Befehl "a?.bat" ist entweder falsch geschrieben oder
    konnte nicht gefunden werden.
     perl -Mutf8 -MWin32::Unicode::Process=systemW -e "systemW('αω.bat')"
    Der Befehl "a?.bat" ist entweder falsch geschrieben oder
    konnte nicht gefunden werden.
    Plan of attack: use 5.028 enables use feature 'just-make-it-work-already-dammit', which checks $^O eq 'MSWin32' and then replaces all the broken chdir, mkdir, open, opendir, rename, rmdir, system, unlink, utime, -X stat etc. with the working equivalent code from Win32::Unicode and also somehow on -e, not just with code executed from files.

    Now tell me why this is a stupid idea, but keep in mind that

    • if all the other languages can hack it, then so can we, no matter how shitty and insufficient you think the initial patch is
    • the better is the enemy of the good and a "better" solution did not turn up for decades
    • if I simply file a perlbug it just gets marked by p5p as a duplicate of a discussion whose proposed "better" solution did not turn up for decades
Revitalising your own old posts
7 direct replies — Read more / Contribute
by stevieb
on Feb 21, 2018 at 19:32

    Periodically, I'll go through my posts via the normal mechanism and sort by lowest-highest-this-that-other, and sometimes, like today, I have found one that I'd like to reply to.

    Now, this post has a (relatively) high XP count, and the responses have 15-25% higher than that.

    I want to reply to a poster on such thread legitimately (orig post count was ~45, replies were 60+), but I don't want it realized that I'm doing it in order to get exposure on the overall hierarchical post.

    How do Monks handle these situations? Shatter humility or what?


    ps. I have been accused of raising posts for XP+ before, but those who raised that are irrelevant to me.

Sum to 100 at Rosetta Code
3 direct replies — Read more / Contribute
by choroba
on Feb 17, 2018 at 12:52
    After a long time, I checked the list of tasks not implemented in Perl on RosettaCode. One of them was "Sum to 100", kind of similar to mjd's Simple but difficult arithmetic puzzle:

    In the string 123456789, you can prepend + or - before any digit to form an expression. You should

    • list all the possible expressions that evaluate to 100
    • show the number that is a result of the maximal number of expressions
    • show the lowest positive number that can't be expressed
    • show the ten highest numbers that can be expressed

    Here's my solution:

    I tried to avoid eval to evaluate the expressions, at the same time, I didn't want to implement the traditional full math expression parser as there were only two operations of the same precedence in use.

    $sum += $_ for $expression =~ /([-+]?[0-9]+)/g;

    Feel free to comment on perlishness, effectiveness, golfness, or beauty of the solution, or propose your own.

    Note: Those interested in Perl 6 can read the solution just below mine.

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
Do you like Perl?
4 direct replies — Read more / Contribute
by choroba
on Feb 13, 2018 at 15:21
    Do you like Perl? Do you count yourself among people?

    If both your answers are "Yes", you might want to add your reasons to the discussion Why do people like Perl? on

    I guess we've had similar threads here over the years, but talking to a broader auditorium can be different.

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
RFC Win32::Event2Log ..gimme back my logfiles
2 direct replies — Read more / Contribute
by Discipulus
on Jan 31, 2018 at 07:13
    Hello monks,


    I haved produced my first, at least in my intention, serious module: Win32::Event2Log for the moment on github (current version). I tried to follow all best practices for module creation (a long read..) and I announced on prepan last week but I had no comment back.

    The windows Event Viewer, in my experience, it's good just to lead you to a carpal tunnel syndrome so in the past I have arranged a bounch of Perl programs to inspect it's registries using Win32::EventLog to trigger some action. This approach it's difficult and everytime I had to restart from scratch. So I had the, cool, idea to write an engine that read events and, if a given rule matches, write them on a plain logfile, then the road it's plain for a Perl programmer.


    Essentially what the module do, as it is explained in it's POD, is using Win32::EventLog and parsing windows events and writing them to plain logfiles. This module is rule based: a rule it's a minimal set of conditions to be met to write an entry to a logfile. You must add valid rules before starting the engine. Once started, the engine will check events every x seconds (specified using interval argument) and for every registry (System, Application, Security, Installation or a user defined one) that is requested at least in one rule will check for an event's source specified and optionally for some text contained in the event's description.

    The resulting engine it's designed to survive to shutdowns and user's interruption issued with CTRL-C in the console or a kill of the PID: next run of the program will read just unparsed events on. This is achieved storing numbers of last event read (for each registry) in a file specified with the lastreadfile argument.

    A simple example of it's usage is (as in the example section of the module) is the following:

    use strict; use warnings; use Win32::Event2Log; my $main_log = $0.'.mainlog.log'; my $last_numbers_log = $0.'.last_numbers.log'; my $sys_errors_log = $0.'.System_err_warn.log'; my $engine = Win32::Event2Log->new( interval => 60, endtime => 0, mainlog => $main_log, verbosity => 2, lastreadfile=> $last_numbers_log, + ); $engine->add_rule ( registry => 'System', eventtype=> 'error|warning', source => qr/./, log => $sys_errors_log, name => 'System errors and warnings', + ); $engine->start;

    But since I've always produced modules as private containers of almost related functions, I'm a bit a newbie in regard to CPAN standards. Infact I plan to release it on CPAN soon, but not before having listen your advices. So my Request for Comments are:


    1) name:
    I think the Win32 is naturally the correct one but what about Event2Log ? it seemed the best choice for me

    2) testing:
    in this field I read a lot in the past but, my sin, practiced almost no times.. I've done my best writing 01-basic.t (here(current version)). How the test can be improved? I need to bail out in the test if $^O is not MSWIn32? I tested only the public methods I offer: should I test also private functions?

    3) design and enanchemts:
    Even if the module runs well enough in my tests on various scenarios, I already plan to modify it. Infact actually the core of the engine is a while (1) {.. loop where new events are checked and rules applied (you can see it here(current version)).

    I plan to abstract the reading part, maybe adding a Win32::Event2Log::Reader submodule. Infact I want also the user to choose if use Win32::EventLog as reader or a wrapper around wevtutil.exe that I plan to write soon. How achieve this? Having Win32::Event2Log::Reader using Win32::EventLog by default and Win32::Event2Log::Reader::Wevtutil subclassing Win32::Event2Log::Reader ? What is the cleanest design for such modification? Which tests I must add?

    4) design of an eventual Win32::Event2Log::Reader :
    This seemed to me a good use for an iterator: $reader->next will replace a lot of odd code in my current module. The fact I'm wondering about is for the wrapper around the system call wevtutil.exe

    Since system calls are expensive I plan the first time the iterator it's initialized, to query all previous events and return them one at time: the array of events this first time can be many Mb and in successive calls possibly just few bytes. This seems against the good design of a ligth sized iterator. It's justificable to avoid possibly many system calls?

    Thanks for reading.


    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
RFC: Tutorial for "Using Google Cloud Shell with Perl"
2 direct replies — Read more / Contribute
by Corion
on Jan 28, 2018 at 09:34

    Why would you want to?

    Maybe you are just starting out with Perl and don't have a computer set up for Perl. Unix computers already include Perl, but maybe you don't have the permissions to run it on your computer.

    Maybe you just want to try a Perl module for some external program that you don't want to install on your machine. Maybe you just got a bug report for Linux that you can't easily replicate. Maybe you are online and don't have access to your home machine. Maybe you just need 5GB of storage quickly.

    You just need four steps to get to Perl in the Google Cloud Shell:

    1. Log in with your Google credentials

      That's how you pay for it - with information about yourself. Google will monitor what programs you invoke but not the command line parameters. In return, you get 5GB of permanent storage and a 2GB RAM virtual machine that includes Perl 5.24, other programming languages, the Google Cloud SDKs and other stuff.

    2. Set up CPAN to use local::lib

      Run the cpan command to perform the initial setup:


      There, you need to answer two questions:

      • Choose the quick, no questions asked setup
      • Choose the proposed local::lib method of installing modules
    3. Install some stuff that you maybe want to try out

      Upgrade Test::More, because the Debian stock 1.01 version causes some spurious test failures
      cpan Test::More cpan App::cpanminus Moo Future::AsyncAwait DBD::SQLite
    4. Enjoy

    More documentation on the Cloud Shell

    Using the Cloud Shell as a web development environment

    The cloud shell also comes with an included web proxy so that you (and only you) can try out web applications served from any web server on that machine. This makes the Cloud Shell a convenient testbed to try out web frameworks like Mojolicious, Dancer2, Dancer or even CGI::Application in PSGI mode.

    Using Mojolicious

    Install Mojolicious

    cpan Mojolicious

    Run minimal Mojolicious program:

    perl -Mojo -E 'a("/hello" => {text => "Hello Mojo!"})->start' daemon - +l

    Visit /hello in the Web Preview pane

    Using Dancer2

    Install Dancer2

    cpan Dancer2

    Run minimal Dancer2 program:

    perl -MDancer2 -e 'set port => 8080; get "/" => sub { "<i>Just</i> Ano +ther <b>Perl</b> <u>Hacker</u>," }; dance'

    Using Dancer with Twiggy

    Install Dancer and Twiggy

    cpan Dancer Twiggy

    Run minimal Dancer program:

    plackup -e 'use Dancer; get "/hello/:name" => sub { return "Why, hello + there " . param("name"); }; dance;' --port 8080 -s Twiggy

    Visit /hello/yourname in the Web Preview pane

Add your Meditation
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 studying the Monastery: (8)
    As of 2018-07-19 21:51 GMT
    Find Nodes?
      Voting Booth?
      It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?

      Results (420 votes). Check out past polls.