Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

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
time passed calculation
2 direct replies — Read more / Contribute
by frank1
on Jan 27, 2022 at 12:22

    Am having a problem with my last seen time script. its outputting is not normal.

    it outputs wrong results, let me say i can set Seen time to current one, it says seen 1 hour ago. yet its just 2 minutes ago

    Thanks i appreciate for help.

    #!/usr/bin/perl use strict; use warnings; use Date::Parse; use DateTime; use POSIX qw/strftime/; my $Datetime = DateTime->now; my $Seen = '01/27/2022 07:40:03'; my $CurrentDateTime = strftime('%m/%d/%Y %H:%M:%S',localtime); my $SeenDateTime = DateTime->from_epoch( epoch => str2time( $Seen ) ); my $CurrentDate_AndTime = DateTime->from_epoch( epoch => str2time( $Cu +rrentDateTime ) ); my $diff = $CurrentDate_AndTime->subtract_datetime( $SeenDateTime ); my ( $years, $months, $weeks, $days, $hours, $minutes ) = $diff->in_units(qw( years months weeks days hours minutes )); my $SeenTime =''; if ( $years >= 1 ) { $SeenTime = "Seen $years Years Ago"; } elsif ( $months > 1 ) { $SeenTime = "Seen $months Month Ago"; } elsif ( $months == 1 ) { $SeenTime = "Seen $months Month Ago"; } elsif ( $weeks > 1 ) { $SeenTime = "Seen $weeks Weeks Ago"; } elsif ( $weeks == 1 ) { $SeenTime = "Seen $weeks Weeks Ago"; } elsif ( $days > 1 ) { $SeenTime = "Seen $days Days Ago"; } elsif ( $days == 1 ) { $SeenTime = "Seen $days Days Ago"; } elsif ( $hours > 1 ) { $SeenTime = "Seen $hours Hours Ago"; } elsif ( $hours == 1 ) { $SeenTime = "Seen $hours Hours Ago"; } elsif ( $minutes > 1 ) { $SeenTime = "Seen $minutes Minutes Ago"; } elsif ( $minutes == 1 ) { $SeenTime = "Seen $minutes Minutes Ago"; } elsif ( $Seen == $CurrentDateTime) { $SeenTime = "Online"; } print $SeenTime;
Running multiple Raisin apps on a single Plack server
No replies — Read more | Post response
by cLive ;-)
on Jan 27, 2022 at 12:14

    I'm loving Raisin as a framework for OpenAPI applications, but I've hit a wall and am needing some fresh eyes.

    I want to spin up multiple Raisin apps on the same Plack server, something like this:

    use Plack::Builder; use RaisinApp1; use RaisinApp2; builder { mount '/app1' => RaisinApp1->new(); mount '/app2' => RaisinApp2->new(); };

    But, since Raisin is a functional framework, there's just a single application created, with the second "app" just being concatenated to the first, and with imported methods failing (eg, plugin) because they get imported into the first namespace that uses them.

    I'm playing around with possible solutions, but nothing has stuck so far:

    • Reloading the entire Raisin::API module under a different namespace for each app (breaks helper methods in Raisin, so I'd have to rename all modules and code - way too messy)
    • Attempting to overload the "my" variables via an extra 'package Raisin::API' block (didn't think it would work, but worth a try - it didn't).

    What I *think* I need is a way to load Raisin::API and it's dependencies in a scope limited way to lock it to each app's instance, but I can't think of how to do it. Would that be doable, or should I just drop the idea of trying to run multiple Raisin apps under Plack in this way? (yes, this is an odd setup, but it's transitional for a year or two while migrating away from a monolith)

    Something like this:

    my $app1 = some_scope_wrapper(sub { use Raisin::API; build_app1_here(); }); my $app2 = some_scope_wrapper(sub { use Raisin::API; build_app2_here(); }); # Raisin code won't work here...

    Am I barking up the wrong tree, or just barking mad?

Perl::Critic and the POSIX module.
4 direct replies — Read more / Contribute
on Jan 26, 2022 at 11:00
    $ cat #!/usr/bin/perl use strict; use warnings; use POSIX qw( :unistd_h :sys_wait_h setsid WNOHANG ); POSIX::setsid() or die 'failed'; $ perlcritic --stern ./ Subroutine "setsid" not exported by "POSIX" at line...
    What am I missing? Perl::Critic has certainly found examples of dubious technique on my part, but it also seems to have a few blind spots. What do the wise folks here think of Perl::Critic generally?
set context for method's return values
4 direct replies — Read more / Contribute
by demoralizer
on Jan 25, 2022 at 01:42
    Hi folks,

    I wonder if it is possible to use a method's return value as an array without pre-storing it into one.
    This is what I really want to do:
    print(split(",", "A,B,C,D")[2]);

    Only solution I found (without storing the values into an array), was:
    print([split(",", "A,B,C,D")]->[2]);

    Is there a common perl-ish way how one can "set" the context for method's return values?

    Thanks a lot in advance for all your wisdom!
Examples of top command written in Pure PERL
4 direct replies — Read more / Contribute
by davidfavor
on Jan 24, 2022 at 11:00
    If someone has an example of a Pure PERL top-ish type command, pass it along. Many of the LXD tools I've written would be far easier to use, if rewritten as top-ish commands, so this is the project I have in mind. Thanks!
reading the wrong input file out of 2 opened file
6 direct replies — Read more / Contribute
by perl_boy
on Jan 24, 2022 at 10:08
    Hi everyone, I have 2 open input files F0 and F1 and trying to read the second (F1) which contains IPs only but get the first instead when using print "$_ at line 9 3    PORT    state    protocol I m suppored to get and IP as in what s wrong
    here I read a second file F1 (line 9) while within a while loop for the second (line 9) and first file F0 (line 3)
    I have read
    the open function
    the read file
    Open and read
    I have double checked the program command line arguements perl port.txt IP.txt output.txt here are the
    open(F0, $ARGV[0]); open(F1, $ARGV[1]); open(F2, ">$ARGV[2]"); $line_no=$line_stop=0; while (<F0>) { while (s/^[\ \t]//g) {}; while (s/[\ \t]$//g) {}; s/\r\n//;s/\t+/\t/;chomp; /^[0-9]+/; $line=$'; $line_no=$&; while (<F1> && ($line_stop++ < $line_no)) { while (s/^[\ \t]//g) { +}; while (s/[\ \t]$//g) {}; s/\r\n//;s/\t+/\t/;chomp; print "$_\n";} print F2 $IP, "\t$line\n" if /[0-9]+\//; } close F0; close F1; close F2;
    IP file
    port file
    3 PORT state protocol 3 80/tcp closed http 3 443/tcp closed https 3 8080/tcp open http-proxy 5 80/tcp open http 5 443/tcp filtered https 5 8080/tcp filtered http-proxy
    can someone tell me why I m reading from the wrong filehandle
    Thanks for you help
Help requested to find the cause of an "uninitialized value" message
6 direct replies — Read more / Contribute
by andyok
on Jan 24, 2022 at 09:12
    I'm using
    use diagnostics
    and very occasionally I get a
    Use of uninitialized value in hash dereference at ....

    Basically, I have a background task that is accumulating information into a hash. This hash is then transacted back to the parent.
    I'm using Data::Dumper to convert the hash in the background task into a string.
    Once this string is received (by the parent), I then convert the string back into a hash with:
    my %info   = %{ eval $dumper };
    And it is this line that generates the "uninitialized value" message.
    (The background task sends data back to the parent every 10 seconds, and the "uninitialized warning" message is only genereted once in 2-3 weeks).

    Before executing the line above, I do check that $dumper contians $VAR1=.
    I'm struggling to find out what it is about the original hash that is being packed by Data::Dumper that might cause this "uninitialized value" message.
    One line of inquiry might be to see if I can get PERL to break-point when this "uninitialized value" message occurs ...
    ... at least then I could inspect the value of $dumper at the point of failure.

    Any thoughts on how I might track down this intermittent error would be greatly appreciated.
    Thank you.
LeetCode Problem #1 - Two Sum - Improve and/or discuss.
8 direct replies — Read more / Contribute
by kcott
on Jan 23, 2022 at 19:22

    See "leetcode perl solutions" for background. See for the problem.

    Here's a quick solution I put together. Feel free to improve or discuss. Use of features from more recent Perls is fine (do indicate the version required). Use modules if you want. Golfing solutions are acceptable.

    Update: I received feedback from ++LanX#11140763 and ++NetWallah#11140770 regarding issues with my original code. I made changes accordingly. I also noted that the issue identified by NetWallah, was also present in the next OUTER if $input->[$i] > $target; statement: I've removed that line and added two more tests (which also show that zero is a valid target). The new code follows. The original code can be found at the end in the spoiler.

    #!/usr/bin/env perl use strict; use warnings; use constant { INPUT => 0, TARGET => 1, EXPECTED => 2, }; use Test::More; my @tests = ( [[2,7,11,15], 9, [0,1]], [[2,7,11,15], 9, [1,0]], [[3,2,4], 6, [1,2]], [[3,2,4], 6, [2,1]], [[3,3], 6, [0,1]], [[3,3], 6, [1,0]], [[-5,-3,1,4,7], 1, [1,3]], [[-5,-3,1,4,7], 1, [3,1]], [[1,-1], 0, [0,1]], [[1,-1], 0, [1,0]], ); plan tests => 0+@tests; for my $test (@tests) { is_deeply sort_arrayref(two_sum($test->[INPUT], $test->[TARGET])), sort_arrayref($test->[EXPECTED]); } sub two_sum { my ($input, $target) = @_; my $got; OUTER: for my $i (0 .. $#$input - 1) { for my $j ($i + 1 .. $#$input) { if ($input->[$i] + $input->[$j] == $target) { $got = [$i, $j]; last OUTER; } } } return $got; } sub sort_arrayref { my ($aref) = @_; return [ sort { $a <=> $b } @$aref ]; }

    New output:

    1..8 ok 1 ok 2 ok 3 ok 4 ok 5 ok 6 ok 7 ok 8 ok 9 ok 10

    The original code and its output are in the spoiler. Note that this is code on which others' comments were based.

    — Ken

Adding CatalystX::I18N::Maketext to my DBIC schema
1 direct reply — Read more / Contribute
by mkchris
on Jan 23, 2022 at 17:56
    Hello folks - sorry, I thought I had got there after my last post, however I only got as far as accessing from a separate PL file. I'm now trying to ensure I can load the lexicon with the schema load and not everytime I call a method in my result / resultset classes (which seems like a really terrible idea). So to try and give a complete picture, here's the script I eventually got to work:
    #!/usr/bin/perl use strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/../lib"; use Data::Dumper::Concise; use TopTable::Maketext; use Config::ZOMG; use Path::Class::Dir; # Load the Catalyst config my $tt_config = Config::ZOMG->new( name => "TopTable" ); my $config_hash = $tt_config->load; # Load the locales from the config my (@locales, %inheritance, $config); $config = $config_hash->{I18N}{locales}; foreach my $locale (keys %$config) { push(@locales, $locale); $inheritance{$locale} = $config->{$locale}{inherits} if defined $con +fig->{$locale}{inherits}; } # Get the directory where the messages are defined my $dir = Path::Class::Dir->new( "$Bin/..", "root", "locale" ); # Load the lexicon TopTable::Maketext->load_lexicon( locales => \@locales, directories => [$dir], gettext_style => 1, inheritance => \%inheritance, ); my $lang = TopTable::Maketext->get_handle( "en_GB" ); printf "%s\n", $lang->maketext( "menu.title.league-tables", "Division +Three" ); 1;
    Here's my TopTable::Maketext:
    package TopTable::Maketext; use strict; use warnings; use parent qw(CatalystX::I18N::Maketext); 1;
    Now here's my schema file:
    use utf8; package TopTable::Schema; # Created by DBIx::Class::Schema::Loader # DO NOT MODIFY THE FIRST PART OF THIS FILE use Moose; use MooseX::MarkAsMethods autoclean => 1; extends 'DBIx::Class::Schema'; __PACKAGE__->load_namespaces; # Created by DBIx::Class::Schema::Loader v0.07037 @ 2013-12-03 11:04:4 +4 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:uMxbZipkwEqVJYByeZhY5Q # You can replace this text with custom code or comments, and it will +be preserved on regeneration __PACKAGE__->meta->make_immutable(inline_constructor => 0); 1;
    I'm very much a Moose novice I'm afraid, but believed if I added a 'lang' attribute with a builder method that sets all that up, I could then access that from my DB methods:
    use utf8; package TopTable::Schema; # Created by DBIx::Class::Schema::Loader # DO NOT MODIFY THE FIRST PART OF THIS FILE use Moose; use MooseX::MarkAsMethods autoclean => 1; extends 'DBIx::Class::Schema'; __PACKAGE__->load_namespaces; # Created by DBIx::Class::Schema::Loader v0.07037 @ 2013-12-03 11:04:4 +4 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:uMxbZipkwEqVJYByeZhY5Q use FindBin qw( $Bin ); use TopTable::Maketext; has "lang" => ( is => "ro", isa => "TopTable::Maketext", builder => "_set_maketext", required => 1, ); sub _set_maketext { my ( $self ) = @_; my $class = $self->class; my $app = $self->_app; my (@locales, %inheritance); my $config = $app->config->{I18N}{locales}; $app->log->debug( sprintf( "app: %s, class: %s", $app, $class ) ); printf( "app: %s, class: %s", $app, $class ); foreach my $locale (keys %$config) { push(@locales, $locale); $inheritance{$locale} = $config->{$locale}{inherits} if defined $c +onfig->{$locale}{inherits}; } my $dir = Path::Class::Dir->new( "$Bin/..", "root", "locale" ); TopTable::Maketext->load_lexicon( locales => \@locales, directories => [$dir], gettext_style => 1, inheritance => \%inheritance, ); return TopTable::Maketext->get_handle( "en_GB" ); } # You can replace this text with custom code or comments, and it will +be preserved on regeneration __PACKAGE__->meta->make_immutable(inline_constructor => 0); 1;
    This however, doesn't work - the 'lang' method is accessible, but returns undef - I have added this as a test in one of my resultset methods: $logger->( "debug", $self->result_source->schema->lang->maketext("menu.title.league-tables", "Division Three") ); But this gives an error:
    [error] Caught exception in TopTable::Controller::Admin::Bans->process +_form "Can't call method "maketext" on an undefined value at D:\Perso +nal\Dev\Web\\TopTable\lib/TopTable/Schema/ResultSet/Ba line 88."
    Grateful for any advice, thanks so much! I hope I've provided enough to see what's going on.
Dumping opaque objects
2 direct replies — Read more / Contribute
by hv
on Jan 23, 2022 at 17:52

    A bit too often I write some code, have a problem, stick in a temporary Data::Dumper call, and see something like this:

    sub munge_data { my($data) = @_; # temp hack use Data::Dumper; warn Dumper($data); ... # do munging } ... $VAR1 = [ bless( do{\(my $o = 63036880)}, 'Math::GMP' ), bless( do{\(my $o = 63024960)}, 'Math::GMP' ), bless( do{\(my $o = 63021408)}, 'Math::GMP' ) ],

    Now Data::Dumper has the Freezer interface, which provides a way to modify the object before dumping - useful if the object caches a bunch of verbose but uninteresting stuff which will automatically be recreated when needed.

    What Data::Dumper doesn't seem to provide is a way to say "call this method/function to get the _actual string_ this object should dump as". For this case it would be ideal to represent a GMP object $z as something like "z$z", taking advantage of its existing stringification overload - despite Data::Dumper's stated purpose, I hardly ever care about evalling the output to recreate the data structure.

    Does anyone know of a recommended (or remotely usable) way to achieve such a thing? Ideal would be a per-class override, but even a global one would nearly always be as useful to me.

    Update: I'm perfectly happy to use a module other than Data::Dumper, clearly that wasn't clear.

    Update: I've managed to make some progress with Data::Printer after a few false starts. I'm going to spend some time seeing if I can learn to live with its output format (which has lots of options, but not necessarily the ones I'd want), but I like that I can throw almost everything in a config file so there's minimal boilerplate when I use it:

    % cat ~/.dataprinter use_prototypes = 0 index = 0 align_hash = 0 hash_separator = ' => ' colored = 0 begin filter Math::GMP $ddp->unsee($obj); "z_$obj"; end filter % perl -MDDP -MMath::GMP -we ' $val = 1; $zval = Math::GMP->new(1); p [$val, $val, $zval, $zval]; ' [ 1, 1, z_1, z_1 ] %

    The hardest bit was avoiding its handling of duplicate references, which was making the last line of output show var[2] instead of z_1. That's what the unsee() call is fixing for me.

Add your question
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?

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

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (5)
As of 2022-01-28 09:04 GMT
Find Nodes?
    Voting Booth?
    In 2022, my preferred method to securely store passwords is:

    Results (73 votes). Check out past polls.