When I created an account here some five weeks ago, little did I realise just how much varied learning I would receive in such a short time...so I am asking for advice on an issue that has had me scratching my head many times over the years. How best to lay out code when quite a bit of text output is required, such as when dynamically creating a webpage, inside an indented block.

In the main body of the code I usually use an interpolating heredoc with any runtime variations defined in variables ahead of printing it all out.

my $login_text = $user_number?'logout':'login';

print<<"END_HTML";
<div>
  ...part of webpage...
<input type="button" name="log" value="$login_text" onClick="doSomethi
+ng();">
  ...more of webpage...
</div>
END_HTML
[download]

if (isAdmin($user_number)) {
    print ...some extra content...
}
[download]

This leaves a few option.
The one that most of my legacy code has is to simply put every line in a separate print statement

if (isAdmin($user_number)) {
    print "<table>\n";
    print "<tr>\n";
    print "<td class=\"someclass\" style=\"text-align:center\">Some Co
+ntent</td>\n";
    print "</tr><tr>\n<td class=\"someClass\">Restricted</td>\n" if $u
+ser_number == 20;
    print "</tr>\n";
    print "</table>";
}
[download]

   print qq[<td class="someclass" style="text-align:center">Some Conte
+nt</td>\n];
   print qq[</tr><tr>\n<td class="someClass">Restricted</td>\n] if $us
+er_number == 20;
[download]

I have tried having a subroutine to strip out leading spaces but this has the disadvantage of always stripping leading spaces even when they are wanted! In this format it also strips out blank lines although this is not too tricky to solve.

#!/usr/bin/perl
use strict;

print "Content-type: text/plain\n\n";

print "Test\n\n";

sub indent {
    my $text = shift;
    $text =~ s/^\s+//gm;
    return $text;
}

if (1) {
    print indent(<<"END_TEXT");
    Here is
    some test text
    with plenty of space 
    at the start
END_TEXT
}

exit 0;
[download]

Many times I have searched for a solution and found several references to the issue but nothing offering a 'proper' solution. The topic of indentation in some form or another crops up periodically in all sorts of forms including Mandatory indenting which was interesting despite not being directly relevant.

Other than upgrading to Perl 5.26 or later, is there an elegant solution to laying out code to print a lot of text in an indented block?

Dear Perl Monks,

I am trying to figure out how I can do server-side caching of dynamic webpages that Mojolicious generates in response to webrequests. So that, expensive processing (e.g. on data pulled from a database) done on regenerating the same webpages again is bypassed for subsequent webrequests.

I was looking for a file-based caching solution for Mojolicious, something like what this module does, but unfortunately the module seems outdated and does not install: Mojolicious::Plugin::Cache. In CGI, such a solution is implemented in CGI::Buffer, and Cache::Cache.

I found caching support in Mojolicious, but this appears to be client-side caching, as shown below:

helper 'cache_control.five_minutes' => sub ($c) { $c->res->headers->ca
+che_control('public, max-age=300') };
get '/some_older_story' => sub ($c) {
    $c->cache_control->five_minutes;
    $c->render(text => 'This one can be cached for a bit.');
};
#ref: https://metacpan.org/pod/distribution/Mojolicious/lib/Mojoliciou
+s/Guides/Rendering.pod
[download]

I also tried to use statements as below, but this does not seem to work for me, maybe I am missing something here.

use Mojolicious::Lite 
app->renderer->cache->max_keys(100);
[download]

Please advise how to go about.

Thank you very much!

package ECClib;

my $dbh;

sub initialise(){
.
.
$dbh = db_connect($dbuser, $dbpasswd, $dbserver);
.
.
)
[download]

use ECClib;

ECClib::initialise();

my $sql="select InputID from ECCInput order by InputID";
my $sth = $ECClib::dbh->prepare($sql);
[download]

Greetings wise brothers, I seek your advice on how to concurrently access the old and the new.

I am working on a legacy Perl system that makes heavy use of Storable objects (in a database, traversing the network etc), so it has to run Perl 5.10.1 and no other version. Up until now, it has been run on Ubuntu 10.04 Lucid, which means running a 10 year old Linux distro (with no support) on 10 year old hardware also with no support that could die at any moment.

I would like to migrate the system to a modern OS (Ubuntu 20.04 Focal) and hardware, while using perlbrew to run the application using the correct Perl version. I have successfully built and installed Perl 5.10.1 and all the necessary libraries using Carton, but I have two problems with this setup that I would like to solve.

Firstly, to run a Perl script with the correct libraries, I need to put “carton exec” on the front of each script invocation. If you don’t do that then the correct Perl binary runs, but it fails because it cannot find the modules that carton installed.

How can I arrange things so that just running perl from a shell will do the right thing? (Run Perl 5.10.0 with the carton installed modules available), Perhaps by tweaking PERL5LIB for bash shells, or putting a wrapper script into the path? (note that I don't need to worry about multi user accounts here, all users login as root!)

Secondly, there are about 200 CGI scripts mostly in Perl, and each with a #!/usr/bin/perl shebang line. How should I configure Apache to call my perlbrew installed version of perl, again with the carton installed modules, preferably without re-writing the shebang line on every script, though if I must do that, then the change needs to be backwards compatible with the old setup.

Note that this is plain old CGI, not modperl FastCGI or anything like that. I would not object to using an FCGI wrapper if it can be dropped in painlessly, but not if it would require modifications to the scripts, or could be a source of bugs or incompatibilities.

And before you say it, Yes I am well aware that it would be better to migrate away from Perl Storable. I have seen Elizabeth Mattijsen’s talks on how Booking.com did so at various Perl events. I also know that plain old CGI is no longer considered best practice. My problem is that this is a legacy system, and there is not much time or money available for major system changes, and there is no appetite for anything that could introduce hard to find bugs.

Dear Monks,

I need some advice about logging with DBIx::Simple (+ SQL::Interp), since I can't figure it out myself.

I'd like a unified way to trace the SQL queries and log the application errors, so something like Log::Any seems the way to go. Of course, I'd rather see the placeholders replaced by quoted bind values in my logs, like DBI::Log does (but limited to DBI tracing). And there's also DBIx::LogAny.

If it's possible to use DBIx::Simple and DBIx::LogAny together, then I don't understand how to do it. For example, DBIx::Simple::connect seems to call DBI::connect and DBIx::LogAny::connect calls SUPER::connect, so what will happen if I use both modules? Should I pass them $dbh, but then in what order?

• MacOS X 10.15.7 Catalina
• Perl 5.33.4 installed via 'brew' (Homebrew 2.6.2)
• cpan 1.64

I want to build/install Net::Google:Spreadsheets, which depends on:
• Any::Moose (though there are a bunch of warnings that this should be replaced with Moo)
• Net::Google::DataAPI
• XML::Atom
• and other modules which I've had no problem installing
The last one seems to be my current blocker, as XML::Atom fails to install.

slightly modified to reduce line-wraps

cpan[6]> install XML::Atom
Running install for module 'XML::Atom'
  MIYAGAWA/XML-Atom-0.42.tar.gz
  Has already been unwrapped into directory ~/.cpan/build/XML-Atom-0.4
+2-6
Configuring M/MI/MIYAGAWA/XML-Atom-0.42.tar.gz with Build.PL
Creating new 'Build' script for 'XML-Atom' version '0.42'
  MIYAGAWA/XML-Atom-0.42.tar.gz
  ~/perl5/perlbrew/perls/perl-5.33.4/bin/perl5.33.4 Build.PL -- OK
Running Build for M/MI/MIYAGAWA/XML-Atom-0.42.tar.gz
cp lib/XML/Atom/Link.pm blib/lib/XML/Atom/Link.pm
cp lib/XML/Atom/ErrorHandler.pm blib/lib/XML/Atom/ErrorHandler.pm
cp lib/XML/Atom/Base.pm blib/lib/XML/Atom/Base.pm
cp lib/XML/Atom/Server.pm blib/lib/XML/Atom/Server.pm
cp lib/XML/Atom/Entry.pm blib/lib/XML/Atom/Entry.pm
cp lib/XML/Atom/Category.pm blib/lib/XML/Atom/Category.pm
cp lib/XML/Atom/Thing.pm blib/lib/XML/Atom/Thing.pm
cp lib/XML/Atom/Util.pm blib/lib/XML/Atom/Util.pm
cp lib/XML/Atom.pm blib/lib/XML/Atom.pm
cp lib/XML/Atom/Feed.pm blib/lib/XML/Atom/Feed.pm
cp lib/XML/Atom/Content.pm blib/lib/XML/Atom/Content.pm
cp lib/XML/Atom/Person.pm blib/lib/XML/Atom/Person.pm
cp lib/XML/Atom/Client.pm blib/lib/XML/Atom/Client.pm
  MIYAGAWA/XML-Atom-0.42.tar.gz
  ./Build -- OK
Running Build test for MIYAGAWA/XML-Atom-0.42.tar.gz
t/00-compile.t ................... ok
t/01-util.t ...................... ok
t/02-content.t ................... ok
t/03-link.t ...................... ok
t/04-person.t .................... ok
t/11-entry.t ..................... ok
t/12-feed.t ...................... ok
t/13-atom1.t ..................... ok
t/14-atom1-create.t .............. ok
t/15-content-image.t ............. ok
t/16-content-binary.t ............ ok
t/17-renames.t ................... ok
t/18-unicode.t ................... skipped: Skipping Unicode test sinc
+e it depends on LibXML
t/19-ext.t ....................... ok
t/20-content-xhtml.t ............. ok
t/21-client.t .................... skipped: Don't do live Atom test
t/22-autodiscovery.t ............. skipped: http://diveintomark.org/te
+sts/client/autodiscovery/: 200 OK
t/23-category.t .................. ok
t/24-bad-content.t ............... ok
t/25-utf8-create.t ............... ok
t/27-client-leaks.t .............. ok
t/28-ext.t ....................... ok
t/29-source.t .................... ok
t/30-datetime-stringification.t .. ok
t/31-external-entities-libxml.t .. 1/4
#   Failed test 'resolved entity'
#   at t/31-external-entities-libxml.t line 57.
#                   '<p>No, Ben isn't updating. It's me testing out gu
+est author functionality.</p>'
#     doesn't match '(?^:This is what you get when you do unit testing
+)'
# Looks like you failed 1 test of 4.
t/31-external-entities-libxml.t .. Dubious, test returned 1 (wstat 256
+, 0x100)
Failed 1/4 subtests
t/31-external-entities-xpath.t ... # XPath Override in place
Constant subroutine XML::Atom::LIBXML redefined at t/31-external-entit
+ies-xpath.t line 18.
External Entities disabled. at ~/.cpan/build/XML-Atom-0.42-6/blib/lib/
+XML/Atom.pm line 52.
t/31-external-entities-xpath.t ... ok
t/author-pod-syntax.t ............ skipped: these tests are for testin
+g by the author

Test Summary Report
-------------------
t/31-external-entities-libxml.t (Wstat: 256 Tests: 4 Failed: 1)
  Failed test:  4
  Non-zero exit status: 1
Files=27, Tests=285,  6 wallclock secs ( 0.09 usr  0.05 sys +  4.73 cu
+sr  0.78 csys =  5.65 CPU)
Result: FAIL
  MIYAGAWA/XML-Atom-0.42.tar.gz
  ./Build test -- NOT OK
//hint// to see the cpan-testers results for installing this module, t
+ry:
  reports MIYAGAWA/XML-Atom-0.42.tar.gz
Failed during this command:
 MIYAGAWA/XML-Atom-0.42.tar.gz                : make_test NO

cpan[7]>
[download]

At first I was hung up on:

t/18-unicode.t ................... skipped: Skipping Unicode test sinc
+e it depends on LibXML
[download]

which becomes more confusing when I see:

cpan[7]> install XML::LibXML
XML::LibXML is up to date (2.0206).
[download]

but clearly the main issue is:

t/31-external-entities-libxml.t .. 1/4
#   Failed test 'resolved entity'
#   at t/31-external-entities-libxml.t line 57.
#                   '<p>No, Ben isn't updating. It's me testing out gu
+est author functionality.</p>'
#     doesn't match '(?^:This is what you get when you do unit testing
+)'
# Looks like you failed 1 test of 4.
[download]

So... what can I do to fix this?

In a json if I want to search for a key which could be at any level and multiple places, how do I do it. Example I have below JSON. In JSON there are places where componentID is present. Each ComponentId is different. I need to search value of that componentId in json and where it matches pick that object in json. This is kind of function which helps to pickup that object out of json based on componentId value. Any module to achieve this or any idea to help on this

json

  "infra": {
    "config": {
      "rack": [
        {
          "componentId": "xxx-001",
          "model": "xxx",
          "server": [
            {
              "componentId": "server-001",
              "type": "xxxx",
              "model": "xxxx",
              "role": "Management",
              "specificAttributes": ""
............

    "platform": {
      "config": {
        "mgmtser": [{
          "componentId": "sr-001",
          "domainName": "xxxxx",
          "thinDiskMode": true,
          "deployment": "small",
[download]

The question is about naming methods in the module the same as Perl's built-in functions. For example, since I am storing key/value pairs I want to know if a key exists. Perl has a built-in function exists() and has to be called on an array or hash, e.g. exists(foo[0])

That name "exists" is the perfect description of what I want to do with this module. So if I write in the module:

sub exists {
  ... blah ...
}
[download]

use MyPackage;
my $obj = MyPackage->new();
$obj->set_value('foo', 'bar');
if($obj->exists('foo')) {
    print "that key is there\n";
}
[download]

It works just fine. So I want to know why I'm able to override the built-in function? Is it because the procedure I'm writing is always called by the object handle? Does that make it NOT the same as the built-in function?

Just trying to understand how it works

$ cat data.HW2
1.1 2.1 3.1 4.1
1.2 2.2 3.2 4.2
1.3 2.3 3.3 4.3
1.4 2.4 3.4 4.4
[download]

cat jackkinfe.pl

#! /usr/bin/perl
use warnings; use strict;
my @n=0;
my @x;
my $j;
my $i;
my $dg;
my @x_jack;
my @x_tot=0;
my $cols;
my $col_start=0;

# read in the data
while(<>)
{
  my @column = split();
  $cols=@column;
  foreach my $j ($col_start .. $#column) {
    $x[$n[$j]][$j] = $column[$j];
    $x_tot[$j] += $x[$n[$j]][$j];
    $n[$j]++;
  }
}
# Do the jackknife estimates
for ($j=$col_start; $j<$cols; $j++)
{
  for ($i = 0; $i < $n[$j]; $i++)
  {
    $x_jack[$i][$j] = ($x_tot[$j] - $x[$i][$j]) / ($n[$j] - 1);
  }
# Do the final jackknife estimate
  my @g_jack_av=0;
  my @g_jack_err=0;
  for ($i = 0; $i < $n[$j]; $i++)
  {
    $dg = $x_jack[$i][$j];
    $g_jack_av[$j] += $dg;
    $g_jack_err[$j] += $dg**2;
  }
  $g_jack_av[$j] /= $n[$j];
  $g_jack_err[$j] /= $n[$j];
  $g_jack_err[$j] = sqrt(($n[$j] - 1) * abs($g_jack_err[$j] - $g_jack_
+av[$j]**2));
  printf "%e %e ", $g_jack_av[$j], $g_jack_err[$j];
}
printf "\n";
[download]

$cat data.HW2 | perl jackknife.pl
Use of uninitialized value within @n in array element at cols_jacknife
+.pl line 19, <> line 1.
Use of uninitialized value within @n in array element at cols_jacknife
+.pl line 20, <> line 1.
[download]

$x[$n[$j]][$j] = $column[$j];
$x_tot[$j] += $x[$n[$j]][$j];
[download]

my ($C,$R)=(4,3); #Columns,Rows

my @list = qw(1 2 3 4 5 6 7 8 9 10 11 12);
my @AoA=();

while (@list) { push(@AoA, [ splice(@list, 0, $C) ]);  }

pp \@AoA;
pp \@list;
[[1 .. 4], [5 .. 8], [9 .. 12]]
[]
[download]

I'm seeking an equivalent without splice - so that @list remains unaffected. Any suggestions...?

This isn't really a cool use for Perl, but more of a cool use of Perl.

I was making some updates to my Hook::Output::Tiny software, in which I have a couple of subs that do the exact same thing, but the names are different. One thing I like to do in cases such as this is auto generate the subs dynamically.

For example... you've got a module that has subs one(), two(), three() etc, and they all do the same thing... accept an optional value to stash into the object (setter), and return the value (getter). Each sub has the same (or perhaps different) default values. I always use the old-fashioned Perl way of writing OO code, so that would look like this:

sub one {
    my ($self, $value) = @_;
    
    $self->{one} = $value if defined $value;
    return $self->{one} // 1;
}
sub two {
    my ($self, $value) = @_;
    
    $self->{two} = $value if defined $value;
    return $self->{two} // 2;
}
# and so on...
[download]

That gets tedious and frustrating, and is prone to mistypes and other mistakes. What I often do in cases such as this, is auto generate these types of subs within a BEGIN block dynamically, using the magical no strict 'refs';, which allows us to muck with the symbol table directly and do very dangerous stuff in ways that one shouldn't normally do. Here's an example module:

package Dynamic;

use warnings;
use strict;

BEGIN {

    my %sub_info = (
        one     => 1,
        two     => 2,
        three   => 3,
        four    => 4,
        five    => 5,
    );

    no strict 'refs';

    for (keys %sub_info) {
        my $sub_name = $_; # Take a copy of the key, which is the sub 
+name

        *$_ = sub {
            my ($self, $value) = @_;
            $self->{$sub_name} = $value if defined $value;
            return $self->{$sub_name} // $sub_info{$sub_name};
        };
    }
}

sub new {
    return bless {}, $_[0];
}

1;
__END__
[download]

First, we set things up near the top of the file so it's easily visible within a BEGIN block to ensure the code is compiled first. Here's what's happening:

• %sub_info is a hash that contains each sub name as the key, and the default value we'll return if the user doesn't change it
• We disable strict's reference checking with no strict 'refs' so that we can perform super-dangerous stuff, like using a string as a symbol reference
• Iterate over the hash and copy the key name into a separate variable
• Set the current key name as the name of the new subroutine by prepending an asterisk to signify a symbol table entry, and assign it a new anonymous sub
• Just like any other method, we put the code in exactly as we would if we were manually writing it out. Note the use of $sub_name instead of using just $_. This is because we've clobbered $_ by assigning a sub to it. This is why we made a copy of it above
• Done! Looks just like any other setter/getter, but instead of typing out five subs that look near identical, we've only typed it out once, and let Perl write them for us in a loop

Here's a script that puts the new module into action. Note that both the module and script are in the same directory for this demonstration:

use warnings;
use strict;
use feature 'say';

use lib '.';

use Dynamic;

my $dyn = Dynamic->new;

say "Manual calls";

say $dyn->one;
say $dyn->two;

# Or even

say "Stringified calls";

for (qw(one two three four five)) {
    if ($_ eq 'three') {
        # Update the value of the 'three' method
        $dyn->three(99);
    }
    printf "sub $_: %d\n", $dyn->$_();
}
[download]

Output:

spek@scelia ~/repos/scripts/perl/dynamically_auto_generate_subs $ perl
+ dyn.pl

Manual calls
1
2
Stringified calls
sub one: 1
sub two: 2
sub three: 99
sub four: 4
sub five: 5
[download]

In closing, if you're only doing a couple of subs, it probably isn't worth the hassle, but when you are doing several, it makes things very simple, especially if you need to add new ones in the future. You simply have to enter a new record into the hash.

Here's the code section that I just wrote that inspired me to write this post. It's from my Hook::Output::Tiny distribution. I am dynamically creating four methods... stdout() and stderr() which effectively do the same thing but act on different things, and their helper counterparts _stdout() and _stderr():

BEGIN {
    # Auto generate the stdout() and stderr() methods, and their priva
+te
    # helper counterparts

    no strict 'refs';

    for ('stdout', 'stderr') {
        my $sub_name = $_;

        # Public

        *$_ = sub {
            my ($self) = @_;

            if (! wantarray) {
                warn "Calling $sub_name() in non-list context is depre
+cated!\n";
            }
            return defined $self->{$sub_name}{data}
                ? split /\n/, $self->{$sub_name}{data}
                : @{[ () ]}; # Empty list
        };

        # Private

        my $private_sub_name = "_$sub_name";

        *$private_sub_name = sub {
            my ($self) = @_;

            my $HANDLE = uc $sub_name;
            open $self->{$sub_name}{handle}, ">&$HANDLE"
              or die "can't hook " . uc $sub_name . ": $!";
            close $HANDLE;
            open $HANDLE, '>>', \$self->{$sub_name}{data} or die $!;
        };
    }
}
[download]