Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
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
Escaping special characters for POD output
1 direct reply — Read more / Contribute
by perlancar
on Dec 15, 2019 at 07:02

    This should be simple, but I can't seem to find it at the moment. What module (preferably core one) can be used to escape (encode) special characters that might be interpreted as markup by a POD parser, so it will be rendered as literal? Basically the equivalent of HTML::Entities's encode_entities, or String::ShellQuote's shell_quote, for POD.

    For example, I have a single-line string "Compare using Perl's <=> instead of cmp" which I want to convert to: "Compare using Perl's E<lt>=E<gt> instead of cmp".
Why are some OS blank in CPAN Testers Matrix?
3 direct replies — Read more / Contribute
by Anonymous Monk
on Dec 13, 2019 at 15:54
    I was intrigued by the creative spirit of the programmer of a new Perl app on CPAN called "sweat". I wanted to check out the speech-centric UI and hear it read randomly chosen threads of related Wikipedia articles, top news headlines, and offensive jokes from the fortune program. I wondered if it would run on macOS and clicked the "Testers" link on the metacpan page but the column for darwin is totally blank. The perldoc mentions Mac enough times that my faith was rewarded with a painless install of a very cool program that appears to function perfectly. But I still wonder why it does not appear to be tested on darwin. Does anyone know? Thanks
strange behaviour: continue with \G and /gc and look forward
3 direct replies — Read more / Contribute
by leszekdubiel
on Dec 13, 2019 at 15:19
    Dear Perl Monks! Please explain why the program doesn't print "Z: passed" but displays "E: failed"?
    #!/usr/bin/perl my $a = " -1"; # remove trailing spaces warn "A: pos is ", pos $a; $a =~ /\G */gc; warn "B: pos is ", pos $a; $a =~ /\G(?=-)/gc or die "C: failed"; warn "D: pos is ", pos $a; $a =~ /\G(?=-)/gc or die "E: failed"; print "Z: passed";
    output is:
    A: pos is at ./l2 line 7. B: pos is 1 at ./l2 line 10. D: pos is 1 at ./l2 line 13. E: failed at ./l2 line 14.
    Strange is that "pos $a" is 1, and look ahead for minus sign fails. B: situation is exactly the same as D:, but C: doesn't fail, but E: does...
use conditional
2 direct replies — Read more / Contribute
by Takamoto
on Dec 12, 2019 at 11:00

    I have a very stupid question...

    I need to call 'use' in a conditional statement. I do it normally like this:

    use if $VersionOS eq 'Win', DBD::ODBC;

    What is if need to use the following:

    use if $VersionOS eq 'Win', Win32::OLE 'CP_UTF8';

    This of course does not work.

Checking whether a value is between two limits: Useless use of private variable in void context
3 direct replies — Read more / Contribute
by Bloehdian
on Dec 11, 2019 at 13:47

    I simply want to check, whether a numeric value is between an upper and a lower limit using the following one liner:

    perl -we 'use strict; my $value=1; my $lower_limit = 0; my $upper_limi +t = 2; if ( ( $value <= $upper_limit ) && ( $value => $lower_limit ) +) { print "the value is in the range!\n"}' Useless use of private variable in void context at -e line 1.

    Currently it seems that I am kind of blind, since I cannot see what is wrong with the condition. I guess here is somebody out who has better eyes. ;-)

Class attribute handling
3 direct replies — Read more / Contribute
by Dirk80
on Dec 11, 2019 at 10:55

    I know that there are many systems like Moo, Moose, etc. to build classes. But at the moment I'm reading the old book "Object Oriented Perl" from Damian Conway. Although it is very old, it helps me great to understand Object oriented Perl.

    In his book there is an example with a derived class. It is ok for me, but the derived classes have to inherit a lot. I show that to you in Variant 1.

    package Variant1::RootClass; our $VERSION = 1.00; use strict; use warnings; use Carp; use vars qw( $AUTOLOAD ); { # Encapsulated class data my %_attr_data = # DEFAULT ACCESSIBILITY ( '_root_entry1' => [ undef , 'read/write'], '_root_entry2' => [ undef , 'read'] ); # Class methods to operate on encapsulated class data # Is a specified object attribute accessible in a given mode sub _accessible { my ($self, $attr, $mode) = @_; $_attr_data{$attr}[1] =~ /$mode/; } # Classwide default value for a specified object attribute sub _default_for { my ($self, $attr) = @_; $_attr_data{$attr}[0]; } # List of names of all specified object attributes sub _standard_keys { keys %_attr_data; } } # Constructor may be called as a class method or object method sub new { my ($caller, %arg) = @_; my $caller_is_obj = ref($caller); my $class = $caller_is_obj || $caller; my $self = bless {}, $ class; foreach my $attr_name ( $self->_standard_keys() ) { my ($arg_name) = ($attr_name =~ /^_(.*)/); # take value from given argument if available if( exists $arg{$arg_name} ) { $self->{$attr_name} = $arg{$arg_name}; } # take value from object if caller is an object elsif( $caller_is_obj ) { $self->{$attr_name} = $caller->{$attr_name}; } # take default value else { $self->{$attr_name} = $self->_default_for($attr_name); } } return $self; } sub DESTROY { # nothing to do here } # Implement get_... and set_... methods sub AUTOLOAD { no strict "refs"; my ($self, $newval) = @_; # Was it a get_... method? if( $AUTOLOAD =~ /.*::get(_\w+)/ && $self->_accessible($1, 'read') + ) { my $attr_name = $1; *{$AUTOLOAD} = sub { return $_[0]->{$attr_name} }; return $self->{$attr_name}; } # Was it a set_... method? if( $AUTOLOAD =~ /.*::set(_\w+)/ && $self->_accessible($1, 'write' +) ) { my $attr_name = $1; *{$AUTOLOAD} = sub { $_[0]->{$attr_name} = $_[1]; return; }; $self->{$1} = $newval; return; } # Must have a mistake then ... croak "No such method: $AUTOLOAD"; } 1;
    use Variant1::RootClass; package Variant1::DerivedClass; our @ISA = qw( Variant1::RootClass ); our $VERSION = 1.00; use strict; use warnings; { # Encapsulated class data my %_attr_data = # DEFAULT ACCESSIBILITY ( '_derived_entry1' => [ undef , 'read'], '_derived_entry2' => [ undef , 'read'], '_derived_entry3' => [ undef , 'read/write']); # Class methods to operate on encapsulated class data # Is a specified object attribute accessible in a given mode sub _accessible { my ($self, $attr, $mode) = @_; return $_attr_data{$attr}[1] =~ /$mode/ if exists $_attr_data{ +$attr}; return $self->SUPER::_accessible($attr,$mode); } # Classwide default value for a specified object attribute sub _default_for { my ($self, $attr) = @_; return $_attr_data{$attr}[0] if exists $_attr_data{$attr}; return $self->SUPER::_default_for($attr); } # List of names of all specified object attributes sub _standard_keys { my ($self) = @_; (keys %_attr_data, $self->SUPER::_standard_keys()); } } 1;
    use Variant1::DerivedClass; package Variant1::DerivedDerivedClass; our @ISA = qw( Variant1::DerivedClass ); our $VERSION = 1.00; use strict; use warnings; { # Encapsulated class data my %_attr_data = # DEFAULT ACCESSIBILI +TY ( '_derived_derived_entry1' => [ undef , 'read'], '_derived_derived_entry2' => [ undef , 'read'], '_derived_derived_entry3' => [ undef , 'read/writ +e']); # Class methods to operate on encapsulated class data # Is a specified object attribute accessible in a given mode sub _accessible { my ($self, $attr, $mode) = @_; return $_attr_data{$attr}[1] =~ /$mode/ if exists $_attr_data{ +$attr}; return $self->SUPER::_accessible($attr,$mode); } # Classwide default value for a specified object attribute sub _default_for { my ($self, $attr) = @_; return $_attr_data{$attr}[0] if exists $_attr_data{$attr}; return $self->SUPER::_default_for($attr); } # List of names of all specified object attributes sub _standard_keys { my ($self) = @_; (keys %_attr_data, $self->SUPER::_standard_keys()); } } 1;

    In this variant 1 the derived classes have to reimplement _accessible, _default_for and _standard_keys. But they can inherit the constructor new and the AUTOLOAD subroutines.

    I now created a variant 2. It has the same behavior from outside the class. But here the derived classes only need to reimplement _get_attr_data. All other subroutines can be inherited.

    package Variant2::RootClass; our $VERSION = 1.00; use strict; use warnings; use Carp; use vars qw( $AUTOLOAD ); { # Encapsulated class data my %_attr_data = # DEFAULT ACCESSIBILITY ( '_root_entry1' => [ undef , 'read/write'], '_root_entry2' => [ undef , 'read'] ); # Class methods to operate on encapsulated class data # get attribute class data sub _get_attr_data { %_attr_data; } # Is a specified object attribute accessible in a given mode sub _accessible { my ($self, $attr, $mode) = @_; my %attr_data = $self->_get_attr_data(); $attr_data{$attr}[1] =~ /$mode/; } # Classwide default value for a specified object attribute sub _default_for { my ($self, $attr) = @_; my %attr_data = $self->_get_attr_data(); $attr_data{$attr}[0]; } # List of names of all specified object attributes sub _standard_keys { my ($self) = @_; my %attr_data = $self->_get_attr_data(); keys %attr_data; } } # Constructor may be called as a class method or object method sub new { my ($caller, %arg) = @_; my $caller_is_obj = ref($caller); my $class = $caller_is_obj || $caller; my $self = bless {}, $ class; foreach my $attr_name ( $self->_standard_keys() ) { my ($arg_name) = ($attr_name =~ /^_(.*)/); # take value from given argument if available if( exists $arg{$arg_name} ) { $self->{$attr_name} = $arg{$arg_name}; } # take value from object if caller is an object elsif( $caller_is_obj ) { $self->{$attr_name} = $caller->{$attr_name}; } # take default value else { $self->{$attr_name} = $self->_default_for($attr_name); } } return $self; } sub DESTROY { # nothing to do here } # Implement get_... and set_... methods sub AUTOLOAD { no strict "refs"; my ($self, $newval) = @_; # Was it a get_... method? if( $AUTOLOAD =~ /.*::get(_\w+)/ && $self->_accessible($1, 'read') + ) { my $attr_name = $1; *{$AUTOLOAD} = sub { return $_[0]->{$attr_name} }; return $self->{$attr_name}; } # Was it a set_... method? if( $AUTOLOAD =~ /.*::set(_\w+)/ && $self->_accessible($1, 'write' +) ) { my $attr_name = $1; *{$AUTOLOAD} = sub { $_[0]->{$attr_name} = $_[1]; return; }; $self->{$1} = $newval; return; } # Must have a mistake then ... croak "No such method: $AUTOLOAD"; } 1;
    use Variant2::RootClass; package Variant2::DerivedClass; our @ISA = qw( Variant2::RootClass ); our $VERSION = 1.00; use strict; use warnings; { # Encapsulated class data my %_attr_data = # DEFAULT ACCESSIBILITY ( '_derived_entry1' => [ undef , 'read'], '_derived_entry2' => [ undef , 'read'], '_derived_entry3' => [ undef , 'read/write']); # Class methods to operate on encapsulated class data # get attribute class data of this class and its base class sub _get_attr_data { (%_attr_data, $_[0]->SUPER::_get_attr_data()); } } 1;
    use Variant2::DerivedClass; package Variant2::DerivedDerivedClass; our @ISA = qw( Variant2::DerivedClass ); our $VERSION = 1.00; use strict; use warnings; { # Encapsulated class data my %_attr_data = # DEFAULT ACCESSIBILI +TY ( '_derived_derived_entry1' => [ undef , 'read'], '_derived_derived_entry2' => [ undef , 'read'], '_derived_derived_entry3' => [ undef , 'read/writ +e']); # Class methods to operate on encapsulated class data # get attribute class data of this class and its base class sub _get_attr_data { (%_attr_data, $_[0]->SUPER::_get_attr_data()); } } 1;

    And here a test script to use these classes.

    #!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Variant1::DerivedDerivedClass; use Variant2::DerivedDerivedClass; # VARIANT 1 my $obj1 = Variant1::DerivedDerivedClass->new('root_entry1' => 1, 'root_entry2' => 2, 'derived_entry1' => 3, 'derived_entry2' => 4, 'derived_entry3' => 5, 'derived_derived_entry1' +=> 6, 'derived_derived_entry2' +=> 7, 'derived_derived_entry3' +=> 8 ); print $obj1->set_derived_entry3(27); print Dumper $obj1; # VARIANT 2 my $obj2 = Variant2::DerivedDerivedClass->new('root_entry1' => 1, 'root_entry2' => 2, 'derived_entry1' => 3, 'derived_entry2' => 4, 'derived_entry3' => 5, 'derived_derived_entry1' +=> 6, 'derived_derived_entry2' +=> 7, 'derived_derived_entry3' +=> 8 ); print $obj2->set_derived_entry3(27); print Dumper $obj2;

    Would it be possible to even put the _get_attr_data only in the base class. In this way the derived classes would have to reimplement nothing. Everything could be derived.

    If not. I'm not sure if I implemented the variant 2 in a good way. For my feeling I'm doing it in a bad way because I'm calling the _get_attr_data at so many places. Is there a better way to implement it?

    Thanks a lot for your help.

How to install Net::SSLeay using custom SSL libraries via Carton package manager?
1 direct reply — Read more / Contribute
by xcodejoy
on Dec 11, 2019 at 08:47

    Hi guys!

    I have various version of the SSL libraries in my $HOME:

    $HOME/opt/LibreSSL/v1 $HOME/opt/LibreSSL/v... $HOME/opt/OpenSSL/v1 $HOME/opt/OpenSSL/v...

    How to install Net::SSLeay with a determined SSL library using Carton package manager (via cpanfile) for a determined Perl project?

    I have read that:

    ## https://metacpan.org/source/CHRISN/Net-SSLeay-1.88/README ## If your OpenSSL is installed in an unusual place, ## you can tell Net-SSLeay where to find it ## with the OPENSSL_PREFIX environment: ## OPENSSL_PREFIX=/$HOME/path/to/openssl

    But, what about LIBRESSL_PREFIX? I didn't found the answer here:

    ## https://st.aticpan.org/source/CHRISN/Net-SSLeay-1.88/

    "cpanfile" allows to set building options using such syntax:

    https://metacpan.org/pod/distribution/Module-CPANfile/lib/cpanfile.pod

    on configure => sub { ... };

    Is it correct to use it for OPENSSL_PREFIX? And, what about LIBRESSL_PREFIX?

Using perl module if env is enabled
6 direct replies — Read more / Contribute
by ovedpo15
on Dec 09, 2019 at 10:13
    Hello monks,
    I have a module XYZ.
    I would like to use it in my code $USE_XYZ is enabled. I tried to add:
    begin { if($ENV{USE_XYZ} == 1) { use XYZ; } }
    but it looks like it still being used, even though $USE_XYZ is undefined.
    How can I acheive this behaviour?
New Meditations
Hacker News! Just another reinvented wheel: uni
1 direct reply — Read more / Contribute
by Anonymous Monk
on Dec 13, 2019 at 23:49
    Four years and seven weeks ago our friend Ricardo SIGNES brought forth on this network, a new program, conceived by Audrey Tang: App::Uni! For some reason a year old clone of uni, written in Go, was advertised as "Hacker News" yesterday:
    Uni: Query the Unicode database from the CLI...
    https://news.ycombinator.com/item?id=21777025
    
    Usage of App::Uni:

    Identify a character:

    uni €
    € - U+020AC - EURO SIGN
    
    Or a string:
    uni -c h€ý
    h - U+00068 - LATIN SMALL LETTER H
    € - U+020AC - EURO SIGN
    ý - U+000FD - LATIN SMALL LETTER Y WITH ACUTE
    
    Search description:
    uni /euro/
    ₠ - U+020A0 - EURO-CURRENCY SIGN
    € - U+020AC - EURO SIGN
    𐡷 - U+10877 - PALMYRENE LEFT-POINTING FLEURON
    𐡸 - U+10878 - PALMYRENE RIGHT-POINTING FLEURON
    𐫱 - U+10AF1 - MANICHAEAN PUNCTUATION FLEURON
    🌍 - U+1F30D - EARTH GLOBE EUROPE-AFRICA
    🏤 - U+1F3E4 - EUROPEAN POST OFFICE
    🏰 - U+1F3F0 - EUROPEAN CASTLE
    💶 - U+1F4B6 - BANKNOTE WITH EURO SIGN
    
    Multiple words are matched individually:
    uni globe earth
    🌍 - U+1F30D - EARTH GLOBE EUROPE-AFRICA
    🌎 - U+1F30E - EARTH GLOBE AMERICAS
    🌏 - U+1F30F - EARTH GLOBE ASIA-AUSTRALIA
    
    Print specific codepoints or groups of codepoints:
    uni -u 2042
    ⁂ - U+02042 - ASTERISM
    
    uni -u 2042 2043 2044
    ⁂ - U+02042 - ASTERISM
    ⁃ - U+02043 - HYPHEN BULLET
    ⁄ - U+02044 - FRACTION SLASH
    
    AFAIK App::Uni does not have the -race (I mean -tone) or -gender switches of the Go uni so there was some innovation I guess.

    Anyway my meditation consists of encouraging Perl programmers to announce their wares on Hacker News, and other such websites.

    https://news.ycombinator.com/news
    
Beware of global! And bless the local!
3 direct replies — Read more / Contribute
by alexander_lunev
on Dec 12, 2019 at 03:40

    Hello monks.

    Today I found that a little negligence can cause a week-long debugging.

    I wrote a program that uses Crypt::OpenPGP module, and for a strange reason module works great when I simply initialize it with keyrings from file, but it crashes when i first read keyrings from files and combines them for my needs and then initialize module with constructed keyring objects. Terrible crashes of the Perl interpreter itself (sic!) was accompanied by cryptic messages like these:

    Win32::API::parse_prototype: WARNING unknown parameter type 'PVOID' at + C:/Strawberry32/perl/vendor/lib/Win32/API.pm line 568. Win32::API::parse_prototype: WARNING unknown parameter type 'ULONG' at + C:/Strawberry32/perl/vendor/lib/Win32/API.pm line 568. Win32::API::parse_prototype: WARNING unknown output parameter type 'IN +T' at C:/Strawberry32/perl/vendor/lib/Win32/API.pm line 600. Argument "\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..." + isn't numeric in subroutine entry at C:/Strawberry32/perl/vendor/lib +/Crypt/Random/Seed.pm line 247.

    I was wondering - what have i done to bring this punishment upon me? I compared objects that come out from keyring-file initialization and from keyring-objects initializations with Data::Dumper and couldn't find a difference. I even saved constructed keyring objects to files and initialize Crypt::OpenPGP with this newly created files - still all was crashing. The holy fear seized me and I decided to start my journey to the depth of module forest to find deliverance. I walk through Crypt::OpenPGP to Bytes::Random::Secure, to know that road leads - as it was told to me in the cryptic omen - to Crypt::Random::Seed, line 247, which was a Call to Win32::API function:

    my $rtlgenrand = Win32::API->new( 'advapi32', <<'_RTLGENRANDOM_PROTO_' +); INT SystemFunction036( PVOID RandomBuffer, ULONG RandomBufferLength ) _RTLGENRANDOM_PROTO_ return unless defined $rtlgenrand; return ('RtlGenRand', sub { my $nbytes = shift; my $buffer = chr(0) x $nbytes; my $result = $rtlgenrand->Call($buffer, $nbytes); # <= 247

    My journey comes to a dead end, for I didn't find deliverance there. And I started from the beginning of my code, turning lines of code off one by one. And I found it.

    This is the code that was a root of all misfortunes.

    open my $fh, "<", $file or die "can't open $file"; $/ = undef; my $key_string = <$fh>; close $fh;

    If you're enlightened enough, you will see my sin right away. I'm not enlightened enough to see it right away, but a doubt crawls into my mind - could it be the line $/ = undef;? I stared at this line for a minute and go search wisdom on the Internet. And then I found the Truth. And as always the Truth was under my nose all the time, but I couldn't see it. It should be local $/ = undef;!

    I don't know if it is clean and right way to read all file in a string, but even the great Gabor Szabo blesses slurp mode by setting $/ = undef;. But beware if you read his great article not thoroughly! The great misfortune awaits those who forget about local in a rush! Like me for example.

    You see? Setting $/ = undef; globally make things broken all the way up to the Perl interpreter itself, which was casting strange messages on his way to crash.

    But why would anyone write about it again, and again, and again? Because, as it said in every language:

    Repetitio mater studiorum est.

    Repetition is the mother of all learning.

    Wiederholen ist die Mutter des Studierens.

    La répétition est la mère de la science.

    Повторение - мать учения.

    Let my mistake will be a lesson to others. Using global variables is always a risky and erroneous path, local variables is the only way to enlightenment. But this is the Truth that we were told from the beginning and we are still making this silly mistakes. And while we code simple programs, errors are simple and debuggable. But when we become more mature - so are the errors that we cause by violation of a simple rules that we doesn't learned well from the start. Beware of global! And bless the local! Amen.

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: (3)
As of 2019-12-16 08:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?