Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
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
Tk add icon to popup menu
No replies — Read more | Post response
by IB2017
on Jan 19, 2020 at 04:48

    Hello monks

    this is surely a naive question, but me and Menus in Tk are not really good friends. How do I add an icon to a pop-menu contructed like this?

    #use strict; use warnings; use Tk; my $mw = tkinit(); my $CkAutomaticBackUp; my $b1 = $mw->Button( -text => "Create pop-up", ); $b1->grid(-row => 0, -column => 1,); Popup($mw, $b1); $mw->MainLoop; sub Popup{ my ($mw, $obj) = @_; my $menu = $mw->Menu(-tearoff=>0, -menuitems=>[ [command=>"Something", -command=>[sub {print "Hello"}, $obj,]], ]); $obj->menu($menu); $obj->bind('<ButtonPress>', ['PostPopupMenu', Ev('X'), Ev('Y'), ]) +; return $obj; }
sorting array of arrays
2 direct replies — Read more / Contribute
by Anonymous Monk
on Jan 18, 2020 at 12:23

    Hi all, I am trying to sort an array of arrays, but i am stuck. I have red some sources on the internet, but it is not helping me enough. I hope someone can tell me why i am failing. I am trying to sort this array on the second element. Here is the code:

    @ar = ([1,12],[8,3],[4,57],[22,5]); @sort = sort{$a[1]<=>$b[1]}@ar; foreach (@sort){ print "@$_\n";}

    The desired output is: 8,3 22,5 1,12 4,57. But all i'm getting is the same sorting as i started with. Tx in advance.

When aliasing sub arguments to @_ elements, PADTMP, READONLY flags are copied inconsistently
1 direct reply — Read more / Contribute
by vr
on Jan 17, 2020 at 18:38

    I wrote a fragment of code dealing with passing pointers to pointers to data for some FFI calls. Reducing it now to SSCC(?)E: if written as

    pack 'P', pack 'P', $data

    then Perl warns "Attempt to pack pointer to temporary value", so it's easy to debug. But in my case, it was something like:

    sub foo { pack 'P', $_[0] } foo pack 'P', $data;

    -- no warnings, correct result for single call, but incorrect if return values are not used immediately but e.g. stored. Then I ran some tests:

    >perl -MDevel::Peek -we "Dump 1; sub foo{Dump $_[0];$_[0]=1} foo(1)" SV = IV(0x653478) at 0x653488 REFCNT = 1 FLAGS = (IOK,READONLY,PROTECT,pIOK) IV = 1 SV = IV(0x653358) at 0x653368 REFCNT = 1 FLAGS = (IOK,READONLY,PROTECT,pIOK) IV = 1 Modification of a read-only value attempted at -e line 1. >perl -MDevel::Peek -we "Dump 1+1; sub foo{Dump $_[0];$_[0]=1} foo(1+1 +)" SV = IV(0x2612cf8) at 0x2612d08 REFCNT = 1 FLAGS = (PADTMP,IOK,READONLY,PROTECT,pIOK) IV = 2 SV = IV(0xfcb140) at 0xfcb150 REFCNT = 1 FLAGS = (IOK,pIOK) IV = 2

    Why is not PADTMP flag copied to $_[0], and why, if present, it also prevents copying READONLY?

Dualvar via table
4 direct replies — Read more / Contribute
by Dirk80
on Jan 17, 2020 at 12:21

    I often have the case when reading a binary value from a file that it also has a textual representation. So I can use the dualvar functionality of Scalar::Util to solve this issue.

    But that's not enough for me. Usually I have a corresponding table which contains the valid values and its representations. To avoid doing the same checks so often in code, I decided to tie the read scalar variable to a package which is doing these checks for me. Additionally on a change it shall always update the numeric and string context.

    Here an example:

    #!/usr/bin/perl use strict; use warnings; use My::DualVar; my %table = ( 1 => 'NORTH', 2 => 'SOUTH', 3 => 'EAST', 4 => 'WEST' ); # Case 1: Table num -> str print "Case 1: Dualvar via num2str table\n\n"; { my $direction = 2; My::DualVar->tie($direction, \%table); print_dualvar($direction); $direction = 4; print_dualvar($direction); $direction = 'NORTH'; print_dualvar($direction); } # Case 2: Table str -> num print "Case 2: Dualvar via str2num table\n\n"; { my $direction = 'SOUTH'; My::DualVar->tie($direction, reverse %table); print_dualvar($direction); $direction = 4; print_dualvar($direction); $direction = 'NORTH'; print_dualvar($direction); } sub print_dualvar { print "as num: " . ($_[0]+0) . "\n"; print "as str: $_[0]\n"; print "\n"; }

    And here my written package:

    This code is working. But I would be interested in your opinion. What could I do better?

    And the second thing. Currently my code would work randomly if the values of the given table (hash) are not unique. Is there an efficient way to check whether the values of a hash are unique? Then I would reject such a hash

    Or would there be a solution to return several values if the hash is not unique, e.g. key 2 and 5 would have value 'SOUTH'?

    In numeric context it would not work. If I would set a dualvar variable to 'SOUTH', then I would have to return 2 or 5 in the FETCH-method. Perhaps in numeric context the smaller value should be returned.

    In string context I think it is possible. Because I could give back a concatenated string and I still would have a scalar.

Signal to a sleeping Perl program
6 direct replies — Read more / Contribute
by jerryhone
on Jan 17, 2020 at 09:12
    I have an Autosys triggered Perl script that does a load of stuff and then sleeps for 15 minutes before doing it all again. I need to find a way to cleanly exit the program but I can't get it to respond to any signal handlers other than KILL and ALRM - both cause an immediate termination. If I add an ALRM signal handler, the ALRM stops working i.e. program keeps running!!!! Any thoughts? Jerry
Setting $0 clears /proc/PID/environ too
3 direct replies — Read more / Contribute
by kikuchiyo
on Jan 16, 2020 at 12:52

    As the title says: on Linux, if you assign anything to $0 (with the intent to change the program's name as displayed by ps et al.), not just the the program's name and arguments are changed, but the environment (as shown in /proc/PID/environ) is cleared as well, or more precisely, filled with spaces.

    The perlvar entry for $0 contains a paragraph that vaguely alludes to this:

                In some platforms there may be arbitrary amount of padding, for
                example space characters, after the modified name as shown by
                "ps". In some platforms this padding may extend all the way to
                the original length of the argument area, no matter what you do
                (this is the case for example with Linux 2.2).
    

    So I kind of understand what happens here and why, I just find it rude.

    It is somewhat more concerning that the effect persists even if you localize $0.

    #!/usr/bin/perl sleep 10; { local $0 = 'changed'; sleep 10; } sleep 10;

    When you run the program above, and watch a process list in a different terminal, you can observe that the apparent process name changes to 'changed' after 10 seconds, then changed back again, but if you watch the contents of /proc/PID/environ at the same time, you can see that it gets filled with spaces, then doesn't change back.

    Two additional things to note:

    • The fake process name (as assigned to $0) spills over the memory that formerly contained the environment, so if you do something like $0 = 'changed' x 10000, /proc/PID/environ will contain something like "angedchangedchanged...changed\x00 ...".
    • When the localized $0 goes out of scope, Perl only makes a weak attempt to change the process name back to its original. So if you originally ran the program with arguments, the output of ps contained something like "perl foo.pl -a -b -c", but after restoration it will just be "foo.pl".

    I think that an argument could be made that Perl should try to preserve the contents of /proc/PID/environ when changing $0, and do a more thorough job of restoring the original command line if $0 is localized.

Linux file handle not working
2 direct replies — Read more / Contribute
by pvfki
on Jan 15, 2020 at 19:46

    Hi, I am trying to run a perl command through linux console using filehandle ($_ sign) in order to indicate a file to use when running the command. The commands from the code snippet below are from https://metacpan.org/pod/ntheory

    For example, I have the following number in input.txt: 147416345806550029415781910597841
    Running with Windows:
    >perl -Mntheory=:all -nE "chomp; say is_prime($_);" input.txt 1 >perl -Mntheory=:all -nE "chomp; say length($_);" input.txt 33
    Running on Linux however I get:
    >perl -Mntheory=:all -nE "chomp; say is_prime($_);" input.txt Parameter 'inputtxt' must be a positive integer at -e line 1, <> line +1. >perl -Mntheory=:all -nE "chomp; say length($_);" input.txt Parameter 'inputtxt' must be a positive integer at -e line 1, <> line +1.
    Does anyone know how to fix this? I'm not sure how perl (shell) via Linux works? How do I get the same output as Windows? Thanks for help!
@INC error
4 direct replies — Read more / Contribute
by worstead
on Jan 15, 2020 at 11:46
    I have an error that says I do not have "Mailer.pm" in @INC:
    Can't locate Mail/Mailer.pm in @INC (you may need to install the Mail: +:Mailer module) (@INC contains: /usr/local/lib64/perl5/5.30 /usr/loca +l/share/perl5/5.30 /usr/lib64/perl5/vendor_perl /usr/share/perl5/vend +or_perl /usr/lib64/perl5 /usr/share/perl5) at /home/jrayner/CRON/emai +l-reminder-2.0.pl line 62.
    yet when I list @INC with
    !/usr/bin/env perl # lookinc - where to look for modules $"="\n"; print "@INC\n";
    it is there in /usr/local/share/perl5/Mail:
    /home/jrayner/perl5/lib/perl5/x86_64-linux-thread-multi /home/jrayner/perl5/lib/perl5 /home/jrayner/perl5/lib/perl5/x86_64-linux-thread-multi /home/jrayner/perl5/lib/perl5 /usr/local/share/perl5/Mail /usr/local/lib64/perl5/5.30 /usr/local/share/perl5/5.30 /usr/lib64/perl5/vendor_perl /usr/share/perl5/vendor_perl /usr/lib64/perl5 /usr/share/perl5
    Where's my error?
Wireshark JSON to perl script
2 direct replies — Read more / Contribute
by Tux
on Jan 15, 2020 at 11:04

    Before I even try to think if it would be possible at all, I want to ask if there is a monk or group of monks that has tried this before:

    I have a Wireshark JSON output froom the communication of an application with a connected device.

    What I want is a script that translates this JSON log into a perl script that reproduces this communication.

    In theory the log contains all the requirements: if the first entry to the device has eth, ip, and udp information, that should suffice to create a connection with given IP and port and send the data in the packet.

    The returned data - if this works - can then be compared to the returning packet in the JSON log etc etc.

    Ideas? Links? Existing attempts?


    Enjoy, Have FUN! H.Merijn
Directory hierarchy for Strawberry Perl build
1 direct reply — Read more / Contribute
by fdesar
on Jan 14, 2020 at 04:54

    Dear wise Monks,

    A silly little question :

    I'm "playing" with Perldist_Strawberry with a lot of success, but have a little question still unsolved :

    the build zip file I get has an architecture like (forgetting about c, site and vendor) :

    .\perl\bin\<binaries and .dll> .\perl\lib|<various modules>

    But I would better like to get something like :

    .\<binaries and .dll> .\perl5-lib\<various modules>

    with perl.exe beeing aware of where to find its modules relative to it (I mean @INC).

    This is for a very special local use of Perl and is not vital but it would allow me not to alter the PATH environment variable in this case while installing...

    Hum, and I, halas, have no way to add any switch to the command line, perl not being called be me so I cannot interact !</p

    Any idea on how to achieve this result ?

    Any suggestion's welcome and thanks for your time

    François

Connect to Kafka server over SSL
2 direct replies — Read more / Contribute
by cLive ;-)
on Jan 13, 2020 at 21:05

    I have a requirement to connect to a Kafka server over SSL. I have the certs, private key, and password, but I can't work out how to even test a connection. Looking at the Kafka modules, they use Socket to create the connection, and the Kafka modules don't support SSL.

    I've started playing with IO::Socket::SSL to try to connect to the server, but I think I'll have to work out how to do this at the lower level Socket interface, even if I manage to connect using IO::Socket::SSL, because of how Kafka::IO is written. I know very little about socket coding, nor why the decision was made to use Socket over IO::Socket so this feels like a very steep learning curve. So far, I've managed to create the socket, and I can send data to the server, but I'm guessing the server thinks it's just gibberish, because it closes the socket straight away. Or, possibly, I'm not doing whatever it is I need to do with the password to get a valid response.

    Does anyone have any pointers that could get me going in the right direction. I did drag out my old copy of Stein's Network programming with Perl, but I don't see any references to SSL in it.

    I get no errors when running this at debug level 3:

    my $socket = IO::Socket::SSL->new( PeerAddr => $host, PeerPort => 9094, SSL_verify_mode => SSL_VERIFY_NONE, SSL_key_file => './key.pem', SSL_cert_file => './cert.pem', ) or die "failed to connect: $SSL_ERROR"

    but that doesn't include using the password (I'm not sure whether that's for the SSL level or Kafka level ATM). Is there something I can print to the socket to get metadata from the server?

    I tried looking for info on the raw socket commends that Kafka uses, but I'm only finding API docs right now :/

    All pointers welcomed...

    update

    Got it working with Net::Kafka after following the pointers below. For future reference for those that need it, here's the code I used:
    use v5.22; use strictures 2; use JSON::XS qw(decode_json); use Data::Dumper 'Dumper'; use Net::Kafka::Consumer; my $consumer = Net::Kafka::Consumer->new( 'bootstrap.servers' => 'server1.com:9094,server2.com:9094,server +3.com:9094', 'group.id' => 'my_consumer_group', 'security.protocol' => 'SSL', 'ssl.keystore.location' => '/path/to/kafka.client.keystore.p12', 'ssl.keystore.password' => 'password', 'ssl.key.password' => 'password', error_cb => sub { my ($self, $err, $msg) = @_; warn Dumper({ ERR => $err, MSG => $msg }); }, ); # see https://github.com/edenhill/librdkafka/blob/master/CONFIGURATION +.md for all options $consumer->subscribe( [ "my_topic" ] ); warn Dumper({ consumer => $consumer }); while (1) { my $msg = $consumer->poll(1000); if ($msg) { if ( my $err = $msg->err ) { say "Error: ", Net::Kafka::Error::to_string($err); } else { say Dumper({ PAYLOAD => decode_json $msg->payload }); } } }
    The module is sparsely documented, so I ended up doing a little hit and miss testing to get here.
Wget works but not HTTP::Request
3 direct replies — Read more / Contribute
by perltastica
on Jan 13, 2020 at 19:36

    Hello Monks, Thought this would be easy after got it going with wget + jq, but in perl it always returns a 403 error The wget example below works fine, although I have removed the actual API key ;) -- but it works no problems at all, returns a correctly parsed json object. As you can see the API key must be passed in the header as 'hibp-api-key: <API KEY>'

    # This works fine wget --quiet -O- 'https://haveibeenpwned.com/api/v3/breachedaccount/so +meemail@somewhere.com?truncateResponse=false' --header='hibp-api-key: + SAMPLEKEY' | jq -r '.[] | [.Name, .DataClasses[]] | @csv'

    This perl code does NOT work, returns a 403 error.

    #!/usr/bin/perl require LWP::UserAgent; require HTTP::Request; my $address = shift or die "Enter an email address to check\n"; my $APIKEY = 'SAMPLEKEY'; my $ua = LWP::UserAgent->new; my $url = 'https://haveibeenpwned.com/api/v3/breachedaccount/'; my $header = [ 'hibp-api-key' => $APIKEY ]; $request = HTTP::Request->new( 'GET', $url . $address . '?truncateResponse=false', $header ); print $request->as_string; my $resp = $ua->request($request); print $resp->as_string;

    Output of that perl:

    # ./checkpwn.pl someemail@somewhere.com GET https://haveibeenpwned.com/api/v3/breachedaccount/someemail@somewh +ere.com?truncateResponse=false Hibp-Api-Key: <SAMPLEKEY> HTTP/1.1 403 Forbidden Cache-Control: max-age=10 Connection: close Date: Tue, 14 Jan 2020 00:33:08 GMT Server: cloudflare Content-Type: text/plain; charset=UTF-8 Expires: Tue, 14 Jan 2020 00:33:18 GMT CF-RAY: 554b844d8c61f4b2-YVR Client-Date: Tue, 14 Jan 2020 00:33:08 GMT Client-Peer: 104.18.172.13:443 Client-Response-Num: 1 Client-SSL-Cert-Issuer: /C=GB/ST=Greater Manchester/L=Salford/O=COMODO + CA Limited/CN=COMODO ECC Domain Validation Secure Server CA 2 Client-SSL-Cert-Subject: /OU=Domain Control Validated/OU=PositiveSSL M +ulti-Domain/CN=ssl767795.cloudflaressl.com Client-SSL-Cipher: ECDHE-ECDSA-AES128-GCM-SHA256 Client-SSL-Socket-Class: IO::Socket::SSL Client-Transfer-Encoding: chunked Expect-CT: max-age=604800, report-uri="https://report-uri.cloudflare.c +om/cdn-cgi/beacon/expect-ct" Set-Cookie: __cfduid=da914544ec647170750f29b53abed85cf1578961988; expi +res=Thu, 13-Feb-20 00:33:08 GMT; path=/; domain=.haveibeenpwned.com; +HttpOnly; SameSite=Lax Strict-Transport-Security: max-age=31536000; includeSubDomains; preloa +d X-Content-Type-Options: nosniff error code: 1010

    Seems like the header is there as it should be in the output, so I have no idea why this wouldn't work... Please enlighten me monks! Thank-you JS

New Meditations
Reinventing Moops
No replies — Read more | Post response
by tobyink
on Jan 14, 2020 at 05:20

    It seems every few years, I come up with some kind of weird syntax extension for doing OO programming in Perl. Moops was the most recent but while it's cool, it's built on some shaky foundations.

    I've been working on this thing MooX::Press for a little while now. It allows you to define a bunch of classes in one use statement. Like:

    use MooX::Press ( prefix => 'MyApp', role => [ 'Livestock', 'Pet', 'Milkable' => { can => [ 'milk' => sub { print "giving milk\n"; }, ], }, ], class => [ 'Animal' => { has => [ 'name' => { type => 'Str' }, 'colour', 'age' => { type => 'Num' }, 'status' => { enum => ['alive', 'dead'], default => 'alive' }, ], subclass => [ 'Panda', 'Cat' => { with => ['Pet'] }, 'Dog' => { with => ['Pet'] }, 'Cow' => { with => ['Livestock', 'Milkable'] }, 'Pig' => { with => ['Livestock'] }, ], }, ], ); my $porky = MyApp->new_pig(name => 'Porky'); print $porky->status, "\n";

    It's designed to be as declarative as possible; with the exception of a coderefs for defining your methods, it's pretty much just a big hash that could be serialized as JSON or YAML or whatever. Indeed, I've written portable::loader as a way of loading MooX::Press classes/roles from JSON or TOML and deciding their package namespace at runtime.

    It's also very opinionated about how your classes and roles should be interacted with. Although MyApp::Pig->new works, you are encouraged to use MyApp->new_pig instead. And if a Panda object needs to create a Pig (because that happens in nature, right?) then it should call $self->FACTORY->new_pig to do the business. MyApp is the factory package, and objects get created via that; objects can find their factory package using $self->FACTORY. There are ways to override some of MooX::Press's opinions, but it steers you in this direction.

    Anyway, recently I started looking at how to combine this with Keyword::Declare to create something Moops-like. This is the syntax I have currently got working:

    use v5.14; use strict; use warnings; use Data::Dumper; use MooX::Press::Declare prefix => 'MyApp', toolkit => 'Moo'; class Quux { version 3.1; extends Quuux; with Xyzzy; has foo : ( is => ro, type => 'Foo' ); has bar : ( type => 'Barrr' ); has nooo!; # exclamation mark means required constant yeah = 42; method say_stuff { my $self = shift; say $self->yeah + $self->nooo; } } my $obj = MyApp->new_quux( foo => MyApp->new_foo, bar => MyApp->new_bar_baz, nooo => 1, ); print Dumper($obj); $obj->say_stuff; # Note the order you define stuff mostly doesn't matter. # We used these classes above and define them now. class Quuux; role Xyzzy; class Foo; class Bar::Baz { type_name Barrr; }

    It's still early days, but it's coming along pretty nicely too. I'm impressed with how easy Keyword::Declare makes syntax extensions.

    Still to do: method signatures, method modifiers (before, around, after), type coercions, and custom factory methods. (These are all supported by MooX::Press, but not by the declarative syntax yet.)

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 perusing the Monastery: (5)
As of 2020-01-19 16:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?