Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

The Monastery Gates

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

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

Quests
poll ideas quest 2020
Starts at: Jan 01, 2020 at 00:00
Ends at: Dec 31, 2020 at 23:59
Current Status: Active
11 replies by pollsters
    First, read How do I create a Poll?. Then suggest your poll here. Complete ideas are more likely to be used.

    Note that links may be used in choices but not in the title.

Perl News
Strawberry Perl 5.32.0 is now officially available.
on Aug 30, 2020 at 10:16
0 replies by syphilis
    kmx has finally responded to the issue I raised more than 3 weeks ago with responses of "fixed" and "closed".

    UPDATE: My mistake - the assertion (below) that the issue is NOT fixed is rubbish. It's just that I can't tell the difference between "5.32.0" and "5.30.2".
    AFAICT, the issue I raised is NOT fixed, but if you visit http://strawberryperl.com/releases.html you'll see that, in addition to the listing of perl-5.30.3 builds, perl-5.32.0 builds (which have been sitting on the Strawberry Perl server for at least a week or two) are, as of a few hours ago, now also officially available.
    That's about all I know ... with little expectation that kmx will provide any additional information.

    Cheers,
    Rob
German Perlmongers Online Meeting
on Aug 04, 2020 at 12:59
1 reply by LanX
    @ All German speakers here:

    Next German PM Online Meeting in (cough) 30 minutes.

    Announcement:

    Hallo Perlmongers aus den deutschsprachigem Raum,

    Heute, am Dienstag, den 4. August 2020, um 19:30 Uhr ist German-PM Online-Treffen im Jitsi.

    Dank Corona wurde das Online-Treffen mehrfach in Erlangen und Frankfurt ausprobiert. Der Wunsch wurde geäußert, das online neben den Treffen vor Ort weiterzuführen.

    Nimm an der Besprechung teil: https://meet.jit.si/German-PM

    I'm not the organizer, but I'll use this thread for future announcements.

    UPDATE

    on Daxim's request

    NO REBROADCAST WITHOUT PERMISSION!

    ONLY PRIVATE RECORDING ALLOWED!

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

Supplications
Question about regex.
4 direct replies — Read more / Contribute
by that_perl_guy
on Sep 28, 2020 at 22:10

    Hi Monks,

    I will be extremely thankful if the monks here could help me understanding regex in Perl.

    Suppose I have a text file that has these lines:

    This is line one. Line Two is this. Third line starts here. This is line four. This is line five. This is line six. This is the seventh line. This is line eight.

    If the record contains the word "third" our "four", I want it to print the whole record, meaning the stuff between the empty lines, not just lines with those words in it. But I am not able to write it correctly. Here is what I have tried:

    use strict; use warnings; open my $fh, "+<", "testlines.txt"; while (<$fh>) { if ($_=~ /(third | four)/si) { chomp; local $/ = "\n\n"; print "line is: $_\n"; } }

    And it prints:

    >perl regex.pl line is: Third line starts here. line is: This is line four.

    But what I want is:

    This is line one. Line Two is this. Third line starts here. This is line four

    Where am I going wrong? Please guide. Please note, this is just an example. Depending on the data supplied the other lines in the file may contain some different words.

    Not sure if this matters, but I'm on Windows 10 with Strawberry Perl version 5.32.

DBIx::Class : match integer-cols having specific bits set
1 direct reply — Read more / Contribute
by bliako
on Sep 28, 2020 at 14:26

    Enlightened Brothers,

    I am having bit (!) trouble with telling DBIx::Class to match records where a specific column of integer type (actually BIGINT) has specific bit(s) set. The equivalent SQL is something like: select * from TABLE where (roles & 4) = 1 (Edit: the RHS of this where expression, i.e.: =1 was written rather hastily and it does not make sense for checking if the 2nd LSbit is set. roles=4 is much clearer and probably faster. Instead,  (roles&4) = 4, (roles&4) > 0. (roles&4)=0 make more sense in my particular scenario)

    Since we are on the topic, I have not yet understood how to use the column-name in a search with DBIx::Class. For example how to DBIx::Class this: select * from TABLE where (roles & 4) = (roles & 2) ?

    I can also settle for someone telling me how to pass a custom WHERE-in-SQL using DBIx::Class::ResultSet::search(), if possible.

    Oh! MySQL latest

    bw, bliako

substrings that consist of repeating characters
10 direct replies — Read more / Contribute
by Anonymous Monk
on Sep 27, 2020 at 13:30

    Hi. I am studying regular expressions and wanted to write a script that searches a DNA string for the longest substrings that consist of repeating letters. For example: CCCCC or GGG or AAAA etc. I managed to do that, but i am not very happy with the end resuslt. I was hoping to get most of the work done with a regex, in that regard i have failed. Furthermore there are statements in the while loop that look doubtful, and the idea of using an array to store the substring along with its length might not be good. Any advice is welcome. Thank you.

    use strict; use warnings; my $string = "AAATTTAGTTCTTAAGGCTGACATCGGTTTACGTCAGCGTTACCCCCCAAGTTATT +GGGGACTTT"; my @substrings; while($string =~ /([ACTG])(\1+)/g){ my $comb = $1.$2; my $len = length($1) + length($2); push @substrings, [$comb,$len]; } my @sorted = sort {$b->[1] <=> $a->[1]} @substrings; foreach my $substring (@sorted){ foreach my $element (@$substring){ print "$element "; } print "\n"; }
Visualize Perl Program
3 direct replies — Read more / Contribute
by aartist
on Sep 25, 2020 at 15:07
    Hi
    How I can visualize a Perl program? For example I like to see all the perl variables and the line-numbers or subroutines where it is used. I understand that variables can be created on the fly with eval and $$ and even another name-space but let's ignore for them for now, as my current code base doesn't have that.

    Thanks.
Help with Excel::Table
3 direct replies — Read more / Contribute
by BernieC
on Sep 25, 2020 at 10:27
    I'm trying to do some Excel hacking and Excel::Table looks like the perfect module. but I can't get it to open a spreadsheet. my 'open' subroutine is simple:
    sub getWB { my ($dir, $excel) = $_[0] =~ /(.*)\/(.*)/ ; my $xs = Excel::Table->new(dir => $dir) ; $xs->open($excel) ; return $xs ; }
    and when I try to open the spreadsheet with 'getWB("D:myexcel.xlsx")' I get
    Log4perl: Seems like no initialization happened. Forgot to call init() +? no such path [D:\myexcel.xslx] at D:\Perl\spreadsheet.pl line 55.
    Any advice at what I'm missing/getting wrong? Thanks
simplish script (I think)
4 direct replies — Read more / Contribute
by notoriousrab430
on Sep 24, 2020 at 20:13
    Hi, I have a simple 30 line perl script which basically just compares a bunch of numbers in a list. I'm a little rusty with perl as I haven't used it in a few years now, but no matter what I try, I can't get past the syntax error which is complaining about the line where I compare two numbers out of my array. I've given up and just can't see what is wrong. Is there a monk out there who could guide me please? I hate to post up on such a simple thing, but I'm totally stuck. Running the script complains of a syntax error:
    $ ./perlAnalyzeDailyStats.pl syntax error at ./perlAnalyzeDailyStats.pl line 29, near "@array(" Execution of ./perlAnalyzeDailyStats.pl aborted due to compilation err +ors.
    1 #!/usr/bin/perl 2 3 @files = `ls -1trh s3_dailystats.*`; 4 foreach (@files) 5 { 6 $filename = $_; 7 #print $filename; 8 open(FH,"<$filename"); 9 while(<FH>) 10 { 11 $line = $_; 12 if($line =~ /([0-9]{17,18})/) 13 { 14 print "$1\n"; 15 push(@array,$1); 16 last; 17 } 18 } 19 } 20 $arrayCount = @array; 21 print "array count is $arrayCount"; 22 foreach(@array) 23 { 24 if ($counter eq $arrayCount) 25 { 26 last; 27 } 28 $counter++; 29 print "difference is " . @array($counter) - @array($counte +r - 1); 30 } 31
Retrieving column names from SQL with DBI
6 direct replies — Read more / Contribute
by Krillian
on Sep 24, 2020 at 13:34
    Hi everyone, I have the following script:
    my ($query) = our $connect->prepare("SELECT number, name FROM TableNam +e"); $query->execute(); my $data = $query->fetchall_arrayref(); $query->finish; foreach $data ( @$data) { my %row_data; # get a fresh hash for the row data my ($variable1, $variable2) = @$data; $row_data{number} = "$variable1"; $row_data{name} = "$variable2"; } push(@loop_data, \%row_data); }
    Not the most efficient way of doing this but achieves what I want. I would like to be able to do a similar thing, but for an unknown number of columns in the SQL Table. So:
    my ($query) = our $connect->prepare("SELECT * FROM TableName"); $query->execute(); my $data = $query->fetchall_arrayref(); $query->finish; foreach $data ( @$data) { my %row_data; # get a fresh hash for the row data foreach my $data_item (@$data) { $row_data{NAMEOFSQLCOLUMN} = "$data_item"; # How do I get the name + of the SQL column that the data_item belong to? } } push(@loop_data, \%row_data); }
    Any help would be very much appreciated!
scope of variables in a sub
6 direct replies — Read more / Contribute
by frontrange
on Sep 23, 2020 at 18:43

    I feel like this is a really stupid question, but I'm sort of at my wit's end and really hoping someone can point out what it is that I'm missing. I have a subroutine and have some variables that are not in scope as I expected and can't figure out why, any wisdom on what I'm missing would be greatly appreciated

    sub make_ap_stanza () { my $policy = $_[0]; my $vsname; my $vsowner; my $owner; my $group; my $regexp; my $volumeset; my $volumeset_owner; print "Policy:$policy\n"; my @attrs = @{ $Policy_HoA{$policy} }; foreach(@attrs){ if(($vsname) = ($_ =~ /vs_name =\s+(.*)/)){ print "VSNAME:$vsname\n"; } elsif(($vsowner) = ($_ =~ /vs_owner =\s+(.*)/)){ print "VSOWNER:$vsowner\n"; } elsif(($filter) = ($_ =~ /filter_name =\s+(.*)/)){ #print "FILTER:$filter\n"; my @attrs = @{ $RegexHoA{$filter} }; foreach(@attrs){ if(($regexp) = ($_ =~ /REGEXP =\s+(.*)/)){ print "REGEXP:$regexp\n"; } elsif(($owner) = ($_ =~ /OWNER =\s+(.*)/)){ print "OWNER:$owner\n"; } elsif(($group) = ($_ =~ /GROUP =\s+(.*)/)){ print "GROUP:$group\n"; } } } } print "foo $vsowner\n"; }

    So I declared a bunch of variables in the beginning of the code block, the nested routines populate them, but outside of the foreach loop, the variables are uninitialized???

    [test1] change_timeout = 10 comment = foobar logmask = 0xffffff parent = thanos policy = perms policy = foobar queue_depth = 32 supports_hsm = yes path = /test1 Policy:perms REGEXP:image.([0-9]+).([0-9]+) OWNER:ANY GROUP:ANY VSNAME:dyn{2}{1} VSOWNER:root Use of uninitialized value $vsowner in concatenation (.) or string at +./getconf line 395. foo

    It looks like no matter how long I stare at this, I just can't understand why my variables are not properly declared

RFC: How did I do writing my first test?
4 direct replies — Read more / Contribute
by Lady_Aleena
on Sep 23, 2020 at 16:40

    The test I needed help with in Can Test::MockObject mock a file? is finished. I would like to know how I did writing it.

    I got some advice on looping I did not quite get a handle on, but this is a short test for a little module.

    Here are links to the Fancy::Open module and Fancy::Open pod (unfinished).

    My OS is Debian 10 (Buster); my perl versions are 5.28.1 local and 5.16.3 or 5.30.0 on web host depending on the shebang.

    No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
    Lady Aleena
wxPerl and MacOS
1 direct reply — Read more / Contribute
by sciurius
on Sep 23, 2020 at 04:38

    Greetings,

    I have a neat perl application that uses Wx (wxPerl). It runs on Linux, Windows and MacOS.

    One of the things currently missing on MacOS is the ability to respond to Finder commands. For example, double-clicking on an associated document should start the application. The association is dealt with in the app's Info.plist and works -- double-clicking the document starts the application but the application always starts with its main window, as if the application was double-clicked instead of the document.

    The wxWidgets docs suggest that I should override Wx::App::MacOpenFiles but this function does not seem to be in wxPerl.

    Are there any PerlMonks using wxPerl on MacOS that could shed some light on this?

Unicode vulgar fraction composition
3 direct replies — Read more / Contribute
by raygun
on Sep 22, 2020 at 20:05
    Greetings, Monks.

    Unicode has precomposed fractions, such as VULGAR FRACTION THREE EIGHTHS (U+215C), that Unicode::Normalize's NFKC or NFKD function decomposes into the string "3\N{FRACTION SLASH}8".

    But I can't get any function in that module to go the other way, turning the decomposed form back into the vulgar fraction. Clearly the module is aware of the equivalency of these forms. And while it wouldn't be difficult to write my own function to handle these fractions (there are only a dozen or so), rolling my own code to do a translation that already lives inside Unicode::Normalize seems like a wrongheaded approach. Is there a standard mechanism or tool for composing arbitrary fractions into precomposed ones, where such precomposed ones are available?

Test::Deep::noclass propagation
1 direct reply — Read more / Contribute
by choroba
on Sep 22, 2020 at 18:57
    Let's pretend we have an object:
    my $o = bless { x => bless ['y'], 'My::Value' }, 'My::Class';

    I want to verify that the object when cursed recursively will consist of

    { x => [$v], # where $v is 'y' or 'z' a => 'b' } # if a exists at all

    I thought Test::Deep's noclass should be able to tell me.

    cmp_deeply $o, noclass(subhashof({ a => 'b', x => subbagof('y', 'z') } +));

    But it doesn't work:

    # Failed test at ... # Comparing $data->{"x"} as a SubBag # got : My::Value=ARRAY(0x561fbd1fe3a8) # expect : An array to use as a Bag

    Without an object, it works nicely:

    cmp_deeply { x => ['y'] }, subhashof({ a => 'b', x => subbagof('y', 'z') });

    I asked about it in #freenode and was pointed towards Test2::Tools::Compare. It was the first time I played with it, so maybe my code is a bit clumsy, but I was able to write a test that passes:

    use Test2::Tools::Compare qw{ like hash item field in_set DNE bag }; my $o = bless { x => bless ['y'], 'My::Value' }, 'My::Class'; like({ x => ['y'] }, hash { field a => in_set(DNE(), 'b'); field x => bag { item in_set('y', 'z') }; } ); like $o, hash { field a => in_set(DNE(), 'b'); field x => [ in_set('y', 'z') ]; };

    How to do the comparison with Test::Deep? I tried adding another noclass to the value, or even noclass(useclass(...)), but it always failed similarly.

    map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
Meditations
Diary of a Zydeco experiment - E03 - Errors for fun and success
1 direct reply — Read more / Contribute
by Smonff
on Sep 22, 2020 at 15:29

    So today for the third episode of this diary, and after Diary of a Zydeco experiment - E02 - History, I would like to share a nice error message that I encountered while working on the modeling of my project. It can look strange to be happy about encountering an error message, but this one made my life really easier. It is still not about Zydeco directly but about one of the stable technology it relies on. Please don't look too deeply at the examples, they are mostly sarcastic but not very well structured on the OO side for now.

    So we have this role, that summarize very naively what a Buyer can do:

    # lib/Wildlife/Behavior/Buyer.zydeco.pm role Buyer { requires money; method acquire ( Num $price ) { say "I bought !"; } method sale ( Num $price ) { say "I sold !"; } }
    There is also an Exhibit role, that I will show only for the fun, but it is mostly distraction at this point:
    # lib/Place/Behavior/Exhibit.zydeco.pm role Exhibit { has exhibition ( type => ArrayRef ); has artist ( type => ArrayRef ); has artwork ( type => ArrayRef ) method display { say "Shoooow"; } }
    Then we have a Gallerist class, that consumes the Buyer role. You will maybe notice that there is a tiny mistake in this class (we'll come back a bit later on the mistake so don't look too much):
    # lib/Art.pm package Art { use Zydeco; class Place { has space; include Place::Behavior::Exhibit; include Wildlife::Behavior::Buyer; class Gallery with Exhibit, Buyer { has artwork ( type => ArrayRef ); has artist ( type => ArrayRef ); has event ( type => ArrayRef ); has owner; has public; } } }
    A test:
    # t/gallery.t use v5.16; use Test::More; use Art; my $gallery = Art->new_gallery( space => 1000, exhibitions => [ "Foo", "Bar" ], owner => "Arty Person", money => 10_000_000 ); ok $gallery->does('Art::Exhibit'), 'Gallery does role Exhibit'; ok $gallery->exhibitions, 'Gallery got an exhibitions attribute'; ok $gallery->owner, 'Gallery got an owner'; can_ok $gallery, 'acquire'; can_ok $gallery, 'sale';
    Let's run it! But it won't go very well.
    smonff@padi:~/projects/Art-World$ prove -lv t/15_gallery.t t/15_gallery.t .. Can't apply Art::Buyer to Art::Gallery - missing + money at /home/smonff/perl5/perlbrew/perls/perl-5.32.0/lib/site_perl +/5.32.0/Moo/Role.pm line 307. BEGIN failed--compilation aborted at (eval 269) line 1. at /home/smonff/perl5/perlbrew/perls/perl-5.32.0/lib/site_perl/5. +32.0/B/Hooks/EndOfScope/XS.pm line 26. Compilation failed in require at t/15_gallery.t line 3. BEGIN failed--compilation aborted at t/15_gallery.t line 3. Dubious, test returned 2 (wstat 512, 0x200) No subtests run Test Summary Report ------------------- t/15_gallery.t (Wstat: 512 Tests: 0 Failed: 0) Non-zero exit status: 2 Parse errors: No plan found in TAP output Files=1, Tests=0, 2 wallclock secs ( 0.03 usr 0.00 sys + 2.00 c +usr 0.10 csys = 2.13 CPU) Result: FAIL
    What I want to focus on is the Can't apply Art::Buyer to Art::Gallery - missing money part.

    The error message is launched by a croak call in the _check_requires() method of Role::Tiny.

    croak "Can't apply ${name} to ${to} - missing ".join(', ', @requir +es_fail);

    Once we add the right attribut to the Gallery class, everything goes well:

    class Gallery with Exhibit, Buyer { has artwork ( type => ArrayRef ); has artist ( type => ArrayRef ); has event ( type => ArrayRef ); has owner; has public; has money; ... }
    And we run the tests again:
    smonff@padi:~/projects/Art-World$ prove -lv t/15_gallery.t t/15_gallery.t .. ok 1 - use Art; ok 2 - Gallery does role Exhibit ok 3 - Gallery got an exhibition attribute ok 4 - Gallery got an owner ok 5 - Art::Gallery->can('acquire') ok 6 - Art::Gallery->can('serve') ok 7 - Art::Gallery->can('sale') 1..7 ok All tests successful. Files=1, Tests=7, 2 wallclock secs ( 0.03 usr 0.00 sys + 2.30 cus +r 0.16 csys = 2.49 CPU) Result: PASS
    We actually don't even need to check the attributes in details.

    What I found amazing is how the error message makes sense. It just tells what should be done to fix the problem: adding a money attribute to the Gallery class. But more than that, it have a deeper meaning, that is exactly the point og this project. I mean you wouldn't have an art gallery with zero money would you? This is what I call efficient and reliable object oriented programming thanks Zydeco making a great use of the stable technologies it is built on (like Role::Tiny).

    So far, my overall use of Zydeco is very satisfactory during the application modeling phase. Some could say that I could draw some class diagrams and not coding, but the Zydeco use is so easy and non-verbose that it really make possible to focus ont the modeling and not on the coding: focusing on listing attributes, methods, roles and their relationship, not on the implementation.

    🌸
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 chanting in the Monastery: (4)
As of 2020-09-29 08:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I don’t succeed, I …










    Results (146 votes). Check out past polls.

    Notices?