Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Bod

by Bod (Chaplain)
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...


Find me on LinkedIn


CPAN Release

Business::Stripe::WebCheckout


Posts by Bod
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?

Making distribution on Strawberry Perl for CPAN in Seekers of Perl Wisdom
2 direct replies — Read more / Contribute
by Bod
on Apr 16, 2021 at 19:09

    I've uploaded Business::Stripe::WebCheckout to CPAN as a developer release. Release 1 failed when Stripe couldn't be contacted. Release 2 has cured this problem and, so far, all the CPAN Testers reports have passed 😊

    However, Windows doesn't have gzip. So in Makefile.PL I have this line to use IO::Compress::Gzip which is included with Strawberry Perl:

    dist => { COMPRESS => q{perl -MIO::Compress::Gzip=gzip,:constants -e" +my $$in = $$ARGV[0]; gzip($$in => qq($$in.gz), q(Level) => Z_BEST_COM +PRESSION, q(BinModeIn) => 1) or die q(gzip failed); unlink $$in;"}, S +UFFIX => 'gz', },
    This is included in the tarball that was uploaded.

    Does this need changing in the release?
    My best guess is that it is OK as it is only used when building the distribution, not when installing it but I wanted to check this is correct.

Obtaining OAuth2 Access Token in Seekers of Perl Wisdom
2 direct replies — Read more / Contribute
by Bod
on Apr 16, 2021 at 10:07

    I am trying to connect to LinkedIn using LWP::Authen::OAuth2. Authorisation goes fine but when I come to exchange the authorisation token for an access token, I get this error:

    Endpoint: https://api.linkedin.com/v2/accessToken JSON: { "serviceErrorCode":65604, "message":"Empty oauth2 access token", "status":401 }
    That doesn't seem to make alot of sense to me as I would expect the OAuth2 Access Token to be empty in a request to get it!

    This is the bare bones of what I am doing...

    my $linkedin = LWP::Authen::OAuth2->new( client_id => 'xxxxxxx', client_secret => 'xxxxxxx', authorization_endpoint => 'https://api.linkedin.com/uas/oauth2/a +uthorization', token_endpoint => 'https://api.linkedin.com/v2/accessTok +en', redirect_uri => "https://$ENV{'HTTP_HOST'}/cgi-bin/pos +tdog.pl?command=authorize_linkedin", scope => 'w_member_social', save_tokens => \&save_linkedin_token, ); ######################### # LinkedIn button clicked sub linkedin { my $auth_url = $linkedin->authorization_url; print "Location: $auth_url\n\n"; exit 0; }
    The code above behaves as expected by going off to LinkedIn, authorising the app and calling the callback URL
    The callback URL does this:
    sub authorize_linkedin { my $token = $linkedin->request_tokens( code => $data{'code'}, ); print "Content-type: text-plain\n\n"; print "ERROR: $data{'error'}\n\nMessage: $data{'error_description' +}\n\n"; print "TOKEN: $token\n"; print $data{'code'}; exit 0; }
    The error (above) is generated at the request_tokens call. $data{'code'} contains the code passed as a query parameter to the callback URL.

    I feel I must be missing something obvious here...

[RFC] Module code and POD for CPAN in Meditations
6 direct replies — Read more / Contribute
by Bod
on Apr 13, 2021 at 17:27

    Having needed to implement a simple workflow for taking card payments by Stripe and knowing that I need to do the same again soon for a different product set, I have created a module that I think will be useful to other people. Existing modules to connect with Stripe either do not cater for the latest security measures of 3D card payments in Europe or are a wrapper for the Stripe API. Both of which are, of course useful. But I wanted to create something easy to use that can be used for the typical simple workflow required by many small businesses.

    This gives a simple workflow of adding products to a 'Trolley' and then sending the user directly to the Stripe hosted checkout. From there, Stripe returns to either a success URL if payment was taken successfully or a cancel URL if, for any reason, the transaction failed.

    Could you please provide me with some feedback regarding both the code and the POD ahead of uploading it to CPAN?

    I was thinking Business::Stripe::Simple as the module name - is that sensible?

    Note - at the moment, the examples in the documentation have not been tested. They will be before uploading!

    Thank you to the Monks who have helped me develop the skills to get the module this far and to the ones who will give useful feedback.
    It is very much appreciated.

    UPDATE:
    I have run the code through Perl::Critic and it passes at 'stern' but generates warnings at 'harsh'. One thing it has found are tab characters instead of spaces despite changing my editor to use spaces after this discussion. I will take out the tabs that have crept in from copying and pasting a few bits of code.

    On the suggestion of Critic, I have moved the declaration of $VERSION to after use strict;. Although I thought that had to be first for the CPAN toolchain?

Useless use of string in return statement in Seekers of Perl Wisdom
7 direct replies — Read more / Contribute
by Bod
on Apr 12, 2021 at 19:06

    Is there something strange about the way return treats conditions?

    I have this and it doesn't work as expected...

    sub get_ids { my ($self, %attrs) = @_; # Do stuff... my %result; # $result{'message'} = ''; if ($self->{'error'}) { $result{'status'} = 'error'; $result{'message'} = $self->{'error'}; } else { $result{'status'} = 'success'; $result{'api-key'} = $self->{'api-public'}; $result{'session'} = $intent_id; } return encode_json(\%result) if lc($attrs{'format'}) eq 'json'; return $result{'message'} or "$result{'api-key'}:$result{'session' +}"; # <- line 229 return "SOMETHING"; }
    If it is called as get_ids( 'format' => 'json' ); it works fine but asking it to return a text string returns undef and warns Useless use of string in void context at line 229. The way I think it should work is that if $result{'message'} evaluates as true, that will get returned but if it evaluates as false then "$result{'api-key'}:$result{'session'}" wil be returned instead.

    Can you explain why this is not behaving as expected?

    As an aside, in searching for an answer I found this post -> Useless use of string in void context
    There it is suggested that Perl reports the wrong line number for this warning so it is quite possible that I'm actually looking in the wrong place!

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (7)
As of 2021-05-14 09:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Perl 7 will be out ...





    Results (149 votes). Check out past polls.

    Notices?