Here is my test program. And I know, you're going to hate me for this, because I forgot how to collapse the code within the CODE tags. :/

Anyway, here it is. It's a little QR code generator JavaScript with some HTML and perl and yad and xwd. This program has a little bit of everything in it. ;)

( This code has many bugs in it, so please forgive me for that. One of the big bugs is the fact that I try to take a snapshot of the QR code using xwd. But yad closes the dialog, and only then I execute xwd, which then takes a snapshot of everything else EXCEPT the QR code. Heh )

Got this docker command I want to run. Note the tail command at the end for keeping the container up and running.

docker run -d --name xxxyyyzzz-blah alpine /bin/ash -c "/usr/bin/tail 
+-f /dev/null"
[download]

The following backtick operation runs this command with no issue and the container is detached from and the container is left still running:

use v5.38;
`docker run -d --name xxxyyyzzz-blah alpine /bin/ash -c "/usr/bin/tail
+ -f /dev/null"`;
[download]

However, with the IPC::Run3 module, the container gets set up, but the tail command never seems to get executed and the container exits immediately:

use v5.38;
use IPC::Run3;

my $cmd = [ 'docker', 'run', '-d', '--name', 'xxxyyyzzz-blah', 'alpine
+', '/bin/ash', '-c', '"/usr/bin/tail -f /dev/null"' ];

my ($out, $err);
my $success = run3($cmd, undef, \$out, \$err);

print $success; # prints 1
[download]

I tried breaking up the the last element into 3 different elements separated by spaces but that didn't help.

In the following example I'm simply returning any value enclosed in < > .

I'm facing some "complications", which make me doubt I'm doing the right thing.

• to access the original data I have to pass the hash-ref again to the constructor, there doesn't seem to be any reverse tied command helping here, so I need to explicitly store it in the object. °
• When internally accessing the data of the original hash, I have to explicitly untie and retie the hash again, otherwise I'm causing an infinite recursion (yikes)
• I'm getting an untie attempted while 1 inner references still exist unless I undef the object prior, I'm not sure what this warning is supposed to mean. And it only cares about other refs in the same scope. SEE UPDATE ²

Any more elegant approach???

use v5.12;
use warnings;


package main;

my %hash;
@hash{"a".."c"} = 40 ..42;              # init

tie                                     # bind wrapper
  %hash,
  'Data::Proxy::TieHash',
  \%hash;                               # redundant, why?

say $hash{a};

say @hash{"a".."c"};

delete $hash{b};

say @hash{"a".."c"};

untie %hash;                            # unbind wrapper

say @hash{"a".."c"};


BEGIN {
    package Data::Proxy::TieHash;
    require Tie::Hash;
    use Scalar::Util qw/blessed/;

    use Carp;
    our @ISA = qw(Tie::ExtraHash);

    # All methods provided by default, define 
    # only those needing overrides
    # Accessors access the storage in %{$_[0][0]};
    # TIEHASH should return an array reference with the first element
    # being the reference to the actual storage

    sub _report {
        #  uncomment to trace
        #carp "Doing \U$_[0]\E of $_[1] at $_[2].\n"
    };

    sub DELETE {
        my ($obj, $key) = @_;
        my ($meta, $orig) =@$obj;
        _report('DELETE', $orig, $key);

        my $class = blessed $obj;
        undef $obj;
        untie %{$orig};
        my $ret = delete $orig->{$key};
        tie %{$orig}, $class, $orig;
        return $ret;
    }

    sub FETCH {
        goto &FETCH1;                   # use implementation
    }

    sub FETCH0 {
        _report('FETCH', $_[0][1], $_[1]); 

        untie %{$_[0][1]};
        my $ret = $_[0][1]->{$_[1]};
        tie %{$_[0][1]}, 'Data::Proxy::TieHash', $_[0][1];
        return "<$ret>" if defined $ret;
        return undef;
    }


    sub FETCH1 {
        my ($obj, $key) = @_;
        my ($meta, $orig) =@$obj;

        _report('FETCH', $orig, $key);

        my $class = blessed $obj;
        undef $obj;                     # avoid warning
        untie %{$orig};
        my $ret = $orig->{$key};
        tie %{$orig}, $class, $orig;
        return "<$ret>" if defined $ret;
        return undef;
    }

}
[download]

<40>
<40><41><42>
Use of uninitialized value in say at proxy_tiehash.pl line 21.
<40><42>
Use of uninitialized value in say at proxy_tiehash.pl line 25.
4042
[download]

UPDATES

°) this smells like internally causing a recursive data structure

²) OK I got it https://perldoc.perl.org/perltie#The-untie-Gotcha, untie is normally supposed to trigger DESTROY, but inf there are still other refs to the underlying $object DESTROY can't be triggered. In my case it's actually better not to trigger DESTROY and better to silence the warning altogether.

I'm trying to capture and remove certain substrings from a string. In this example I want to capture and remove words starting with 'foo', preserving the residual string.

#!/usr/bin/env perl
use v5.36;
my $x = "xyzzy foo1 foo2";
my @captured;
while ($x =~ s{ \s* (foo\w) \s* }{}msxg) {
    push @captured, $1;
}
say "Captured: '$_'" for @captured;
say "Left with '$x'";
[download]

Captured: 'foo2'
Left with 'xyzzy'
[download]

Captured: 'foo1'
Captured: 'foo2'
Left with 'xyzzy'
[download]

Also, I'm wondering if there's a better way to capture and remove a repeated pattern from a string like the above.

After putting aside the problem I asked about last year in Insecure dependency in mkdir while running with -T switch at ... File/Temp.pm line 542 I went back to it and made some headway. Now I would like to see if any of you esteemed monks with more insight into the inner workings of perl will have an idea about what is going on.

I distilled the problem down to the following code which fails only on certain CPAN testers that run various older Linux and FreeBSD distros with perl versions in the 5.16 to 5.20 range, but not on all testers running the same OS and perl versions, and not on any VM I set up trying to copy the different configurations of the failing testers. So the only way I can debug this is by submitting to CPAN and look at the failure reports.

The following sequence of code results in those testers getting the insecure dependency failure. The first line creates a tainted string that is an absolute directory path that exists. It doesn't seem to matter which directory or how I get it to be tainted. The second line has to consist of the -d expression and the call to file_name_is_absolute in that order. Even though both are true and therefore both are evaluated, the error only happens if it is done in that order. Also, the error does not happen if I make it two consecutive statements rather than combined by and. The third line is the call to tempdir in which the insecure dependency happens. In my tests the directory ./log does exist, but the program dies before it actually tries to make a subdirectory under it, and I haven't tested what happens if ./log doesn't exist. Notice that the ./log directory has nothing to do with $pathdir. Also, I happened to have started out with code that had use File::Temp qw(tempdir); so that's what's here, but the results are unchanged without the qw and with the function call line having File::Temp::tempdir

my $pathdir = $ENV{HOME};
(-d $pathdir) and File::Spec->file_name_is_absolute($pathdir);
my $workdir = tempdir("temp.XXXXXX", DIR => "log");
[download]

I created an Acme module to test this, monkey patching some functions in File::Temp and File::Spec to narrow down where the taint happens. Here is one example report. All of the testers that exhibit the problem have the same results in the tests. The test t/a1.t demonstrates the failure with the above code. The other test files add monkey patching with carp output to narrow down exactly where something becomes tainted. In t/a4.t the output shows that File::Temp::tempdir calls File::Spec::Unix->catdir which calls File::Spec::Unix->canonpath passing it untainted values, and getting a tainted value returned back. In t/t5.t and t/t6.t I find that if I try to monkey patch File::Spec::Unix->canonpath even making the patch a duplicate of the original source code, the error does not happen, the return value is not tainted. I can't see anything in the code in File::Spec::Unix->canonpath that could possibly result in a tainted value given untainted input.

I specified File::Temp and File::Spec as required dependencies in Makefile.PL so that the reports would list which versions the testers were running. You can see that both are the latest released versions, which is what I based the monkey patches on.

Does this look like some obscure bug in these versions of perl? Any ideas?

Am trying to get my output of data to this format

({
    "items": [
       {
            "title": "Valls"
       },
       
       {
            "title": "AUT15605"
       },
       {
            "title": "10UT15605"
       }
        ]
})
[download]

Am getting this error with my code

my $dbh = DBI->connect("DBI:mysql:$dbname:$host", $usr, $pwd, {
                                  RaiseError => 1,
                                  }) or die $DBI::errstr;

my $sth = $dbh->prepare("SELECT titles FROM tbl_1");
$sth->execute();
my $Data = $sth->fetchall_arrayref();
my %output;

foreach my $Data (@$Data) {
    
my ($title) = @$Data;

%output .= (
  'items' => [("title" => "$title")]
);
}


my $results = to_json(\%output);

print "Content-type: text/html\n\n";  
print $results;
[download]

Hi.

I'm working on a Linux server that hosts a website using Perl.

I need to download a file to the browser like downloads normally work. The page doesn't change, and the file is immediately downloaded when the user clicks on a link. There are hundreds of thousands of files, and which file gets downloaded depends on the Linux relative path. I do not know the file type. For example, the URL might look like this:

https://www.my-website.com/download.pl?file=path1/path2/filename.ext

What is the Perl code that will accomplish this? I've search the web, and I cannot find a definitive answer. At least not an answer that I understand.

I am not an experienced Perl programmer. Any help will be appreciated.

Thanks,

David

i am not able to follow symbolic links when using the find() command. it says on the manual that the 'follow' or 'follow_fast' option should be used but i don't understand how to use it together with the '\&wanted' routine -

use File::Find;

find(\&wanted,  @directories);
find(\%options, @directories);
[download]

I'm using Imager to render truetype fonts but there is no output, and no error, it's just blank. I checked $Imager::formats{tt} to see if Imager has truetype support and it's blank. I have some /usr/share/fonts/truetype so I dunno why Imager says that. How can Imager be compiled with tt support?

I have another computer with a similar setup but on that one Imager does render truetype even though $Imager::formats{tt} is blank! They are different operating systems and versions of Imager so I don't know. I could install the only fonts that Imager supports on this box: Freetype2, but I want to use truetype and would appreciate any ideas you have on how to get Imager to use my fonts.

Thank you.