Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer


by Bod (Curate)
on Nov 15, 2020 at 00:48 UTC ( #11123653=user: print w/replies, xml ) Need Help??

Long time amateur coder since growing up with a ZX Spectrum and BBC Micro...

Introduced to Perl in the early 1990's which quickly became the language of choice. Built many websites and backend applications using Perl including the sites for my property business:
Lets Delight - company site
Lets Stay - booking site
Also a few simple TK based desktop apps to speed things up.

Guilty of only learning what I need to get the job done - a recipe for propagating bad practice and difficult to maintain code...difficult for me so good luck to anyone else!

Now (Nov 2020) decided to improve my coding skills although I'm not really sure what "improve" means in this context. It seems Perl and best practice have come along way since I last checked in and my programming is approach is stuck in the last decade.

Onwards and upwards...

20th October 2021 - added to Saint in our Book 😀

Find me on LinkedIn

CPAN Release


Posts by Bod
HTTP::Tiny losing headers for Stripe in Seekers of Perl Wisdom
3 direct replies — Read more / Contribute
by Bod
on Jun 25, 2022 at 16:32

    I'm trying to update a subscription in Stripe.

    This involves calling an API with an authorisation header using POST. If the payload is empty, the API returns a JSON object representing the existing subscription. If there is subscription data in the payload, Stripe attempts to update the subscription and returns the complete subscription object. Pretty straightforward and it all works fine. Until I need to read the existing subscription object and then update it.

    I have hit a problem and I can't think of how to debug it further!
    Here is the minimum code to demonstrate the problem:

    #!/usr/bin/perl -T use CGI::Carp qw(fatalsToBrowser); use FindBin qw($RealBin); my $safepath; BEGIN { if ($RealBin =~ m!^(/home/...path.../(test|uk)/www)!) { $safepath = "$1/../lib"; } else { die "Illegal use of software - visit to use +this site"; } } use lib "$safepath"; use Site::Variables; use HTTP::Tiny; use JSON; use Data::Dumper; use strict; use warnings; my $http = HTTP::Tiny->new; my $headers = { 'headers' => { 'Authorization' => 'Bearer ' . $Site::Variables::stripe_secret +, }, 'agent' => 'Wayfinder/v3.0', }; my $sub_id = 'sub_xxxxxxxxxxx'; # This line is the culprit... my $res = $http->post_form("$s +ub_id", {}, $headers); my $payload = decode_json($res->{'content'}); my $subscription = { 'items[0][id]' => 'x', 'items[0][price]' => 'some price', }; my $response = $http->post_form(" +ns/$sub_id", $subscription, $headers); print "Content-type: text/plain\n\n"; print Dumper $response;
    With the code as it is, I get an error from Stripe that I have not supplied an API key. The key is in the $headers variable. If I take out the first call to Stripe, the one with the empty payload, then the second one succeeds * so the API key is working fine in this case. But as soon as I make two calls, it fails.

    Things I've tried but haven't helped:

    • Turning off taint mode
    • Creating two instances of HTTP::Tiny and making each call with a different instance
    • Creating a copy of $headers to use in the second call
    • Adding a 5 second delay between calls to Stripe
    Any ideas what I can try to solve this problem?

    It is as if HTTP::Tiny doesn't like making consecutive POSTs but I cannot find anything in the documentation about this.

    * - Without the first call, the second call to Stripe gives an error because I haven't got the parameters right. But it doesn't complain about there not not being an API key

Replacing a module dependency in Seekers of Perl Wisdom
4 direct replies — Read more / Contribute
by Bod
on Apr 26, 2022 at 19:34

    We send automated emails with things like registration verifications automatically. We user MIME::Lite to do the sending and use the default send mechanism which is sendmail as it is a Linux server.

    But we are having some issues with deliverability. So, I decided to switch to using SMTP instead to see if that works more reliably. To send via SMTP MIME::Lite uses Net::SMTP which in turn requires MIME::Base64. This last module is XS and I don't have it installed on the shared hosting.

    We use Net::SMTP elsewhere to send lots of emails so I have looked at what I did in the past to get around this problem. It turns out that I created a new module that inherits from Net::SMTP and overrides the auth method. This works fine as we always send through the same SMTP server with the same authentication. Doing the same will be fine for the MIME::Lite setup.

    Like this:

    package Mail::SMTP; require Net::SMTP; $VERSION="1.0"; @ISA=qw(Net::SMTP); sub auth { my $self = shift; my $code; my $CMD_MORE = 3; my $CMD_OK = 2; my @cmd = ("AUTH LOGIN"); push @cmd, 'xxxxx='; # Base64 encoded username while (($code = $self->command(@cmd)->response()) == $CMD_MORE) { @cmd = ('xxxxx='); # Base64 encoded password } $code == $CMD_OK; } 1;

    But, how can I easily get MIME::Lite to use the new module inherited from New::SMTP?

    I could created a new module that inherits from MIME::Lite and just override the send_by_smtp with the only change being the require file it calls. But that doesn't seen a very elegant solution!

    Is there some way to instead put a new version of Net::SMTP in a directory relative to my script and get MIME::Lite to use that? If so, how can I inherit from a module of the same name (but a different path) as the new module?

    Or is there a 'better' solution I am missing?

Video streaming module in Seekers of Perl Wisdom
4 direct replies — Read more / Contribute
by Bod
on Apr 19, 2022 at 18:15

    Can you give any recommendations for a Perl video streaming module?
    Usually, I would ask Google but all I get are video tutorials for learning Perl.

    Here is what I am vaguely thinking of doing in case anyone can offer any specific help.

    We have a bluetit nesting in our new birdbox. Being above the back door, it cannot be seen from inside the house and we thought it would be nice to be able to observe its comings and going. Nice for us, perhaps not so much for the bluetits. So, I've bought a WiFi camera, built a little box for it and set it up opposite the birdbox. It works OK but the only way to use the camera is to use the mobile app. I thought it might be nice to be able to do something else with the stream, perhaps monitor it for movement or display it on a bigger screen.

    So I thought about trying to capture the video stream using a Perl script on a computer permanently hooked up to the network. Once I've got the stream, it should be relatively trivial to do whatever I want with it.

    The other thing I need to do is power the camera with a solar panel instead of having to bring it inside to charge every few hours.

    Any suggestions appreciated although this is nothing more than a fun project...perhaps better labelled as a means to procrastination!

DBI returns zero! in Seekers of Perl Wisdom
2 direct replies — Read more / Contribute
by Bod
on Mar 12, 2022 at 14:04

    I have a relatively simple DB query that is giving very strange results. Have you seen anything like this before or do you have any ideas about how I might debug the problem?

    print "Content-type: text/plain\n\n"; my $point = "POINT( $data{'lng'} $data{'lat'} )"; my ($usrn) = $dbh->selectrow_array("SELECT idUSRN FROM USRN WHERE idUS +RN > 0 ORDER BY ST_Distance_Sphere( ST_GeomFromText( ?, 4326 ), cente +r ) LIMIT 1", undef, $point); #my ($usrn) = $dbh->selectrow_array("SELECT idUSRN FROM USRN LIMIT 1") +; print $dbh->errstr; print "\n$point $usrn\n"; print "SELECT idUSRN FROM USRN ORDER BY ST_Distance_Sphere( ST_GeomFro +mText( '$point', 4326 ), center ) LIMIT 1"; exit;

    I am getting a value of $usrn of zero. Despite the query excluding zero in the WHERE clause and there being no zero for idUSRN in the database table!

    This placeholder syntax works fine elsewhere for me. However, just in case this was the problem I have tried removing the placeholder and writing ST_Distance_Sphere( ST_GeomFromText( '$point', 4326 ), center ) and this also gives zero.

    But...when I copy the select statement which is printed and paste it into MySQL Query Browser connected to the same database schema, I get an eight-digit integer as expected.

    DBI is not displaying an error so no clues there!

    Swapping commenting out of the queries gives a sensible, non-zero, result.

    Any ideas on what I can try to get to the bottom of this would be very much appreciated. It seems weird that the same query works differently from Perl than it does when run directly against the database.

Geo Package files in Seekers of Perl Wisdom
2 direct replies — Read more / Contribute
by Bod
on Mar 03, 2022 at 08:45

    I suspect this is a bit of a longshot...but...

    Has anyone had any dealings with reading a Geo Package .gpkg file using Perl. I cannot find anything in CPAN that might help.

    A .gpkg file is a SQLite3 DB file. Of course, Perl can handle this. I have used DBD::SQLite to access the Geo Package. The file I am trying to use only has one layer so it only has one row in the gpkg_contents table. This defines the content I need as being in the openUSRN table.

    I've used this code to peek at this table....

    use DBD::SQLite; use Data::Dumper; use strict; use warnings; my $dbh = DBI->connect("dbi:SQLite:uri=file:osopenusrn_202203.gpkg?mod +e=rwc"); my $tab = $dbh->prepare("SELECT * FROM openUSRN"); $tab->execute; while (my $n = $tab->fetchrow_hashref) { print Dumper $n; }

    There are four fields in the table. Three are human-readable text. However, the one I am most interested in, geometry, is gobbledegook. A quick look at the specification seems to show that it is not going to be trivial to work out how to decode this from scratch. So I am hopeful that someone has trodden this path before to give me a head start or even a solution.

    I suspect that the geometry is actually a linestring. I am only interested in getting the co-ordinates of the start and the end of the linestring.

    Here is a sample of the output...

    $VAR1 = { 'geometry' => 'GP ♣4l ►░~▬A ]m&# +9827;↓⌂▬A└╔├☼$→A&#94 +92;╚v■[$→A ☺♥ ☻ + ☺♥ ☻ ]m♣↓⌂▬A└& +#9562;v■[$→A ░▀~▬A└&#9 +556;├☼$→A ☺♥ ☻ ► +░~▬A`▲E+$→A ░▀~&#96 +44;A└╔├☼$→A ', 'usrn' => 2900534, 'id' => 1497, 'street_type' => 'Designated Street Name' };

Object method in wrong namespace in Seekers of Perl Wisdom
1 direct reply — Read more / Contribute
by Bod
on Feb 27, 2022 at 15:27

    Wise Monks,

    I have been scratching my head for too long is time to seek your wisdom. I suspect the problem is simple and sufficiently obvious that I shall kick myself when it is revealed!

    I am developing a module for internal use that manipulates blog posts. It takes a hashref from a database, manipulates the data and can return either another hashref or any of the individual pieces of data. But it's not working so I have added some debug code. It is the behaviours of this debug code that I cannot understand.

    my $query = $dbh->prepare("SELECT * FROM Blog ORDER BY created DESC"); $query->execute; my $test; while( my $bg = $query->fetchrow_hashref ) { my $blog = Bod::Blog->new($bg) or die "Blog not defined"; $test = $blog->heading; # line 152 push @blogs, $blog->hashref; }
    I am getting this error:
    Can't locate object method "heading" via package "main" at line 152.

    The heading method should be in the Bod::Blog namespace but the error suggests that Perl is looking for it in the main namespace. I cannot figure out why that might be!

    Here is the first part of

    package Bod::Blog; use strict; use warnings; sub new { my ($class, $blog, $vars); $vars->{'heading_class'} ||= 'blogHead'; $vars->{'subheading_class'} ||= 'blogSubHead'; $vars->{'body_class'} ||= 'blogBody'; $vars->{'base_path'} ||= '/blog/'; $vars->{'image_path'} ||= '/images/blog/'; my $self = bless { 'blog' => $blog, 'vars' => $vars, }, $class; return $self; } sub heading { my $self = shift; return $self->{'heading'}; }

Sharing STDIN after fork in Seekers of Perl Wisdom
3 direct replies — Read more / Contribute
by Bod
on Feb 12, 2022 at 21:09

    I am trying to create an email sending system that can be driven directly from our CRM. The current system which this will replace works fine but involves copying and pasting blocks of text with addresses and HTML code for emails. So I want something easier to use and less error-prone.

    The script we currently use calls itself with a query string parameter set so it tracks the sending of the emails. The problem is that it can behave strangely if refreshed or called again whilst an email is still sending. So, for the replacement, I am trying to fork a process. One process will send the emails and the other will load a webpage that will periodically check the progress through AJAX calls. The progress will be stored in a DB table.

    I am getting strange behaviour which I think is because sometimes one process grabs STDIN and other times the other process gets it.

    #!/usr/bin/perl use CGI::Carp qw(fatalsToBrowser); use strict; use warnings; my ($etc, $pid); if ($ENV{'QUERY_STRING'} =~ /etc=(\d{6})/ ) { $etc = $1; if ( !defined($pid = fork()) ) { die "Unable to fork!"; } } else { die "Missing Email Tracking Code"; } our (%data, %file); our $dbh; our $user_number; use Template; use MIME::Lite; require "incl/"; require "incl/"; if ($pid != 0) { my $template = Template->new({INCLUDE_PATH => "$ENV{'DOCUMENT_ROOT +'}/template"}); &html_head; my $vars = { 'command' => $data{'command'}, 'mail' => $data{'mail'}, }; $template->process('', $vars); &html_foot; exit; } open my $fh, '>', "testfile.txt"; print $fh "MAIL - $data{'mail'}\n\n"; #.... # spend a long time sending email #....

    Within the require "incl/"; file, the %data hash is populated from the $ENV{'QUERY_STRING'} variable and STDIN. This file also connects the database. Sometimes $data{'mail'} is passed to the template and sometimes it is written to the test file.

    I have had problems with fork before where I have made the database connection after the fork. Then one process has ended and closed the database connection on the other process. For that reason, here I am connecting after the fork. I don't really want to play with the require (it is nasty but works) as a lot of other code relies on it.

    I have rarely used fork I along the right lines in how I am doing this with fork or is there a better way?
    Would the solution to the problem be to do all the hash populating and database connection stuff before the fork then make a copy of the hash and database handle in each process?

Alternative to smart match in Seekers of Perl Wisdom
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...

Quoting hash keys in Seekers of Perl Wisdom
5 direct replies — Read more / Contribute
by Bod
on Nov 08, 2021 at 19:11

    This follows on from Indirect Object Syntax but it is a different question so it gets its own place!

    In doing some of the reading that came out from Indirect Object Syntax, especially this on SO from ikegami, I have noticed that often (but not always) hash keys are not quoted literals but barewords. Given the potential for confusion that has been shown from Indirect Object Syntax, it seems that this is another place where confusion could arise.

    I have noticed this before but never really thought anything of it.

    my $value = $hash{ key };
    I never write it like that. I always quote it unless the key is non-constant.
    my $value = $hash{'key'}; my $value = $hash{ $key_value }; my $value = $hash{"st_$id"};

    Is there a difference between $hash{ key } and $hash{'key'}?

Indirect Object Syntax in Seekers of Perl Wisdom
5 direct replies — Read more / Contribute
by Bod
on Nov 06, 2021 at 16:04

    Over on on another thread, I got my wrist slapped* by kcott for using Indirect Object Syntax. I have read the linked documentation and its warnings and I am not sure I totally understand. So I am hoping some wise Monks will help with clarification.

    The offending code I posted was:

    my @bounds = new GD::Image->stringFT($colour, "Image/outline.ttf", 90, + 0.18, 0, 0, $watermark_text);
    As I read the documentation, the problem is that the Perl interpreter has difficulty knowing whether I mean:
    @bounds = &new(GD::Image->stringFT(...));
    my $gd = new GD::Image; @bounds = $gd->stringFT(...);
    (&new used to make it clear it is a subroutine!)
    and because Perl's interpreter could potentially get this wrong, so could any human trying to understand the code.

    Is that about right???
    Or is there more too it than that?

    A secondary question that follows on...
    The documentation says:
    To parse this code, Perl uses a heuristic based on what package names it has seen, what subroutines exist in the current package, what barewords it has previously seen, and other input. Needless to say, heuristics can produce very surprising results!

    Does this mean that a constant piece of code, such as a module, could behave very differently depending on context? For example, if the same module were utilised in two different scripts? And what about between different versions of Perl. Could code behave differently depending on the version of Perl?

    * Just to be clear, it was a very welcome wrist slapping from kcott - I am here to learn and hopefully help others. I am always very grateful when my mistakes are pointed out as it allows me to improve my skills.

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 studying the Monastery: (5)
As of 2022-08-18 17:38 GMT
Find Nodes?
    Voting Booth?

    No recent polls found