I need help with my script uploading files to google drive

i have tried to read some modules like LWP::Authen::OAuth2, and many examples on internet but they all pointing out to 'URL for user to go to to start the process in browser', but for me am using this script in server as a background process

Anyone who can help i really appreciate

#!/usr/bin/perl - wT

    use strict;
    use warnings;
    use LWP::UserAgent;    
    use LWP::Authen::OAuth2;


    my $ua = LWP::UserAgent->new;
    my $oauth2 = LWP::Authen::OAuth2->new(
        client_id     => 'client_id',
        client_secret => 'client_secret',
        site          => 'https://accounts.google.com/o/oauth2/token',
+ # Token endpoint
        authorize_url => 'https://accounts.google.com/o/oauth2/auth', 
+# Authorization endpoint
        redirect_uri  => 'my_url_used_in_google_console_when_creating_
+client_id_and_client_secret',
    );

    # Use the access token to make API requests
    $ua->default_header( 'Authorization' => 'Bearer ' . $oauth2->acces
+s_token );
    my $url = 'https://www.googleapis.com/upload/drive/v3/files';
    my $metadata = {
        name => '/var/www/.../filename.sql', # Path to file in server
        mimeType => 'application/txt',
    };
    my $response = $ua->post(
        $url,
        'Authorization' => 'Bearer ' . $oauth2->access_token,
        'Content-Type' => 'application/json; charset=UTF-8',
        'X-Upload-Content-Type' => 'application/txt',
        Content => encode_json($metadata),
    );
        
     if ($response->is_success) {
     print $res->decoded_content;
     } else {
     print $response->decoded_content;
     print $response->status_line, "n";
    }
[download]

Hi Monks. I would like some help gaining insight on this one. I've just been installing dependency dists for a CPAN module and one of them fails the make install step. Tracing the action, I see this dangling off the end of the usual processing:

Appending installation info to D:/AllSBP\lib\perl5\MSWin32-x64-multi-t
+hread/perllocal.pod
destdir=; \
test -n "$destdir" && destdir="-d $destdir"; \
create-modulino.pl -m Module::ScanDeps::FindRequires \
   -a find-requires $destdir -b D:/AllSBP\bin
'destdir' is not recognized as an internal or external command,
operable program or batch file.
gmake: *** [makefile:1006: install] Error 1
[download]

# --- MakeMaker postamble section:
#-*- mode:makefile; -*-

postamble ::
install::
    destdir=$(DESTDIR); \
    test -n "$$destdir" && destdir="-d $$destdir"; \
    create-modulino.pl -m Module::ScanDeps::FindRequires \
       -a find-requires $$destdir -b $(INSTALLSITESCRIPT)


# End.
[download]

Oh, you'd like to know which distribution this is? Of course. It's Module::ScanDeps::Static v1.7.6.

I imagine this is a very cool thing when it works (haven't tried it on Gnu/Linux yet). My perl setup is:

osname=MSWin32 osvers=10.0.26100.4652 archname=MSWin32-x64-multi-thread uname='Win32 strawberry-perl 5.42.0.1 # 05:37:25 Fri August 01 2025 x64'

I know the "blah blah is not recognized as an internal or external ..." is classic Windows, often useless in diagnosing what's really going on. This scrap of shell script has me confused though, especially destdir="-d $$destdir". Dunno what that does.

Although we don't see the absence of the create-modulino.pl command in the output, it isn't in the package files and isn't installed anywhere on my PATH.

Hope I am not wasting anyone's time. :-)

Estimado Monjees

I am looking for guidance on how to connect to a server via secure websocket (wss) using perl, at as high level as possible, using a module preferably. My browser initiates this connection with this header Sec-WebSocket-Key: which is base64-encoded binary data. My interaction with it would be mostly reading what it periodically sends.

I have looked AnyEvent::WebSocket::Connection and Net::Async::WebSocket::Client but they do not mention wss. Am I wrong?

Whereas Mojo::UserAgent does support wss (it says), and allows for headers to be passed on but alas it fails. I used something like this:

use strict;
use warnings;

use Mojo::UserAgent;

my $URI = 'wss://echo.websocket.org';

my $ua  = Mojo::UserAgent->new;
my $tx = $ua->build_websocket_tx($URI);
$tx->req->headers->user_agent('Mozilla/5.0 (X11; Linux x86_64) AppleWe
+bKit/537.36 (KHTML, like Gecko) Chrome/140.0.0.0 Safari/537.36');

print $tx->req->headers->to_string."\n";

$ua->start(
  $tx => sub {
    my ($ua, $tx) = @_;
    print "Headers: ".$tx->req->headers->to_string."\n";
    print "WebSocket handshake failed!\n" and
        return unless $tx->is_websocket
    ;
    print "Got a handshake\n";
    $tx->on(message => sub {
        my ($ua, $msg) = @_;
        print "WebSocket message: $msg\n";
        $tx->finish;
    });
  }
);
print "waiting ...\n";
[download]

outputs this:

waiting ...
UA: Mojo::UserAgent
TX: Mojo::Transaction::HTTP
WebSocket handshake failed!
[download]

I am using a test site for the target (https://ws-playground.netlify.app/) which works on the browser and I have checked it does not need extra headers/cookies. But above code fails.

10min Edit: this works (nodejs client):

this does not (waits...) :

PWC #340 (current) task #1 is to delete pairs of duplicate adjacent letters until none are left. I thought "maybe it's a good place to use a recursive pattern instead of (possibly) many loop iterations" Did I write it wrong? Is it just not applicable for tasks like these?

use strict;
use warnings;
use Time::HiRes 'time';

my $str;
$str .= chr 97 + rand 2 for 1 .. 5e3;

{
my $n = 0;
my $s = $str;
my $t = time;
$n ++ while $s =~ s/((.)(?1)?\2)//g;
printf qq(%3d loops, %.3f s, result: "%s"\n), $n, time - $t, $s
}

{
my $n = 0;
my $s = $str;
my $t = time;
$n ++ while $s =~ s/(.)\1//g;
printf qq(%3d loops, %.3f s, result: "%s"\n), $n, time - $t, $s
}

#  4 loops, 1.542 s, result: "babababa"
# 47 loops, 0.001 s, result: "babababa"
[download]

Dear Perl Monks,

I just tried to make a simple logger package, having a compilation error with its ver.1 as attached below.

error message

Bareword found where operator expected at /home/tatsu/Perl/MyLog/MyLog
+.pm line 36, near "} encode"
    (Missing operator before encode?)
syntax error at /home/tatsu/Perl/MyLog/MyLog.pm line 36, near "} encod
+e"
Compilation failed in require at logtest.pl line 6.
BEGIN failed--compilation aborted at logtest.pl line 6.
[download]

MyLog.pm (ver.1)

use utf8;
use Time::Piece;
use Carp 'croak';
use Encode 'encode';

sub new {
  my $class = shift;
  my $self = {};
  bless $self, $class;
  my $timesig = localtime->strftime("%y%m%d%H%M%S");
  my $logfile = $timesig . '.log';
  if (-f $logfile) {
    croak "log file ${logfile} already exists.: $!";
  }
  open my $fh, '>>', $logfile
    or croak "can't open log file ${logfile}.: $!";
  $self->{fh} = $fh;
  return $self;
}

sub DESTROY {
  my $self = shift;
  close $self->{fh};
}

sub log {
  my $self = shift;
  my $timesig = localtime->strftime("%y%m%d%H%M%S");
#  my $fh = $self->{fh};
  foreach my $msg (@_) {
    print $self->{fh} encode('utf8', $timesig . ': ' . $msg . "\n");
#    print $fh encode('utf8', $timesig . ': ' . $msg . "\n");
  }
}

1;
[download]

When a local var $fh was used for the file handle with its print command in the log subroutine (ver.2), however, no error occurred and everything worked as expected. It appears that the error occurs with the 'print $self->{fh}' part, but I am not sure how it comes to the error message 'Bareword found where operator expected...'.

Any advice would be much appreciated.

Sincerely,

MyLog.pm (ver.2, log subroutine only)

sub log {
  my $self = shift;
  my $timesig = localtime->strftime("%y%m%d%H%M%S");
  my $fh = $self->{fh};
  foreach my $msg (@_) {
#    print $self->{fh} encode('utf8', $timesig . ': ' . $msg . "\n");
    print $fh encode('utf8', $timesig . ': ' . $msg . "\n");
  }
}

1;
[download]

logtest.pl

use strict;
use warnings;
use utf8;
use FindBin;
use lib $FindBin::Bin;
use MyLog;

my $mylog = MyLog->new();

$mylog->log();
$mylog->log('');
$mylog->log('a', 'b');
[download]

I saw a regex here on PerlMonks awhile back that took a string and inserts commas into numbers. It's pretty amazing how that works, and I am just now beginning to grasp why and how it works. But now I would like to port it to bash. Now, of course, bash doesn't have regex search and replace but sed does. So, when I plugged this into sed, it complains and says "sed: -e expression #1, char 39: Invalid preceding regular expression" (I'm using sed GNU v4.9 and bash 5.2.15 x64)

WHAT IS WRONG???

Original perl code:

#!/usr/bin/perl -w
use strict;
use warnings;
# I copied this regex from:
# www.PerlMonks.org/?node_id=157725
# Usage: STRING = Commify(STRING)
#
sub Commify
{
  defined $_[0] or return '';
  my $N = reverse $_[0];
  $N =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
  return scalar reverse $N;
}
print Commify('Testing 1234 testing... -123456789.01234567800 testing 
+test 4,500,000.00000');
[download]

And now the BASH script:

#!/bin/bash
# This function inserts commas into numbers
# at every 3 digits and returns the result
# in a global variable called $STR.
#
function Commify
{
  # First, reverse the string
  STR=$(echo "$1" | rev)

  STR=$(echo "$STR" | sed -E 's/([0-9]{3})(?=[0-9])(?![0-9]*\.)/\1,/g'
+)

  # Now reverse it back:
  STR=$(echo "$STR" | rev)
}
Commify 'Testing 1234 testing... -123456789.01234567800 testing test 4
+,500,000.00000'
echo $STR
[download]

my %haystack; @haystack{'aa'..'ff'} = ();
# syntax error:
say exists @haystack{qw(aa bb cc dd)};

# need to use this instead:
use List::Util qw(first);
say !! first { exists $haystack{$_} } qw(aa bb cc dd);
[download]

I built the aging but probably still-useful module extension HTML::Tidy this week (and, oi, that was an adventure) and it is failing one test. Built it using/for StrawberryPerl. I inserted blank lines in the screen output pasted below, for easier reading.

$ perl -T -Iblib/lib -Iblib/arch  t/clean.t

not ok 3 - $tidy->clean("") returns empty HTML document
#   Failed test '$tidy->clean("") returns empty HTML document'
#   at t/clean.t line 20.

#                   '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 3.2//EN">
# <html>
# <head>
# <meta name="generator" content="tidyp for Windows (v1.04), see www.w
+3.org">
# <title></title>
# </head>
# <body>
# </body>
# </html>
# '
#     doesn't match '(?^:<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 3.2//
+EN">
# <html>
# <head>
# <meta name="generator" content="[^"]+">
# <title></title>
# </head>
# <body>
# </body>
# </html>
# )'

Looks like you failed 1 test of 3.
[download]

  Platform:
    osname=MSWin32
    osvers=10.0.22631.5189
    archname=MSWin32-x64-multi-thread
    uname='Win32 strawberry-perl 5.40.2.1 # 05:42:50 Sun May 11 2025 x64'
    

Can anyone explain Andy's intent in how he coded that test? Thanks all.

Sep 19, 2025 at 22:28 UTC

This is a broad question; I'd be happy to be directed to any package for, or discussion of, this issue, even in Python or other languages.

I'm working with a legacy system that has functionality for sending reminder emails in relation to various events. It is unbelievably complicated, involving tens of thousands of lines of spaghetti if-else code, using dozens of non-obvious configuration variables. It seems to me that someone must have dealt with this before, and that there's a cleaner solution in place for this not-unusual problem, but I haven't been able to find anything.

The current system allows for many, many variations: Number of reminders in between "now" and the event; sending reminders every X days from "now"; sending reminders every X days before the event; adjusting the scheduling after a manual event (that is, if you manually cause a reminder to be sent, does that affect the timing of the remaining reminders, and if so, how); changing the timing in between reminders (e.g. the first reminders are a week apart, but the schedule compresses as we draw near to the event); reminders are usually sent by email but can also be sent by other mechanisms, and these don't necessarily work on the same schedule as the emails; etc. etc. etc.

The system is in use among a large number of people, and apparently many people genuinely do use all of these features at one point or another, so we can't simplify it by removing functionality. But any time we do need to make a change, we end up with even more spaghetti mess, and testing is a nightmare.

Is there a term for this, or some widely understood way of handling this problem, that I just haven't encountered? Thanks for any suggestions.

i have a JSON response of this

my question is how to get lending figures before (.) dot and have output 0

same applies to below

my question is how to get lending figures before (:) dots and have output 0