Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Seekers of Perl Wisdom

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

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask.

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

Post a new question!

User Questions
How to get better exponentiation?
7 direct replies — Read more / Contribute
by Athanasius
on Jan 22, 2022 at 02:14

    There are times when Perl’s inbuilt exponentiation operator, **, just doesn’t cut it:

    16:46 >perl -wE "my $cube_root = (-8)**(1/3); say $cube_root;" NaN 16:46 >perl -v This is perl 5, version 32, subversion 1 (v5.32.1) built for MSWin32-x +64-multi-thread

    I note in the documentation that ** “...is implemented using C's pow(3) function...”, and that’s where the limitation appears to lie. (I’m using Strawberry Perl running under Windows 8.1 64-bit. I get the same results using Raku. I don’t know if C’s pow(3) function has the same limitations under Unix?)

    I came up with the following, which works for my use-case but is really a kludge:

    sub cube_root { my ($n) = @_; return (abs( $n ) ** (1 / 3)) * ($n < 0 ? -1 : 1); }

    So, what’s the quickest/simplest/correct way to get Perl to act like the calculator app that comes with Windows, and give -2 as the cube root of -8? (I’m only interested in the real solution.) I had a quick look through CPAN, but nothing stood out. I’m probably overlooking the obvious.

    Thanks,

    Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

Alternative to smart match
1 direct reply — Read more / Contribute
by Bod
on Jan 21, 2022 at 19:22

    Happy January fellow Monks

    I've written some code that works...but I don't like it!

    Not only is it a bit messy, it also is probably not as efficient as it could be although it is only handle small amounts of data. But the main problem is that it uses Perl's smart match operator. I am using Perl 5.16.3 and smart match works well for what I want under this version. But I cannot guarantee it will always be using this version so don't want to stop it from being forward compatible.

    Here's the bare bones of the code:

    my $query = $dbh->prepare("SELECT * FROM Sector, Lane_has_Sector WHERE + Sector_idSector = idSector AND Lane_wid = ? ORDER BY metric"); $query->execute($wid); while (my $sec = $query->fetchrow_hashref) { # More stuff happens here... ($sec->{'authority'}, my $prefix, my $suffix) = $dbh->selectrow_ar +ray("SELECT name, prefix, suffix FROM Authority WHERE idAuthority = ? +", undef, $sec->{'Authority_idAuthority'}); $prefix = "$prefix " if $prefix; $suffix = " $suffix" if $suffix; push @authority, $prefix . $sec->{'authority'} . $suffix unless $p +refix . $sec->{'authority'} . $suffix ~~ @authority; } my $auth_list = join '<br>', @authority;
    Essentially I am pulling data from a database. Collecting together a some information into the @authority array but I only want unique values. This strikes me as the sort of thing databases are good at so I could hit the database again with another query that's quantified as DISTINCT and build my @authority array from that. But that seems messy as well. In the vast majority of cases, @authority will only hold one value but there are few times when it will hold two, perhaps three.

    I'm thinking grep or List::Util might be a more elegant and robust solution here.

    Any suggestions would be very welcome...

Archive::Tar directory permissions
3 direct replies — Read more / Contribute
by LiveandLearn2021
on Jan 20, 2022 at 14:14
    Hello all, I am trying to determine if I'm encountering a bug or expected behavior with Archive::Tar. I've noticed that if I archive a directory such as /usr/include/sys/*.h that permissions are retained only for files underneath the sys directory. The permissions for /usr/include/sys change to the user that is extracting the files, including root. If the directory(/usr/include/sys) is owned by someone other than root it is not retained even if root does the extraction. If I use tar standalone to archive the directory then the permissions are retained for all directories. Is this to be expected? Additionally I've noticed that I cannot archive named pipes at all. The process will attempt to open the pipe and remain hung waiting on a response. This is the basic code I am using.
    use Archive::Tar; $tar = Archive::Tar->new(); $tar->add_files(<"/usr/include/sys/*.h">) or die("Failed $!\n"); $tar->write("files.tar") or die("Failed $!\n");
    These are the permissions on the original directories: ls -ld /usr drwxr-xr-x 54 root sys 69 Apr 9 2018 /usr ls -ld /usr/include drwxr-xr-x 117 root bin 436 Sep 25 22:10 /usr/include ls -ld /usr/include/sys drwxr-xr-x 25 root bin 628 Sep 25 22:09 /usr/include/sys When I extract the archive(as root) generated from my code I see these permissions: ls -ld usr drwxr-xr-x 3 root root 512 Jan 20 13:06 usr ls -ld usr/include drwxr-xr-x 3 root root 512 Jan 20 13:06 usr/include ls -ld usr/include/sys drwxr-xr-x 2 root root 11776 Jan 20 13:07 usr/include/sys Thank you for any assistance!
Catalyst: accessing maketext from a model
3 direct replies — Read more / Contribute
by mkchris
on Jan 20, 2022 at 11:47
    Hi everyone - apologies, I'll try and make this as clear as I can. I have a Catalyst app that has internationalisation via CatalystX::I18N. This includes the ability to call $c->maketext($msgid, $params). Essentially, I want to be able to use these in my DB model so that I can generate response messages in the relevant language. The only way I have thought of to do this so far (don't shoot me, I know it's not recommended!) is by passing $c->maketext as part of the parameters into the method I'm calling:
    $c->model("DB::$resultset")->do_something({ language => sub{ $c->maketext( @_ ); } });
    What I would like is to be able to use a maketext model (which seems to be available via CatalystX::I18N::Model::Maketext) so that I can use App::Maketext in my result and resultset classes and then use ->maketext() directly in those, if that makes sense? I have set this up and can debug the following:
    $c->log->debug( sprintf( "maketext: '%s'", $c->maketext("menu.title. +news") ) ); $c->log->debug( sprintf( "model maketext: '%s'", $c->model("maketext") +->maketext("menu.title.news") ) );
    Both of these give the same output from the function calls:
    [debug] maketext: 'News Index' [debug] model maketext: 'News Index'
    However, I don't seem to be able to call this from outside Catalyst (which I need to be able to call it from the DB model) - I've run up a little test script and I was initially trying to load the config from my app's config file:
    #!/usr/bin/perl use strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/../lib"; use App::Maketext; use Config::ZOMG; my $config = Config::ZOMG->new( name => 'App' ); my $config_hash = $config->load; my $maketext_info = $config_hash->{"Model::Maketext"}; my $lang = TopTable::Maketext->new($maketext_info); printf "%s\n", $lang->maketext( "menu.title.news" );
    However, I get the foillowing response:
    maketext doesn't know how to say: menu.title.news as needed at bin\maketext-demo.pl line 16.
    Then I thought I'd pass in the directories manually (at least for the time being):
    my $dir = Path::Class::Dir->new( "$Bin/..", "root", "locale" ); my $lang = TopTable::Maketext->new(directories => $dir);
    Finally I tried passing in the locale as well:
    my $dir = Path::Class::Dir->new( "$Bin/..", "root", "locale" ); my $lang = TopTable::Maketext->new(directories => $dir, locales => "en +-GB");
    All of which give the same result. I am sure I'm missing something about the way it all hangs together and would be hugely greatful for any pointers that could be given! Many thanks in advance.
Replace empty alt tag on <img> tag
3 direct replies — Read more / Contribute
by vlearner
on Jan 20, 2022 at 02:52

    I would like to replace my empty alt tags on images in a string. I have a string that contains all the text for a curtain page. In the text are also images, and a lot of them have empty tags (old data), but most of the time they do have title tags. For e.g.<image href = "images/cron1.png"><<alt>></alt></image> What I wish to have:<image href = "images/cron1.png"></image> kindly guide me how should I proceed Here is my tried implementation. what changes do I need to make to get the desired output?

    sub RemoveAltTag($) { my $doc = shift; ############################## my $cnt = 0; my $nodes = $doc->getElementsByTagName("image"); for(my $i = 0;$i < $nodes->getLength(); $i++) { my $kids = $nodes->item($i)->getChildNodes(); for(my $k =0; $k < $kids->getLength(); $k++) { if($kids->item($k)->toString() =~ /<alt>/i) { $nodes->item($i)->removeChild($kids->item($k)); print "\n Removed <alt> tag" if $VERBOSE; $cnt++ } } } return $cnt;
designing a program - your wisdom needed
8 direct replies — Read more / Contribute
by SpaceCowboy
on Jan 20, 2022 at 01:18
    Dear Monks,

    I would like your wisdom and advice on designing on following. I am looking to extract tables from a database and start executing SQL statements in a certain order.

    so far, I have four perl programs, primary.pl, first.pl, second.pl, third.pl. primary will be the main program in which i am calling the other three scripts.

    primary.pl will call the scripts, first.pl and second.pl will create temp table schema and each will run a huge query that loads data into respective temp table schema. third.pl will join the two temp tables from first and second and load it into third.

    my question is,

    How can I declare the database connection parameters just once?
    when I call the scripts, the first/second/third wont execute without the database connection parameters mentioned in each one of them

    how can I serialize the execution? such that subsequent scripts execute if and only if the first one executes successfully.

    Is it possible to write multiple statements like dbh->do("create temp schema", "insert table");

    Any general wisdom here? am I doing something outlandish?

    primary.pl
    use dbi; use warnings; use strict; ***import database credentials here usename password database host driver dbh $dbh->do("alter session set current_schema = the current schema”); my $jobs = `perl C:/first.pl`; print “first script executed”; my $jobs = `perl C:/second.pl`; print “second script executed”; my $jobs = `perl C:/third.pl`; print “third script executed”; *** code to export the final temp table to csv.


    first.pl
    use dbi; use warnings; use strict; ***import database credentials here usename password database host driver dbh dbh->do(“create temp table”) dbh->do(“insert into ttemp table”); *** exit the database


    second.pl
    use dbi; use warnings; use strict; ***import database credentials here usename password database host driver dbh dbh->do(“create second temp table”) dbh->do(“insert into second temp table”); *** exit the database


    third.pl
    use dbi; use warnings; use strict; ***import database credentials here usename password database host driver dbh dbh->do(“create third temp table”) dbh->do(“insert into third temp table where you join first and second” +); *** exit the database


    thank you for your time
Refer by relative way to regex group (eg. the last one)
2 direct replies — Read more / Contribute
by Anonymous Monk
on Jan 18, 2022 at 20:01
    How to refer by relative way e.g. to get the last regex group from Perl code inserted inside regex, as
    'foobar' =~ /(oo)(bar)(?{$word=${-1}})/

    fails, word var. can't be bar ?
Getting permutations of length n of an array of length greater than n?
3 direct replies — Read more / Contribute
by LittleJack
on Jan 18, 2022 at 17:04

    I'm looking at Algorithm::Permute and it doesn't seem to have this feature: given an array of say 8 items, how can I list all permutations of length 5, not the full 8?

Get most recent data based on a date from an array of hashes.
7 direct replies — Read more / Contribute
by Anonymous Monk
on Jan 18, 2022 at 12:35
    Hi Monks,

    Trying to get the most recent data set from this array, "sort" not working, prints all the data instead.
    I only want to get the most recent:

    { 'Color' => 'green', 'Step' => 'Platform', 'acc' => '1111', 'Date' => '08-06-2022' }
    Which is the most recent based on the " 'Date' => '08-06-2022'".
    Any suggestions?

    Test code:
    #!/usr/bin/perl -w use strict; use Data::Dumper; my $data = [ { 'Color' => 'green', 'Step' => 'Platform', 'acc' => '1111', 'Date' => '08-06-2022' }, { 'Color' => 'black', 'Step' => 'Platform', 'acc' => '1111', 'Date' => '01-05-2019' }, { 'Color' => 'blue', 'Step' => 'Platform', 'acc' => '1111', 'Date' => '10-11-2020' }, { 'Color' => 'white', 'Step' => 'Platform', 'acc' => '1111', 'Date' => '01-03-2022' }, { 'Color' => 'red', 'Step' => 'Platform', 'acc' => '1111', 'Date' => '03-21-2021' }, ]; my @filtered = sort { $a->{Date} cmp $b->{Date} } @$data; print Dumper @filtered;

    Thanks for looking!
perl -d myprog autostarts - but only in one specific directory
2 direct replies — Read more / Contribute
by ibm1620
on Jan 18, 2022 at 08:49
    When I run the debugger on any program from one particular directory, it does not stop at the first executable line, but runs to completion as if I'd given the 'c' debugger command to continue.

    The-Air:~/private/lewis_folder/client$ cat wjma.pl #!/usr/bin/env perl use warnings; use strict; print "HEY\n";
    Here's my perl executable:
    The-Air:~/private/lewis_folder/client$ which perl /Users/chap/perl5/perlbrew/perls/perl-5.34.0/bin/perl
    Demonstrating that the program works:
    The-Air:~/private/lewis_folder/client$ ./wjma.pl HEY
    Demonstrating running debugger on program, from within the problem directory. Note that it automatically runs to completion.
    The-Air:~/private/lewis_folder/client$ perl -d wjma.pl Loading DB routines from perl5db.pl version 1.60 Editor support available. Enter h or 'h h' for help, or 'man perldebug' for more help. main::(wjma.pl:4): print "HEY\n"; DB<1> HEY The-Air:~/private/lewis_folder/client$
    Now I run the debugger on the same program while in a different directory. Note that it behaves correctly, stopping on the first statement.
    The-Air:~$ /bin/pwd /Users/chap The-Air:~$ perl -d /Users/chap/private/lewis_folder/client/wjma.pl Loading DB routines from perl5db.pl version 1.60 Editor support available. Enter h or 'h h' for help, or 'man perldebug' for more help. main::(/Users/chap/private/lewis_folder/client/wjma.pl:4): 4: print "HEY\n"; DB<1>
    Now I run the debugger from the problem directory on the same program, located in a different directory. Note that again it runs to completion rather than stopping:
    The-Air:~/private/lewis_folder/client$ perl -d /Users/chap/private/per +l/wjma.pl Loading DB routines from perl5db.pl version 1.60 Editor support available. Enter h or 'h h' for help, or 'man perldebug' for more help. main::(/Users/chap/private/perl/wjma.pl:4): 4: print "HEY\n"; DB<1> HEY The-Air:~/private/lewis_folder/client$
    So the problem occurs when I run perl -d from this one directory, which contains:
    The-Air:~/private/lewis_folder/client$ ls -al total 56 drwxrwxr-x 8 chap staff 256 Jan 18 08:43 . drwxrwxr-x 7 chap staff 224 Apr 2 2020 .. drwxrwxr-x 3 chap staff 96 Jul 13 2013 con lrwxrwxr-x 1 chap staff 25 Nov 27 2015 dict -> /Users/chap/priv +ate/text/ drwxrwxr-x 4 chap staff 128 Sep 29 2010 dictorg -rwxrwxr-x 1 chap staff 15749 Jan 18 07:29 lewis-client -rw-rw-r-- 1 chap staff 4880 Jan 17 19:56 lewis-client.config -rwxr-xr-x 1 chap staff 61 Jan 18 08:22 wjma.pl The-Air:~/private/lewis_folder/client$
    I'm scratching my head here. Any suggestions?

Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (8)
As of 2022-01-27 12:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In 2022, my preferred method to securely store passwords is:












    Results (70 votes). Check out past polls.

    Notices?