http://qs1969.pair.com?node_id=479

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
Comparing time strings from a list of HH:MM:SS times
2 direct replies — Read more / Contribute
by slugger415
on Aug 10, 2022 at 14:38

    Hello esteemed PerlMonks,

    I have a list of time strings in the HH:MM:SS format. I want to add each to a variable set with localtime and compare it to a timestamp later in the script. I'm having trouble understanding how to add that HH:MM:SS string to the localtime variable.

    #! /usr/bin/perl use Time::Piece; use strict; my(@times) = ("00:05:21","00:08:05","00:10:33"); my $startTime = localtime(); print "Start: ", $startTime, $/; foreach my $t (@times) { sleep 2; my $newTime = localtime(); my $ss = $startTime + $t; ### this is where I need advice if($ss > $newTime){ print "\$ss is greater.\n"; ### execute some functions here } print "Newtime: ", $newTime, $/; my $diff = $newTime - $startTime; print $diff, $/;

    The $diff part works but not the addition of $t, how do I add that time to it? Obviously I need to convert it to something Time::Piece understands.

    Thank you.

Rename/mkdir with File::Fetch
3 direct replies — Read more / Contribute
by justin423
on Aug 10, 2022 at 11:03
    I posted a question on here before about File:Fetch and got a bunch of great responses, so thank you all... It doesn't seem like this is possible, but can file:Fetch either rename the files to a particular filename, or alternatively create a new directory each time with a pre-determined folder name? The URL's are in format www.example.com/document_id/document.pdf where document id is a unique number provided by the publisher. So all the files to fetch are named document.pdf. So that each successive document doesn't overwrite the previous one, I rename them to document0.pdf, document1.pdf using a loop to keep them unique. (see code below) so is there a way to either change the filename to document_id.pdf or make a new directory of data/documents/document_id/ and save the document.pdf to that new folder? I think file:fetch only takes one variable input. and won't work with SELECT DOCUMENT_ID,URL FROM LINKS
    my $query = "select url FROM LINKS"; # << minor edit my $sth = $dbh->prepare($query) or die "prepare: ".$dbh->errstr; $sth-> execute() or die "execute: ".$dbh->errstr; $i=0; while (my $ref = $sth->fetchrow_hashref()) { print "\nurl: $ref->{url}\n"; my $ff = File::Fetch->new(uri=>$ref->{url}); my $where = $ff->fetch( to => '/data/documents/'); my $error= $ff->error(); rename ("C:/data/documents/document.pdf","C:/data/documents/document$i.pdf"); ($i++); }
WWW::Mechanize and SSL
2 direct replies — Read more / Contribute
by Jonathan
on Aug 10, 2022 at 09:09

    Firstly, apologies as this is more a SSL issue than just Perl. I have an HTTPS url that I want to pull some data from (the url is another server on our local network). The url works fine with Chrome, MS Edge etc but I'm getting a certificate error running my test script from a dev server (Ubuntu). Also wget also fails with certificate errors.

    #!/usr/bin/perl use strict; use warnings; use WWW::Mechanize; use Net::SSLeay; my $m = WWW::Mechanize->new( autocheck => 1 ); print "LWP: $LWP::UserAgent::VERSION\n"; print "Mech: $WWW::Mechanize::VERSION\n"; print "Net::SSLeay $Net::SSLeay::VERSION\n"; my $url = $ARGV[0]; $m->get($url); print $m->content();
    Which outputs;
    $ ./testit.pl LWP: 6.43 Mech: 1.96 Net::SSLeay 1.88 Error GETing https://xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx: Can't conn +ect to xxxxxxxxxxx:443 (certificate verify failed) at ./testit.pl lin +e 15. $
    I suspect there is something available on the companies servers that satisfies browsers but isn't available elsewhere. Anyone seen this before and have any idea what I need to do? Thanks
How to use the right timezone in a DBIx::Class ResultSet call?
1 direct reply — Read more / Contribute
by LittleJack
on Aug 08, 2022 at 21:38

    I have a working DBIx::Class resultset which looks roughly like this:

    my $tasks_to_do = $self->search( { -and => [ scheduled_run_time => { '<= +', 'NOW()'}, status => 'pending' ] } );

    But I need that "NOW()" to be in Sydney, Australia time, not the server time which is UTC.

    In the script which calls this ResultSet method I've got both

    BEGIN { $ENV{TZ} = 'Australia/Sydney'; }

    and

    $schema->storage->dbh_do(sub {"SET TIMEZONE='Australia/Sydney'"} );

    But it still returns no records.

    Due diligence: I know there are records because if I go in to the db manually and do this:

    sessions=> SET TIMEZONE='UTC'; SET sessions=> select * from mytable where scheduled_run_time <= NOW() and + status = 'pending';

    I get "no rows", but if I do this:

    sessions=> SET TIMEZONE='Australia/Sydney'; SET sessions=> select * from mytable where scheduled_run_time <= NOW() and + status = 'pending';

    I get the expected number of records.

    TIA. I have had my coffee by the way.

cURL and HTTP::Request
2 direct replies — Read more / Contribute
by jeanbaptiste93
on Aug 08, 2022 at 18:10

    Hi, all!

    I am trying to call a particular API endpoint and am being unsuccessful. I have been able to make calls to dozens of endpoints to the same API, so I was unsure as to what the issue was. I tried a cURL with the relevant params and it worked successfully. But I am being unable to replicate it to HTTP::Request.

    Here's the cURL:

    curl --request PUT --url 'https://[URL]/[ENDPOINT]/item?key=[KEY]&token=[TOKEN]' --header 'Content-Type: application/json' --data '{"value": {"text": "38"}}'

    I have tried:

    my $browser = LWP::UserAgent::JSON->new(); my $response = $browser->put( $url, Content => to_json($data) );

    and:

    my $request = HTTP::Request::JSON->new( 'PUT', $url, [ Accept => 'application/json', 'Content-Type' => 'application/json', ], to_json($data) ); my $browser = LWP::UserAgent::JSON->new(); my $response = $browser->request($request);

    and similar solutions to no avail. I appreciate any help!

Allowing regex entries in web form to search database: Risks or gotchas?
4 direct replies — Read more / Contribute
by Polyglot
on Aug 08, 2022 at 13:10

    I have a research-oriented database, online, accessible via my own web interface and open to public use. The application is set up to allow read-only access to the database, the CGI script is hosted on a linux server, and the script is definitely not set as setuid. I am not allowing any use of nested executable code inside the regex, via the following sort of rules during the parsing of the query:

    return "ERROR: For security and bandwidth reasons, query may not conta +in pure wildcards." if $SR_query =~ m/^[( ]*\.\s*(?:(?:\{\s*\d+\s*,?\ +s*\d*\s*})?|[*+?]*)[) ]*$/; return "ERROR: Regex containing code disallowed." if $SR_query =~ m[\( +\?\??\{];

    Beyond these fundamental/basic protections against potential malicious actors, is there anything I might be blindly walking into by unleashing this capability in my website?

    I have had to run a rather complicated subroutine on the query itself to prevent taint from objecting to it--even though the code is never "executed" other than being inserted into a m// to run against text drawn from the database prior to formatting the results for return to the browser. But this is a small price to pay for the very useful functionality of having regex-capable searches on the database.

    Blessings,

    ~Polyglot~

Strawberry Perl can't find a module installed at a non-standard location
1 direct reply — Read more / Contribute
by LittleJack
on Aug 07, 2022 at 20:04

    I need to test what happens when a module is installed at a non-standard location.

    So I installed HTML::Template using:

    cpanm -l "C:/Users/Me/SecretModules" HTML::Template

    And installation was successful.

    When I go to use it (from Eclipse), like this:

    Package::DummyModule; use lib 'C:/Users/Me/SecretModules/lib/perl5'; use Text::HTML;

    It says that it can't find the module:

    Can't locate Text/HTML.pm in @INC (you may need to install the Text::H +TML module) (@INC contains: C:/Users/Me/SecretModules/lib/perl5/MSWin +32-x64-multi-thread [etc]

    So I'm confused. The module is installed at C:/Users/Me/SecretModules/lib/perl5 and there's a packlist file in C:/Users/Me/SecretModules/lib/perl5/MSWin32-x64-multi-thread/auto but why can't Strawberry Perl find the module? Why does it automatically append the multi-thread directory? Can I install in such a way that it's non-multi-thread compatible?

    TIA

Why does eof have a prototype?
2 direct replies — Read more / Contribute
by LanX
on Aug 07, 2022 at 12:57
    Hi

    I'm trying to parse the usage infos in the pod of perlfunc to create code snippets, and am getting surprised by idiosyncrasies.

    For instance is eof magic when called with empty brackets eof()

    but has a prototype

    $ perl print prototype 'CORE::eof',"\n" __END__ ;* $

    See also perlsub

    > Note however that some built-ins can't have their syntax expressed by a prototype (such as system or chomp). If you override them you won't be able to fully mimic their original syntax.

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

Immediately writing the results of search-and-replace
2 direct replies — Read more / Contribute
by Anonymous Monk
on Aug 05, 2022 at 13:56
    Most gracious monks: I am a Perl novice working on a script that takes a CSV file as input, uses the first element of each row as a string to search on, and the second element of each row as the replacement string. In the event that one search term appears in multiple rows, these are merged together so that the second element becomes an array of replacement candidates, reduced down to unique items. In either case, the user is prompted to adjudicate the replacement (either yes/no for a single replacement candidate, or a numeric input for multiple). I have the core functionality working, but some problems crop up when doing replacements on search strings for which other search strings are substrings.

    For example, if my script finds that a file contains the search string 'IP whitelist' on a given line, even if I confirm that I want to replace this with 'IP access list', it will then prompt me to replace just 'whitelist' with one of its various candidates. What I would expect to happen in that case is that the replacement of 'IP whitelist' with 'IP access list' happens before the search for the 'whitelist' key is initiated, preventing it from finding a match there. Doing some digging, it seemed that setting up autoflushing would solve my problem, but either I've misunderstood and that is not a solution to the situation, or I have implemented it incorrectly. Here is the subroutine that performs the actual search-and-replace:
    sub search_and_replace { open my $target_file, "<", $_; $| = 1; my $filename = $_; while (my $target_string = <$target_file>) { for my $row (@table) { my $search = $row->[0]; my $replacement = $row->[1]; if ((lc $target_string) =~ (lc $search)) { print "Found $search in $filename in the following context +:\n"; print "$target_string\n"; if (ref($replacement) eq 'ARRAY' && length $replacement > +1) { print "Choose a replacement candidate by typing the appr +opriate number, or else type '0' to skip.\n"; my $count = 1; for my $value (@$replacement) { print "$count\) $value\n"; $count++; } my $choice = <STDIN>; if ($choice >= 1 && $choice <= (length $replacement)) { my $replace_choice = $replacement->[$choice]; edit_file { s/$search/$replace_choice/gi} $filename; } else { print "Skipping this occurrence without replacing.\n"; } } else { print "Confirm replacement with $replacement by typing y +, or skip by typing any other key.\n"; my $choice = <STDIN>; if ($choice eq 'y' || 'Y') { edit_file { s/$search/$replacement/gi } $filename; } else { print "Skipping this occurrence without replacing.\n"; } } } } } close $target_file; }
    1) I was under the impression that autoflushing on the currently open filehandle can be set using the $| variable, but if that's the case, why doesn't this have any affect?
    2) Is refactoring this subroutine so that it loops over the rows of the tables first, and then over each file in the inner loop a better solution? It seems like a lot more IO to be opening and closing every file over and over for each term, but I'm not a real programmer by any stretch, so I could be way off the mark here.
    3) I also tried putting the line $target_file->flush; as the last line of each of the replacement 'if' statements, and that did nothing either.

    Please let me know if there is any additional info I can provide that would help. Thank you very much.
XS Error: Segfault with B::HooksAtRuntime
2 direct replies — Read more / Contribute
by Ovid
on Aug 05, 2022 at 06:01

    My module, MooseX::Extended is quickly becoming popular and is now being used in production at some companies. However, one person is reporting intermittent segfaults. This appears to be related to my using B::Hooks::AtRuntime to avoid the need to add __PACKAGE__->meta->>make_immutable; to the end of every Moose module. There's not much XS code involved, but my XS knowledge is even worse than my C.

    Paul "LeoNerd" Evans commented on IRC:

    14:18 LeoNerd: #0 Perl_SvREFCNT_dec_NN (sv=0xa65636e6174736e, my_perl=0x55921df002a0) at inline.h:242 <== that looks very much like a bad sv address
    14:20 LeoNerd: Not terribly clear where that comes from.. the next context frame is popeval, which suggests stack unwind. Possibly at this point some accessing of bad memory
    14:20 LeoNerd: valgrind might help.

    Can anyone with XS knowledge help me? As far as I can tell, the code is still solid for prod. I'm wondering if this has something to do with the effectively random order of global destruction because this is just being triggered by a compilation test. (That's just speculation and could be a red herring).

    Note: If anyone else experiences this, the workaround is to simply exclude the automatic immutable behavior and add it manually to your M ooseX::Extended classes.


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":