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

I'm using the 'libunistring' library in C to uppercase utf8-encoded characters.

In C it works fine with no memory leaks according to Valgrind. But, when I try to do it in XS it works, but valgrind complains loudly.

Here's the C:

#include <stdio.h>
#include <unicase.h>
#include <stdlib.h>
#include <unistr.h>
#include <uninorm.h>
#include <string.h>
#include <unistr.h>
#include <unitypes.h>
void main(){
char* instring = "Hauptstraße 3"; // Works with uint8_t too
size_t length;
uint8_t *result;
size_t input_length;
input_length=strlen(instring); //u8_strlen works too
result = u8_toupper (instring, input_length, NULL, UNINORM_NFC, NULL, 
+&length);
[download]

The result is as expected: HAUPTSTRASSE 3

my XS function (same includes as above):

SV*
uppercase_utf8_2(SV* sv)
PREINIT:
    size_t len;
    char* s;
    char* upperstring; //uint8_t also
    SV* aresult;

   size_t upperlength;
CODE:
    s = SvPVbyte(sv, len);  //strings from my editor (locale?) are alr
+eady utf8 encoded
    upperstring = u8_toupper (s, len, NULL, NULL,NULL, &upperlength);
    upperlength = u8_strlen(upperstring);
    aresult = newSVpv(upperstring,upperlength);
    free(upperstring);
    RETVAL = aresult;
OUTPUT:
    RETVAL
[download]

All hunky-dory except for a tonne of errors from Valgirind, none of which mention the XS sub

e.g:

==614897== Invalid read of size 1
==614897==    at 0x484F234: strlen (in /usr/libexec/valgrind/vgpreload
+_memcheck-amd64-linux.so)
==614897==    by 0x485B74A: XS_Simple__Ngram_uppercase_utf8_2 (Ngram.x
+s:79)
==614897==    by 0x2441A9: ??? (in /usr/bin/perl)
==614897==    by 0x2396DD: Perl_runops_standard (in /usr/bin/perl)
==614897==    by 0x1781DA: perl_run (in /usr/bin/perl)
==614897==    by 0x14D639: main (in /usr/bin/perl)
==614897==  Address 0x5bb9282 is 0 bytes after a block of size 18 allo
+c'd
==614897==    at 0x484DB80: realloc (in /usr/libexec/valgrind/vgpreloa
+d_memcheck-amd64-linux.so)
==614897==    by 0x55AEF01: libunistring_u8_casemap (in /usr/lib/x86_6
+4-linux-gnu/libunistring.so.5.0.0)
==614897==    by 0x55AF478: u8_toupper (in /usr/lib/x86_64-linux-gnu/l
+ibunistring.so.5.0.0)
==614897==    by 0x485B73F: XS_Simple__Ngram_uppercase_utf8_2 (Ngram.x
+s:78)
==614897==    by 0x2441A9: ??? (in /usr/bin/perl)
==614897==    by 0x2396DD: Perl_runops_standard (in /usr/bin/perl)
==614897==    by 0x1781DA: perl_run (in /usr/bin/perl)
==614897==    by 0x14D639: main (in /usr/bin/perl)
==614897== 
==614897== 
==614897== HEAP SUMMARY:
==614897==     in use at exit: 2,544,437 bytes in 9,481 blocks
==614897==   total heap usage: 33,789 allocs, 24,308 frees, 6,454,177 
+bytes allocated
==614897== 
==614897== 2 bytes in 1 blocks are possibly lost in loss record 1 of 1
+,342
==614897==    at 0x4846828: malloc (in /usr/libexec/valgrind/vgpreload
+_memcheck-amd64-linux.so)
==614897==    by 0x24EADB: Perl_sv_magicext (in /usr/bin/perl)
==614897==    by 0x24ED0A: Perl_sv_magic (in /usr/bin/perl)
==614897==    by 0x183F8C: Perl_gv_fetchpvn_flags (in /usr/bin/perl)
==614897==    by 0x174ED2: perl_parse (in /usr/bin/perl)
==614897==    by 0x14D55B: main (in /usr/bin/perl)
[download]

Any ideas?

I've got the two following snippets:

PERL:

my $fn = shift;
exit 1 if not defined $fn;

my $input = do {
    open my $fh, "<", $fn or die "open failed";
    local $/;
    <$fh>
};

my $count = () = $input =~ m/mul\(\d{1,3},\d{1,3}\)/g;

print "Found $count matches.\n";
[download]

PYTHON:

import re
import sys

if len(sys.argv) < 2: exit(1)

mul_re = re.compile(r"mul\(\d{1,3},\d{1,3}\)")

with open (sys.argv[1], "r") as f:
    input = f.read()

count = len(mul_re.findall(input))

print(f"Found {count} matches.")
[download]

Which do more or less the same thing. Running both scripts on the same file, I found that the Python version runs a full second faster! 1.375s as opposed to Perl's 2.466s

I had always thought that Perl's regex and parsing performance was particularly strong compared to other languages, so this was a shocker for me. What is it that I am doing wrong? How can I make the Perl version run as fast as the one in Python?

Thanks. -- Dave

Hi Monks,

Quick question, and dumb: are we supposed to be able to reach CPAN authors by emailing to AUTHOR@cpan.ORG? I tried it on myself an hour ago and there's no message in my inbox.

I'm trying to reach MICHIELB (Michiel Beijen) about test warnings in his module File::MimeInfo

I have the following code segment in a much larger script:

if ($myfile =~ /\.gz$/)
{
    open(MYFILE, "/bin/zcat $myfile |") || die("ERROR: Cannot open $my
+file for read: $!\n");
}

else
{
    open(MYFILE, "$myfile") || die("ERROR: Cannot open $myfile for rea
+d: $!\n");
}

my $myfile_timestamp = (stat(MYFILE))[9];

close(MYFILE);
[download]

When I run the script that contains the above, I receive the following error at the "close(MYFILE)" line:

gzip: stdout: Broken pipe
[download]

But the script runs to completion without any other apparent issues. If I just copy/paste the above code into a standalone script and hardcode the path to $myfile, the error doesn't occur.

If I add "use autodie;" to the top of the script, the script exits at the "close(MYFILE)" line with the following messages:

gzip: stdout: Broken pipe
Can't close filehandle 'MYFILE': '' at myscript.pl line 1014
[download]

If I add the following code either before or after the timestamp assignment, the error doesn't occur:

while (<MYFILE>)
{
    chomp($_);
}
[download]

If I don't close the filehandle, the error doesn't occur and it doesn't seem to cause any other problems in the script.

If I change the assignment to $myfile_timestamp to a constant as opposed to reading an attribute from the filehandle, the error is the same.

Does anyone know what could be causing the broken pipe error? Is there any way I can debug it further? Reading from the pipe seems to provide a workaround but I'm not sure why it's necessary. This same code structure (doing either a standard open/read for a non-gzipped file or a zcat pipe open for a gzipped file) is used elsewhere in the script and doesn't ever give a "broken pipe" error.