Bod's user image
User since: Nov 15, 2020 at 00:48 UTC (31 weeks ago)
Last here: Jun 14, 2021 at 23:39 UTC (4 days ago)
Experience: 2356
Level: Chaplain (11)
Writeups: 463
Location:Coventry, UK
User's localtime: Jun 18, 2021 at 22:27 UTC
Scratchpad: View
For this user:Search nodes

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...


Find me on LinkedIn


CPAN Release

Business::Stripe::WebCheckout


Posts by Bod
When not to use taint mode in Seekers of Perl Wisdom
8 direct replies — Read more / Contribute
by Bod
on Jun 12, 2021 at 15:09

    A few times recently in the Monastery I have noticed mention of taint mode

    A long time ago I first came across taint mode and decided it is far too difficult to understand...I've since looked again and it doesn't appear anything like as mystical as it once did. That's what happens when one improves of course.

    I have never used taint mode so have no idea of the ease or otherwise of actually using it. It seems from this poll that most others don't use it either. So why not? Is it that taint mode is actually difficult to use or are there reasons to keep it switched off as it is by default?

    Do you have any advice on the topic?

Piping to sendmail in Seekers of Perl Wisdom
2 direct replies — Read more / Contribute
by Bod
on May 15, 2021 at 18:21

    As I was complating 6 months in the Monastery I took a look back at some very old code I wrote about 20 years ago. It is clear that things have come a long way since then :)

    But, in that code was a pipe straight into sendmail. These days, and for quite a few years, if I want to send an email I either use MIME::Lite or a module I created some years ago (my first module I think) which is a wrapper around Net::SMTP.

    open(MAIL,"|$send_path -t"); # send email headers print MAIL ("To: $send_addr\n"); print MAIL ("From: $from_addr\n"); print MAIL ("Subject: Lane Entry Form submitted\n\n"); # send email body print MAIL ("----- Notification of new Lane Data -----\n\n"); close(MAIL);

    I'm not sure why I put the brackets in!
    But it got me thinking that piping to sendmail is quite simple. The code is clear and, presumably, it is quite an efficient way to send an email.

    Other than it not being portable away from an *nix environment, is there any reason not to do this?

6 months in the Monastery in Meditations
No replies — Read more | Post response
by Bod
on May 15, 2021 at 18:13

    Today is six months since I created an account here in the Monastery...

    Seldom have more than a few days passed without me kicking myself that I didn't do so much, much earlier. I have been writing Perl code since the mid-1990's but have learnt more in the last six months than in most of the time before. I managed to get quite a bit of 'stuff' working, mostly web based but also quite a few client tools. Even a handful of GUI tools using Tk. Over the years I has to do some C++ coding as part of my physics degree which I did not get on with and knew I never wanted to revisit... I've had a couple of brushes with Java including recently to create a couple of simple Android apps. But it has always been Perl that has been the language of choice.

    When I needed to do something, I found out just enough to make it work. Then didn't go any further. Why would I? I didn't know there was a better way to do things!

    A great example was when I posted some code and suddenly found out about placeholders in database queries...I had vaguely heard about the things but thought they were just for reusing one query multiple times. I soon found out they were a lot more useful than that. So useful in fact that all my code is slowly being converted.
    Re^5: Splitting the records into multiple worksheets

    The Monastery changed all that from almost immediately entering. Straight away I was implored to use strict. Something I knew of but didn't understand. I thought it was a pain and made coding much slower. But I tried using it and, yes, I have to be more careful with my coding but that's no bad thing. Now all my code has use strict at the start. Just today I've refactored a script to include it and had to change 638 lines, mostly adding my to the start!

    All my code now uses Template's where appropriate. All thanks to the Monastery. Yes, it was quite a learning curve but has enabled me to refactor an entire website and incorporate AB Testing right into the core. We just create test templates rather than having to duplicate all the code. So much easier to create, test and maintain. Certainly worth the learning curve.

    My blind uncle now has automated curtains thanks to Controlling USB on Raspberry Pi which quite possibly would never have been successfully completed without the help of fellow Monks.

    Plus, I have published a module on CPAN - Business::Stripe::WebCheckout
    Something else that almost certainly would not have happened without the help and encouragement of so many Monks

    Thanks for making the last 6 months sch a great period of learning....
    Here's to plenty more time. Hopefully, over time I will be able to pass something on to new Monks.

GD colorAllocate not changing colour in Seekers of Perl Wisdom
1 direct reply — Read more / Contribute
by Bod
on May 15, 2021 at 17:18

    Whilst refactoring some code, I'm trying to solve a long time minor bug.

    The code takes an image which is $file{'image', 'file'}. It creates a blank background image of 600x450 pixels then places the original image on top. If the aspect ratio of the original image is too tall it gets cropped, if it is too wide then the width is maintained so the background forms a band top and bottom. The background is set to white but it nearly always comes out as black and occasionally dark green.

    my $white; # Create background my $image = new GD::Image(600, 450); $white = $image->colorAllocate(255, 255, 255); # Resize uploaded image to 600 wide my $picture = GD::Image->new($file{'image', 'file'}); my ($srcw, $srch) = $picture->getBounds(); my $newh = ($srch * 600 / $srcw) - 1; my $resize = GD::Image->new(599, $newh - 1); $resize->copyResized($picture, 0, 0, 0, 0, 600, $newh, $srcw, $srch); # Copy onto background image offset to crop or center $image->copy($resize, 0, 0, 0, ($newh - 450) / 2, 600, 450); $white = $image->colorAllocate(255, 255, 255); open my $fh, '>' ,"$root/images/property/unit/$filename.png"; binmode $fh; print $fh $image->png; close $fh;

    A second call to colorAllocate() has been added to check that copy() wasn't resetting the colour pallette. This makes no difference. When $white is checked it is always a positive number. 16777215 for colorAllocate(255, 255, 255) and different positive numbers for different colours.

    Any ideas what else I can check?
    The documentation for GD->colorAllocate is not very helpful.

    Or, perhaps there is a better way to solve the problem...
    To create images that are always 600px x 450px regardless of the original but without distorting them.

Designing multiple related modules in Seekers of Perl Wisdom
4 direct replies — Read more / Contribute
by Bod
on May 12, 2021 at 08:06

    Not strictly a Perl question although the solution will be implemented in Perl and the modules will probably appear on CPAN...

    I am writing three, perhaps more, related modules which will have the same basic methods. The three modules will post content to different social media sites. I want to be able to use them something like this:

    my $social; if ($network eq 'Facebook') { $social = Bod::Social::Facebook->new( ... ); } if ($network eq 'Twitter') { $social = Bod::Social::Twitter->new( ... ); } if ($network eq 'LinkedIn') { $social = Bod::Social::LinkedIn->new( ... ); } unless ($social) { # Handle invalid network; } # Post text content to whichever network has been selected without car +ing which $social->post("Some test text"); # Post text and image content my $image_handle = $social->upload("images/test.jpg"); $social->post("Test text with image", $image_handle);
    There are at least three four options of how to implement this, probably more. I am looking for some advice on which way I should choose.

    1 - Three separate module
    Simply write three modules with similar names as in the code above. Each module has methods with the same names and similar new method. All social media platforms use OAuth2 so new can be largely the same.

    2 - Three modules that all inherit from one class
    Have a Bod::Social module that defines the methods. Then have modules as in the code above that inherit from Bod::Social and implement the methods. A bit like what I understand an interface to be in Java1. I don't see any advantage in this option in Perl over option 1 but there are certainly modules on CPAN that do this. Either there is good reason or they are written by people coming from stricter OOP languages.

    3 - Have a single method and Service Providers
    Have a single module that the code uses. In the new method, specify a Service Provider that is different for each social network. Each service provider implements the platform specific calls needed for interacting with the network. LWP::Authen::OAuth2 is implemented this way and it seems to work reasonably well but, again, I don't understand the advantages and disadvantages of this approach. Like this:

    my $social; if ($network eq 'Facebook') { $social = Bod::Social->new( service_provider => 'Facebook', ... , ); } if ($network eq 'Twitter') { $social = Bod::Social->new( service_provider => 'Twitter', ... , ); } if ($network eq 'LinkedIn') { $social = Bod::Social->new( service_provider => 'LinkedIn', ... , ); }

    4 - Use a Factory Class
    Use a Factory Class as we discussed here -> Factory classes in Perl
    As these modules will always run in the same environment this strikes me as overkill.


    I don't see there being a need to add new networks very frequently but it is quite possible that others will need adding. Which approach would you take or would you use a different solution I haven't considered? Why would you do it that way?

    This more general than just this application. Since writing Business::Stripe::WebCheckout I have decided that it would be useful if there was also Business::PayPal::WebCheckout that behaves exactly the same. Therefore the end user's code only has to call a different constructor and everything else gets called the same for multiple payment gateways. I am sure there will be more requirements for multiple related module.

    1 I'm not a Java programmer and only use it when I need to create simple Android apps.

    Edit 1: - Added option 4

    Edit 2: - Added reference to Business::Stripe::WebCheckout and corrected spelling errors.

Brackets in LWP Post in Seekers of Perl Wisdom
3 direct replies — Read more / Contribute
by Bod
on May 11, 2021 at 13:23

    A while ago I asked about Data::Dumper output which was silly error on my part that was obscuring what was really going on!

    The real problem is that LinkedIn is generating an error when I attempt to post. The error is: Illegal character VCHAR='(' So, instead of struggling with LWP::Authen::OAuth2, I thought I'd write my own module using LWP::Authen::OAuth2 to do the authentication and my own method to post to LinkedIn.

    But I still get the same problem. I have tried debugging all the variables I use and these are all as expected.
    This is the method I have to post to LinkedIn

    sub post { my ($self, $text) = @_; my $ua = $self->{'auth'}->user_agent; my $token = $self->{'auth'}->access_token; my $header = { 'Authorization:' => 'Bearer ' . $token->{'access_t +oken'}, 'X-Restli-Protocol-Version:' => '2.0.0', 'Content-type:' => 'text/json', }; my $user = $self->get_id; my $json = { 'owner' => "urn:li:person:$user", 'text' => { 'text' => $text, }, }; $ua->default_header('Content-type' => 'text/json'); return $ua->post( $self->{'auth'}->api_url_base . 'shares', Content => encode_json($json), $header, ); }

    First off we get the underlaying User Agent from $self->{'auth'}. This is an instance of LWP::Authen::OAuth2 which has been authorised. I have checked that authorisation is happening correctly by calling the me endpoint which returns the authenticated user. The underlaying User Agent is an instance of LWP::UserAgent.
    Next we get the user string which again I have checked to ensure it is correct - it is!

    We have to call $ua->default_header('Content-type' => 'text/json'); as, for some reason, it doesn't set in $header earlier.

    The call to $ua->post is going to the right place and sending the right data. The JSON payload might be a bit light to work as I have stripped it down to the bare minimum for testing. However, that would almost certainly produce a different error. When I call the method:

    my $post = $linkedin->post("Some test text to post"); print Dumper $post;
    I get a long JSON output back from LinkedIn. Here is the bit I think it is complaining about...
    '_request' => bless( { '_content' => '{"owner":"urn:l +i:person:GKiAGefMOA","text":{"text":"Some test text to post"}}', '_uri' => bless( do{\(my $o = +'https://api.linkedin.com/v2/shares')}, 'URI::https' ), '_headers' => bless( { 'user-a +gent' => 'libwww-perl/6.49', 'hash(0 +x29bc430)' => undef, 'conten +t-type' => 'text/json', 'conten +t-length' => 77, '::std_ +case' => { + 'hash(0x29bc430)' => 'HASH(0x29bc430)', + 'if-ssl-cert-subject' => 'If-SSL-Cert-Subject' + } }, 'HTTP: +:Headers' ), '_method' => 'POST', '_uri_canonical' => $VAR1->{'_ +request'}{'_uri'} }, 'HTTP::Request' )
    I do not understand where ::std_case is coming from or why it contains un expanded hash references. Is this a bug in LWP perhaps?

    Any ideas on how I can debug this problem further please?

    If it helps, here is the full JSON response from LinkedIn:

Counting characters within regexp in Seekers of Perl Wisdom
5 direct replies — Read more / Contribute
by Bod
on May 08, 2021 at 18:15

    Good evening fellow Monks

    I've just been writing a bit of code to partially hide an email address such that the owner of the address would recognise it but anyone else would find it difficult, at least to work out. I tried a simple substitution but hit a problem. How can I determine how many characters there are and replace them with that same number of full stops or asterisks or whatever?

    I have come up with a three line solution but it seems like the sort of problem that should be able to be done with a regexp substitution

    use strict; use warnings; my @email = ( 'someone@example.co.uk', 'andrew.test@some.company.co.uk', 'jo@abc.com', ); foreach my $em(@email) { print "$em - "; my ($name, $comp) = split /@/, $em; $em =~ /^(\w[\w|\.]).*@(\w\w).*\.(\w+)$/; $em = $1 . '.' x (length($name) - 2) . "\@$2" . '.' x (length($com +p) - length($3) - 2) . $3; print "$em\n"; }
    This produces this result:
    C:\Users\joolz\Perl>perl regtest.pl someone@example.co.uk - so.....@ex.........uk andrew.test@some.company.co.uk - an.........@so..............uk jo@abc.com - jo@ab..com
    This is one of those problems that seems relatively trivial until you actually come to do it! It also suffers as a difficult one to search for as Google wants to tell me how to match a range of lengths {x,y} or count the number times one string occurs in another.

    Is there a nice, simple, succinct way to do this?

    I guess the nicest solution would change the number of characters properly displayed as a function of the overall length!

Data::Dumper output in Seekers of Perl Wisdom
3 direct replies — Read more / Contribute
by Bod
on May 07, 2021 at 19:33

    Esteemed Monks,

    The LinkedIn API is returning an error Illegal character VCHAR=( and I am trying to resolve where the bracket is coming from as no brackets appear in the request headers or JSON body content. However, $request is ultimately passed to LWP::UserAgent->request. So I have tried:

    print Dumper $request; $VAR1 = 'HTTP::Request=HASH(0x1c23960) ';
    So I am wondering if this is where the bracket is coming from. Unlikely, but it has to be coming from somewhere...

    Seeing as Dumper is giving me a hash, I tried to dereference it like this:

    print Dumper %$request; $VAR1 = '4/8 ';
    I do not understand this.
    What does 4/8 mean? I cannot find any clues in the Data::Dumper documentation but I am struggling to understand it properly.

    Any advice on how I interpret 4/8 or how I can further work out where the bracket is coming from that is generating the error from the LinkedIn API?

Subs calling themselves in Seekers of Perl Wisdom
2 direct replies — Read more / Contribute
by Bod
on May 07, 2021 at 08:43

    Continuing from my previous discussion about connecting to LinkedIn - see Injecting a value into HTTP::Header

    I have managed to authenticate with LinkedIn using LWP::Authen::OAuth2::ServiceProvider::LinkedIn which I am writing. This is used by LWP::Authen::OAuth2. LinkedIn doesn't obey the OAuth2 standard which is why there was a need to add extra information.

    But now I am having difficulty posting anything to LinkedIn and I am getting an error from LWP::Authen::OAuth2
    Can't call method "request" on an undefined value at /home/shoples1/perl5/lib/perl5/LWP/Authen/OAuth2.pm line 107.

    I've looked at the source code of LWP::Authen::OAuth2 to try and see what I need to do differently to make this work. However, I cannot fathom how that module is supposed to work. Clearly, it does work and it is my understanding that is missing because it is a working module. But these two subroutines just seem to be calling each other:

    sub request { my ($self, $request, @rest) = @_; return $self->access_token->request($self, $request, @rest); # <- +line 107 } sub access_token { my $self = shift; return $self->{access_token}; }
    Having gone through the authentication and obtained a token, I am trying to make a post using the following code. I am not expecting it to actually make a post yet but I was expecting to get an error from LinkedIn and not an error from Perl.
    my $params = { 'content' => { 'title' => 'Test Title', 'descrition' => 'Test message', }, }; my $res = $linkedin->post('https://api.linkedin.com/v2/shares', $param +s); if ($res) { print "Content-type: text/plain\n\n"; print $res; exit 0; }
    Can you help me understand what the two subroutines in LWP::Authen::OAuth2 are actually doing?

Injecting a value into HTTP::Header in Seekers of Perl Wisdom
1 direct reply — Read more / Contribute
by Bod
on Apr 18, 2021 at 16:52

    As part of connecting to LinkedIn using LWP::Authen::OAuth2, I have decided to write a sub-class of LWP::Authen::OAuth2::ServiceProvider which is designed to be sub-classed for exactly this kind of application. This way, it will hopefully be useful to other people.

    However, I need to override a method which has not been designed to be overridden! The LinkedIn API doesn't comply with the OAuth2 spec. The token_type parameter is mandatory but missing. Therefore, I am trying to inject it into the response from LinkedIn by sub-classing the method, adding the missing parameter and then calling the method in the super class. But I am not managing to get the injection to work.

    Here is the sub in LWP::Authen::OAuth2::ServiceProvider that I am overridding:

    The author has commented the point it fails as # Someone failed to follow the spec...!

    This is my sub that overrides the above...

    sub construct_tokens { my ($self, $oauth2, $response) = @_; my $content = eval {$response->decoded_content}; eval {decode_json($content)}; $response->push_header( 'token_type', 'Bearer' ) unless $@; $self->SUPER::construct_tokens($oauth2, $response); }
    I'm trying to set token_type as Bearer so that the rest of the sub in the superclass doesn't complain.

    Is there a good way to to inject this parameter or am I approaching this in the wrong way?