Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

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
Help publishing my DB migration project
2 direct replies — Read more / Contribute
by juankpro
on Aug 16, 2018 at 19:56

    I started learning Perl a couple of months ago and started a project which I call Migrate so I can learn as much Perl as possible.

    The project allows managing DB schema changes (migrations) using Perl syntax for creating and removing tables, indexes, columns and constraints instead of plain SQL.

    The current implementation is using DBI and DBD::SQLite and there is also an implementation for Informix, but I made it in such a way other RDMS implementation can be added as separate libraries easily.

    I need the following:

    • Advice on how can I get a Perl partner to help me finish the tool. Specially the tests suite.
    • Get someone to review my code so I can be confident I'm in the right path
    • Advice on what are the next steps or what I'm still missing to get t publish my project in CPAN
    My project is posted here: There is already general documentation on the README file as well as an API in the repo Wiki. Please guide me. Thanks in advance
Bitbucket Pipelines and DBD::mysql
No replies — Read more | Post response
by zecat
on Aug 15, 2018 at 13:05
    Decided to try out a Perl project with Bitbucket Pipelines and deploy it to an EC2 running Ubuntu Xenial in AWS using the perl:5.26 Docker Hub image. This is also my first time using Docker as well. All goes well except when I try to start the PSGI I get the following:

    Can't load application from file "/var/www/production-1534349533/script/testproject": Can't load '/var/www/production-1534349533/script/../local/lib/perl5/x86_64-linux-gnu/auto/DBD/mysql/' for module DBD::mysql: cannot open shared object file: No such file or directory at /home/ubuntu/perl5/perlbrew/perls/perl-5.26.0/lib/5.26.0/x86_64-linux/ line 193. at /var/www/production-1534349533/local/lib/perl5/Mojo/mysql/ line 5.

    Some googling revealed a few of possible solutions that involved updating a symlink or purging, installing/reinstalling MariaDB to utilize their MySQL drivers, or install this library (which seems to have dropped off the map in the apt-get repos). Instead I deleted my local directory and run my dependency pipeline command on the EC2 instead:

    cpanm -nvL local --installdeps .

    Try firing up the PSGI again and now it works! So this leads me to building my own image for Pipelines to use base images of ubuntu:xenial and perl:5.26 to see this solves the problem and I still get the same error as mentioned above. Any thoughts on what would be different between my Xenial image and my Xenial EC2 instance when trying to run PSGI? I'm on the fence on whether this is a lack of understanding of the compiler and library requirements of DBD::mysql or of Docker.

    Dockerfile of my custom image mentioned above:
    FROM ubuntu:16.04 RUN apt-get update RUN apt-get -q -y install build-essential RUN apt-get -q -y install libxml2 RUN apt-get -q -y install libxml2-dev RUN apt-get -q -y install libmysqlclient-dev RUN apt-get -q -y install libexpat1-dev RUN apt-get -q -y install libssl-dev RUN apt-get -q -y install libnet-ssleay-perl RUN apt-get -q -y install git-core FROM perl:5.26 RUN cpanm -nv local::lib Dist::Zilla Dist::Zilla::Plugin::FakeRelease +Dist::Zilla::Plugin::Git::NextVersion Dist::Zilla::Plugin::PkgVersion + Dist::Zilla::Plugin::Prereqs Dist::Zilla::Plugin::PruneFiles Dist::Z +illa::PluginBundle::Filter Dist::Zilla::PluginBundle::Git
Paws S3 Download Object?
No replies — Read more | Post response
by taylorK
on Aug 15, 2018 at 12:37

    Hi Monks!

    Does anyone have any Paws/S3 experience? I have been working on using Paws to work with an S3 bucket and an SQS queue and need to download objects from the S3 bucket. My original method used curl but this doesn't work since you just get an unauthorized file back. I understand using GetObject then reading the body into a file but unfortunately the objects I am trying to download are all .gz "files" so reading the Object body does not really work out. I looked at the S3 module and it looks like there is a "get_key_filename" method that does what I am looking for, does anyone know if there is a similar method in Paws or do you have any other crafty ways of taking care of this?

    Thank you!

use warnings is complaining
5 direct replies — Read more / Contribute
by Anonymous Monk
on Aug 15, 2018 at 09:34

    Hi, i have written a script that reads some data and reports about it. Only when i use warnings i got the following complaint: 'Argument "" isn't numeric in printf at C:\Strawberry\codes\ line 11, <DATA> line 3.

    Here's my code:

    use strict; #use warnings; printf("%-11s %-27s %9s %11s","Date","Description","Incoming","Outgoin +g\n"); my $x = 0; my $tot; my $totex; while(<DATA>){ if($x==0){$x++;next;} my($date,$des,$inc,$exp)= unpack("A10 A27 A10 A*",$_); printf("%-10s %-27s %10.2f %10.2f\n",$date,$des,$inc,$exp); $tot += $inc; $totex += $exp; } printf("%38s %10.2f %10.2f","Totals",$tot,$totex); __DATA__ Date Description incoming outgoing 01/24/2001 Zed's Camel Emporium 100.00 1147.99 01/28/2001 Flea spray 24.99 01/29/2001 Camel rides to tourists 235.00 01/31/2001 avage1 125.00 01/20/2001 carpe diem 20.00 23.00

    How can i get rid of this, besides from turning warnings off?

Net::SSH2::Cisco and Nexus switches
2 direct replies — Read more / Contribute
by cnoyes72
on Aug 14, 2018 at 13:44

    I'm trying to use the Net::SSH2::Cisco module against Cisco Nexus switches and keep getting a timeout when executing the command. The logs show the command executed (I recieved the expected response from the switch), but the script timesout. This same script runs perfectly against and IOS switch. I think it may be waiting for the prompt but doesn't recognize it. Has anyone had luck getting this to work with Nexus gear?

    #!/usr/local/bin/perl # # use strict; use warnings; use Net::SSH2::Cisco; my $t = Net::SSH2::Cisco->new( host => 'nexus-switch', Dump_log => '/root/dump.log', Output_log => '/root/output.log', Input_log => '/root/input.log', Waitfor_clear => '0' ); $t->login( Name => 'name', Password => 'passwd' ); # Execute Command my @output = $t->cmd(string => "show clock"); print @output; $t->close;
Spumux loop to add subs..
2 direct replies — Read more / Contribute
by armight29
on Aug 14, 2018 at 12:22

    hello trying to create a loop which will iterate through an array of .xml files to add subtitles to a clip with spumux..but not working. Here is code:

    foreach my $i(0 .. $#subxmlfiles) { chdir('/users/dragonzero29/.wine/drive_c/mvtmp') or die "Could not cha +nge to dir...$!"; my @subxmllist=glob("@subxmlfiles"); system("spumux -s$i -m dvd -P \"/users/dragonzero29/.wine/drive_c/mvtm +p/$subxmllist[$i]\" < \"/users/dragonzero29/.wine/drive_c/mvtmp/$MM.M +PG\" > \"/users/dragonzero29/.wine/drive_c/mvtmp/.\" . ++$MM . \".MPG +\""); }

    The array @subxmlfiles is created earlier in the script and if you're not familiar with spumux it takes an .xml file and uses it with an input clip to create subtitles and then outputs to your designated filename; if you have multiple .xml files (for multiple languages) then

    each invokation of spumux MUST use the previous muxed clip to add to...I hope this makes sense. This is where I run into problems. the first clip (without subs) should be 0.MPG. This will be the input file and it will be used with the first .xml file in the array and the output file should a filename with $MM incremented by 1 which will be 1.MPG; 1.MPG will then be the input for the next iteration of the loop and so on and so forth so your expertise will be greatly appreciated :)

Compile perl for performance
2 direct replies — Read more / Contribute
by learnedbyerror
on Aug 14, 2018 at 10:55

    Oh so kind Monks

    Last night, I watched Graham TerMarsch's presentation "Red Wunz Go Fasta" from TPC 2018. It inspired me to go out and build perl 5.28.0 using perlbrew adding -D usemyalloc and -D optimize="-O3" flags. I have run a few benchmarks for one of my applications that munges through a large corpus of data files and builds several LMDB databases containing the parsed/analyzed information. The result is that I have shaved almost 25% of my runtime for this one program from per 5.26.2. This is running in a Debian Jessie LXC on a proxmox physical host running Debian Stretch

    In doing the above, I violated one of the cardinal rules of "Optimization Club" - make one change at a time. I changed both perl versions and two compiler flags. I promise to be more disciplined next time.

    My question to you oh so wise ones is - what options should I consider when trying to optimize against my specific code based?

    Some of those that come to mind are:

    • Compiler and compiler version - gcc/clang
    • glibc version
    • compiler flags
    • perl features - such as no threads

    At this time, my platforms of interest are Linux and Macos. My current plan is to compare 5.26.2 to 5.28.0 only. I have done previous comparisons with earlier versions of perl and have seen significant performance increases from versions prior to 5.26.0. This is primarily due to the changes in hash generation as my applications tends to be hash heavy.

    I kindly request that those of you who may be inclined to inform me using intemperate language that this investigation is folly save your time and not try to convince a fool of his self-recognized folly

    I do greatly appreciate those who do offer up options. I will happily update this thread with my findings.

    Thank you in advance


Implementing named infix operators with parser hook?
5 direct replies — Read more / Contribute
by LanX
on Aug 12, 2018 at 09:04
    To those familiar with the Perl guts ...

    The following code demonstrates two approaches to "simulate" a named infix operator in Perl

    use strict; use warnings; package mypkg; use Carp; sub BETWEEN { carp "left = ", shift; carp "right = @_"; }; our $BETWEEN = \&BETWEEN; 2->$BETWEEN(1,3) ; BETWEEN 2 => 1,3; #2 BETWEEN (1,3) ;

    But commenting out the last line naturally leads to compile-time parser error:

    Bareword found where operator expected at d:/Users/lanx/tmp/rewrite_bi line 20, near "2 BETWEEN" (Missing operator before BETWEEN?) syntax error at d:/Users/lanx/tmp/ line 20, near "2 B +ETWEEN " Execution of d:/Users/lanx/tmp/ aborted due to compil +ation errors.


    Is there a clean approach to hook into the parse to catch this error event and to rewrite the code?

    Such that

    2 BETWEEN (1,3)

    is translated to


    if ref $BETWEEN eq 'CODE' and parsing continues?

    No source filters please... :)

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery FootballPerl is like chess, only without the dice


    I stumbled over perlguts#Custom-Operators but didn't understand the restrictions. (especially how do I create a "custom peephole optimizer"?)


    that's it, so if I understand correctly, I need to register BETWEEN as custom operator and use optimize to provide a callback?

POST fieldnames with underscores
1 direct reply — Read more / Contribute
by BernieC
on Aug 11, 2018 at 13:45
    This is odd: I'm trying to post a form that has fields with underscores in them. It appears that LWP converts the underscores to hyphens. Can that be? {my problem is that the post doesn't work and I am trying to figure out why not} When I GET the page with the form on it and scrape it for INPUT fields, I find
    [...] $VAR53 = 'slagk%40xx.com_nomail'; $VAR54 = 'on'; $VAR55 = 'slagk%40xx.com_nodupes'; $VAR56 = 'on'; [...]
    but when I use Dumper to look at the _request object, it tells me
    [...] '' => 'on', '' => 'on', '' => 'en', [...]
    I looked at the code in HTTP::Request::Common and didn't see anything obvious that might be causing this {if this is actually happening, of course}

    two questions: is LWP really converting underscores to hyphens? And if so, how can I pass an underscore through to the web server.

New Meditations
The Future of Perl 5
No replies — Read more | Post response
by Laurent_R
on Aug 18, 2018 at 09:17
    Yesterday, for the last day of The Perl Conference (formerly known as YAPC) in Glasgow, Scotland, Curtis "Ovid" Poe delivered a very inspiring keynote address on the future of Perl.

    Ovid's idea was to imagine where Perl 5 would stand in ten years from now.

    These are some of the things Perl would have in 10 years in Ovid's vision:

    As an example for the first point above, consider the following subroutine:
    sub fibonacci { my $n = shift; return 1 if $n == 1 or $n == 0; return fibonacci($n-1) + fibonacci($n-2); }
    This subroutine should work correctly if the subroutine is called with a positive integer, but a number of things could go wrong: what will happen if no parameter is passed to the subroutine? or if the parameter is a negative integer, say -3? or if the parameter is a positive number but not an integer, e.g. 3.14? or if the parameter is not a number but a string? (Note that there would also be a problem with a large integer, but that's a different story.)

    For the above subroutine to be correct, you would need to add probably half a dozen boiler plate code lines to guard against invalid input, for example maybe something like this:

    sub fibonacci { die "..." unless defined $_[0]; my $n = shift; die "..." unless is_a_number($n); # the is_a_number function is to + be defined die "..." if $n < 0; die "..." if $n != int $n; # ... }

    With (non experimental) function signatures and proper typing, all you would need might just boil down to something like:

    sub fibonacci (PositiveInt $n) { return 1 if $n <= 1; return fibonacci($n-1) + fibonacci($n-2); }
    I think this would look quite cleaner.

    I hope the video of Ovid's talk will on-line soon.

    Comments are welcome.

RFC: A DSL for SQL (part 1)
No replies — Read more | Post response
by LanX
on Aug 17, 2018 at 18:10

    this is just a rough hack demonstrating a proof of concept for a "SQL::DSL".

    (and a general pattern for designing complex domain specific languages)

    I'm currently refactoring it out into clean sub-modules but wanted to show something already.

    The demonstrated ideas here are already sufficiently complex to discuss.

    (The implementation of named operators like BETWEEN and a JOIN mechanism are subject of threads to come)

    given this input:

    my ($user, $workhrs0, $geo0, $workhrs1, $geo1) = ('NWIGER', '20', 'ASIA', '50', 'EURO'); query { package Table; WHERE ( ANDS ( user == $user, ORS ( ANDS ( workhrs > $workhrs0 , geo == 20 ), ORS ( $workhrs1 < workhrs, geo == $geo1 ) ) ) ); };

    will the function query return an AST (abstract syntax tree) of nested "SQL::DSL" objects, which can be rendered into a target dialect like MySQL, Oracle ... (or maybe even SQL::Abstract or DBIx code ).

    Some basic ideas are:

    • SQL-Tables (here "Table") are realized as packages
    • These packages are limited to the scope of the surrounding code-block such that no namespace pollution occurs (a common problem with DSLs)
    • The Columns (here user) are realized as constants in this namespace returning "SQL::DSL::Column" objects
    • The operators are overloaded for Column objects and return "SQL::DSL::Operator" objects with nested Operand objects
    • Literal operands (like 20) are identified because they are readonly
    • Variable operands are identified and can be replaced by ? placeholders at render-time
    • actual values of the placeholders can be captured as variable references from the closure-vars and can be bound to the DBI->execute() later
    • "higher order" operations on nested operations just return the nested objects in a higher blessed container augmenting the AST
    • the rendering happens by walking the generated AST and calling a render methods on the encountered objects
    • the whole algorithm might look slow but we only need to run it once and memoize the result for later executions.
    Here the steps in the middle:

    === B::Deparse of the Code: { package Table; use warnings; use strict; use feature 'say'; WHERE(ANDS(user() == $user, ORS(ANDS(workhrs() > $workhrs0, geo() +== 20), ORS($workhrs1 < workhrs(), geo() == $geo1)))); } at d:/Users/lanx/vm_share/perl/Talks/DSL/2018_GPW/exp/SQL_abstract.p +l line 51. === Tidy of deparsed Perl-code: { package Table; use warnings; use strict; use feature 'say'; WHERE( ANDS( user() == $user, ORS( ANDS( workhrs() > $workhrs0, geo() == 20 ), ORS( $workhrs1 < workhrs(), geo() == $geo1 ) ) ) ); } === Abstract Syntax Tree (simplified): :'WHERE' is ::Clause :'ANDS' is ::Joiner :'=' is ::Infix :'user' is ::Column :'NWIGER' is ::Placeholder ["\n ", "NWIGER"] :'ORS' is ::Joiner :'ANDS' is ::Joiner :'>' is ::Infix :'workhrs' is ::Column :'20' is ::Placeholder ["\n ", 20] :'=' is ::Infix :'geo' is ::Column :'20' is SCALAR :'ORS' is ::Joiner :'<' is ::Infix :'50' is ::Placeholder ["\n ", 50] :'workhrs' is ::Column :'=' is ::Infix :'geo' is ::Column :'EURO' is ::Placeholder ["\n ", "EURO"] === Produced SQL: WHERE ( user = ? AND ( ( workhrs > ? AND geo = 20 ) OR ( ? < workhrs OR geo = ? ) ) ) at d:/Users/lanx/vm_share/perl/Talks/DSL/2018_GPW/exp/SQL_abstr line 59.

    here the code

    Any comments so far? :)

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

New Cool Uses for Perl
Proxying (almost) all methods in a class for mass memoization
1 direct reply — Read more / Contribute
by Tommy
on Aug 15, 2018 at 20:08

    If this could be done in a 'better' way, I'd enjoy hearing it. Criticisms welcome.

    Recently needed to basically cache the output of almost every class method in one of my modules that is part of a web app. Every method runs a different database query and encodes the results to JSON. The results change daily, so upstream of the module implementation there is logic that enforces a 12 hour TTL for anything any method returns. In the interim time though, there's no reason for the app to run these database queries at all when it already did the work. Reading about possible approaches to the problem on stack overflow yesterday I saw that use of autoload was discouraged, so this is what I came up with and as far as I can tell, after running two days in DEV, it appears to have no issues. I'm actually quite pleased, because this approach allowed me to be 'clever' without an implementation that is unmaintainable and unintelligible by others... Gist here

    use strict; use warnings; package My::Class::Proxy; # Drop-in replacement for 'Some Class' # Proxies all public method calls to Some::Class in order to provide s +mart # caching and memoization, e.g.- avoiding expensive DB queries when no +t required use 5.020; use Moose; extends 'Some::Class'; use Moose::Util qw(); my $meta = Moose::Util::find_meta( 'Some::Class' ); my @nocache = qw( new meta DESTROY AUTOLOAD ); state $outputs = {}; for my $method ( $meta->get_method_list ) { # don't memo-ize blaclisted or private methods next if ( grep { $_ eq $method } @nocache or $method =~ /^_/ ); around $method => sub { my ( $orig, $self, $refresh, @args ) = @_; $outputs = {} if !!$refresh; @args = map { $_ // '' } @args; my $call_key = join '', $orig, @args; return $outputs->{ $call_key } if defined $outputs->{ $call_key +}; $outputs->{ $call_key } = $self->$orig( @args ); return $outputs->{ $call_key }; }; } # Moose-specific optimization __PACKAGE__->meta->make_immutable(); 1;

    A mistake can be valuable or costly, depending on how faithfully you pursue correction
Exploring Type::Tiny Part 4: Using Types::Standard as a Ref::Util-Like Library
No replies — Read more | Post response
by tobyink
on Aug 12, 2018 at 11:50

    Type::Tiny is probably best known as a way of having Moose-like type constraints in Moo, but it can be used for so much more. This is the third in a series of posts showing other things you can use Type::Tiny for. This article along with part 1, part 2, and part 3 can be found on my blog and in the Cool Uses for Perl section of PerlMonks.

    Even if you read the documentation of Types::Standard pretty thoroughly, you'd probably miss that you can do things like this:

    use Types::Standard qw(is_ArrayRef is_HashRef); if (is_ArrayRef($var)) { ...; } elsif (is_HashRef($var)) { ...; }

    It is documented that Types::Standard exports functions called ArrayRef and HashRef, which are constant-like functions returning Moose/Moo-compatible type constraint objects, but where did these is_ArrayRef and is_HashRef functions come from?

    Well, their existence is documented in Type::Library, the type library base class used by Types::Standard. Any type library built with it will offer is_* variants of type constraints. These functions check their argument and return a boolean indicating whether it passes the type constraint.

    The object-oriented way of writing these checks is like this:

    use Types::Standard qw(ArrayRef HashRef); if (ArrayRef->check($var)) { ...; } elsif (HashRef->check($var)) { ...; }

    Though the object-oriented way is a little slower because it will result in at least three sub calls (including a method call).

    The is_* functions should be pretty darn fast, especially if Type::Tiny::XS is installed. Ref::Util::XS is faster, and Params::Util is sometimes faster, but using Type::Library-based type libraries (such as Types::Standard, Types::Common::Numeric, Types::Common::String, Types::Path::Tiny, Types::XSD, etc) will give you a richer selection of types that you can check.


    A common use for type checking functions is to do something like:

       is_ArrayRef($var) or die(...);

    Type::Library-based type libraries offer a shortcut for this:


    The return value of the assert_* functions (if they don't die) is the parameter you passed to them, which makes it convenient to do things like:

    use Types::Standard qw(assert_Object assert_ArrayRef); sub process_data { my $self = assert_Object( $_[0] ); my $data = assert_ArrayRef( $_[1] ); ...; }

    The object-oriented equivalent of assert_Object($thing) is Object->assert_return($thing). Due to overloading Object->($thing) will also work.


    If a type constraint has coercions (like Path from Types::Path::Tiny), there's also a to_* function:

    use Types::Path::Tiny qw( to_Path ); my $path = to_Path($thing);

    Note that if a coercion fails, there is no exception thrown, and the original value is passed through unaltered. If you want to make sure coercion succeeded:

    use Types::Path::Tiny qw( assert_Path to_Path ); my $path = assert_Path( to_Path($thing) );

    The object-oriented equivalent of to_Path($thing) is Path->coerce($thing). The object-oriented equivalent of assert_Path(to_Path($thing)) is Path->assert_coerce($thing).

    Parameterized Types

    It would be pretty cool if you could do:

    if (is_ArrayRef[Int]($var)) { ...; }

    But that wouldn't be syntactically valid Perl.

    You can do this though:

    use Types::Standard qw(ArrayRef Int); BEGIN { my $type = ArrayRef->of(Int); *is_ArrayRef_of_Int = $type->compiled_check; *assert_ArrayRef_of_Int = \&{ $type }; *to_ArrayRef_of_Int = sub { $type->coerce(@_) }; } if (is_ArrayRef_of_Int($var)) { ...; }

    Exporting Tricks

    To export just Object:

       use Types::Standard qw(Object);

    To export just is_Object:

       use Types::Standard qw(is_Object);

    To export Object and is_Object:

       use Types::Standard qw(Object is_Object);

    To export Object and all related functions (is_Object, assert_Object, and to_Object):

       use Types::Standard qw(+Object);

    To export Object, ArrayRef, and all the other types:

       use Types::Standard qw(:types);

    To export Object, ArrayRef, all the other types, and the related is_* functions:

       use Types::Standard qw(:types :is);

    To export Object, ArrayRef, all the other types, and the related is_*, assert_*, and to_* functions:

       use Types::Standard qw(:types :is :assert :to);
Log In?

What's my password?
Create A New User
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2018-08-18 14:07 GMT
Find Nodes?
    Voting Booth?
    Asked to put a square peg in a round hole, I would:

    Results (185 votes). Check out past polls.