Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

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: https://github.com/juank-pa/Perl-Migrate 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/mysql.so' for module DBD::mysql: libmariadbclient.so.18: 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/DynaLoader.pm line 193. at /var/www/production-1534349533/local/lib/perl5/Mojo/mysql/Database.pm 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\pack.pl 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

    lbe

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 +nary.pl line 20, near "2 BETWEEN" (Missing operator before BETWEEN?) syntax error at d:/Users/lanx/tmp/rewrite_binary.pl line 20, near "2 B +ETWEEN " Execution of d:/Users/lanx/tmp/rewrite_binary.pl aborted due to compil +ation errors.

    Question:

    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

    2->$BETWEEN(1,3)

    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

    update

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

    update

    that's it https://metacpan.org/pod/optimize, 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
    [...] 'slagk%40xx.com-plain' => 'on', 'slagk%40xx.com-nomail' => 'on', 'qoz%40puz.org-language' => '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.

Failure with IO::AIO
No replies — Read more | Post response
by vr
on Aug 11, 2018 at 07:10

    Looks like async file operations are popular topic; I also was trying, recently, to replace what I'm using with something more elegant. However, async file copy (aio_copy) fails, at the step (see description) of changing file atime and mtime. So it can be reduced to failure of aio_utime.

    use strict; use warnings; use feature 'say'; use AnyEvent; use AnyEvent::IO; my $c = AnyEvent-> condvar; aio_utime( 'x', 0, 0, sub { $c-> send( @_ )}); say $c-> recv;

    File named 'x' is in current directory, IO::AIO and AnyEvent::AIO should be installed. The above example works in Linux, but not in Windows (where actual script is to be used). Perl dies silently in Win10, or with usual OS messagebox "Application needs to be closed blah-blah" in e.g. Win2008.

    I found that if this line is replaced with

    int i; printf( "calling\n" ); i = utime (filename, &buf); printf( "called\n" ); return i;

    then I only see "calling", and process crashes. A call to "utime" looks quite innocent, of course it works from either simple C program or wrapped into Perl and Inline::C. Apart from reporting a bug, perhaps there is some simple and quick fix?

WebService::YQL "Couldn't find a decoder method"
1 direct reply — Read more / Contribute
by chuntuk
on Aug 11, 2018 at 07:05
    I have some established perl code that uses WebService::YQL to access web services, it's been working fine for years. But for the last few days any script using that module has crashed out with this error:
    Couldn't find a decoder method. at /home/redacted/perl/usr/share/perl5/WebService/YQL.pm line 9.
    BEGIN failed--compilation aborted at /home/redacted/perl/usr/share/perl5/WebService/YQL.pm line 9.
    
    I get the error even with a test script like this:
    use CGI::Carp qw(fatalsToBrowser);
    
    use WebService::YQL;
    
    print "Content-type: text/plain\n\n";
    
    print "Hello World\n";
    
    Line 9 of YQL.pm is "use JSON::Any;", which is deprecated, but I don't see what I can do about that. Could anyone help me figure out what the problem is and how to fix it? Thanks.
Libxml parser cosuming 100% cpu
5 direct replies — Read more / Contribute
by geek2882
on Aug 11, 2018 at 02:50
    Hi Monk how can i optimize the parser. its take 2.5 min to finish the job but cpu usage is 100% untill the job finish script. i have post a design and a small view of code
    xml File open store on array of @lines(file contain record block) foreach line(@lines) #10Lakhs Line { $stringparse .=line # stringparse get the record (maybe of 100 lin +es which go to if block for parsing) IF(Endtags of block)# Execute 10000 times for each record($str +ingparse 100 lines xml) { $XML::LibXML::skipXMLDeclaration = 1; our $dom = XML::LibXML->load_xml(string => $stringparse); our $xml = $dom->documentElement; . . . #Some of use Api of my Code $method = $xml->getChildrenByTagName('Method')->to_literal; $Value = $xml->getChildrenByTagName("$Check")->to_literal; $bune = $xml->getChildrenByTagName('Number')->to_literal; if ($xml->findnodes('./Indi/Lost/true') ) { } if ( $xml->findnodes('./Indi/Lost/true') || $xml->findnodes('. +/Indi/Losgshshsht/false') ) { } if(($xml->findnodes('./nike'))[0]->firstChild){ ($xml->findnodes('./nike'))[0]->firstChild->setData($localS); } my $Tag =$dom->createElement('Nike_identifier') + $Tag->appendText($localS); $xml->addChild($Tag); $org= $xml->findnodes('./NikkooIdentifiers/abc')->to_literal; } }
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;

    Tommy
    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.

    Assertions

    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:

       assert_ArrayRef($var);

    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.

    Coercions

    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?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (3)
As of 2018-08-17 16:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Asked to put a square peg in a round hole, I would:









    Results (182 votes). Check out past polls.

    Notices?