Not really a question. Well, I did ask this question around 3 or so years ago, and I was finally able to figure it out - how to connect to perl with JDBC. One challenge I found was that the documenetation for modern databases was very sparse. I'm including directions here- in case any one runs into this problem.

Perl + JDBC + Trino End-to-End Example 1. Prerequisites Strawberry Perl with DBI and DBD::JDBC modules installed. Java Proxy JAR (from DBD::JDBC) running: java -jar jdbc_bridge.jar -port 12345 Trino JDBC Driver (trino-jdbc-*.jar) in your CLASSPATH. 2. Certificate Setup (Optional SSL) If your Trino instance requires a trusted connection: Convert your .crt file to .jks (Java KeyStore): keytool -import -trustcacerts -alias trino -file your_cert.crt -keystore truststore.jks -storepass changeit Then use the truststore.jks with your Java command if needed: java -Djavax.net.ssl.trustStore=truststore.jks -Djavax.net.ssl.trustStorePassword=changeit -jar jdbc_bridge.jar -port 12345 3. Perl Script: trino_connect.pl

use strict;
use warnings;
use DBI;
# -- Your credentials
my $user     = "svc-ndevfcollect";
my $password = "yourPasswordHere!";  # Use secure storage in productio
+n
# -- JDBC URL to Trino (443 confirmed)
my $url = "jdbc:trino://query.comcast.com:443?SSL=true&catalog=dx";
# -- JDBC bridge connection (localhost to Java proxy)
my $dsn = "dbi:JDBC:hostname=localhost;port=12345;url=$url";
# -- Optional: Print connection hash for debugging
my %conn_attrs = (
    RaiseError     => 1,
    jdbc_user      => $user,
    jdbc_password  => $password,
    jdbc_catalog   => "dx",            # Change as needed
);
use Data::Dumper;
print Dumper(\%conn_attrs);
# -- Connect to Trino
my $dbh = DBI->connect($dsn, undef, undef, \%conn_attrs)
    or die "Failed to connect: $DBI::errstr";
print "Connected successfully!\n";
# -- Run sample query
my $sth = $dbh->prepare("SELECT current_user");
$sth->execute();
while (my @row = $sth->fetchrow_array) {
    print "User: $row[0]\n";
}
$sth->finish();
$dbh->disconnect();
[download]

In my code I frequently have to write conditions like this:

if (defined $string and $string ne "") {
  .....
}
[download]

What I really want is to check if the string is not entirely empty. I would like to be able to do something like if ($string) but this would exclude "0".

So I hope that there is a shorter and nicer way to do this. For now I have been using a utility strempty subroutine which runs that check but I doubt it's idiomatic.

In my own code I try to have it so that empty strings are simply undef, where applicable, but sometimes it can't be helped and external modules don't follow this rule hence why I have to write these conditions.

if ($STRING =~ m/[^\x00-\xFF]{1}/)
{
  ...
}
[download]

OR MAYBE:

if (length($STRING) > ($STRING =~ tr|\x00-\xFF|\x00-\xFF|))
{
  ...
}
[download]

I can't think of anything better. Maybe this, but I bet it's slow:

sub isUnicode
{
  my $L = defined $_[0] ? length($_[0]) : 0;
  for (my $i = 0; $i < $L; $i++)
  {
    ord(substr($_[0], $i, 1)) < 256 or return 1;
  }
  return 0;
}
[download]

Hello Monks,

I've recently learned about the DEFINE predicate and I'm testing it with a simple script that I wrote to practice Perl and regular expressions. The script simply checks for IPv4 or IPv6 addresses (I know there is a CPAN module for that, this is for me to practice), and I re-wrote the regular expression like so:

my $re = qr{
  (?>
    \b ((?&IPV6) | (?&IPV4)) \b
  )

  (?(DEFINE)
    (?<IPV6>
      (                                   ((?&H16) :){6} (?&LS32))
      | (                             ::  ((?&H16) :){5} (?&LS32))
      | ((                 (?&H16))?  ::  ((?&H16) :){4} (?&LS32))
      | ((((?&H16) :){0,1} (?&H16))?  ::  ((?&H16) :){3} (?&LS32))
      | ((((?&H16) :){0,2} (?&H16))?  ::  ((?&H16) :){2} (?&LS32))
      | ((((?&H16) :){0,3} (?&H16))?  ::  ((?&H16) :){1} (?&LS32))
      | ((((?&H16) :){0,4} (?&H16))?  ::                 (?&LS32))
      | ((((?&H16) :){0,5} (?&H16))?  ::                 (?&H16) )
      | ((((?&H16) :){0,6} (?&H16))?  :: )
    )
    (?<LS32>        ((?&H16) : (?&H16)) | (?&IPV4)               )
    (?<H16>         (?&HEX_DIGIT){1,4}                           )
    (?<HEX_DIGIT>   [a-fA-F0-9]                                  )
    (?<IPV4>        ((?&DEC_OCTET)\.){3}(?&DEC_OCTET)            )
    (?<DEC_OCTET>   25[0-5]|2[0-4]\d|1\d\d|\d\d|\d               )
    (?<IP_VFUTURE>
      v(?&HEX_DIGIT)+\.((?&UNRESERVED) | (?&SUB_DELIMS) | : )+
    )
    (?<UNRESERVED>[a-zA-Z0-9\-\._~]                              )
    (?<SUB_DELIMS>[!\$&'\(\)\*\+,;=]                             )
  )
}x;
[download]

It works, but it only seems to capture the first occurrence of an IP address on each line. For example:

if ("This is the same address in IPv6: 0:0:0:0:0:0:0:1 and 127.0.0.1" 
+=~ /$re/g ) {
  say $&;
  say $1;
  say $2;
}
[download]

I was expecting to capture both IP addresses, but only the first is ever captured. Can anyone shed some light on how could I make this work in this way?

Thank you!

use HTTP::Tiny;
use HTTP::CookieJar;
use HTTP::Cookies::Mozilla;

my $cookies = HTTP::Cookies::Mozilla->new(file => $firefox_cookies_sql
+ite_file);
my @cookies = map { s/^Set-Cookie3:\s*//; $_ }
    split "\n", $cookies->as_string;
my $cookie_jar = HTTP::CookieJar->new;
$cookie_jar->load_cookies(@cookies);
my $ua = HTTP::Tiny->new(cookie_jar => $cookie_jar);
[download]

Dear monks,

I'm trying to search for several regexes in some long files. To speed things up, I tried first checking a combined regex, to see if any of them matches the line. Like so:

my $comb=join('|',@ARGV);
while($line=<$infile>){
  if($line=~$comb){
    for $target(@ARGV){
      if($line=~$target){
        # do a thing
}}}}
[download]

This seems to speed things up, at least when the regexes are just plain words. But: If I try input regexes which are anchored ("^word"), then suddenly it's much slower! Is there some weirdness with alternations and anchors? Or did I make some obvious mistake?

(I could rewrite ^aaa|^bbb|^ccc as ^(aaa|bbb|ccc), but it might be that only some of the inputs are anchored.)

The code below is the smallest example I could come up with.

There are two curiosities that I'd like to figure-out.

1. When I double-click (left-mouse-button), a small dashed box appears around the entry that's been clicked
2. When I double-click (left-mouse-button), the entry changes color from green to black (still with Courier 12 bold)

When I single (left-click) the window not containing an entry, then the entry that was clicked returns to being displayed as DarkGreen with no highlight box round it.

Questions (somewhat inter-related):

1. Is it possible to disable HList from responding to the double-left-click (so that the entry doesn't get a dashed-box and the color of the entry doesn't change)?
2. On other GUIs I've written, the dashed-box has proved annoying. Is it possible to prevent the dashed-box from appearing?

Thank you for your time.

#!/usr/bin/perl


use Tk;
use Tk::HList;
use Tk::ItemStyle;
use File::Basename;

$FONT_BOLD = "Courier 12 bold";

$mw        = MainWindow->new(-title => $0);
$hlist     = $mw->HList(-selectmode=>"none",
                        -selectbackground=>"Wheat", 
                        -selectborderwidth=>0,
                        -background=>"Wheat",
                        -selectbackground=>"Wheat",
                        -separator=>"/",      
                        -drawbranch=>1, 
                        -indicator=>1,        
                       ) -> pack(qw/-fill both -expand yes/);
$Highlight = $mw->ItemStyle('text', -foreground=>"DarkGreen", -backgro
+und=>"Wheat", -font=>$FONT_BOLD);

foreach $path("/", "/home", "/home/andrew")
   { $hlist -> add($path, -text=>basename($path), -style=>$Highlight);
   }

MainLoop();
[download]

This blog entry lists JS methods which were influenced verbatim by Perl.

• https://2ality.com/2013/02/javascript-influences.html

The referenced Chinese blog entry even has a screen shot.

• https://images0.cnblogs.com/blog/116671/201302/06202428-4fa9b726d88d4a16be4ac498a60f9a95.jpg

The link to the original source is broken, can someone please help me proving that point?

Hi. I am using a sub with my Tk module similar to;

sub tick {
   # Run every 1000 milliseconds.
   if ($toggle_scan_v eq 0) {return};       # Break out of this tick l
+oop
   
   # Do something
   
   $kount++;
   print "$kount ";
   $mw->after(1000, \&tick);           # Suggest loop here
   print "No Error; we should get here often. \n";
}
[download]

I trust that whenever the "after" is executed, the print is executed, after which a graceful exit of the subroutine occurs. This provides dead time for the thread of execution. In turn other events belonging to this same thread may occur and execute (possibly turning $toggle_scan_v on and stopping this "tick" loop which is earmarked to execute 1000 mSec after the "after" method).

I trust that the subroutine is called and always subsequently returns in such a manner that there is no stack littering.?

Regards JC....

Hi. I am using the above serial module and come across the 2 mentioned methods. Both seem to behave the same wrt inputting the characters from a COM port.

What is the difference between the 2 methods and where is there a decent play to get some documentation for the module as a whole and it's methods.?

Also, these methods seem to behave in a non-blocking manner. I would ideally like an input that blocks with a time-out option while it's waits for a line as input.?

Regards JC....