Published by Perl Steering Council on Thursday 12 June 2025 21:56
All three of us attended.
Published by Perl Steering Council on Thursday 12 June 2025 21:56
All three of us attended.
open
done by readline
. We will outline our thoughts on the thread.Published by LNATION on Thursday 12 June 2025 20:00
In the last post we investigated prototype subroutines in Perl. In this post, we will look at operator overloading, which allows you to define how operators behave for objects of a class.
An operator in programming is a symbol or keyword that performs a specific operation on one or more operands (values or variables). There are many types of operators, such as arithmetic operators (like +
, -
, *
, /
) and comparison operators (like ==
, !=
, <
, >
).
In Perl, you can overload these operators for your own classes, allowing you to define custom behaviour when these operators are used with objects of that class. The following table can be used as a reference to operators that can be overloaded in Perl:
Operator Symbol | Description |
---|---|
'+' | Addition |
'-' | Subtraction |
'*' | Multiplication |
'/' | Division |
'%' | Modulus |
'**' | Exponentiation |
'<<' | Left bitshift |
'>>' | Right bitshift |
'x' | String/array repetition |
'.' | String concatenation |
'<' | Numeric less than |
'<=' | Numeric less or equal |
'>' | Numeric greater than |
'>=' | Numeric greater or equal |
'==' | Numeric equality |
'!=' | Numeric inequality |
'<=>' | Numeric comparison |
'lt' | String less than |
'le' | String less or equal |
'gt' | String greater than |
'ge' | String greater or equal |
'eq' | String equality |
'ne' | String inequality |
'cmp' | String comparison |
'bool' | Boolean context |
'""' | String context |
'0+' | Numeric context |
'++' | Increment |
'--' | Decrement |
'abs' | Absolute value |
'neg' | Negation |
'not' | Logical not |
'~' | Bitwise not |
'atan2' | Arctangent |
'cos' | Cosine |
'sin' | Sine |
'exp' | Exponential |
'log' | Logarithm |
'sqrt' | Square root |
'${}' | Dereference as scalar |
'@{}' | Dereference as array |
'%{}' | Dereference as hash |
'&{}' | Dereference as code |
'*{}' | Dereference as glob |
'fallback' | Fallback for unknown ops |
All of these operators can be overloaded by defining methods in your class that correspond to the operator. For example, to overload the addition operator (+
), you would define a method named add
in your class. And then you can use the use overload
pragma to associate that method with the +
operator.
When overloading in Perl, the fallback
option is important to set because it tells Perl what to do if an operator is used on your object but you haven’t provided an explicit overload for that operator. It will fallback to the default operator. If you do not set fallback
then perl will throw an error when your object is used with an unimplemented operator.
Today we will create a new module that will represent a simple mathematical 3D vector. We will overload the addition, subtraction, multiplication, stringification operators for this example. Lets start by creating a new distribution called Math::Vector3D
using Module::Starter
:
module-starter --module="Math::Vector3D" --author="Your Name" --email="your email"
This will create a new directory called Math-Vector3D
with the basic structure of a Perl module. First we will add a new test file to test our module. We will start simple by just testing the instantiation of our object. Create a new file called t/01-vector3d.t
with the following content.
use Test::More;
use_ok('Math::Vector3D');
ok(my $v = Math::Vector3D->new(1, 2, 3), 'Created a new vector');
isa_ok($v, 'Math::Vector3D', 'Object is of correct class');
eval {
Math::Vector3D->new('a', 'b', 'c');
};
like($@, qr/Invalid vector component/, 'Invalid components raise an error');
done_testing();
As you can see, we are testing the creation of a new vector object and checking that it is of the correct class. We also test that invalid components raise an error, as we only want our object to be instantiated with numbers.
Next, we will implement the new
method in our module. Open the file lib/Math/Vector3D.pm
and replace the function1
definition with the following code:
=head2 new
Constructor for the Math::Vector3D object.
my $vector = Math::Vector3D->new(1, 2, 3);
=cut
sub new {
my ($class, @vector) = @_;
looks_like_number($_) or die "Invalid vector component: $_" for @vector;
return bless { vector => \@vector }, $class;
}
This new
method takes a list of components for the vector, checks that they are all numbers using looks_like_number
, and then blesses the array reference into the class. The looks_like_number
function is not a built-in function, so we need to import it from the Scalar::Util
module. The Scalar::Util
module is one of many core
modules that come bundled with Perl, so you don't need to install it separately. To use it, we will add the following line at the top of our file after the use warnings
line:
use Scalar::Util qw(looks_like_number);
Now we can run our test file to see if it passes:
prove -lv t/01-vector3d.t
You should see output indicating that all tests passed. Next we will implement stringification for our vector object. This will allow us to convert our vector object to a string representation when we use it in a string context, such as when we print it. Open the test file and extend with these tests:
is($v->stringify, "(1, 2, 3)", 'Stringification method works');
is("$v", "(1, 2, 3)", 'Stringification works');
As you can see we are testing the stringify
method directly on the object, and also testing the stringification when we use the object in a string context. Now we will implement the stringify
method in our module. Add the following code to lib/Math/Vector3D.pm
first replacing the function2
definition:
=head2 stringify
Returns a string representation of the vector.
my $string = $vector->stringify();
=cut
sub stringify {
my ($self) = @_;
return sprintf "(%s)", join(', ', @{$self->{vector}});
}
And then add the overload declaration at the top of the file after the use Scalar::Util
line:
use overload
'""' => 'stringify',
fallback => 1;
This overload declaration tells Perl to use the stringify
method when the object is used in a string context (like when interpolated in a double-quoted string). The fallback => 1
option allows Perl to fall back to the default behavior if the operator is not overloaded.
Now we can run our test file again to see if the stringification tests pass:
prove -lv t/01-vector3d.t
You should see output indicating that all tests passed. Next, we will implement the addition operator (+
) for our vector object. This will allow us to add two vectors together using the +
operator. Open the test file and extend with these tests:
ok(my $v2 = Math::Vector3D->new(4, 5, 6));
is($v->add($v2), "(5, 7, 9)", 'Addition with another vector works');
is($v + $v2, "(5, 7, 9)", "Addition operator works");
We create a new vector to be used in the addition tests, and then we test both the add
method directly and the overloaded +
operator. Now with our tests failing we will implement the add
method in our module. Add the following code to lib/Math/Vector3D.pm
.
=head2 add
Adds another vector to this vector.
my $result = $vector->add(Math::Vector3D->new(4, 5, 6));
=cut
sub add {
my ($self, $other) = @_;
ref($self) eq 'Math::Vector3D' or die "Method called on non-Math::Vector3D object";
ref($other) eq 'Math::Vector3D' or die "Argument must be a Math::Vector3D object";
return Math::Vector3D->new(
map { $self->{vector}[$_] + $other->{vector}[$_] } 0..2
);
}
This add
method checks that both the object and the argument are of the correct class, and then returns a new Math::Vector3D
object with the sum of the components. The map
function is used to iterate over the indices of the vector components (0 to 2 for a 3D vector) and add the corresponding components of both vectors. When overloading numeric operators you also get a third argument which is the context in which the operator was called on the object. For example the third argument will be true if the operator was called before the object (5 + $obj) and false if it was called after the object ($obj + 5). It's important to understand the first argument $self will always be the object, the $other variable will be the operand/value, the third argument is whether $other comes before or after $obj. In all of our methods today we do not need to use this context but it is good to know it exists.
With the above in place before our tests will pass we need to add the overload declaration for the +
operator. Add the following code replacing your existing overload declaration:
use overload
'+' => 'add',
'""' => 'stringify',
fallback => 1;
Now we can run our test file again to see if the addition tests pass:
prove -lv t/01-vector3d.t
You should see output indicating that all tests passed. Next, we will implement the subtraction operator for our vector object. This will allow us to subtract one vector from another using the -
operator. Open the test file and extend with these tests:
is($v->subtract($v2), "(-3, -3, -3)", 'Subtraction with another vector works');
is($v - $v2, "(-3, -3, -3)", "Subtraction operator works");
is($v2->subtract($v), "(3, 3, 3)", 'Subtraction with another vector works in reverse');
is($v2 - $v, "(3, 3, 3)", "Subtraction operator works in reverse");
With the failing tests in place we will implement the subtract
method in our module. Add the following code to lib/Math/Vector3D.pm
:
=head2 subtract
Subtracts another vector from this vector.
my $result = $vector->subtract(Math::Vector3D->new(4, 5, 6));
=cut
sub subtract {
my ($self, $other) = @_;
ref($self) eq 'Math::Vector3D' or die "Method called on non-Math::Vector3D object";
ref($other) eq 'Math::Vector3D' or die "Argument must be a Math::Vector3D object";
return Math::Vector3D->new(
map { $self->{vector}[$_] - $other->{vector}[$_] } 0..2
);
}
This subtract
method is similar to the add
method, but it subtracts the components of the second vector from the first. The same checks for class and context are applied.
Now we will add the overload declaration for the -
operator. Add the following code replacing your existing overload declaration:
use overload
'+' => 'add',
'-' => 'subtract',
'""' => 'stringify',
fallback => 1;
Now run your tests again and all should pass. The next method we will implement is mutiply this will work slightly differently to the add
and subtract
we will allow normal multiplication between a vector and an number however when you multiple two vectors together we will calculate the Dot product of the vectors. The dot product (also called the scalar product) of two vectors is a single number obtained by multiplying their corresponding components and then adding those products together. Add the following tests to your test file:
is($v->multiply(2), "(2, 4, 6)", 'Multiplication with a number works');
is($v * 2, "(2, 4, 6)", "Multiplication operator with a number works");
is($v->multiply($v2), 32, 'Dot product with another vector works');
is($v * $v2, 32, "Multiplication operator returns dot product with another vector");
Then to implement the multiply
method in our module, add the following code to lib/Math/Vector3D.pm
:
=head2 multiply
Multiplies this vector by a scalar or another vector.
my $result = $vector->multiply(2);
... or
my $dot = $vector->multiply(Math::Vector3D->new(2, 2, 2));
=cut
sub multiply {
my ($self, $other) = @_;
if (ref($other) eq 'Math::Vector3D') {
# Dot product
return $self->{vector}[0] * $other->{vector}[0]
+ $self->{vector}[1] * $other->{vector}[1]
+ $self->{vector}[2] * $other->{vector}[2];
} elsif (looks_like_number($other)) {
# Scalar multiplication
return Math::Vector3D->new(
map { $self->{vector}[$_] * $other } 0..2
);
} else {
die "Argument must be a scalar or Math::Vector3D object";
}
}
This multiply
method checks if the argument is a number or a Math::Vector3D
object. If it's another vector, it calculates the dot product. If it's a number, it multiplies each component of the vector by that number. If the argument is neither, it raises an error.
Now update the overload declaration to include the *
operator. Replace your existing overload declaration with the following code:
use overload
'+' => 'add',
'-' => 'subtract',
'*' => 'multiply',
'""' => 'stringify',
fallback => 1;
Now run your tests again and all should pass.
This concludes today's post. We have learned the basics of operator overloading in Perl by building a simple 3D vector class. We covered how to overload arithmetic and stringification operators, and how to write tests to verify our implementation. With these techniques, you can make your own Perl classes behave more naturally and intuitively when used with Perl's built-in operators.
If you do feel inspired, you could continue building on this module. For example, you might add a magnitude
method and then overload the comparison operator <=>
to compare vectors. If you do come up with your own extensions or improvements, please do share them below!
In the next post we will look at phasers in Perl. Phasers are special blocks that control when certain code is executed during the compile and run phases of your program. We'll explore what each phaser does, when it runs, and practical examples of how you can use them.
Continue with the blog series, in this post, I am talking about AWS KMS Encryption.
Please check out the link for more information:
https://theweeklychallenge.org/blog/aws-kms-encryption
Published by Steve Waring on Thursday 12 June 2025 13:48
my $mw = MainWindow->new;
my $text = $mw->Text->pack;
$text->insert('end', 'hello world', 'mytag');
$text->deleteTextTaggedWith('mytag');
MainLoop;
The deleteTextTaggedWith
causes:
Can't locate auto/Tk/Text/deleteTextT.al in @INC (@INC entries checked: /etc/perl /usr/local/lib/x86_64-linux-gnu/perl/5.38.2 /usr/local/share/perl/5.38.2 /usr/lib/x86_64-linux-gnu/perl5/5.38 /usr/share/perl5 /usr/lib/x86_64-linux-gnu/perl-base /usr/lib/x86_64-linux-gnu/perl/5.38 /usr/share/perl/5.38 /usr/local/lib/site_perl) at Programs/weird.pl line 10.
Why is this?
Published by /u/tseeling on Thursday 12 June 2025 13:41
I have added a new module to a big, existing system. There is an established framework for DB2 access, and it does internal caching of the connection handle. When activating my new module we notice handling time goes up - a lot, factor 10-25 from avg. 0.2 seconds to something up to 5 seconds but wildly varying. This increase is visible throughout the whole system, not just my addition, so I'm not sure my module is really to blame for that.
The framework takes care of reconnecting when the handle has expired but I don't know about the lifetime of a DBI handle, and I have no idea if this is a perl DBI or DB2 issue. Basically it works whether the handle is still valid or not, but we're concerned about the execution time.
Is it possible to verify the validity of a cached DBI handle so that I can add some debugging output about the state of the DB2 connection to further narrow down the problem?
Or someone can suggest some pointers for me for further research?
Published by /u/briandfoy on Thursday 12 June 2025 11:31
Today we are going to discuss Perl subroutine prototypes, which are a way to enforce a certain structure on the arguments passed to subroutines. Prototypes can help catch errors early and make your code more readable.
In Perl, subroutine prototypes are used to define the expected number and types of arguments that a subroutine should receive. They are specified in the subroutine declaration and can include various modifiers. The prototype is placed immediately after the subroutine name. Here’s a simple example:
sub my_subroutine ($$) {
my ($arg1, $arg2) = @_;
print "Argument 1: $arg1\n";
print "Argument 2: $arg2\n";
}
In this example, the prototype ($$)
indicates that my_subroutine
expects exactly two scalar arguments. If you call it with the wrong number of arguments, Perl will throw an error.
You can also use prototypes to enforce that a subroutine receives a key-value list or hash. For example:
sub my_hash_subroutine (%) {
my %args = @_;
print "Arguments as hash:\n";
foreach my $key (keys %args) {
print "$key => $args{$key}\n";
}
}
In this case, the prototype (%)
indicates that my_hash_subroutine
expects a hash as its argument. When you call it, you should pass a hash. If you do not for example you pass a odd number of arguments, Perl will again throw an error.
The following table summarises common Perl subroutine prototypes:
Prototype | Meaning |
---|---|
'$' | Scalar value |
'@' | Array value (flattens list) |
'%' | Hash value (flattens list) |
'&' | Code block (subroutine reference) |
'*' | Typeglob |
';' | Separates mandatory and optional arguments |
'[$@%&*]' | Reference to scalar, array, hash, code, or typeglob |
'[]' | Optional argument (used in documentation, not in actual prototypes) |
Today we will apply this concept in a practical example, we will create a new functional Perl module that exports functions with prototypes to demonstrate there usage. Our module will be a basic statistics module that calculates the min, max, mean and median of a list of numbers. We will also allow them to specify a code reference as the first argument to be used to coerce the subsequent list. Think of it like custom grep
or map
keywords for basic statistics. Let's start by creating a new distribution using Module::Starter
we will call it Stats::Basic
.
module-starter --module="Stats::Basic" --author="Your Name" --email="your email"
First lets add a new test file t/01-basic.t
to test our module. We will start by accessing functions by namespace and add the exporting at the end. The first function we will implement is min
, which will return the minimum value from a list of numbers. Add the following to the test file:
use Test::More;
use Stats::Basic;
my $min = Stats::Basic::min { $_ } 5, 1, 3, 2, 4;
is($min, 1, 'Minimum value is correct');
my $min = Stats::Basic::min { $_->{num} } (
{ num => 5 },
{ num => 1 },
{ num => 3 },
{ num => 2 },
{ num => 4 }
);
is($min, 1, 'Minimum value from hash is correct');
done_testing();
Even some experienced Perl developers may not realise this, but when you define a subroutine prototype with a code reference as an argument, you don't explicitly use the sub
keyword before the code reference. Perl automatically recognises that the argument is expected to be a code reference and will automagically figure it out, I find this to be a particularly elegant feature and will make our final implementation cleaner. Now let's implement the min
function in our module. Open lib/Stats/Basic.pm
and add the following code replacing the function1
placeholder:
=head2 min
Returns the minimum value from a list of numbers or a list of numbers.
my $min = min { $_ } 5, 1, 3, 2, 4;
=cut
sub min (&@) {
my ($code, @numbers) = @_;
@numbers = sort {
$a <=> $b
} map { $code->($_) } @numbers;
return $numbers[0];
}
As you can see we have declared our prototype &@
this signifies to Perl that our function accepts a code reference as the first argument and a list as the second. We use map to iterate over the numbers calling the code reference on each item, then the result of that is passed to sort where we sort in ascending numerical order using $a <=> $b
. Finally, we return the first element of the sorted array, which will be the minimum value.
If you now run your tests using prove you will see that our basic tests pass:
prove -lv t/
Next lets extend our test file with tests for the max
function.
my $max = Stats::Basic::max { $_ } 5, 1, 3, 2, 4;
is($max, 5, 'Maximum value is correct');
$max = Stats::Basic::max { $_->{num} } (
{ num => 5 },
{ num => 1 },
{ num => 3 },
{ num => 2 },
{ num => 4 }
);
is($max, 5, 'Maximum valus is correct');
Now to implement we take a very similar approach to min
but switch the sorting.
=head2 max
Returns the maximum value from a list of numbers or a list of numbers.
my $max = max { $_ } 5, 1, 3, 2, 4;
=cut
sub max (&@) {
my ($code, @numbers) = @_;
@numbers = sort {
$b <=> $a
} map { $code->($_) } @numbers;
return $numbers[0];
}
With that in place run your tests again and all should pass. Next we will add the sum
function. Lets first add the tests.
my $sum = Stats::Basic::sum { $_ } 5, 1, 3, 2, 4;
is($sum, 15, 'Sum value is correct');
$sum = Stats::Basic::sum { $_->{num} } (
{ num => 5 },
{ num => 1 },
{ num => 3 },
{ num => 2 },
{ num => 4 }
);
is($sum, 15, 'Sum value is correct');
Now to implement this in lib/Stats/Basic.pm
:
=head2 sum
Returns the sum value from a list of numbers.
my $sum = sum { $_ } 5, 1, 3, 2, 4;
=cut
sub sum (&@) {
my ($code, @numbers) = @_;
my $sum = 0;
map { $sum += $code->($_) } @numbers;
return $sum;
}
The logic is simple we have again defined the &@
prototype, this time we define a variable $sum
initialised to 0, then use map
to iterate over the numbers, applying our code reference to each item and adding the result to our running total. Finally, we return the accumulated sum. If you run your tests they will pass once again. The final function we are going to implement is mean. The mean is just the sum
divided by the number of items so we should be able to reuse the function we just wrote. Lets first write the tests.
my $mean = Stats::Basic::mean { $_ } 5, 1, 3, 2, 4;
is($mean, 3, 'Mean value is correct');
$mean = Stats::Basic::mean { $_->{num} } (
{ num => 5 },
{ num => 1 },
{ num => 3 },
{ num => 2 },
{ num => 4 }
);
is($mean, 3, 'Mean value is correct');
To implement update your lib/Stats/Basic.pm
by adding the following:
=head2 mean
Returns the mean value from a list of numebrs
my $mean = sum { $_ } 5, 1, 3, 2, 4;
=cut
sub mean (&@) {
my ($code, @numbers) = @_;
my $sum = sum {$code->($_)} @numbers;
return $sum / scalar @numbers;
}
We reuse the sum function but there is a caveat - we can't call it directly with our existing code reference. Instead, we need to create a new code reference that calls our original code reference from within. We then divide the sum by the total number of passed arguments to get the mean.
Now if you run your tests they should all pass and you now have a basic statistic module. The final task we need to complete though is the exporting of our functions so we can access them without the namespace. To do this add the following under the version declaration.
use parent 'Exporter';
our @EXPORT_OK = qw/min max sum mean/;
And that completes this post on subroutine prototypes in Perl. Through our Stats::Basic
module, we've demonstrated how prototypes can be used to validate arguments and create functions that feel like natural extensions to the Perl language, similar to built-in keywords like grep
and map
. In the next post, we'll explore overloading of operators, which will allow you to write custom behaviour for your objects when used with certain operators.
Published by /u/inhplease on Wednesday 11 June 2025 19:29
Just got out of a Perl job interview and I’m still scratching my head.
One of the questions was about extracting multiple values from a hash. So naturally, I used a hash slice. Interviewer immediately stopped me and said, “That’s not valid Perl.”
I tried to explain what a hash slice is, even pointed out it’s a super common in idiomatic Perl. But they just doubled down and said I must be confused and that hashes can’t be indexed like arrays. 😐
They moved on, but I could tell I’d already been mentally disqualified. Got the rejection email later today. Honestly getting dinged because I used a core Perl feature that they didn’t know? That stings.
Weirdly, this isn’t the first time. Many years ago, I interviewed at Rent.com in Santa Monica, and one of the folks there also didn’t know what a hash slice was—but at least they still offered me the job!!
UPDATE: I am still looking for a position, so please DM me if you have something. Thanks.
In programming file processing is a key skill to master. Files are essential for storing data, reading configurations, and logging information. A file handle is a reference to an open file, allowing you to read from or write to that file. Today I will show you how to work with files in Perl
In Perl, file handles are used to interact with files. You can open a file for reading, writing, or appending. There are multiple ways to open a file, but the most common method is using the open
keyword. The open
keyword takes three arguments: a file handle, a mode, and the filename. The mode specifies how you want to interact with the file. There are multiple modes available you can use the following table as a reference to common file modes in Perl:
Mode | Description | Example Usage |
---|---|---|
< |
Read-only | open(FH, "<", "file.txt") |
> |
Write (truncate file) | open(FH, ">", "file.txt") |
>> |
Append | open(FH, ">>", "file.txt") |
+< |
Read/write (no truncate) | open(FH, "+<", "file.txt") |
+> |
Read/write (truncate file) | open(FH, "+>", "file.txt") |
+>> |
Read/write (append) | open(FH, "+>>", "file.txt") |
:raw |
Binary mode (no translation) | open(FH, "<:raw", "file.bin") |
:utf8 |
UTF-8 encoding for reading | open(FH, "<:utf8", "file.txt") |
When you open a file, you need to specify the file handle, which is a variable that will hold the reference to the opened file. You also need to pass either a relative or absolute path to the file you want to open. open will return true if the file is opened successfully, or false if it fails. It is a good practice to check the return value of open
and handle any errors appropriately.
You can use the die
function to print an error message and exit the program if the file cannot be opened. This is a common practice to ensure that your program does not continue running with an invalid file handle.
Here is an example of how to open a file for reading in Perl:
open(my $fh, '<', 'file.txt') or die "Could not open file: $!";
The $fh
variable is the file handle that will be used to read from file.txt
. The <
mode indicates that we are opening the file for reading. The or die
part is used to handle any errors that may occur while trying to open the file. If the file cannot be opened, it will print an error message and terminate the program.
Once the file is opened successfully, you can read from it using various pragmas like readline
and <FH>
. Here is an example of reading a file line by line:
while (my $line = <$fh>) {
print "$line"; # Print each line
}
After you are done reading from the file, it is important to close the file handle to free up system resources. You can do this using the close
keyword:
close($fh) or die "Could not close file: $!";
This will close the file handle and ensure that any changes made to the file are saved properly. If the close operation fails, it will print an error message and terminate the program.
As well as manipulating files, Perl also provides a simple way to manipulate directories. You can use the opendir
keyword to open a directory. The readdir
keyword can be used to read the entries in the directory one by one. And closedir
can be used to close the directory handle. Here is an example of how to read a directory:
opendir(my $dir, '/path/to/directory') or die "Could not open directory: $!";
while (my $entry = readdir($dir)) {
next if ($entry =~ /^\.\.?$/); # Skip '.' and '..'
print "$entry\n"; # Print each entry
}
closedir($dir) or die "Could not close directory: $!";
This code opens a directory, reads its entries, and prints each entry to the console. The next
statement is used to skip the special entries .
and ..
, which represent the current and parent directories, respectively.
As well as opening, reading and writing files and directories perl also has several flags that can be used to first test whether a file or directory exists you can use the following table as a reference:
Flag | Description | Example Usage |
---|---|---|
-e | File or directory exists | -e "file.txt" |
-f | Is a plain file | -f "file.txt" |
-d | Is a directory | -d "mydir" |
-r | File or directory is readable | -r "file.txt" |
-w | File or directory is writable | -w "file.txt" |
-x | File or directory is executable | -x "script.pl" |
-s | File has nonzero size (returns size in bytes) | -s "file.txt" |
-z | File has zero size | -z "empty.txt" |
-T | File is a text file | -T "file.txt" |
-B | File is a binary file | -B "file.bin" |
-l | Is a symbolic link | -l "symlink" |
-o | File is owned by the effective user | -o "file.txt" |
-O | File is owned by the real user | -O "file.txt" |
-g | File has setgid bit set | -g "file.txt" |
-u | File has setuid bit set | -u "file.txt" |
-k | File has sticky bit set | -k "file.txt" |
-p | File is a named pipe (FIFO) | -p "pipe" |
-S | File is a socket | -S "mysocket" |
-b | File is a block special file | -b "blockdev" |
-c | File is a character special file | -c "chardev" |
Today as an example to learn how to work with files in Perl, we will create a simple module called Personal::Log
that will handle logging message to a file and then parsing the log file back to display the historical messages. This module will demonstrate how to open, write to, and read from a file in Perl.
First we will create the distribution, to do this we will use the Module::Starter
module.
module-starter --module="Personal::Log" --author="Your Name" --email="your email"
This command will create a new directory called Personal-Log
, which contains the basic structure of a Perl module distribution. Inside this directory, you will find a file named Log.pm
where we will implement our logging functionality. First we will create a test file to test our module, we will create a file called t/01-log.t
with the following content:
use Test::More;
use_ok("Personal::Log");
my $file = 'test.log';
my $log = Personal::Log->new(file => $file);
isa_ok($log, 'Personal::Log', 'Log object created');
is_deeply($log, { file => 'test.log', lines => [] }, 'Log object has correct file attribute');
done_testing();
We are have setup a basic test to check if our Personal::Log
module can be instantiated correctly and if it has the correct attributes. We have two accessors for our object, file
and lines
. The file
attribute will hold the name of the log file, and the lines
attribute will hold the lines read from the log file.
Next we will implement a basic new
method in our lib/Personal/Log.pm
file to create a new log object. Open the Log.pm
file and add the following code replacing function1
.
=head2 new
Constructor for the Personal::Log object.
my $log = Personal::Log->new(file => 'test.log');
=cut
sub new {
my ($self, %args) = @_;
if ( -f $args{file} ) {
open my $fh, '<', $args{file} or die "Could not open file '$args{file}': $!";
$args{lines} = [ <$fh> ];
close $fh;
} else {
$args{lines} = [];
}
return bless \%args, $self;
}
This new
method checks if the specified log file exists. If it does, it opens the file for reading and reads all lines into the lines
attribute. If the file does not exist, it initializes lines
as an empty array reference.
Next, we will implement a method to log messages to the file. First lets add new tests to our t/01-log.t
file to test the logging functionality. Add the following code after the existing tests, we will return the line we add to the log:
is($log->log("This is a test message"), "This is a test message", 'Log message added successfully');
is($log->log("Another message"), "Another message", 'Another log message added successfully');
Next, we will implement the log
method in our lib/Personal/Log.pm
file. The log function will just log the line of text to the file and will return the line that was logged. Add the following code to the Log.pm
file:
=head2 log
Logs a message to the log file.
$log->log("This is a log message");
=cut
sub log {
my ($self, $message) = @_;
push @{$self->{lines}}, "$message\n";
open my $fh, '>>', $self->{file} or die "Could not open file '$self->{file}': $!";
print $fh "$message\n";
close $fh;
return $message
}
This log
method appends the message to the lines
attribute and writes it to the log file. It opens the file in append mode (>>
), writes the message, and then closes the file.
Now we can run our tests to ensure that the logging functionality works as expected. Run the following command in your terminal:
prove -lv t/01-log.t
If everything is set up correctly, you should see output indicating that all tests passed. This means our Personal::Log
module can successfully log messages to a file. You will also see the test.log
file created in your project directory with the logged messages. Each time you run the tests, the log file will be appended with the test messages. However, if you do run the test currently more than once it will 'fail' because we now parse the lines. To fix this we will actually need to delete
the log file when our test ends. To do this we can use the unlink
keyword, which will delete the file at the end of each run. Add the following before done_testing in t/01-log.t
:
unlink $file;
Now run your tests again twice
and the second time it will pass as the log file will be deleted after the tests have run each time.
Finally, we will implement a method to print the current log messages to the command line. To do this add the following test to our t/01-log.t
file after the existing tests and before the unlink
line:
is($log->print_log, 1, 'Log messages printed successfully');
Now to implement the print_log
method we will simply itterate the internal array which should contain all rows that exist in the log file and print each message to the terminal. Add the following code to your lib/Personal/Log.pm
file:
=head2 print_log
Prints all logged messages to STDOUT.
$log->print_log();
=cut
sub print_log {
my ($self) = @_;
foreach my $line (@{$self->{lines}}) {
print $line;
}
return 1;
}
This print_log
method iterates over the lines
attribute and prints each message to the standard output. It returns 1
to indicate success. Now you can run your tests again and you should see the output of the log messages printed to the terminal. This completes our simple logging module in Perl.
There are many more advanced features you can implement in a logging module, such as a timestamp, different log levels (info, warning, error), log rotation and more. However, this example provides a solid foundation for understanding how to work with files and file handles in Perl and we will leave it here.
In the next post we will explore subroutine prototypes and how they can be used to validate arguments you pass to functions. Subroutine prototypes in Perl allow you to specify the expected types and number of arguments for your functions, providing compile-time checking and enabling you to create functions that behave more like built-in Perl operators. We'll see how prototypes can make your code more robust and how they enable advanced features like creating your own control structures. Until then if you have any questions ask away.
Published by /u/briandfoy on Wednesday 11 June 2025 11:31
In the last post we discussed Object Oriented Programming in Perl, focusing on the basics of creating an object. In this post, we will delve into inheritance, a powerful feature of programming that allows us extend existing code with new functionality.
Inheritance is a concept that allows code to be reused and extended, and it appears in both object-oriented and functional programming, though in different ways:
In Object-Oriented Programming (OOP) inheritance means creating a new class (child or subclass) that automatically gets the properties and methods of an existing class (parent or superclass). The child class can use, override, or extend the parent’s behaviour. This helps organise code, avoid duplication, and build on existing functionality.
While functional programming doesn’t have classes, code reuse is achieved by sharing and composing functions.
In perl you can implement inheritance for any package whether it is functional or object-oriented. You can achieve this by manipulating something known as the @ISA
array, which is a special array that holds the names of parent classes for a given class. A package will inherit from all packages found in its @ISA
array. The @ISA
array is generated by default when you use
a package, it will be empty unless you explicitly set it. An example of this is shown below:
package Baz;
BEGIN {
require Foo;
require Bar;
push @ISA, qw(Foo Bar);
}
The require
statements will be new to you, like use
, require
is a way to include other Perl modules or packages in your code. The difference is that use
is evaluated at compile time, while require
is evaluated at runtime. This means that require
can be used conditionally, and it will not throw an error if the module is not found until the code is actually executed. We wrap all the code in a BEGIN
block to ensure that it is executed at compile time, before the package is fully loaded. This allows us to modify the @ISA
array before the package is used. The push @ISA, qw(Foo Bar);
line adds Foo
and Bar
to the @ISA
array, meaning that Baz
will inherit from both of these classes.
Setting the @ISA
array directly like this is one way to implement inheritance in Perl, but it can be a bit cumbersome and error-prone, hence Perl provides some built-in pragmas to make this easier and more reliable. There are two common pragmas for this purpose: base
and parent
. They both allow you to specify a list of parent classes for your package to inherit from, the base
pragma is just the older of the two and parent
is the newer, now recommended approach, it has less cruft.
To use the parent
pragma, you simply include it at the top of your package like this:
package Baz;
use parent qw(Foo Bar);
This line tells Perl that Baz
is a subclass of Foo
and Bar
, and it will automatically set up the @ISA
array for you.
Today, we’re continuing from our last post by creating a new subclass of the Note object we previously built. If you’ve been following along, this will actually be the second time we’ve used inheritance in this series.
In the Exporter post, we inherited from the Exporter module. That inheritance allowed us to take all the functionality of the module and make it available within our own package. The key method involved in that process was the import method. A special method that's automatically called when a package is used. This lets it perform actions like exporting functions in our case. We'll dive deeper into how that works in a future post on monkey patching.
In today’s example, when we inherit from our Note object, we’re doing the same thing but this time we're gaining access to all the functionality we wrote in the previous post. From there, we can extend it however we like to suit new needs.
Today we will extend our Note
object to create a new subclass called Ingredient
. This will allow us to add specific functionality for ingredient items while still retaining all the features of the original Note
object. For the Ingredient
object, we will add new properties quantity
and unit
, which are specific to ingredients. We will also need to modify the new
method to validate these new properties and ensure they are set correctly when creating a new Ingredient
object. Finally, we will need to fix the info
method to include the new properties in the output.
First lets create a new test file for our new Ingredient
object. We will call it t/02-ingredient.t
. This file will contain the tests for our new Ingredient
object, ensuring that it behaves as expected and meets our requirements. We will start by creating a basic test file that loads the Ingredient
module and checks that it can be used without errors with the existing inherited functionality. Here is the initial content of t/02-ingredient.t
:
use Test::More;
use Test::More;
use_ok('Ingredient');
my $ingredient = Ingredient->new(
title => 'apple',
description => 'fresh red apple',
);
my $last_changed = qr/\w{3}\s+\w{3}\s+\d{1,2}\s+\d{1,2}\:\d{2}\:\d{2}\s+\d{4}/;
is($ingredient->title, 'apple', 'Title is set correctly');
is($ingredient->description, 'fresh red apple', 'Description is set correctly');
like($ingredient->last_changed, $last_changed, 'Last changed is set correctly');
done_testing();
This code should be familiar to you, we are just testing the basic functionality we created in the previous post. Now we will create the Ingredient
package itself. We will create a new file called lib/Ingredient.pm
. This file will contain the implementation of the Ingredient
object, which will inherit from the Note
object. Here is the initial content of lib/Ingredient.pm
that we will then expand upon:
package Ingredient;
use 5.006;
use strict;
use warnings;
=head1 NAME
Ingredient - The great new Ingredient!
=head1 VERSION
Version 0.01
=cut
our $VERSION = '0.01';
use parent qw/Note/;
=head1 SYNOPSIS
Quick summary of what the module does.
Perhaps a little code snippet.
use Ingredient;
my $ingredient = Ingredient->new(
title => 'apple',
description => 'fresh red apple',
quantity => 1,
unit => 'whole'
);
$ingredient->info; # Returns a string with the note's information
$ingredient->title; # Returns the title of the ingredient
$ingredient->description; # Returns the description of the ingredient
$ingredient->quantity; # returns the required amount of the ingredient
$ingredient->unit; # return the measurement unit for the ingredient
$ingredient->last_changed; # Returns the last changed time in a formatted string
$ingredient->title('Updated Note'); # Updates the title of the note
$ingredient->description('Updated description'); # Updates the description of the note
$ingredient->quantity(100);
$ingredient->unit('grams');
=head1 SUBROUTINES/METHODS
=head2 new
Instantiate a new Ingredient object
Ingredient->new(%args);
=cut
=head2 title
Accessor to get and set title attribute
$ingredient->title()
=cut
=head2 description
Accessor to get and set description attribute
$ingredient->description()
=cut
=head2 quantity
Accessor to get and set quantity attribute
$ingredient->quantity()
=cut
=head2 unit
Accessor to get and set unit attribute
$ingredient->unit()
=cut
=head2 last_changed
Accessor to access last_changed attribute, returns the epoch in localtime format.
$ingredient->last_changed
=cut
=head2 info
Returns a string with the note's information, including title, description, quantity, unit, and last changed time.
$ingredient->info();
=cut
1; # End of Ingredient
This code sets up the basic structure of the Ingredient
package, including the necessary documentation. The only code added from a default package declaration is the use parent qw/Note/;
line which indicates that Ingredient
is a subclass of Note
, allowing it to inherit all the properties and methods defined in the Note
package.
Now if you run the test file t/02-ingredient.t
, you should see that it passes successfully, indicating that the Ingredient
object can be created and that it inherits the functionality from the Note
object.
We are now ready to extend the Ingredient
object with the new properties quantity
and unit
. We will need to first modify the new
method to validate these new properties. By default they will already populate the internal hash, however any value will be accepted and this would then cause us potential unexpected issues later on.
Luckily in Perl it is easy to update functionality of our inherited objects in a way that we can still use the parent's functionality. In this case, we don't want to completely overwrite the parent's method and reimplement everything from scratch. Instead, we want to extend the method so that it still calls the parent, after we have validated the new arguments.
In Perl, we can do this using the SUPER
pragma. The SUPER
pragma allows you to call the parent class's method from within the child class.
To extend the new
method in the Ingredient
package, we will validate the quantity
and unit
properties, and then call the parent class's new
method using SUPER::new
. The quantity property should be a positive number and the unit property should be one of a predefined set of units. For the units we will create a global variable called %UNITS
that will contain the valid units we can then use to validate against. First lets update our test file to include the additional tests for the new properties:
$ingredient = Ingredient->new(
title => 'apple',
description => 'fresh red apple',
quantity => 1,
unit => 'whole'
);
is($ingredient->{quantity}, 1);
is($ingredient->{unit}, 'whole');
eval {
Ingredient->new(
quantity => { not => 'valid' },
unit => 'grams'
);
};
like($@, qr/quantity must be a positive integer/, 'quantity validation works');
eval {
Ingredient->new(
quantity => 1,
unit => 'invalid'
);
};
like($@, qr/unit must be a valid measurement/, 'unit validation works');
Then in preperation for the new new
method, we will create a global variable %UNITS
that contains the valid units we want to allow. Add the following code under the use parent qw/Note/;
line in the Ingredient.pm
file:
our %UNITS = (
'whole' => 1,
'grams' => 1,
'litres' => 1,
'cups' => 1,
'tablespoons' => 1,
'teaspoons' => 1,
);
Now we can implement the new
method in the Ingredient
package. This method will validate the quantity
and unit
properties, and then call the parent class's new
method using SUPER::new
. Here is the updated new
method:
sub new {
my ($class, %args) = @_;
# Validate quantity
if (defined $args{quantity}) {
die "quantity must be a positive integer"
unless ! ref $args{quantity} && $args{quantity} =~ m/^\d+$/ && $args{quantity} > 0;
}
# Validate unit
die "unit must be a valid measurement" if defined $args{unit} && ! exists $UNITS{$args{unit}};
# Call the parent class's new method
return $class->SUPER::new(%args);
}
This new
method first checks if the quantity
is defined and is a positive integer. If not, it throws an error. Then it checks if the unit
is defined and if it exists in the %UNITS
hash. If not, it throws an error as well. Finally, it calls the parent class's new
method using SUPER::new
, passing along the validated arguments. Now if you run the test file t/02-ingredient.t
, you should see that all tests pass successfully, indicating that the Ingredient
object can be created with the new properties and that the validation works as expected.
Next we will implement the relevant accessors for the new properties quantity
and unit
. These accessors will allow us to get and set the values of these properties. First we will add tests for the accessors in the t/02-ingredient.t
file:
is($ingredient->quantity, 1, 'Quantity is set correctly');
is($ingredient->unit, 'whole', 'Unit is set correctly');
is($ingredient->quantity(200), 200, 'Quantity can be updated');
is($ingredient->unit('grams'), 'grams', 'Unit can be updated');
Now we can implement the accessors in the Ingredient
package. Lets add the quantity
by inserting the following code after the quantity PDD declaration:
sub quantity {
my ($self, $value) = @_;
if (defined $value && !ref $value && $value =~ m/^\d+$/ && $value > 0) {
$self->{quantity} = $value;
$self->{last_changed} = time; # Update last changed time
}
return $self->{quantity};
}
We are following the same pattern as we did for the title
and description
accessors. Here check if the value is defined, not a reference, is a positive integer, and then set the value in the object’s internal hash. We also update the last_changed
time to reflect that the object has been modified. We do not error out if the value is not valid, instead we just return the current value. Next we will implement the unit
accessor by inserting the following code after the relevant POD declaration:
sub unit {
my ($self, $value) = @_;
if (defined $value && exists $UNITS{$value}) {
$self->{unit} = $value;
$self->{last_changed} = time; # Update last changed time
}
return $self->{unit};
}
This again follows the same pattern, this time we simply need to check if the passed value is in our global %UNITS
variable. We also remember to update the last_changed
time to reflect that the object has been modified.
With both of those accessors in place your tests should now pass once again. The final task to complete our Ingredient object is to update the existing info
method to reflect the new information we now have available. To do this we will just overwrite it's existing functionality so not call SUPER
. Lets add our final test of the day:
like($ingredient->info, qr/Ingredient: apple, Description: fresh red apple, Quantity: 200 grams, Last Changed: $last_changed/, 'Info method returns correct information');
Now to implement the info
method, we will add the following code to the Ingredient
package:
sub info {
my ($self) = @_;
return sprintf(
"Ingredient: %s, Description: %s, Quantity: %s %s, Last Changed: %s",
$self->{title},
$self->{description},
$self->{quantity},
$self->{unit},
scalar localtime($self->{last_changed})
);
}
None of this should be new to you, it's the same pattern we used in the Note
object, but now we have changed some wording and included the quantity
and unit
properties in the output string.
Now if you run the test file t/02-ingredient.t
, you should see that all tests pass successfully, indicating that the Ingredient
object has been successfully created with the new properties and functionality.
This concludes our exploration of inheritance in Perl. We have seen how to create a subclass that inherits from a parent class, how to extend the functionality of the parent class, and how to add new properties and methods specific to the subclass. Inheritance is a powerful feature that allows us to build on existing code, making it easier to maintain and extend our applications.
We could continue to extend the Ingredient
object further, for example by adding methods to convert between different units or to calculate the total cost of an ingredient based on its quantity and price per unit. We could also go further and create an Recipe
object that also inherited from Note
but used Ingredient
objects to represent the ingredients in a recipe. However, I will let you use your own imagination on how you would implement that.
In the next post, we will move onto file handles. We will explore the different modes of file handling, how to read from and write to files, and how to handle errors when working with files. This will be an important step in building more complex applications that need to persist data to disk.
Published by /u/briandfoy on Tuesday 10 June 2025 11:31
Published by Leont on Monday 09 June 2025 23:15
Use PerlLIO_dup_cloexec in Perl_dirp_dup to set O_CLOEXEC dup doesn't mark the new descriptor as close-on-exec, which can lead to a descriptor leaking to the new process.
Object-Oriented Programming (OOP) is a widely used programming paradigm that enables the creation of objects that encapsulate both data and behaviour. These objects can represent virtually anything you can imagine, there are no strict limits on what you can create. It's all about how you choose to structure your code.
By encapsulating related data and behaviour, objects promote cleaner, more organised, and maintainable code. A key feature of object orientation also is inheritance, which allows you to define new classes based on existing ones, enabling code reuse and extension of functionality.
When used correctly, objects are a powerful tool for writing robust and scalable software. In this post, we’ll explore how to create and work with objects in Perl, where object orientation is a core part of the language.
In Perl, object orientation is implemented using packages. A package is a namespace that allows you to group related code together. You can create a package by using the package
keyword followed by the name of the package.
We have created a package before but used it functionally by creating an exporter, to turn a package into an object we need to simply define a constructor method that will bless
a reference into the package. The bless
function associates an object with a class, which is represented by a package. It is that simple.
In Perl the constructor method is usually called new
, but you can name it anything you want. The new
method is responsible for creating a new object and initialising its attributes.
Note how now I talk about functions as methods, this is because in object orientation, functions that are associated with a class are called methods. Methods are just like regular functions, but they are called on an object and can access the object's attributes. This all works transparently in Perl, so you can use the same syntax as you would for a regular function (by name). The only difference is that you need to call the method on an object, which is done using the arrow operator ->
.
I will also use the term accessor
to refer to methods that get or set attributes of an object. Accessors are a common pattern in object-oriented programming, and they allow you to encapsulate the access to an object's attributes. An attribute is a variable that is associated with an object. In Perl, attributes are usually stored in a hash reference you bless
, which allows you to easily add or remove them as needed. Although this is not always the case and understand also an object does not need to be a hash internally it can be any scalar reference for example an array. You would take a different approach to accessors in that case.
Today we will start simple and create a object that represents a note
. The note will have a title, content, and a last_changed time. We will create a constructor method that will initialise these attributes and a method that will return the note's information as a string. We will also create accessor methods that will allow us to change the note's title and content triggering an update of the last_changed time. To achieve this we will use only core
Perl, so no need to install any modules.
First, we will create a new distribution useing the Module::Starter
module. This will create a new directory with the necessary files to start a new Perl module. We will call our module Note
.
module-starter --module="Note" --author="Your Name" --email="your email"
With that done, we can test the module is setup correctly by running the following command:
cd Note
prove -lv t/
This will run the tests in the t/
directory and show the output. If everything is set up correctly, you should see a message saying that all tests passed. Now with the basic structure in place, we can write a test to plan our object. We will create a test file in the t/
directory called 01-note.t
. This file will contain the tests for our Note
module. We will do this progressively first we will simply test instantiating the object.
use Test::More;
use_ok('Note');
my $note = Note->new();
isa_ok($note, 'Note', 'Created a Note object');
done_testing();
Next, we will implement the code needed to pass the test. open the lib/Note.pm
and replace the function1
definition with the following:
=head2 new
Instantiate a new Note object
my $note = Note->new(%args);
=cut
sub new {
my ($pkg, %args) = @_;
bless \%args, $pkg;
}
Now we can run the test again to see if it passes:
prove -lv t/01-note.t
It should pass and that is how simple it is to create an basic object in Perl. Now for our example it is a little more complex, we want to have a title, content and a last modified time which is dynamically calculated. We should add validation to ensure that the title and content are strings when instantiating the object. We should also set the last modified time to the current time when the object is created. Lets first extend our test for our new functionality, add this above the done_testing
line in t/01-note.t
:
$note = Note->new(title => 'Test Note', description => 'This is a test note');
is($note->{title}, 'Test Note', 'Title is set correctly');
is($note->{description}, 'This is a test note', 'Description is set correctly');
like($note->{last_changed}, qr/\d+/, 'last_changed is set to an epoch');
eval {
Note->new(title => { invalid => 'title' }, description => 'This is a test note');
};
like($@, qr/title must be a string/, 'title validation works');
eval {
Note->new(title => 'Test Note', description => { invalid => 'description' });
};
like($@, qr/description must be a string/, 'description validation works');
As you can see we are accessing the attributes directly using the hash reference syntax. If you run the test you will see the first two tests pass but the rest fail. To implement the functionality we will modify the new
method in lib/Note.pm
to look like this:
sub new {
my ($pkg, %args) = @_;
for my $key (qw/title description/) {
die "$key must be a string" if ref $args{$key};
}
$args{last_changed} = time;
bless \%args, $pkg;
}
With this change, we are checking that the title
and description
are strings and setting the last_changed
to the current time. Now if you run the test again, it should pass all tests. Undef also passes the validation, this is expected behaviour as we have a test for instantiating the object without any arguments. the last_changed attribute is always set to the current epoch time, this is a common way to represent time in programming, we will then use this later to convert to a human readable format via our accessor.
Next lets write the accessor methods for the title
, description
, and last_changed
attributes. We will do one at a time, starting with the title
method. First we will add a test for the title
accessor in t/01-note.t
our title accessor will be a simple getter and setter. Add the following test after the previous tests:
is($note->title, 'Test Note', 'note accessor title getter works');
is($note->title('Updated Note'), 'Updated Note', 'note accessor title setter works');
is($note->title, 'Updated Note', 'note accessor title getter works after update');
Now we will implement the title
accessor in lib/Note.pm
. Add the following code replacing the function2
definition:
=head2 title
Accessor to get and set title attribute
$note->title()
=cut
sub title {
my ($self, $title) = @_;
if (defined $title && ! ref $title) {
$self->{title} = $title;
$self->{last_changed} = time;
}
return $self->{title};
}
If you run the test again, it should pass the tests for the title
accessor. Next we will implement the description
accessor in a similar way. Add the following test after the previous tests in t/01-note.t
:
is($note->description, 'This is a test note', 'note accessor description getter works');
is($note->description('This is an updated test note'), 'This is an updated test note.', 'note accessor description setter works');
is($note->description, 'This is an updated test note', 'note accessor description getter works after update');
We will implement the description
accessor in lib/Note.pm
. Add the following code after the title
accessor:
=head2 description
Accessor to get and set description attribute
$note->description($description)
=cut
sub description {
my ($self, $description) = @_;
if (defined $description && ! ref $description) {
$self->{description} = $description;
$self->{last_changed} = time;
}
return $self->{description};
}
Now if you run the test again, it should pass the tests for the description
accessor. Next we will implement the last_changed
accessor. This should only be a getter and should return a user friendly formatted string of the epoch time. Add the following test after the previous tests in t/01-note.t
:
like($note->last_changed, qr/\w{3}\s+\w{3}\s+\d{1,2}\s+\d{1,2}\:\d{2}\:\d{2}\s+\d{4}/, 'note accessor last_changed returns a formatted string');
The regular expression checks that the last changed time is in the format of a human-readable date (e.g., "Mon Jun 9 20:42:45 2025"). This will ensure that the last_changed
accessor returns a formatted string. We can't check the exact time as that will change each time our script runs, there are ways of 'mocking' time but that is for another lesson. Next we will implement the last_changed
accessor in lib/Note.pm
. Add the following code after the description
accessor:
=head2 last_changed
Accessor to get last_changed attribute, returns the epoch in localtime format.
$note->last_changed
=cut
sub last_changed {
my ($self) = @_;
return scalar localtime($self->{last_changed});
}
This accessor will return a formatted string of the epoch time in localtime format (Mon Jun 9 20:42:45 2025). The localtime
function is a core function that can be used to convert an epoch time to a human-readable format. Now if you run the test again, it should pass the tests for the last_changed
accessor.
Finally, we will implement the info
method that will return a string with the note's information. Add the following test after the previous tests in t/01-note.t
:
like($note->info, qr/Note: Updated Note, Description: This is an updated test note, Last Changed: \w{3}\s+\w{3}\s+\d{1,2}\s+\d{1,2}:\d{2}:\d{2}\s+\d{4}/, 'info method returns correct string');
To implement the info
method, add the following code after the last_changed
accessor in lib/Note.pm
:
=head2 info
Method that stringifys the details of the note.
$note->info;
=cut
sub info {
my ($self) = @_;
return sprintf("Note: %s, Description: %s, Last Changed: %s",
$self->title // "", $self->description // "", $self->last_changed);
}
We are using a new function sprintf
to format the string with the note's title, description, and last changed time. sprintf
is a core function that allows you to format strings using patterns, the most simple of patterns is %s
which will be replaced by the string value of the variable passed to it. We are passing 3 arguments to match the three placeholders title, description and last_changed. We use the //
defined or operator for title and description and default them to strings because otherwise sprintf
will warn with a message around undefined values if we were to call the method with an object not instantiated with params.
Now if you run your tests again all should pass and you've just fully implemented a Note object in Perl. To finish the module you should update the SYNOPSIS
with some documentation so you remember in the future how the Note object should work.
=head1 SYNOPSIS
use Note;
my $note = Note->new(
title => 'My Note',
description => 'My first note description',
);
$note->info; # Returns a string with the note's information
$note->title; # Returns the title of the note
$note->description; # Returns the description of the note
$note->last_changed; # Returns the last changed time in a formatted string
$note->title('Updated Note'); # Updates the title of the note
$note->description('Updated description'); # Updates the description of the note
=cut
I hope you found this post useful in understanding how to create and use objects in Perl. Object orientation is a powerful paradigm that can help you write cleaner and more maintainable code. If you have any questions or suggestions, feel free to leave a comment below. Next time we will look at inheritance in Perl and how to create a object that inherits from the Note object we created today.
Published by Steve Waring on Monday 09 June 2025 19:27
Why does this code generate the warning message:
sub really()
{
&{$reallys{$reallyParent->PathName =~ s/.*\.//r}};
}
The warning message is to advise that @_ may be unavailable in future versions of perl within a subroutine using signatures. But this subroutine does not use @_. I change the declaration to:
sub really :prototype()
which has the same effect in this case, and of course the code works fine.
Published by khwilliamson on Sunday 08 June 2025 21:40
perlintern: my_cxt_init is not string handling Instead, the other cxt API elements are in XS
Published by khwilliamson on Sunday 08 June 2025 21:36
perlop: Clean up here-doc documentation The documentation for indented here-docs had a bunch of duplicated concepts with the documentation of plain here-docs. This commit melds them into a single coherent section.
Published by U. Windl on Sunday 08 June 2025 17:41
I wrote some server providing XML output with some debugging comments, like this (just a short extract):
<Result>
<Channel>DB1.PagesFreeMinPct</Channel>
<Value>55.578</Value>
<CustomUnit>%</CustomUnit>
<!--BEG: thresholds-->
<!--(igoring value: end="~")-->
<LimitMinWarning>15</LimitMinWarning>
<!--(igoring value: end="~")-->
<LimitMinError>10</LimitMinError>
<!--END: thresholds-->
</Result>
When using the output in some software named PRTG, I got this error message:
XML Parser mismatch: Wanted </!--(igoring>, got
So obviously that "XML Parser" has no idea what XML comments are; so (while waiting that the product may be fixed some day) I decided to add a quick fix to my server removing the comments (actually the comments are created by XSLT, delivering the result in $XML
).
Using $XML =~ s/<!--.*-->//g;
I was able to remove the XML comments, but I still have lines containing some indent spaces only.
So I tried to remove those lines consisting only of spaces, but failed using $XML =~ s/^\s+\n$//mg;
.
However that doesn't work.
Output would look like
<Result>
<Channel>DB1.PagesFreeMinPct</Channel>
<Value>55.578</Value>
<CustomUnit>%</CustomUnit>
<LimitMinWarning>15</LimitMinWarning>
<LimitMinError>10</LimitMinError>
</Result>
I guess my multi-line substitution is wrong.
Using $XML =~ s/^\s+$//mg;
instead still leaves some blank lines in the output.
<Result>
<Channel>DB1.PagesFreeMaxPct</Channel>
<Value>57.688</Value>
<CustomUnit>%</CustomUnit>
<LimitMinWarning>15</LimitMinWarning>
<LimitMinError>10</LimitMinError>
</Result>
Back in January, I wrote a blog post about adding JSON-LD to your web pages to make it easier for Google to understand what they were about. The example I used was my ReadABooker site, which encourages people to read more Booker Prize shortlisted novels (and to do so by buying them using my Amazon Associate links).
I’m slightly sad to report that in the five months since I implemented that change, visits to the website have remained pretty much static and I have yet to make my fortune from Amazon kickbacks. But that’s ok, we just use it as an excuse to learn more about SEO and to apply more tweaks to the website.
I’ve been using the most excellent ARefs site to get information about how good the on-page SEO is for many of my sites. Every couple of weeks, ARefs crawls the site and will give me a list of suggestions of things I can improve. And for a long time, I had been putting off dealing with one of the biggest issues – because it seemed so difficult.
The site didn’t have enough text on it. You could get lists of Booker years, authors and books. And, eventually, you’d end up on a book page where, hopefully, you’d be tempted to buy a book. But the book pages were pretty bare – just the title, author, year they were short-listed and an image of the cover. Oh, and the all-important “Buy from Amazon” button. AHrefs was insistent that I needed more text (at least a hundred words) on a page in order for Google to take an interest in it. And given that my database of Booker books included hundreds of books by hundreds of authors, that seemed like a big job to take on.
But, a few days ago, I saw a solution to that problem – I could ask ChatGPT for the text.
I wrote a blog post in April about generating a daily-updating website using ChatGPT. This would be similar, but instead of writing the text directly to a Jekyll website, I’d write it to the database and add it to the templates that generate the website.
Adapting the code was very quick. Here’s the finished version for the book blurbs.
#!/usr/bin/env perl use strict; use warnings; use builtin qw[trim]; use feature 'say'; use OpenAPI::Client::OpenAI; use Time::Piece; use Encode qw[encode]; use Booker::Schema; my $sch = Booker::Schema->get_schema; my $count = 0; my $books = $sch->resultset('Book'); while ($count < 20 and my $book = $books->next) { next if defined $book->blurb; ++$count; my $blurb = describe_title($book); $book->update({ blurb => $blurb }); } sub describe_title { my ($book) = @_; my ($title, $author) = ($book->title, $book->author->name); my $debug = 1; my $api_key = $ENV{"OPENAI_API_KEY"} or die "OPENAI_API_KEY is not set\n"; my $client = OpenAPI::Client::OpenAI->new; my $prompt = join " ", 'Produce a 100-200 word description for the book', "'$title' by $author", 'Do not mention the fact that the book was short-listed for (or won)', 'the Booker Prize'; my $res = $client->createChatCompletion({ body => { model => 'gpt-4o', # model => 'gpt-4.1-nano', messages => [ { role => 'system', content => 'You are someone who knows a lot about popular literature.' }, { role => 'user', content => $prompt }, ], temperature => 1.0, }, }); my $text = $res->res->json->{choices}[0]{message}{content}; $text = encode('UTF-8', $text); say $text if $debug; return $text; }
There are a couple of points to note:
I then produced a similar program that did the same thing for authors. It’s similar enough that the next time I need something like this, I’ll spend some time turning it into a generic program.
I then added the new database fields to the book and author templates and re-published the site. You can see the results in, for example, the pages for Salman Rushie and Midnight’s Children.
I had one more slight concern going into this project. I pay for access to the ChatGPT API. I usually have about $10 in my pre-paid account and I really had no idea how much this was going to cost me. I needed have worried. Here’s a graph showing the bump in my API usage on the day I ran the code for all books and authors:
But you can also see that my total costs for the month so far are $0.01!
So, all-in-all, I call that a success and I’ll be using similar techniques to generate content for some other websites.
The post Generating Content with ChatGPT first appeared on Perl Hacks.
Published on Sunday 08 June 2025 12:36
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
You are given an array of integers and two integers $r and $c. Write a script to create two dimension array having $r rows and $c columns using the given array.
The core of the solution is contained in a main loop. The resulting code can be contained in a single file.
sub create_array{
my($i, $r, $c) = @_;
my @a = ();
for (0 .. $r - 1){
my $row = [];
for (0 .. $c - 1){
push @{$row}, shift @{$i};
}
push @a, $row;
}
return @a;
}
◇
Fragment referenced in 1.
Just to make sure things work as expected we’ll define a few short tests. The double chop is just a lazy way to make sure there aren’t any trailing commas in the output.
MAIN:{
my $s = q//;
$s .= q/(/;
do{
$s.= (q/[/ . join(q/, /, @{$_}) . q/], /);
} for create_array [1, 2, 3, 4], 2, 2;
chop $s;
chop $s;
$s .= q/)/;
say $s;
$s = q//;
$s .= q/(/;
do{
$s.= (q/[/ . join(q/, /, @{$_}) . q/], /);
} for create_array [1, 2, 3], 1, 3;
chop $s;
chop $s;
$s .= q/)/;
say $s;
$s = q//;
$s .= q/(/;
do{
$s.= (q/[/ . join(q/, /, @{$_}) . q/], /);
} for create_array [1, 2, 3, 4], 4, 1;
chop $s;
chop $s;
$s .= q/)/;
say $s;
}
◇
Fragment referenced in 1.
$ perl perl/ch-1.pl ([1, 2], [3, 4]) ([1, 2, 3]) ([1], [2], [3], [4])
You are given an array of integers. Write a script to return the sum of total XOR for every subset of given array.
This is another short one, but with a slightly more involved solution. We are going to compute the Power Set (set of all subsets) of the given array of integers and then for each of these sub-arrays compute and sum the XOR results.
The main section is just some basic tests.
MAIN:{
say calculate_total_xor 1, 3;
say calculate_total_xor 5, 1, 6;
say calculate_total_xor 3, 4, 5, 6, 7, 8;
}
◇
Fragment referenced in 4.
sub calculate_total_xor{
my $total = 0;
for my $a (power_set @_){
my $t = 0;
$t = eval join q/ ^ /, ($t, @{$a});
$total += $t;
}
return $total;
}
◇
Fragment referenced in 4.
The Power Set can be computed by using a binary counter. Let’s say we have N elements of the set. We start at 0 x N and continue to 1 x N. At each iteration we compose a subarray by including the ith element from the original array if the ith bit is set. Actually, we arent going to start at 0 x N because we want to exclude the empty set for the purposes of the later XOR computation.
sub power_set{
my @a = ();
for my $i (1 .. 2 ** @_- 1){
my @digits = ();
for my $j (0 .. @_ - 1){
push @digits, $_[$j] if 1 == ($i >> $j & 1);
}
push @a, \@digits;
}
return @a;
}
◇
Fragment referenced in 4.
$ perl perl/ch-2.pl 6 28 480
Power Set Defined
Power Set Calculcation (C++) from TWC 141
The Weekly Challenge 324
Generated Code
Published by prz on Saturday 07 June 2025 22:56
This is the weekly favourites list of CPAN distributions. Votes count: 22
This week there isn't any remarkable distribution
Build date: 2025/06/07 20:53:44 GMT
Clicked for first time:
Increasing its reputation:
AWS S3 Encryption isn't as complex as I thought initially. I had fun playing with it. You can give it a try too. Please check out the link below for more information.
https://theweeklychallenge.org/blog/aws-s3-encryption
With help from the community a development release of DBD::Oracle has been released to the CPAN.
This release includes a number of important changes that we hope will improve stability with threaded Perl.
If you are using DBD::Oracle I would ask that you try it out in your non-production environments initially and perhaps if you are confident there after, in your production environments.
The branch for it is here on github. I am personally grateful for people spending time and sending in pull requests , there is no monetary support for this driver although Oracle's open source community manager is actively engaged in discussions on issues and pull requests.
Github actions are configured on the repo and the quite thorough library of unit tests are run against Oracle XE on Ubuntu. This provides good signal but with extremely limited coverage of operating systems and database versions.
Due to the lack of variety in automated testing on Github - and the business critical nature of most Oracle databases - my recommendation is to mirror the Github repo in to your organization's repos and configure CI testing against your specific combination of Oracle versions, operating systems, and settings. The Github actions can be adapted to Gitlab reasonably quickly and give you a very high level of confidence before trialing new versions in production.
Tales from Basement Level 3
Published by Robert Rothenberg on Friday 06 June 2025 15:00
The 2-argument open function is insecure, because the filename can include the mode. If it is not properly validated, then files can be modified, truncated or in the case of a pipe character, run an external command.
$file = "| echo Aha";
open my $fh, $file; # <-- THIS IS BAD
This will execute the command embedded in $file
.
Even when the filename is generated by your code, you can run into unexpected edge cases. For example, in a Unix shell run the command
touch '| echo Aha'
and in the same directory run the script
opendir( my $dh, ".");
while ( my $file = readdir $dh ) {
next if -d $file;
open my $fh, $file; # <-- THIS IS BAD
close $fh;
}
This is more subtle, and will execute the command embedded in that filename.
It is the same bug in File::Find::Rule that became CVE-2011-10007. (If you haven’t already upgraded File::Find::Rule to version 0.35 or later, please do so. That module has more than 1,700 direct or indirect dependents.)
The SEI CERT Perl Coding Standard recommends against using the two-argument form of open().
The fix is simply to use a 3-argument form, where the second argument is the mode and the third is the filename:
open my $fh, '<', $file;
The 3-argument open has been supported since Perl v5.6.0, so there is no worry about supporting older versions of Perl.
You can identify this issue in your code using the Perl::Critic ProhibitTwoArgOpen policy. There is a similar policy in Perl::Lint.
I seldom release modules to CPAN; mainly because
there’s so much great stuff there already. An answer on StackOverflow
about pretty printing DBIx::Class
result
sets got me thinking. I then
climbed onto the shoulders of several giants to create a wee module which
does just that. Introducing
DBIx::Class::ResultSet::PrettyPrint
!
Strangely enough, I’d released
DBIx::Class::ResultSet::PrettyPrint
in 2024 but had never gotten around to mentioning it anywhere. This post
rectifies that omission, gives some background about the module, and
discusses a small usage example.
One could say that this is a delta-epsilon1 module in that it
doesn’t extend things very much. Although it doesn’t constitute a large
change, it does make printing DBIx::Class
result sets easier. It stands
upon the shoulders of several giants, so all I can claim is to have bundled
the idea into a module.
The original impetus for DBIx::Class::ResultSet::PrettyPrint
came from
wanting to pretty print result sets in a Perl project I’ve been working
on.2 I find that by seeing the data within a result set, I can get
a feeling from what the data looks like and what kinds of information it
contains. Searching for a pretty printing module, I stumbled across an
answer on StackOverflow about pretty printing DBIx::Class
result
sets. I remember thinking
that the proposed solution looked nice and I used the pattern a couple of
times in my work. I eventually realised that the approach would be easier
to use as a module. Since then, I’ve found it handy as a way to get an idea
of the shape of the data that I’m playing with.
I made some small changes to the solution proposed on StackOverflow. For
instance, it recommended using
Text::Table
, but I found the table
output generated by
Text::Table::Tiny
nicer.
This is why DBIx::Class::ResultSet::PrettyPrint
uses Text::Table::Tiny
to generate tables. For instance, the output has +
symbols at the table
cell corners, which is reminiscent of how Postgres displays tables within
psql
. This I found to be a nice touch.
Of course, if one has large database tables with many columns and/or rows, this module might not be so useful. Yet, since it operates on result sets, one can create a result set with a subset of a given table and then pretty print that.
Although one often talks about pretty printing database tables, really the
module operates on DBIx::Class::ResultSet
objects. Hence, there isn’t a
strict one-to-one relationship between database tables and what the pretty
printer operates on. This is why the module was useful in one of my current
projects: sometimes there wasn’t a database table behind the ResultSet
I
was investigating. For instance, by querying the database directly with
psql
, it wasn’t (easily) possible to work out what form the data had and
what kinds of information it contained. Using
DBIx::Class::ResultSet::PrettyPrint
made this investigative work much
easier.
So, how to use the module? A small example should make things clear.
Let’s see the module in action. First off, we’ll need to install it:
$ cpanm DBIx::Class::ResultSet::PrettyPrint
This will pull in several CPAN modules, so you’ll need to wait a bit until it’s finished. For instance, on my test system, it took 22 minutes to download, build, test, and install the necessary 79 distributions. It’ll probably take less time if you’ve already got many of the upstream dependencies installed on your system.
Once that’s done, we can set up an example project. We’ll need to set up a
DBIx::Class
project, so there’s a bit of upfront work to do.
I’m a book fan, so let’s create a project to store metadata about some of my books. We only need one database table in this small example, so it won’t take long to set up.
I’ve got lots of books about Perl and a few about Unix, so let’s call the project “Perl and Unix library”. To give you an idea of what I mean, here’s a “shelfie”:
Create a directory for the project and change into the new directory:
$ mkdir perl-and-unix-library
$ cd perl-and-unix-library
Now we need to create the directory structure for our DBIx::Class
schema:
$ mkdir -p lib/Schema/Result/
We’ll need a stub Schema
package that we can use later to inspect the
database’s contents. So, create a file called lib/Schema.pm
and fill it
with this code:
package Schema;
use strict;
use warnings;
use base qw(DBIx::Class::Schema);
__PACKAGE__->load_namespaces();
1;
# vim: expandtab shiftwidth=4
We need to tell DBIx::Class
about the structure of our books table, so
create a file called lib/Schema/Result/Book.pm
and fill it with this
content:
package Schema::Result::Book;
use strict;
use warnings;
use base qw(DBIx::Class::Core);
use lib '.t/lib';
__PACKAGE__->table('books');
__PACKAGE__->add_columns(
id => {
data_type => 'integer',
size => 16,
is_nullable => 0,
is_auto_increment => 1,
},
title => {
data_type => 'varchar',
size => 128,
is_nullable => 0,
},
author => {
data_type => 'varchar',
size => 128,
is_nullable => 0,
},
pub_date => {
data_type => 'date',
is_nullable => 0,
},
num_pages => {
data_type => 'integer',
size => 16,
is_nullable => 0,
},
isbn => {
data_type => 'varchar',
size => 32,
is_nullable => 0,
},
);
__PACKAGE__->set_primary_key('id');
1;
# vim: expandtab shiftwidth=4
This defines our books
database table in which we’re storing title,
author, publication date, number of pages, and ISBN information about each
of our books.
We’ve now got enough structure for DBIx::Class
to create and query a
database. That means we can add some books to the database.
Create a file in the project’s root directory called create-books-db.pl
and fill it with this content:
use strict;
use warnings;
use lib './lib';
use Schema;
my $schema = Schema->connect("dbi:SQLite:books.db");
$schema->deploy( { add_drop_table => 1 } );
my $books = $schema->resultset('Book');
$books->create(
{
title => "Programming Perl",
author => "Tom Christiansen, brian d foy, Larry Wall, Jon Orwant",
pub_date => "2012-03-18",
num_pages => 1174,
isbn => "9780596004927"
}
);
$books->create(
{
title => "Perl by Example",
author => "Ellie Quigley",
pub_date => "1994-01-01",
num_pages => 200,
isbn => "9780131228399"
}
);
$books->create(
{
title => "Perl in a Nutshell",
author => "Nathan Patwardhan, Ellen Siever and Stephen Spainhour",
pub_date => "1999-01-01",
num_pages => 654,
isbn => "9781565922860"
}
);
$books->create(
{
title => "Perl Best Practices",
author => "Damian Conway",
pub_date => "2005-07-01",
num_pages => 517,
isbn => "9780596001735"
}
);
$books->create(
{
title => "Learning Perl, 7th Edition",
author => "Randal L. Schwartz, brian d foy, Tom Phoenix",
pub_date => "2016-10-05",
num_pages => 369,
isbn => "9781491954324"
}
);
$books->create(
{
title => "UNIX Shell Programming",
author => "Stephen G. Kochan and Patrick H. Wood",
pub_date => "1990",
num_pages => 502,
isbn => "067248448X"
}
);
# vim: expandtab shiftwidth=4
Running this file will create an SQLite database called books.db
in the
same directory as the script. I.e. after running
$ perl create-books-db.pl
you should see a file called books.db
in the project’s root directory.
Now we can query the data in our books database. Create a file called
show-books.pl
in the project base directory with this content:
use strict;
use warnings;
use lib './lib';
use DBIx::Class::ResultSet::PrettyPrint;
use Schema; # load your DBIx::Class schema
# load your database and fetch a result set
my $schema = Schema->connect( 'dbi:SQLite:books.db' );
my $books = $schema->resultset( 'Book' );
print "Title of first entry: ", $books->find(1)->title, "\n";
print "Authors of UNIX-related titles: ",
$books->search({ title => { -like => "%UNIX%" }})->first->author, "\n";
# vim: expandtab shiftwidth=4
Running this script will give this output:
$ perl show-books.pl
Title of first entry: Programming Perl
Authors of UNIX-related titles: Stephen G. Kochan and Patrick H. Wood
That’s all very well and good, but wouldn’t it be nice to view the database
table all in one go? This is the niche task that
DBIx::Class::ResultSet::PrettyPrint
performs.
Change the print
statements in the show-books.pl
script to this:
# pretty print the result set
my $pp = DBIx::Class::ResultSet::PrettyPrint->new();
$pp->print_table( $books );
Now, when we run the script, we get this output:
$ perl show-books.pl
+----+----------------------------+-------------------------------------------------------+------------+-----------+---------------+
| id | title | author | pub_date | num_pages | isbn |
+----+----------------------------+-------------------------------------------------------+------------+-----------+---------------+
| 1 | Programming Perl | Tom Christiansen, brian d foy, Larry Wall, Jon Orwant | 2012-03-18 | 1174 | 9780596004927 |
| 2 | Perl by Example | Ellie Quigley | 1994-01-01 | 200 | 9780131228399 |
| 3 | Perl in a Nutshell | Nathan Patwardhan, Ellen Siever and Stephen Spainhour | 1999-01-01 | 654 | 9781565922860 |
| 4 | Perl Best Practices | Damian Conway | 2005-07-01 | 517 | 9780596001735 |
| 5 | Learning Perl, 7th Edition | Randal L. Schwartz, brian d foy, Tom Phoenix | 2016-10-05 | 369 | 9781491954324 |
| 6 | UNIX Shell Programming | Stephen G. Kochan and Patrick H. Wood | 1990 | 502 | 067248448X |
+----+----------------------------+-------------------------------------------------------+------------+-----------+---------------+
Isn’t that nice?
As I mentioned earlier, I’ve found the module quite handy when using Perl to dig around in database tables in my daily work. Maybe it can help make your work easier too!
This is in reference to delta-epsilon proofs in mathematics where the values delta and epsilon are very small. ↩︎
If you need someone who is stubbornly thorough, give me a yell! I’m available for freelance Python/Perl backend development and maintenance work. Contact me at paul@peateasea.de and let’s discuss how I can help solve your business’ hairiest problems. ↩︎
Published on Thursday 05 June 2025 22:52
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
You are given a list of operations. Write a script to return the final value after performing the given operations in order. The initial value is always 0.
Let’s entertain ourselves with an over engineered solution! We’ll use Parse::Yapp to handle incrementing and decrementing any single letter variable. Or, to put it another way, we’ll define a tiny language which consists of single letter variables that do not require declaration, are only of unsigned integer type, and are automatically initialized to zero. The only operations on these variables are the increment and decrement operations from the problem statement. At the completion of the parser’s execution we will print the final values of each variable.
The majority of the work will be done in the .yp yapp grammar definition file. We’ll focus on this file first.
The declarations section will have some token definitions and a global variable declaration.
For our simple language we’re just going to define a few tokens: the increment and decrement operators, our single letter variables.
We’re going to define a single global variable which will be used to track the state of each variable.
The rules section defines the actions of our increment and decrement operations in both prefix and postfix form. We’ll also allow for a completely optional variable declaration which is just placing a single letter variable by itself
program: statement {$variable_state}
| program statement
;
statement: variable_declaration
| increment_variable
| decrement_variable
;
variable_declaration: LETTER {$variable_state->{$_[1]} = 0}
;
increment_variable: INCREMENT LETTER {$variable_state->{$_[2]}++}
| LETTER INCREMENT {$variable_state->{$_[1]}++}
;
decrement_variable: DECREMENT LETTER {$variable_state->{$_[2]}--}
| LETTER DECREMENT {$variable_state->{$_[1]}--}
;
◇
The final section of the grammar definition file is, historically, called programs. This is where we have Perl code for the lexer, error handing, and a parse function which provides the main point of execution from code that wants to call the parser that has been generated from the grammar.
The parse function is for the convenience of calling the generated parser from other code. yapp will generate a module and this will be the module’s method used by other code to execute the parser against a given input.
Notice here that we are squashing white space, both tabs and newlines, using tr. This reduces all tabs and newlines to a single space. This eases further processing since extra whitespace is just ignored, according to the rules we’ve been given.
Also notice the return value from parsing. In the rules section we provide a return value, a hash reference, in the final action code block executed.
sub parse{
my($self, $input) = @_;
$input =~ tr/\t/ /s;
$input =~ tr/\n/ /s;
$self->YYData->{INPUT} = $input;
my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error);
return $result;
}
◇
Fragment referenced in 6.
This is really just about the most minimal error handling function there can be! All this does is print “syntax error”when the parser encounters a problem.
sub error{
exists $_[0]->YYData->{ERRMSG}
and do{
print $_[0]->YYData->{ERRMSG};
return;
};
print "syntax␣error\n";
}
◇
Fragment referenced in 6.
The lexer function is called repeatedly for the entire input. Regular expressions are used to identify tokens (the ones declared at the top of the file) and pass them along for the rules processing.
sub lexer{
my($parser) = @_;
$parser->YYData->{INPUT} or return(q//, undef);
$parser->YYData->{INPUT} =~ s/^[ \t]//g;
##
# send tokens to parser
##
for($parser->YYData->{INPUT}){
s/^(\s+)// and return (q/SPACE/, $1);
s/^([a-z]{1})// and return (q/LETTER/, $1);
s/^(\+\+)// and return (q/INCREMENT/, $1);
s/^(--)// and return (q/DECREMENT/, $1);
}
}
◇
Fragment referenced in 6.
There’s one more function we should add. The reason for it is a little complex. Variables defined in the declarations section are considered static and are stored in the lexical pad of the package. So each new invocation of the parse() method will re-use the same variables. They are not cleared or reset. So, we’ll define a subroutine which will clear this for us manually.
Let’s define a small file to drive some tests.
The preamble to the test driver sets the minimum perl version to be the most recent one, to take advantage of all recent changes. We also include the generated module file whihc yapp creates. For test purposes we’ll define some constants, taken from TWC’s examples.
use constant TEST0 => q/--x x++ x++/;
use constant TEST1 => q/x++ ++x x++/;
use constant TEST2 => q/x++ ++x --x x--/;
use constant COMPLEX_TEST => <<~END_TEST;
a b c
a++ b++ c++
++a ++b ++c
--a --b --c
a-- b-- c--
a++ ++b c++
END_TEST
◇
Fragment referenced in 12.
For printing the results in a nice way we’ll define a small subroutine to display the return value from the parser.
sub print_variables{
my($results) = @_;
for my $k (keys %{$results}){
print $k;
say qq/:\t$results->{$k}/;
}
}
◇
Fragment referenced in 11.
MAIN:{
my $parser = IncrementDecrement->new();
say TEST0;
say print_variables $parser->parse(TEST0);
say TEST1;
$parser->clear();
say print_variables $parser->parse(TEST1);
say TEST2;
$parser->clear();
say print_variables $parser->parse(TEST2);
say COMPLEX_TEST;
$parser->clear();
say print_variables $parser->parse(COMPLEX_TEST);
}
◇
Fragment referenced in 11.
$ yapp -m IncrementDecrement perl/IncrementDecrement.yp; mv IncrementDecrement.pm perl; perl -Iperl perl/ch-1.pl --x x++ x++ x: 1 x++ ++x x++ x: 3 x++ ++x --x x-- x: 0 a b c a++ b++ c++ ++a ++b ++c --a --b --c a-- b-- c-- a++ ++b c++ b: 1 a: 1 c: 1
You are given an income amount and tax brackets. Write a script to calculate the total tax amount.
After over doing the complexity for the first part, we’ll make this one quite a bit shorter.
The main section is just some basic tests.
MAIN:{
say calculate_tax 10, [[3, 50], [7, 10], [12,25]];
say calculate_tax 2, [[1, 0], [4, 25], [5,50]];
say calculate_tax 0, [[2, 50]];
}
◇
Fragment referenced in 16.
{
my $tax_bracket = shift @{$tax_brackets};
if($tax_bracket->[0] <= $income){
$taxable = $tax_bracket->[0] - $taxable;
$tax += ($taxable * ($tax_bracket->[1]/100));
$taxed += $taxable;
}
else{
$tax += (($income - $taxed) * ($tax_bracket->[1]/100));
$taxed = $income;
}
redo unless $taxed >= $income || @{$tax_brackets} == 0;
}
◇
$ perl perl/ch-2.pl 2.65 0.25 0
Published on Friday 06 June 2025 00:00
Published by Steve Waring on Thursday 05 June 2025 16:20
When I run a two instances of the same perl tk script at the same time, the second one does not pick up the X resources. How can I fix this? For example (for simplicity):
my $mw = MainWindow->new(-title => 'Menu');
$mw->Label(-text => 'hello world')->pack;
MainLoop;
My Xresources file has:
weird*font: clean
weird*foreground: steel blue
weird*background: cornsilk
Here is what the first running copy gives:
Here is what a second copy of the same script running at the same time gives:
Published on Thursday 05 June 2025 09:09
In the previous post, we created a network close enough to reality so that finding routes between stations was possible and sufficiently interesting. In this final post in the series, we’re going to see how to handle indirect connections between stations.
Not all stations in the Hannover tram network are directly connected. A
good example is the line Linie 10
, which starts at the bus station next to
the main train station and has the station name
Hauptbahnhof/ZOB
.1 As its name suggests, this station is
associated with the station Hauptbahnhof
. Although they’re very close to
one another, they’re not connected directly. You have to cross a road to get
to Hauptbahnhof
from the Hauptbahnhof/ZOB
tram stop. A routing
framework such as Map::Tube
should
allow such indirect connections, thus joining Linie 10
to the rest of the
network.
So how do we connect such indirectly connected stations?
Map::Tube
has a solution: the
other_link
attribute.
To see this attribute in action, let’s add the line Linie 10
to the
network and connect Hauptbahnhof
to Hauptbahnhof/ZOB
with an
other_link
. Then we can try creating a route from Ahlem
(at the end of
Linie 10
) to Misburg
(at the end of Linie 7
) and see if our new
connection type works as we expect. Let’s get cracking!
Here’s the planned list of stations, IDs and links:
Station | ID | Links |
---|---|---|
Ahlem | H15 | H16 |
Leinaustraße | H16 | H15, H17 |
Hauptbahnhof/ZOB | H17 | H16 |
Ahlem
is the westernmost station, hence it’s the “first” station along
Linie 10
. Therefore, it gets the next logical ID carrying on from where we
left off in the map file.
As we’ve done before, we drive these changes by leaning on our test suite. We want to have four lines in the network now, hence we update our number of lines test like so:
my $num_lines = scalar @{$hannover->get_lines};
is( $num_lines, 4, "Number of lines in network correct" );
We can test that we’ve added the line and its stations correctly by checking for the expected route. Our routes tests are now:
my @routes = (
"Route 1|Langenhagen|Sarstedt|Langenhagen,Kabelkamp,Hauptbahnhof,Kroepcke,Laatzen,Sarstedt",
"Route 4|Garbsen|Roderbruch|Garbsen,Laukerthof,Kroepcke,Kantplatz,Roderbruch",
"Route 7|Wettbergen|Misburg|Wettbergen,Allerweg,Kroepcke,Hauptbahnhof,Vier Grenzen,Misburg",
"Route 10|Ahlem|Hauptbahnhof/ZOB|Ahlem,Leinaustraße,Hauptbahnhof/ZOB",
);
ok_map_routes($hannover, \@routes);
where we’ve added the expected list of stations for Linie 10
to the end of
the @routes
list.
Let’s make sure the tests fail as expected:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. 1/?
# Failed test 'Number of lines in network correct'
# at t/map-tube-hannover.t line 15.
# got: '3'
# expected: '4'
Yup, that looks good. We expect four lines but only have three. Let’s add the line to our maps file now:
{
"id" : "L10",
"name" : "Linie 10",
"color" : "PaleGreen"
}
where I’ve guessed that the line colour used in the Üstra “Netzplan U” is pale green.
Re-running the tests, we have:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. # Line id L10 consists of 0 separate components
# Failed test 'Hannover'
# at /home/cochrane/perl5/perlbrew/perls/perl-5.38.3/lib/site_perl/5.38.3/Test/Map/Tube.pm line 196.
# Line id L10 defined but serves no stations (not even as other_link)
# Failed test 'Hannover'
# at /home/cochrane/perl5/perlbrew/perls/perl-5.38.3/lib/site_perl/5.38.3/Test/Map/Tube.pm line 196.
# Looks like you failed 2 tests of 14.
Again, we expected this as this line doesn’t have any stations yet. Let’s add them to the map file.
{
"id" : "H15",
"name" : "Ahlem",
"line" : "L10",
"link" : "H16"
},
{
"id" : "H16",
"name" : "Leinaustraße",
"line" : "L10",
"link" : "H15,H17"
},
{
"id" : "H17",
"name" : "Hauptbahnhof/ZOB",
"line" : "L10",
"link" : "H16"
}
This time, we expect the tests to tell us that this line isn’t connected to the network. Sure enough:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. # Map has 2 separate components; e.g., stations with ids H1, H15
# Failed test 'Hannover'
# at
/home/cochrane/perl5/perlbrew/perls/perl-5.38.3/lib/site_perl/5.38.3/Test/Map/Tube.pm line 196.
# Looks like you failed 1 test of 14.
The error message
Map has 2 separate components; e.g., stations with ids H1, H15
means that the line isn’t connected to any of the other lines already present because the map contains separate components.
To fix this, let’s change the entry for Hauptbahnhof/ZOB
to use the
other_link
attribute and see if that helps:
{
"id" : "H17",
"name" : "Hauptbahnhof/ZOB",
"line" : "L10",
"link" : "H16",
"other_link" : "Street:H3"
}
Oddly, the tests still raise an error:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. # Map has 2 separate components; e.g., stations with ids H1, H15
# Failed test 'Hannover'
# at /home/cochrane/perl5/perlbrew/perls/perl-5.38.3/lib/site_perl/5.38.3/Test/Map/Tube.pm line 196.
t/map-tube-hannover.t .. 1/? # Looks like you failed 1 test of 14.
# Failed test 'ok_map_data'
# at t/map-tube-hannover.t line 11.
Oh, that’s right! We’ve only linked Hauptbahnhof/ZOB
to Hauptbahnhof
;
we need to add the other_link
in the other direction as well. We could
have debugged this situation by running bin/map2image.pl
and inspecting
the generated image. Yet we’ve seen this issue
before
and can call on experience instead.
We can fix the problem by updating the entry for Hauptbahnhof
like so:
{
"id" : "H3",
"name" : "Hauptbahnhof",
"line" : "L1,L7",
"link" : "H2,H8,H12",
"other_link" : "Street:H17"
},
Now the tests still fail, even though we thought we’d fixed everything:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. 1/? Map::Tube::get_node_by_name(): ERROR: Invalid Station Name [Leinaustraße]. (status: 101) file /home/cochrane/perl5/perlbrew/perls/perl-5.38.3/lib/site_perl/5.38.3/Test/Map/Tube.pm on line 1434
# Tests were run but no plan was declared and done_testing() was not seen.
What’s going wrong?
Oh, yeah, the sharp-s (ß) character messes with the routing tests as we saw in the previous article in the series.
Let’s replace ß with the equivalent “double-s” for the Leinaustraße
station. First in the map file:
{
"id" : "H16",
"name" : "Leinaustrasse",
"line" : "L10",
"link" : "H15,H17"
},
and then in the routes tests:
my @routes = (
"Route 1|Langenhagen|Sarstedt|Langenhagen,Kabelkamp,Hauptbahnhof,Kroepcke,Laatzen,Sarstedt",
"Route 4|Garbsen|Roderbruch|Garbsen,Laukerthof,Kroepcke,Kantplatz,Roderbruch",
"Route 7|Wettbergen|Misburg|Wettbergen,Allerweg,Kroepcke,Hauptbahnhof,Vier Grenzen,Misburg",
"Route 10|Ahlem|Hauptbahnhof/ZOB|Ahlem,Leinaustrasse,Hauptbahnhof/ZOB",
);
ok_map_routes($hannover, \@routes);
How did we do?
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. ok
All tests successful.
Files=1, Tests=4, 0 wallclock secs ( 0.03 usr 0.00 sys + 0.55 cusr 0.05 csys = 0.63 CPU)
Result: PASS
Success! 🎉
We’ve reached the end of the development phase of the HOWTO. At this point,
the complete test file (t/map-tube-hannover.t
) looks like this:
use strict;
use warnings;
use Test::More;
use Map::Tube::Hannover;
use Test::Map::Tube;
my $hannover = Map::Tube::Hannover->new;
ok_map($hannover);
ok_map_functions($hannover);
my $num_lines = scalar @{$hannover->get_lines};
is( $num_lines, 4, "Number of lines in network correct" );
my @routes = (
"Route 1|Langenhagen|Sarstedt|Langenhagen,Kabelkamp,Hauptbahnhof,Kroepcke,Laatzen,Sarstedt",
"Route 4|Garbsen|Roderbruch|Garbsen,Laukerthof,Kroepcke,Kantplatz,Roderbruch",
"Route 7|Wettbergen|Misburg|Wettbergen,Allerweg,Kroepcke,Hauptbahnhof,Vier Grenzen,Misburg",
"Route 10|Ahlem|Hauptbahnhof/ZOB|Ahlem,Leinaustrasse,Hauptbahnhof/ZOB",
);
ok_map_routes($hannover, \@routes);
done_testing();
with the other Perl files remaining unchanged.
The full JSON content of the map file is too long to display here, but if you’re interested, you can see it in the Git repository accompanying this article series.
To get a feeling for what the network looks like, try running
bin/map2image.pl
. Doing so, you’ll find a network graph similar to this:
Although the graph doesn’t highlight the indirect link, it does show the connectivity in the entire map and gives us a high-level view of what we’ve achieved.
With our latest map changes in hand, we can find our way from Ahlem
to
Misburg
:
$ perl bin/get_route.pl Ahlem Misburg
Ahlem (Linie 10), Leinaustrasse (Linie 10), Hauptbahnhof/ZOB (Linie 10, Street), Hauptbahnhof (Linie 1, Linie 7, Street), Vier Grenzen (Linie 7), Misburg (Linie 7)
Wicked! It worked! And it got the connection from Hauptbahnhof/ZOB
to
Hauptbahnhof
right. Nice!
We can also plan more complex routes, such as travelling from Ahlem
to
Roderbruch
:
$ perl bin/get_route.pl Ahlem Roderbruch
Ahlem (Linie 10), Leinaustrasse (Linie 10), Hauptbahnhof/ZOB (Linie 10, Street), Hauptbahnhof (Linie 1, Linie 7, Street), Kroepcke (Linie 1, Linie 4, Linie 7), Kantplatz (Linie 4), Roderbruch (Linie 4)
Looking closely, we find that we have to change at Hauptbahnhof
and then
again at Kroepcke
to reach our destination. Comparing this with the
Üstra “Netzplan
U”
we can see (for the simpler map created here) that this matches reality.
Brilliant!
Let’s commit that change and give ourselves a pat on the back for a job well done!
$ git ci share/hannover-map.json t/map-tube-hannover.t -m "Add Linie 10 to network
>
> The most interesting part about this change is the use of other_link
> to ensure that Hauptbahnhof/ZOB and Hauptbahnhof are connected to one
> another and hence Linie 10 is connected to the rest of the network
> and routes can be found from Linie 10 to other lines."
[main bc34daa] Add Linie 10 to network
2 files changed, 29 insertions(+), 3 deletions(-)
Welcome to the end of the article series! Thanks for staying until the end. 🙂
Wow, that was quite a lot of work! But it was fun, and we learned a lot along the way. For instance, we’ve learned:
Map::Tube
map is structured,Map::Tube
in a test-driven
manner,Map::Tube
network,This discussion has hopefully given you the tools you need to create your
own Map::Tube
map. There’s so much more you can do with Map::Tube
, so
it’s a good idea to spend some time browsing the
documentation. Therein you will find
many nuggets of information and hints for ideas of things to play with.
I wish you the best of luck and have fun!
For those wondering who don’t speak German: Hauptbahnhof means “main train station” or equivalently “central train station”. ZOB is the abbreviation of Zentralomnibusbahnhof, which looks like it literally translates as “central omnibus train station”, but really means “central bus station”. ↩︎
Published by user18040093 on Wednesday 04 June 2025 23:14
currently I am trying to interpret the following line of code: if (! defined $variabletype) {$variabletype = "";}
I am relatively new to perl so while I can guess what this conditional statement is saying I want to make sure I am correct. I am also wondering how defined
can be used inside this if statement. The only thing I can find is that it is a function that checks if the variable has a value assigned to it or not and returns 1 or 0, but all of the examples I see make the function be used with the value being examined being in parentheses right after ( defined( ) ). Also, if $variabletype
has a value, is it just setting it to ""
or skipping that line if it does have a value?
Published on Wednesday 04 June 2025 08:00
SlapbirdAPM is a free-software observability platform tailor made for Perl web-applications. [ It is also a Perl web-application :^) ] It has first class support for Plack, Mojo, Dancer2, and CGI. Slapbird provides developers with comprehensive observability tools to monitor and optimize their applications’ performance.
In this article I will explain how to setup a Plack application with Slapbird. If you want to use another supported framework, please read our Getting Started documentation, or reach out to me on the Perl Foundations Slack channel!
SlapbirdAPM is easily installed on your Plack application, here is a minimal example, using a Dancer2 application that runs under Plack:
Install with
cpan -I SlapbirdAPM::Agent::Plack
#!/usr/bin/env perl
use Dancer2;
use Plack::Builder;
get '/' => sub {
'Hello World!';
};
builder {
enable 'SlapbirdAPM';
app;
};
Now, you can create an account on SlapbirdAPM, and create your application.
Then, simply copy the API key output and, add it to your application via the SLAPBIRDAPM_API_KEY
environment variable. For example:
SLAPBIRDAPM_API_KEY=<API-KEY> plackup app.pl
or, you can pass your key in to the middleware:
builder {
enable 'SlapbirdAPM', key => <YOUR API KEY>;
...
};
Now when you navigate to /
, you will see it logged in your SlapbirdAPM dashboard!
Then, clicking into one of the transactions, you’ll get some more information:
SlapbirdAPM also supports DBI, meaning you can trace your queries, let’s edit our application to include a few DBI queries:
#!/usr/bin/env perl
use Dancer2;
use DBI;
use Plack::Builder;
my $dbh = DBI->connect( 'dbi:SQLite:dbname=database.db', '', '' );
$dbh->do('create table if not exists users (id integer primary key, name varchar)');
get '/' => sub {
send_as html => 'Hello World!';
};
get '/users/:id' => sub {
my $user_id = route_parameters->get('id');
my ($user) =
$dbh->selectall_array(
'select * from users where id = ?',
{ Slice => {} }, $user_id );
send_as JSON => $user;
};
post '/users' => sub {
my $user_name = body_parameters->get('name');
my ($user) =
$dbh->selectall_array(
'insert into users(name) values ( ? ) returning id, name',
{ Slice => {} }, $user_name );
send_as JSON => $user;
};
builder {
enable 'SlapbirdAPM';
app;
};
Now we can use cURL to add data to our database:
curl -X POST -d 'name=bob' http://127.0.0.1:5000/users
Then, if we go back into Slapbird, we can view our timings for our queries:
This just breaks the surface of what is possible using SlapbirdAPM. You can also, generate reports, perform health-checks, and get notified if your application is creating too many 5XX responses.
Thanks for reading!
Published by Tux on Tuesday 03 June 2025 07:29
pack "s>" was introduced in perl-5.10
Published by Leont on Monday 02 June 2025 23:06
Properly mark new MSVC as v143
Published on Monday 02 June 2025 00:00
Published by prz on Saturday 31 May 2025 16:50
This is the weekly favourites list of CPAN distributions. Votes count: 49
Week's winner: Wanted (+3)
Build date: 2025/05/31 14:46:27 GMT
Clicked for first time:
Increasing its reputation:
Published by Dave Cross on Friday 30 May 2025 15:45
Last summer, I wrote a couple of posts about my lightweight, roll-your-own approach to deploying PSGI (Dancer) web apps:
In those posts, I described how I avoided heavyweight deployment tools by writing a small, custom Perl script (app_service
) to start and manage them. It was minimal, transparent, and easy to replicate.
It also wasn’t great.
The system mostly worked, but it had a number of growing pains:
systemctl
.curl
, not journalctl
.As I started running more apps, this ad-hoc approach became harder to justify. It was time to grow up.
psgi-systemd-deploy
So today (with some help from ChatGPT) I wrote psgi-systemd-deploy — a simple, declarative deployment tool for PSGI apps that integrates directly with systemd
. It generates .service
files for your apps from environment-specific config and handles all the fiddly bits (paths, ports, logging, restart policies, etc.) with minimal fuss.
Key benefits:
.deploy.env
.env
file support for application-specific settingsenvsubst
systemd
units you can inspect and manage yourself--dry-run
mode so you can preview changes before deployingrun_all
helper script for managing all your deployed apps with one commandYou may know about my Line of Succession web site (introductory talk). This is one of the Dancer apps I’ve been talking about. To deploy it, I wrote a .deploy.env
file that looks like this:
WEBAPP_SERVICE_NAME=succession WEBAPP_DESC="British Line of Succession" WEBAPP_WORKDIR=/opt/succession WEBAPP_USER=succession WEBAPP_GROUP=psacln WEBAPP_PORT=2222 WEBAPP_WORKER_COUNT=5 WEBAPP_APP_PRELOAD=1
And optionally a .env
file for app-specific settings (e.g., database credentials). Then I run:
$ /path/to/psgi-systemd-deploy/deploy.sh
And that’s it. The app is now a first-class systemd
service, automatically started on boot and restartable with systemctl
.
run_all
Once you’ve deployed several PSGI apps using psgi-systemd-deploy
, you’ll probably want an easy way to manage them all at once. That’s where the run_all
script comes in.
It’s a simple but powerful wrapper around systemctl
that automatically discovers all deployed services by scanning for .deploy.env
files. That means no need to hard-code service names or paths — it just works, based on the configuration you’ve already provided.
Here’s how you might use it:
# Restart all PSGI apps $ run_all restart # Show current status $ run_all status # Stop them all (e.g., for maintenance) $ run_all stop
And if you want machine-readable output for scripting or monitoring, there’s a --json
flag:
$ run_all --json is-active | jq . [ { "service": "succession.service", "action": "is-active", "status": 0, "output": "active" }, { "service": "klortho.service", "action": "is-active", "status": 0, "output": "active" } ]
Under the hood, run_all
uses the same environment-driven model as the rest of the system — no surprises, no additional config files. It’s just a lightweight helper that understands your layout and automates the boring bits.
It’s not a replacement for systemctl
, but it makes common tasks across many services far more convenient — especially during development, deployment, or server reboots.
The goal of psgi-systemd-deploy
isn’t to replace Docker, K8s, or full-featured PaaS systems. It’s for the rest of us — folks running VPSes or bare-metal boxes where PSGI apps just need to run reliably and predictably under the OS’s own tools.
If you’ve been rolling your own init scripts, cron jobs, or nohup
-based hacks, give it a look. It’s clean, simple, and reliable — and a solid step up from duct tape.
The post Deploying Dancer Apps – The Next Generation first appeared on Perl Hacks.
Published on Friday 30 May 2025 12:00
From May 1–4, 2025, the invite-only Perl Toolchain Summit (PTS) brought together in Leipzig, Germany, 33 of the ecosystem’s most active maintainers — and welcomed 6 first-timers — for four days of uninterrupted deep-dive collaboration in pair-programming sessions, consensus discussions, and critical infrastructure work. Attendees tackled security tooling and infrastructure, modernization and redesign proposals, several CI and test harness improvements, Perl core optimizations, and metadata/spec updates.
Thanks to all the sponsors support —financial, in-kind, and community— this year’s Summit was a huge success and produced multiple module releases, consensus on future smoke-testing and CPAN Testers architecture, and a new CPANSec advisory feed that will allow developers to quickly assess any Perl project’s security using either CLI tools or the MetaCPAN website itself. Those advancements benefit all organizations relying on Perl directly or indirectly.
has_no_cves
checks across core modules, and integrated CVE data into CPAN testers pipelines, making it extremely straightforward to check the security status of a distribution or application;^^=
operator support;defer
/finally
blocks;Bringing 30–35 experts under one roof enabled unprecedented collaboration with real-time problem solving, saving months of remote coordination and alignment. That kind of accelerated development and knowledge transfer not only brings the community together but fuels the contributors of critical open source products for the rest of the year so they can renew their shared goals and work in the same direction. Having 6 first-time attendees gaining direct mentorship is also fundamental to seed future contributions and expand the volunteer base, ensuring the longevity of the Perl ecosystem and toolchain.
The continued support of our sponsors ensures that the Perl Toolchain Summit remains a catalyst for Perl sustainability — translating sponsor investment into tangible improvements in performance, security, and ecosystem features and coherence. We look forward to partnering again to power the next wave of innovation in Perl’s toolchain.
Booking.com, WebPros, CosmoShop, Datensegler, OpenCage, SUSE, Simplelists Ltd, Ctrl O Ltd, Findus Internet-OPAC, plusW GmbH.
Grant Street Group, Fastmail, shift2, Oleeo, Ferenc Erki.
The Perl and Raku Foundation, Japan Perl Association, Harald Jörg, Alexandros Karelas (PerlModules.net), Matthew Persico, Michele Beltrame (Sigmafin), Rob Hall, Joel Roth, Richard Leach, Jonathan Kean, Richard Loveland, Bojan Ramsa.
Published on Sunday 25 May 2025 10:27
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
You are given a string and a positive integer. Write a script to format the string, removing any dashes, in groups of size given by the integer. The first group can be smaller than the integer but should have at least one character. Groups should be separated by dashes.
Our solution will be pretty short, contained in just a single file that has the following structure.
The preamble is just whatever we need to include. Here we aren’t using anything special, just specifying the latest Perl version.
the main section is just some basic tests.
MAIN
:{
say string_format q/ABC-D-E-F/, 3;
say string_format q/A-BC-D-E/, 2;
say string_format q/-A-B-CD-E/, 4;
}
◇
Fragment referenced in 1.
The approach is to maintain an array of arrays, with each sub-array being a new group of letters of the given size. We’ll process the string from right to left. This code seems to be well contained in a single subroutine. This sort of “stack processing” is straightforward enough to not require a lot of extra explanation.
sub string_format{
my($s, $i) = @_;
my @s = split //, $s;
my @t = ([]);
{
my $s_ = pop @s;
unless($s_ eq q/-/){
my $t_ = shift @t;
if(@{$t_} == $i){
unshift @t, $t_;
unshift @t, [$s_];
}
else{
unshift @{$t_}, $s_;
unshift @t, $t_;
}
}
redo if @s;
}
return join(q/-/, map {join q//, @{$_}} @t);
}
◇
Fragment referenced in 1.
$ perl perl/ch-1.pl ABC-DEF A-BC-DE A-BCDE
You are given an array of integers. Write a script to return an array of the ranks of each element:the lowest value has rank 1, next lowest rank 2, etc. If two elements are the same then they share the same rank.
Our solution will have the following structure.
The main section is just some basic tests.
MAIN
:{
say q/(/ . join(q/, /, (rank_array 55, 22, 44, 33)) . q/)/;
say q/(/ . join(q/, /, (rank_array 10, 10, 10)) . q/)/;
say q/(/ . join(q/, /, (rank_array 5, 1, 1, 4, 3)) . q/)/;
}
◇
Fragment referenced in 5.
Just for fun, no sort will be used to solve this problem! What we will do instead is define a subroutine to return the number of unique elements larger than a given number. The fun comes at a cost! This is an O(n2) method.
We use a hash to determine the unique values in the given array
do{$h{$_} = undef} for @i;
◇
Fragment referenced in 7.
Here’s where we compute how many unique numbers are larger than any given one
sub number_larger{
my($x, $unique) = @_;
return @{$unique} - grep {$_ > $x} @{$unique};
}
◇
Fragment referenced in 5.
$ perl perl/ch-2.pl (4, 1, 3, 2) (1, 1, 1) (4, 1, 1, 3, 2)
Published by Nihar Karra on Sunday 25 May 2025 07:25
In modern DevOps, we’re surrounded by structured data — YAML, JSON, logs, config files, and pipelines. And yet, many of us still reach for…
Published by prz on Saturday 24 May 2025 22:48
Published on Saturday 24 May 2025 10:13
The previous post focused on adding more lines to the network and adding colour to those lines. This time, we’ll add another line, but now the map will better match reality. This will allow us to start finding routes between stations on the network.
It’s time to get a bit trickier. In the real tram network in Hannover, the
main hub is actually the station Kröpcke
and not Hauptbahnhof
as we’ve
been using so far. Therefore, if we want to add further lines, we’ll have
to add this station and route the lines through it correctly. Doing so
allows us to do some cool things, like planning routes between seemingly
disjoint parts of the network.
The plan right now is to add Linie 4
from Garbsen
to
Roderbruch
.1 Here are the stations we want to add
along with their IDs and their station links:
Station | ID | Links |
---|---|---|
Garbsen | H10 | H11 |
Laukerthof | H11 | H10, H12 |
Kröpcke | H12 | H11, H13, H3, H4, H7 |
Kantplatz | H13 | H12, H14 |
Roderbruch | H14 | H13 |
As in previous posts, I’ve continued the numbering from where I left off.
This time, Garbsen
is the westernmost station along Linie 4
and hence
the “first” one along that line.
Looking at the links we have for Kröpcke
in the table, we can see that
things are getting more complicated, especially at this particular station.
Since this node is so central to the network, we expect complexity to be
concentrated here. To manage this increase in complexity we’ll continue
using tests to guide the map’s evolution. Also, note that the links
connecting Laatzen
and Allerweg
to Hauptbahnhof
will need to change
because these stations will now be connected to Kröpcke
.
To start making these changes, we’ll need some tests. Fortunately, we
already have a good structure in t/map-tube-hannover.t
that we can build
upon.
What’s the smallest incremental change that we can think of? Well, the network should now have three lines, so we update the “number of lines” test to check for that condition:
my $num_lines = scalar @{$hannover->get_lines};
is( $num_lines, 3, "Number of lines in network correct" );
Running the test file, we see that this will cause the first test failure:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. 1/?
# Failed test 'Number of lines in network correct'
# at t/map-tube-hannover.t line 15.
# got: '2'
# expected: '3'
# Looks like you failed 1 test of 4.
and drive us to add the new line, Linie 4
:
"lines" : {
"line" : [
{
"id" : "L1",
"name" : "Linie 1",
"color" : "red"
},
{
"id" : "L7",
"name" : "Linie 7",
"color" : "blue"
},
{
"id" : "L4",
"name" : "Linie 4",
"color" : "#f9a70c"
}
]
},
Here I’ve used an RGB colour for the line to show how this variant of specifying colour works. I found the colour by loading the PDF of the Üstra “Netzplan U” into Gimp and using the colour picker tool.
From prior experience, we expect the tests to continue to fail, but for a different reason:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. # Line id L4 consists of 0 separate components
# Failed test 'Hannover'
# at /home/cochrane/perl5/perlbrew/perls/perl-5.38.3/lib/site_perl/5.38.3/Test/Map/Tube.pm line 196.
# Line id L4 defined but serves no stations (not even as other_link)
# Failed test 'Hannover'
# at /home/cochrane/perl5/perlbrew/perls/perl-5.38.3/lib/site_perl/5.38.3/Test/Map/Tube.pm line 196.
# Looks like you failed 2 tests of 14.
These errors are what we expect: the validation tests are telling us that
Linie 4
isn’t connected to anything and doesn’t have a station attached to
it.
To build the new line incrementally, we’ll first add only the stations from
Garbsen
to Kröpcke
. Then we’ll connect the new line to the network by
connecting Kröpcke
to Hauptbahnhof
. Later, we’ll add the remaining
stations.
To begin, add these station entries after Misburg
:
{
"id" : "H10",
"name" : "Garbsen",
"line" : "L4",
"link" : "H11"
},
{
"id" : "H11",
"name" : "Laukerthof",
"line" : "L4",
"link" : "H10,H12"
},
{
"id" : "H12",
"name" : "Kröpcke",
"line" : "L1,L4,L7",
"link" : "H3,H11"
}
Running the test file gives this error:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. # Not every station reachable from every other station -- map has 2 separate components; e.g., stations with ids H1//H10
# Failed test 'Hannover'
# at /home/cochrane/perl5/perlbrew/perls/perl-5.38.3/lib/site_perl/5.38.3/Test/Map/Tube.pm line 196.
# Looks like you failed 1 test of 14.
That’s very odd. That wasn’t an error I was expecting after this change. After all, the new line should connect to the previously defined lines.
What can the message
map has 2 separate components; e.g., stations with ids H1//H10
mean? How could we debug this situation?
One thing we can do is to convert the map into an image with map2image.pl
and see if anything looks out of place:
$ perl bin/map2image.pl
Running the above command generates this image:
The problem is much clearer now! We can see that although there’s a link
from Kröpcke
to Hauptbahnhof
, there’s no link from Hauptbahnhof
back
to Kröpcke
. Adding that link (i.e. H12
) to Hauptbahnhof
:
{
"id" : "H3",
"name" : "Hauptbahnhof",
"line" : "L1,L7",
"link" : "H2,H4,H7,H8,H12"
},
gets the test suite to pass again:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. ok
All tests successful.
Files=1, Tests=4, 0 wallclock secs ( 0.03 usr 0.00 sys + 0.54 cusr 0.06 csys = 0.63 CPU)
Result: PASS
Great!
Now we’re in a position to add the remaining stations on Linie 4
. We
drive this change by adding a route from Garbsen
to Roderbruch
to our
routes tests. This then checks that these stations are part of the network:
my @routes = (
"Route 1|Langenhagen|Sarstedt|Langenhagen,Kabelkamp,Hauptbahnhof,Laatzen,Sarstedt",
"Route 4|Garbsen|Roderbruch|Garbsen,Laukerthof,Kröpcke,Kantplatz,Roderbruch",
"Route 7|Wettbergen|Misburg|Wettbergen,Allerweg,Hauptbahnhof,Vier Grenzen,Misburg",
);
ok_map_routes($hannover, \@routes);
This test will hopefully fail because we haven’t added the Roderbruch
station yet:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. 1/? Map::Tube::get_node_by_name(): ERROR: Invalid Station Name [Roderbruch]. (status: 101) file /home/cochrane/perl5/perlbrew/perls/perl-5.38.3/lib/site_perl/5.38.3/Map/Tube.pm on line 897
# Tests were run but no plan was declared and done_testing() was not seen.
# Looks like your test exited with 255 just after 3.
Expectations met again! Failing for the right reason means we’re on the right track.2
To continue, we add the remaining stations along Linie 4
and update the
list of links for Kröpcke
to link to the station Kantplatz
:
{
"id" : "H12",
"name" : "Kröpcke",
"line" : "L1,L4,L7",
"link" : "H3,H11,H13"
},
{
"id" : "H13",
"name" : "Kantplatz",
"line" : "L4",
"link" : "H12,H14"
},
{
"id" : "H14",
"name" : "Roderbruch",
"line" : "L4",
"link" : "H13"
}
Running the test suite gives:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. 1/? Map::Tube::get_node_by_name(): ERROR: Invalid Station Name [Kröpcke]. (status: 101) file /home/cochrane/perl5/perlbrew/perls/perl-5.38.3/lib/site_perl/5.38.3/Test/Map/Tube.pm on line 1434
# Tests were run but no plan was declared and done_testing() was not seen.
# Looks like your test exited with 255 just after 3.
Erm, what?? I expected this test to pass. Unfortunately, we got the error
Invalid Station Name [Kröpcke]
What’s going on here?
As is my wont, this led me down quite the rabbit hole. Yes, another one. To cut a very long story short, the issue here is that the station name contains a non-ascii character, in particular the umlaut ‘ö’.3 If we change the route test to
"Route 4|Garbsen|Roderbruch|Garbsen,Laukerthof,Kroepcke,Kantplatz,Roderbruch",
and update the station entry in the map file:
{
"id" : "H12",
"name" : "Kroepcke",
"line" : "L1,L4,L7",
"link" : "H3,H11,H13"
},
so that they use oe
in place of ö
, then the test suite will
pass:4
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. ok
All tests successful.
Files=1, Tests=4, 1 wallclock secs ( 0.03 usr 0.00 sys + 0.58 cusr 0.06 csys = 0.67 CPU)
Result: PASS
I first mentioned this behaviour in an issue in
Map::Tube::Frankfurt
.
It seems that the Map::Tube
version I’m using here (4.03) doesn’t always
process UTF-8 input correctly. I haven’t yet worked out the exact reason
for this, hence the only way is to avoid umlauts and the sharp-s (ß) and use
their ASCII-compatible versions. For German, this means that ä becomes ae,
ö becomes oe, ü becomes ue, and ß becomes ss.5
What’s weird here is that most of the validation tests work. It’s only as soon as one has a non-ASCII character like an umlaut or a sharp-s (ß) in the route name (at least for German maps) that problems seem to appear.
Since we’ve extended the network and now have a working configuration, it’s a good time for a commit:
$ git commit -m "Add Linie 4 from Garbsen to Roderbruch via Kröpcke" share/hannover-map.json t/map-tube-hannover.t
[main 22d482e] Add Linie 4 from Garbsen to Roderbruch via Kröpcke
2 files changed, 38 insertions(+), 2 deletions(-)
If you convert the map to an image, you’ll find that everything is connected:
The lines do seem to be a bit jumbled up in the graph now, but that’s just an artefact of generating this graph automatically.
Looking at this graph made me realise something: it’s wrong.
But Paul! Our tests are passing, it must be correct!
The thing is, the expectations in our tests are incorrect and we need to fix
them. If you compare the Üstra “Netzplan
U”
with the graph above, then you’ll find that Laatzen
and Allerweg
should
connect to Kröpcke
and not to Hauptbahnhof
as they are currently.
How do we solve this issue? We update the expectations in our routes tests. These tests now look like so:
my @routes = (
"Route 1|Langenhagen|Sarstedt|Langenhagen,Kabelkamp,Hauptbahnhof,Kroepcke,Laatzen,Sarstedt",
"Route 4|Garbsen|Roderbruch|Garbsen,Laukerthof,Kroepcke,Kantplatz,Roderbruch",
"Route 7|Wettbergen|Misburg|Wettbergen,Allerweg,Kroepcke,Hauptbahnhof,Vier Grenzen,Misburg",
);
ok_map_routes($hannover, \@routes);
where, if you look closely, you’ll notice that we’ve squashed Kroepcke
between Hauptbahnhof
and Laatzen
and Allerweg
, respectively:6
my @routes = (
"Route 1|Langenhagen|Sarstedt|Langenhagen,Kabelkamp,Hauptbahnhof,Kroepcke,Laatzen,Sarstedt",
^^^^^^^^^
"Route 4|Garbsen|Roderbruch|Garbsen,Laukerthof,Kroepcke,Kantplatz,Roderbruch",
"Route 7|Wettbergen|Misburg|Wettbergen,Allerweg,Kroepcke,Hauptbahnhof,Vier Grenzen,Misburg",
^^^^^^^^^
);
The test suite will now fail right royally. However, the routes test from
Test::Map::Tube
gives us lots of informative output about what went wrong.
We thus get many hints about how to correct things.
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. 1/?
# Failed test 'Route 1'
# at t/map-tube-hannover.t line 23.
# got: 'Langenhagen (Linie 1)
# Kabelkamp (Linie 1)
# Hauptbahnhof (Linie 1, Linie 7)
# Laatzen (Linie 1)
# Sarstedt (Linie 1)'
# expected: 'Langenhagen (Linie 1)
# Kabelkamp (Linie 1)
# Hauptbahnhof (Linie 1, Linie 7)
# Kroepcke (Linie 1, Linie 4, Linie 7)
# Laatzen (Linie 1)
# Sarstedt (Linie 1)'
# Failed test 'Route 7'
# at t/map-tube-hannover.t line 23.
# got: 'Wettbergen (Linie 7)
# Allerweg (Linie 7)
# Hauptbahnhof (Linie 1, Linie 7)
# Vier Grenzen (Linie 7)
# Misburg (Linie 7)'
# expected: 'Wettbergen (Linie 7)
# Allerweg (Linie 7)
# Kroepcke (Linie 1, Linie 4, Linie 7)
# Hauptbahnhof (Linie 1, Linie 7)
# Vier Grenzen (Linie 7)
# Misburg (Linie 7)'
# Looks like you failed 2 tests of 5.
t/map-tube-hannover.t .. Dubious, test returned 2 (wstat 512, 0x200)
Failed 2/5 subtests
By the way: converting the map to an image with map2image.pl
is very
helpful in debugging connection-related problems such as those appearing in
the test failures above.
To solve these errors, we need to update Hauptbahnhof
to look like the
following (we remove H4
and H7
as they should link to Kröpcke
):
{
"id" : "H3",
"name" : "Hauptbahnhof",
"line" : "L1,L7",
"link" : "H2,H8,H12"
},
and Kröpcke
to look like this (we add in H4
and H7
):
{
"id" : "H12",
"name" : "Kroepcke",
"line" : "L1,L4,L7",
"link" : "H3,H4,H7,H11,H13"
},
as well as Laatzen
, where we replace H3
(Hauptbahnhof
) with H12
(Kröpcke
):
{
"id" : "H4",
"name" : "Laatzen",
"line" : "L1",
"link" : "H5,H12"
},
and Allerweg
(again, H12
replaces H3
):
{
"id" : "H7",
"name" : "Allerweg",
"line" : "L7",
"link" : "H6,H12"
},
The tests should now pass:
$ prove -lr t/map-tube-hannover.t
t/map-tube-hannover.t .. ok
All tests successful.
Files=1, Tests=4, 1 wallclock secs ( 0.03 usr 0.01 sys + 0.54 cusr 0.04
csys = 0.62 CPU)
Result: PASS
… and they do! Yay!
Converting the map into an image with map2image.pl
, you should see this
output:
where most of the connections go through Kröpcke
as we’d expect for such a
central node.
What’s nice about the network graph now is that it’s starting to look more and more like the actual network graph in the Üstra “Netzplan U”.
Since we’ve reached a new stable state of the code, let’s commit this change and move on.
$ git commit share/hannover-map.json t/map-tube-hannover.t -m "Fix connections through Kröpcke
>
> Routes 1 and 7 in the tests were no longer correct as they didn't reflect
> reality. The stations Allerweg and Laatzen were actually connected to
> Kröpcke and not to Hauptbahnhof. This change fixes the issue and ensures
> the network better reflects the actual tram network in Hannover."
[main f931ec1] Fix connections through Kröpcke
2 files changed, 6 insertions(+), 6 deletions(-)
Now that our map has gained more complexity, it means that we can start to
do interesting things. Map::Tube
is, after all, a routing framework.
Thus, we can start planning routes across lines, not only within lines as
we’ve been doing so far. In other words, we can now look for a route
requiring us to change trains and transfer to another line. To search for
routes, we use the get_shortest_route()
method.
Let’s build a small program that we can use to find routes within our
network. Then we can try finding a route from Garbsen
(on Linie 4
) to
Sarstedt
(on Linie 1
) as an example.
I’m going to avoid creating tests for the program and I’ll skip input validation7 so that we can get things up and running quickly. These skipped steps are left as an exercise for the reader. 😉
Create a file called bin/get_route.pl
in your favourite editor and enter
this code:
use strict;
use warnings;
use lib qw(lib);
use Map::Tube::Hannover;
# grab the start and end stations of the route
my $from = $ARGV[0];
my $to = $ARGV[1];
# show how to get from one to the other
my $hannover = Map::Tube::Hannover->new;
print $hannover->get_shortest_route($from, $to), "\n";
# vim: expandtab shiftwidth=4
This should be sufficient for our needs. As with map2image.pl
, we set the
lib
path explicitly so that we don’t have to mention -I lib
on the
command line. Then we import the Map::Tube::Hannover
module. We grab the
start and end stations of our route from the @ARGV
array because we’re
supplying this information via command line arguments. Thus, we’ll run the
program like so:
$ perl get_route.pl 'start station name' 'end station name'
We then create an instance of a Map::Tube::Hannover
object and call the
get_shortest_route()
method on that. The names of our start and end
stations are passed as arguments to get_shortest_route()
. We print the
result of this method call to the terminal, thus showing the route to take.
Let’s see it in action. In our first example, we want to find a route from
Garbsen
to Sarstedt
:
$ perl bin/get_route.pl Garbsen Sarstedt
Garbsen (Linie 4), Laukerthof (Linie 4), Kroepcke (Linie 1, Linie 4, Linie 7), Laatzen (Linie 1), Sarstedt (Linie 1)
That was easy, wasn’t it? Now we know that to get from Garbsen
to Sarstedt
,
we have to change trains at Kröpcke
.
How do we handle stations with spaces in their names, such as Vier Grenzen
? Simply add quotes around the name when calling the program:
$ perl bin/get_route.pl Garbsen 'Vier Grenzen'
Garbsen (Linie 4), Laukerthof (Linie 4), Kroepcke (Linie 1, Linie 4, Linie 7), Hauptbahnhof (Linie 1, Linie 7), Vier Grenzen (Linie 7)
This example highlights two options for the shortest route: one could change
to Linie 1
at Kroepcke
and then change to Linie 7
at Hauptbahnhof
,
or one could change directly to Linie 7
at Kroepcke
. Both paths are
equivalent ways of getting from Garbsen
to Vier Grenzen
.
Cool!
That looks like a handy program to have around. Let’s add it to the repository and commit the change:
$ git add bin/get_route.pl
$ git commit -m "Add program to get a route from one station to another"
[main ff27347] Add program to get a route from one station to another
1 file changed, 17 insertions(+)
create mode 100644 bin/get_route.pl
We’ve finally been able to use our module for what we intended it to do: find routes through the railway network. We’ve also seen that it’s useful to have a visual representation of the map as a debugging aid. Also, we’ve maintained our flow, using tests to drive new features and committing changes to Git as soon as the code achieves a suitable stable state.
In the final post in this series, we’ll see how to build connections between stations that aren’t connected directly.
Originally posted on https://peateasea.de.
Image credits: Hannover coat of arms: Wikimedia Commons, U-Bahn symbol: Wikimedia Commons, Langenhagen coat of arms: Wikimedia Commons, Sarstedt coat of arms: Wikimedia Commons, Wettbergen coat of arms, Misburg coat of arms, Garbsen coat of arms, Telemax tower.
Thumbnail credits: Swiss Cottage Underground Station (Jubilee Line) by Hugh Llewelyn
It turns out that suburb of Roderbruch doesn’t have a coat of arms. One of its well-known landmarks is the Telemax tower, hence I used it to make a coat-of-arms-like image for this station in the article’s cover image. ↩︎
I really, honestly, didn’t intend that pun! ↩︎
In case you’ve ever wondered, the question mark inside a rotated square is called the replacement character and has the Unicode value U+FFFD. ↩︎
In German, umlauts can be written with their ASCII equivalents. In other words, one can write the umlauts ä, ö and ü as “ae”, “oe” and “ue”, respectively. ↩︎
Since I wrote the initial draft of this series,
Mohammad has already fixed the issue. If you want to avoid the UTF-8
problems, then you’ll need to install Map::Tube
with at least version
4.08. ↩︎
It turned out to be difficult to show a nice word diff of the change, so this was the best I could do to highlight what was added. ↩︎
Naughty me! Bad Paul! ↩︎
Published by PERL on Saturday 24 May 2025 07:14
Published on Sunday 18 May 2025 13:01
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
You are given an array of numbers with even length. Write a script to return the count of distinct average. The average is calculate by removing the minimum and the maximum, then average of the two.
Our solution will be pretty short, contained in just a single file that has the following structure.
The preamble is just whatever we need to include. Here we aren’t using anything special, just specifying the latest Perl version.
the main section is just some basic tests.
MAIN
:{
say distinct_average 1, 2, 4, 3, 5, 6;
say distinct_average 0, 2, 4, 8, 3, 5;
say distinct_average 7, 3, 1, 0, 5, 9;
}
◇
Fragment referenced in 1.
All the work is done in the following subroutine. This problem is straightforward enough to not require much more code than this.
To describe the details of this subroutine sections of it are separated out into their own code sections.
$ perl perl/ch-1.pl 1 2 2
You are given two strings containing zero or more #. Write a script to return true if the two given strings are same by treating # as backspace.
Our solution will have the following structure.
The main section is just some basic tests.
MAIN
:{
say backspace_compare q/ab#c/, q/ad#c/;
say backspace_compare q/ab##/, q/a#b#/;
say backspace_compare q/a#b/, q/c/;
}
◇
Fragment referenced in 8.
The approach is to maintain two arrays (think of them as stacks), one for each string. As we process each string we will push a character onto the stack as each non-# character is encountered. We’ll pop a character from the stack for every # encountered. When both strings have been processed we’ll compare the two resulting stacks. This code seems to be well contained in a single subroutine.
sub backspace_compare{
my($s, $t) = @_;
my @s = split //, $s;
my @t = split //, $t;
my @u = ();
my @v = ();
{
my $s_ = shift @s || undef;
my $t_ = shift @t || undef;
push @u, $s_ if $s_ && $s_ ne q/#/;
push @v, $t_ if $t_ && $t_ ne q/#/;
pop @u if $s_ && $s_ eq q/#/;
pop @v if $t_ && $t_ eq q/#/;
redo if @s || @t;
}
return join(q//, @u) eq join(q//, @v)?q/true/
:q/false/;
}
◇
Fragment referenced in 8.
$ perl perl/ch-2.pl true true false
Published on Thursday 15 May 2025 00:00
Published by Dave Cross on Wednesday 14 May 2025 16:22
Like most developers, I have a mental folder labelled “useful little tools I’ll probably never build.” Small utilities, quality-of-life scripts, automations — they’d save time, but not enough to justify the overhead of building them. So they stay stuck in limbo.
That changed when I started using AI as a regular part of my development workflow.
Now, when I hit one of those recurring minor annoyances — something just frictiony enough to slow me down — I open a ChatGPT tab. Twenty minutes later, I usually have a working solution. Not always perfect, but almost always 90% of the way there. And once that initial burst of momentum is going, finishing it off is easy.
It’s not quite mind-reading. But it is like having a superpowered pair programmer on tap.
Obviously, I do a lot of Perl development. When working on a Perl project, it’s common to have one or more lib/
directories in the repo that contain the project’s modules. To run test scripts or local tools, I often need to set the PERL5LIB
environment variable so that Perl can find those modules.
But I’ve got a lot of Perl projects — often nested in folders like ~/git
, and sometimes with extra lib/
directories for testing or shared code. And I switch between them frequently. Typing:
export PERL5LIB=lib
…over and over gets boring fast. And worse, if you forget to do it, your test script breaks with a misleading “Can’t locate Foo/Bar.pm” error.
What I wanted was this:
Every time I cd
into a directory, if there are any valid lib/
subdirectories beneath it, set PERL5LIB
automatically.
Only include lib/
dirs that actually contain .pm
files.
Skip junk like .vscode
, blib
, and old release folders like MyModule-1.23/
.
Don’t scan the entire world if I cd ~/git
, which contains hundreds of repos.
Show me what it’s doing, and let me test it in dry-run mode.
With ChatGPT, I built a drop-in Bash function in about half an hour that does exactly that. It’s now saved as perl5lib_auto.sh
, and it:
Wraps cd()
to trigger a scan after every directory change
Finds all qualifying lib/
directories beneath the current directory
Filters them using simple rules:
Must contain .pm
files
Must not be under .vscode/
, .blib/
, or versioned build folders
Excludes specific top-level directories (like ~/git
) by default
Lets you configure everything via environment variables
Offers verbose
, dry-run
, and force
modes
Can append to or overwrite your existing PERL5LIB
You drop it in your ~/.bashrc
(or wherever you like), and your shell just becomes a little bit smarter.
source ~/bin/perl5lib_auto.sh cd ~/code/MyModule # => PERL5LIB set to: /home/user/code/MyModule/lib PERL5LIB_VERBOSE=1 cd ~/code/AnotherApp # => [PERL5LIB] Found 2 eligible lib dir(s): # => /home/user/code/AnotherApp/lib # => /home/user/code/AnotherApp/t/lib # => PERL5LIB set to: /home/user/code/AnotherApp/lib:/home/user/code/AnotherApp/t/lib
You can also set environment variables to customise behaviour:
export PERL5LIB_EXCLUDE_DIRS="$HOME/git:$HOME/legacy" export PERL5LIB_EXCLUDE_PATTERNS=".vscode:blib" export PERL5LIB_LIB_CAP=5 export PERL5LIB_APPEND=1
Or simulate what it would do:
PERL5LIB_DRYRUN=1 cd ~/code/BigProject
The full script is available on GitHub:
https://github.com/davorg/perl5lib_auto
I’d love to hear how you use it — or how you’d improve it. Feel free to:
Star the repo
Open issues for suggestions or bugs
Send pull requests with fixes, improvements, or completely new ideas
It’s a small tool, but it’s already saved me a surprising amount of friction. If you’re a Perl hacker who jumps between projects regularly, give it a try — and maybe give AI co-coding a try too while you’re at it.
What useful little utilities have you written with help from an AI pair-programmer?
The post Turning AI into a Developer Superpower: The PERL5LIB Auto-Setter first appeared on Perl Hacks.