use Win32::OLE qw(in);
use Win32::OLE::Const 'Microsoft Word';

sub print_tables {
    my $word =Win32::OLE->new('Word.Application','Quit');  # shift;
 
    my $word_file = file(abs_path(shift));
 
    my $doc = $word->{Documents}->Open("$word_file");
    my $tables = $word->ActiveDocument->{Tables};
 

 

    for my $table (in $tables) {
my $numrows=$table->Rows->Count; 
 
my $rownum=1;
 while($rownum<=$table->Rows->Count){
...
 $main::numcols=$table->Columns->Count;
my $cell5=$table->Cell($rownum,$main::numcols);#this is the last colum
+n
.....
                                     }


                               }  
  }
[download]

$password= secret(...);
...
local $password->{stringify_mask}= undef if ref($password) eq 'Crypt::
+SecretBuffer';
$db= DBI->connect($dsn, $user, $password, \%attr);
[download]

On Github, robrwo [suggested a new more functional-programming-like API, namely that a method of SecretBuffer would pass the secret to a callback. My thought on the matter was that the *real* missing feature is a duck-typing API that doesn't need to be specific to SecretBuffer, which should provide an easy and convenient recipe for code that doesn't have a hard dependency on SecretBuffer to gain access to secrets.

I'd like to conduct an informal poll of which design people like the best:

1. "apply", a method which takes a callback of one argument:

   if ($password isa 'Crypt::SecretBuffer') {
     $db= $password->apply(sub { DBI->connect($dsn, $user, $_[0], \%attr)
   + });
   else {
     $db= DBI->connect($dsn, $user, $password, \%attr);
   }
   [download]

2. A more distinct method name that could be used for duck-typing and apply to other types of object:

   if (blessed $password && $password->can("unmask_secret_to")) {
     $db= $password->unmask_secret_to(\&DBI::connect, 'DBI', $dsn, $user,
   + $password, \%attr);
   } else {
     $db= DBI->connect($dsn, $user, $password, \%attr);
   }
   [download]

   1. reveal_secret_to
   2. unmask_secret_to
   3. call_with_secret
   4. call_unmasked
3. Use a scalar-ref overload:

   $db= DBI->connect($dsn, $user, ref $password? $$password : $password, 
   +\%attr);
   [download]

I just came up with that scalar-ref idea, and seems pretty safe because no code would normally scalar-dereference a ref unless the ref type was 'SCALAR'. Still, that's drastically lowering the bar for leaking the secret, and isn't advertising that it has this capability...

While pondering your preference, also consider the question "If someone contributed a patch to a module I maintain that added support for receiving secrets via SecretBuffer, how much boilerplate would I be willing to accept?"

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