Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things

The Monastery Gates

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

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
Problems starting the debugger
1 direct reply — Read more / Contribute
by morelenmir
on May 19, 2018 at 21:58

    Hey Guys!

    I am in the process of getting back in to Perl after being away from programming as a whole for quite a while. I thought this might be a good time to learn how to use the built-in debugger. Previously I ran 'EPIC' inside 'Eclipse', but ended up very much disliking that IDE. Therefore this time around I intend to write programmes in a text editor called 'EditPad Pro' and then employ the native Perl debugger as necessary. Unfortunately I have run in to some problems straight out of the gate,

    As a test I started with the simplest of all one-line programmes, saved as '':

    say "Hello";

    Next, at the console window I used the command:

    perl -d

    This is the output I received from Perl:

    Loading DB routines from version 1.51 Editor support available. Enter h or 'h h' for help, or 'perldoc perldebug' for more help. <main::(test.plx:1): print "hello"; Unable to get Terminal Size. The Win32 GetConsoleScreenBufferInfo call + didn't work. The COLUMNS and LINES environment variables didn't work +. at C:/StrawberryPERL/perl/vendor/lib/Term/ReadLine/ line 41 +0. at C:/StrawberryPERL/perl/vendor/lib/Term/ line 462. Term::ReadKey::GetTerminalSize(GLOB(0x28025f4)) called at C:/S +trawberryPERL/perl/vendor/lib/Term/ReadLine/ line 410 readline::get_window_size called at C:/StrawberryPERL/perl/ven +dor/lib/Term/ReadLine/ line 1114 readline::init called at C:/StrawberryPERL/perl/vendor/lib/Ter +m/ReadLine/ line 208 require Term/ReadLine/ called at C:/StrawberryPERL/ +perl/vendor/lib/Term/ReadLine/ line 63 eval {...} called at C:/StrawberryPERL/perl/vendor/lib/Term/Re +adLine/ line 63 Term::ReadLine::Perl::new("Term::ReadLine", "perldb", GLOB(0x2 +8b27bc), GLOB(0x28025f4)) called at C:/StrawberryPERL/perl/lib/perl5d line 6868 DB::setterm() called at C:/StrawberryPERL/perl/lib/ +line 1849 DB::_DB__read_next_cmd(undef) called at C:/StrawberryPERL/perl +/lib/ line 2786 DB::DB called at test.plx line 1 SetConsoleMode failed, LastError=|6| at C:/StrawberryPERL/perl/vendor/ +lib/Term/ line 346. at C:/StrawberryPERL/perl/vendor/lib/Term/ReadLine/ line 1 +581. readline::readline(" DB<1> ") called at C:/StrawberryPERL/per +l/vendor/lib/Term/ReadLine/ line 11 Term::ReadLine::Perl::readline(Term::ReadLine::Perl=ARRAY(0x61 +1b1c), " DB<1> ") called at C:/StrawberryPERL/perl/lib/ li +ne 7367 DB::readline(" DB<1> ") called at C:/StrawberryPERL/perl/lib/ line 1858 DB::_DB__read_next_cmd(undef) called at C:/StrawberryPERL/perl +/lib/ line 2786 DB::DB called at test.plx line 1

    I am using a fresh install of the newest Strawberry Perl (32Bit), which is release I run this in Windows 7 (64Bit), patched with the latest updates. For what it is worth the same error occurs if I try the 64Bit edition of Strawberry Perl either. Other than this, Perl programmes themselves run without any problem. It is only when I try to execute them under the native debugger that I encounter an issue.

    Can any of you chaps suggest a solution for this?

    A quick search of the forum came up with a very similar issue reported by 'Ovid' way back in 2007. However that gentleman encountered the error while employing something called 'Prove', which I have never come across before and is certainly not something I am using myself. I think most of the suggestions in that thread related to using 'Prove', so I do not know how to apply them in my own far simpler situation.


    Well... A degree more persistence with the search function, both here and over at Google suggested another approach to sort this out that was not centred on 'Prove'; create an environment variable 'TERM' and set its value to 'dumb' (case sensitive for each I believe). After doing so perl -d began working like a charm!!! So... I guess that is the fix. Which is good of course, but I have no idea why I couldn't find that result the first half-dozen times I searched for an answer... Weird indeed. Still. The jobs a good'un--problem solved!

    "Aure Entuluva!" - Hurin Thalion at the Nirnaeth Arnoediad.
How do I use "Long Doubles" in perl?
3 direct replies — Read more / Contribute
by cnd
on May 19, 2018 at 10:46
    My perl has them:
    #perl -e 'use Config;print "long doubles\n" if $Config{d_longdbl} eq " +define";' long doubles
    But they are not default:-
    # perl -e 'use Config;if ($Config{uselongdouble} eq "define") {print " +long doubles by default\n";} else {print "not default? How to use???\ +n"}' not default? How to use???
    So how do I force their use?

    I do not want to use external modules, and yes, I know all about base-2 and float precision.

'%hash = ()' is slower than 'undef %hash'
8 direct replies — Read more / Contribute
by rsFalse
on May 18, 2018 at 06:13

    Today I've found, that my code with %hash = () is slower than undef %hash about 1.2 times. Perl 5.20.1. My hash contained simple values, not a Hash of Hashes or smth.

    I think that %hash = () should be aliased to undef %hash. What is your opinion?
find all numeric values from a string and join them
3 direct replies — Read more / Contribute
by Anonymous Monk
on May 18, 2018 at 05:46

    Hi, Im trying to have all numeric values from a sting and join them with pipe string is

    EEH_ErrorCode=( 15, /* Component */ 65 /* Error */) and my output should be 15|65

    while ($flag == 0 ){ if ($str =~ m/\)/ ) { $flag = 1; } else{ my @array=split(/' '/,$str); if(defined $array[0] ){ $array[0] =~ s/[^0-9]//g}else{$array[0] +=''}; if(defined $array[1] ){ $array[1] =~ s/[^0-9]//g}else{$array[1] +=''}; } }
Distinguishing a filehandle for an in-memory string
2 direct replies — Read more / Contribute
by jrw
on May 17, 2018 at 19:42

    I have noticed that many file IO operations, such as read(), work on in-memory string filehandles, but sysread() doesn't. So, how can I tell if someone has passed me filehandle to such a thing, so I can work around this limitation?

    #!/usr/bin/perl use strict; use warnings; sub dbg { my ($op, $fh, $rc, $scalar) = @_; $rc = "UNDEF" unless defined $rc; print "<$op><$rc><$scalar>\n"; close $fh or die; } sub doit_read { my ($fh) = @_; my $rc = read $fh, my $scalar, 5; dbg "read", $fh, $rc, $scalar; } sub doit_sysread { my ($fh) = @_; my $rc = sysread $fh, my $scalar, 5; dbg "sysread", $fh, $rc, $scalar; } my $fh; open $fh, "<", \"/etc/passwd" or die; doit_sysread $fh; open $fh, "<", \"/etc/passwd" or die; doit_read $fh; open $fh, "<", "/etc/passwd" or die; doit_sysread $fh; open $fh, "<", "/etc/passwd" or die; doit_read $fh;


    <sysread><UNDEF><> <read><5></etc/> <sysread><5><jrw32> <read><5><jrw32>
Using ExtUtils::MakeMaker to install non-Perl files
1 direct reply — Read more / Contribute
by Anonymous Monk
on May 17, 2018 at 03:45

    I'm trying to install a Perl app using ExtUtils::MakeMaker, as a first step towards building a .deb package.

    The app requires various (read-only) text files, icons and sound files that need to be installed too.

    MANIFEST correctly lists all files, Perl and non-Perl, but running Makefile.PL only installs the Perl files.

    What's the recommended shows no interest in anything that's not Perl. I read the docs for EU::MM, and also perlnewmod etc, none of which offer clues.

    What's the recommended method of installing everything at once?

Variable declared in script, used by module, and used in script
4 direct replies — Read more / Contribute
by ExReg
on May 16, 2018 at 13:04

    Having a bad morning remembering. I have a script that runs a bunch of checks. It uses a module that contains an array of checks. There are variables defined in the script that are in the checks in the module that I can get to work. Here is a simplified example: use strict; use warnings; use check_module; my $home_dir = '/home/mine/'; for my $check ( @checks ) { print "Checking $check->{name}\n"; `check->{script}`; } package check_module; use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(@checks); our @checks = ( { name => "Anybody home?", script => qq/echo $home_dir/, }, ); 1;

    When I run it I get

    Checking Anybody home?

    How do I get the $home_dir to evaluate so that I get

    Checking Anybody home? /home/mine

    I hope I typed this simplified example OK. It is on another system that cannot use CPAN or anything else except that which is installed. Thanks.

Abusing Map
5 direct replies — Read more / Contribute
by writch
on May 16, 2018 at 12:34
    I have a loop that calculates the difference between a variable in an array to the next element in the array. I'm currently using a pretty standard manner of doing this, namely

    for (my $i=0;$i<@a;++$i){ $b[$i] = $a[$i] - $a[$i+1]; }

    I wondered if there was any way to address the "$_ + 1" thought in a map statement. I've been looking for any examples, but I don't find them. Obviously this isn't it, but that's the thought at least.

    @b = map{$_ - $_+1}, @a;
Perl parser gets confused with call to "sort" w/o parens
1 direct reply — Read more / Contribute
by vr
on May 16, 2018 at 06:39

    IIRC the PBP advises to omit parens when unambiguously calling built-ins, because (and I agree) it removes extra-noise and improves readability. Thus, CL#1 is written as it was and it runs OK.

    Then, looking at CL#2, I thought to omit a pair of parens -- see CL#3. I don't see anything becoming ambiguous, but Perl is confused -- see CL#4. And why the uniq imposes numeric context?

    Also curious, if I'm explicitly imposing numeric context on sort (CL#5), Perl warns me 6 times, and not 5, as with CL#3.

    >perl -lwe "sub x{@_} print sort x( qw( q w e r t y ))" eqrtwy >perl -MList::Util=uniq -lwe "print sort( uniq( qw( q w e r t y )))" eqrtwy >perl -MList::Util=uniq -lwe "print sort uniq( qw( q w e r t y ))" Argument "w" isn't numeric in sort at -e line 1. Argument "r" isn't numeric in sort at -e line 1. Argument "y" isn't numeric in sort at -e line 1. Argument "e" isn't numeric in sort at -e line 1. Argument "t" isn't numeric in sort at -e line 1. qwerty >perl -MO=Deparse -MList::Util=uniq -lwe "print sort uniq( qw( q w e r + t y ))" BEGIN { $^W = 1; } BEGIN { $/ = "\n"; $\ = "\n"; } use List::Util (split(/,/, 'uniq', 0)); print((sort uniq 'q', 'w', 'e', 'r', 't', 'y')); -e syntax OK >perl -lwe "print sort {$a <=> $b} qw( q w e r t y )" Argument "q" isn't numeric in sort at -e line 1. Argument "w" isn't numeric in sort at -e line 1. Argument "e" isn't numeric in sort at -e line 1. Argument "r" isn't numeric in sort at -e line 1. Argument "t" isn't numeric in sort at -e line 1. Argument "y" isn't numeric in sort at -e line 1. qwerty
Tkx - new_table - how to resize columns ?
2 direct replies — Read more / Contribute
by x-lours
on May 16, 2018 at 06:13


    I'm forced to use Tkx (ActivePerl). I can't move to Tk neither upload any module. The firewall of the company prevent any upload.

    I'm looking for a way to change the size of the columns in a table (new_table).
    I need to fit the size of :

      The column 1 to 2
      The column 2 to 10
      The column 3 to 5
      The column 4 to 5

    but the 4 columns are always with the same size !

    here is a skeleton of a script

    #!/usr/bin/perl -- use strict; use warnings; use Tkx; Tkx::package_require("Tktable"); my $mw = Tkx::widget->new("."); my %hash = ( # data to display for example '1,0' => 'Vertical', '2,0' => 'Lng', '3,0' => 'Lateral', '0,1' => 'Expected shifts (A)', '0,2' => 'Shifts based on img alignment (B)', '0,3' => '|A-B|', ); my $t = $mw->new_table ( -rows => 4, -cols => 4, -cache => 1, -variable => \%hash, ); $t->g_grid(-column => 0, -row => 0, -sticky => "news"); # what i try but did'nt work... $t->g_grid_columnconfigure(0, -weight => 2); $t->g_grid_columnconfigure(1, -weight => 10); $t->g_grid_columnconfigure(2, -weight => 5); $t->g_grid_columnconfigure(3, -weight => 5); Tkx::MainLoop();

    any help is granted ;-)

    best regards
    x-l'ours (a frenchy)

regex for identifying encrypted text
6 direct replies — Read more / Contribute
by skendric
on May 16, 2018 at 06:06
    I write scripts which compare two text files and then do interesting things if they are different.
    use Text::Diff qw(diff); [...] $diff = diff "$config_dir/$config_old", "$config_dir/$config_new", { STYLE => "OldStyle"}; @diff = split '\n', $diff; [...]
    Typically, I want to ignore certain changes ... in the example below, I am uninterested in lines which contain the string 'set password ENC'. I end up writing code like:
    LINE: for my $line (@diff) { next LINE if $line =~ /set password ENC/; [...] }
    Now, I'm discovering that I am uninterested in changes to private keys ... a typical line in a file might look like this:
    set private-key "-----BEGIN ENCRYPTED PRIVATE KEY----- MIIFDjBABgkqhkiG9w0BBQ0wMzAbBgkqhkiG9w0BBQwwDgQInXCep+2zzpgCAggA MBQGCCqGSIb3DHMHBAiSZZZ3CUL1cQSCBNhxHiU0wI3XOMU05aVZybU6OOJOJBa/ M+b28ad6P8VZiN+eToUfs3pTg+VqzAc273fdnZPZFMClXpJk8kQZv0ruEoA99RqE pgsnYGVxzZNmDy5HT3yBDGjRCssDnQ8QUBqabFCpW6d7fzilw9PnoHjFRmLxKnNE [...]
    I'm struggling to figure out how to ignore such lines. My brain wants to construct a regex which identifies "random strings", so that I could write a line like:
    next LINE if $line =~ /{looks like random stuff to me}/;
    (1) Suggestions on how to construct such a regex?
    (2) Suggestions on how to tackle the problem differently?

Linking CPAN modules to specific library
3 direct replies — Read more / Contribute
by ewedaa
on May 15, 2018 at 14:02

    I'm having an interesting problem compiling a CPAN module (Net::SSLeay in particular). This particular module creates a binary library, For various reasons, I have to make/compile this module by hand.

    The problem I am having is that the prior admins never "really" updated this particular system, and instead created a new directory /usr/local/ssl/ssl_version and installed new versions of ssl into that directory tree, and then passed the proper path to Apache and other programs when they compiled/installed the new versions. There are assorted "bad" versions of libssl scattered around the system being used by assorted programs (I'm working on cleaning those up too.)

    I was able to edit the Makefile to get rid of /usr/lib/ and /usr/lib64. I even added the path I want into the Makefile as

    LDDLFLAGS = -shared -O2 -L/usr/local/DPS/openssl/openssl-1.0.1m -L/lib + -L/usr -L/usr/local/lib -fstack-protector LDFLAGS = -fstack-protector -L/usr/local/DPS/openssl/openssl-1.0.1m - +L/usr -L/usr/local/lib EXTRALIBS = -L/usr/local/DPS/openssl/openssl-1.0.1m -L/usr -L/lib - +lssl -lcrypto -lz LDLOADLIBS = -L/usr/local/DPS/openssl/openssl-1.0.1m -L/usr -L/lib +-lssl -lcrypto -lz

    But it still links to the bad version in /lib.

    Any ideas on how to force it to force it to link to the version I want at /usr/local/DPS/openssl/openssl-1.0.1m

    (I'm sure it's something stupid...)


New Cool Uses for Perl
Conways Game of Life in PDL
1 direct reply — Read more / Contribute
by mxb
on May 16, 2018 at 11:31

    Edit: Apparently this is in the PDL Documentation, as an example. Whoops! Still, it was a good learning exercise :)

    Rather than a ported numpy tutorial, this is a self developed implementation of Conways Game of Life written in Perl/PDL. Hopefully people find this interesting as I feel it shows how concise PDL code can be.

    The code is fairly straightforward. There is a single function conway() which accepts a single argument of the game arena. This is a two dimensional PDL matrix. Alive cells are represented by a one, dead ones by zero. The conway() function sums the value of each cell along with value of its nine neighbours into a temporary variable $tmp. It then applies the rules of the game, which are:

    • Any live cell with fewer than two live neighbors dies, as if caused by under population.
    • Any live cell with two or three live neighbors lives on to the next generation.
    • Any live cell with more than three live neighbors dies, as if by overpopulation.
    • Any dead cell with exactly three live neighbors becomes a live cell, as if by reproduction.

    This is implemented as an elementwise or and an elementwise and.

    The main loop of the game is in the body of the code and simply displays the generation and the game arena and awaits input

    The game arena is initialised with a 'glider', but feel free to experiment. As PDL wraps around by default, the surface is that of a torus.

    Enter a blank line for the next generation, anything else to exit


    #!/usr/bin/env perl use strict; use warnings; use 5.016; use PDL; sub conway { my $pdl = shift; die "Not 2D piddle" unless $pdl->ndims == 2; # Add up all values: my $tmp = $pdl + # original $pdl->transpose->rotate(-1)->transpose + # north $pdl->transpose->rotate(-1)->transpose->rotate(-1) + # northeast $pdl->rotate(-1) + # east $pdl->transpose->rotate(1)->transpose->rotate(-1) + # southeast $pdl->transpose->rotate(1)->transpose + # south $pdl->transpose->rotate(1)->transpose->rotate(1) + # southwest $pdl->rotate(1) + # west $pdl->transpose->rotate(-1)->transpose->rotate(1); # northwest # Cell is alive if it's either: return ( $tmp == 4 & $pdl == 1 ) | # Alive +3 neighbors $tmp == 3; # Alive +2 neighbors or dead +3 neighbors } my $arena = pdl(byte, [ [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], [ 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], [ 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], [ 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], ] ); my $gen = 0; while (1) { print "Generation: $gen (press enter for next)\n"; print $arena; $arena = conway($arena); $gen++; exit if <STDIN> ne "\n"; }
Basic Neural Network in PDL
1 direct reply — Read more / Contribute
by mxb
on May 15, 2018 at 07:37

    As part of my ongoing quest to port tutorials from Python/numpy to Perl/PDL please graciously accept the following contribution to the Monastery.

    This is the Perl/PDL port of A Neural Network in 11 Lines of Python. While I've added some documentation, please reference the original blog post for full details.

    #!/usr/bin/env perl use strict; use warnings; use 5.016; use PDL; ###################################################################### # This example is ported from the tutorial at # ###################################################################### # # In this example, we are training a neural network of two layers # (one set of weights). # It has the following variables: # $X - input neurons # $y - desired output values # $syn0 - single layer of weights # $l1 - output neurons # # This is our 'non-linear' function. It accepts two arguments. # The first argument is a piddle of values, and the second argument # is a flag. # # If the flag is unset, the function returns the elementwise Sigmoid # Function ( # # If the flag is set, the function returns the elementwise derivative # of the Sigmoid Function. sub nonlin { my ( $x, $deriv ) = @_; return $x * ( 1 - $x ) if defined $deriv; return 1 / ( 1 + exp( -$x ) ); } # $X is are our input values. It contains four examples of three # inputs. It is the following matrix: # # [ # [0 0 1] # [0 1 1] # [1 0 1] # [1 1 1] # ] my $X = pdl( [ [ 0, 0, 1 ], [ 0, 1, 1 ], [ 1, 0, 1 ], [ 1, 1, 1 ] ] ); # $y is the output vector. It is the following desired outputs for # the four input vectors above: # [0 0 1 1] my $y = pdl( [ 0, 0, 1, 1 ] )->transpose; # $syn0 is the first layer of weights, connecting the input values # ($X) to our first layer ($l1). It is initialised to random values # between -1 and 1. my $syn0 = ( ( 2 * random( 3, 1 ) ) - 1 )->transpose; # $l1 is the second (output) layer: my $l1; # This is the training loop. It performs 10000 training interations. for ( 0 .. 10000 ) { # Predict the outputs for all four examples (full batch training) # This is performed by applying the non-linear function # elementwise over the dot product of our input examples matrix # ($X) and our weights between layers 0 (input) and 1 (output) # ($syn0): $l1 = nonlin( $X x $syn0 ); # Calculate the error by comparing calculated values ($l1) to # known output values ($y) my $l1_error = $y - $l1; # Calculate the 'error weighted derivative'. This is the # elementwise product of the errors and the derivative of the # non-linear function across the outputs my $l1_delta = $l1_error * nonlin( $l1, 1 ); # Update the weights between the layers $syn0 += ( $X->transpose x $l1_delta ); } # Display output say "Expected output:", $y; say "Output After Training:", $l1;

    Running it on my machine takes approximately 1.5 seconds and gives output similar to:

    % perl Expected output: [ [0] [0] [1] [1] ] Output After Training: [ [0.0096660515] [0.0078649669] [ 0.99358927] [ 0.99211856] ]
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 taking refuge in the Monastery: (5)
As of 2018-05-21 10:01 GMT
Find Nodes?
    Voting Booth?