Perl Quiz

Perl/Koha questions and answers

Question 1

What is the output?

my $s = "foo:bar";
my ($r) = split /:/, $s;
say $r;

Answer 1

What is the output?

my $s = "foo:bar";
my ($r) = split /:/, $s;
say $r;
Can't locate object method "say" via package "foo" (perhaps you forgot to load "foo"?)
use Modern::Perl; is missing!

Question 2

What is the output?

use Modern::Perl;
my $s = "foo:bar";
my ($r) = split /:/, $s;
say $r;

Answer 2

What is the output?

use Modern::Perl;
my $s = "foo:bar";
my ($r) = split /:/, $s;
say $r;
foo
Now we assume we always have `use Modern::Perl;` :)

Question 3

What is the output?

my @array = qw( 1 2 3 4 );
my $five = '5';
if ( my $i = grep { $_ == $five } ( @array, $five ) ) {
    say "* $i: ok";
}

Answer 3

What is the output?

my @array = qw( 1 2 3 4 );
my $five = '5';
if ( my $i = grep { $_ == $five } ( @array, $five ) ) {
    say "* $i: ok";
}
* 1: ok

Question 4

What is the output?

my @array = qw( 1 2 3 4 );
my $five = '5';
if ( my $i = grep { $_ == $five } ( @array, $five ) ) {
    say "* $i: ok";
}
# *1: ok

if ( my ($i) = grep { $_ == $five } ( @array, $five ) ) {
    say "** $i: ok";
}

Answer 4

What is the output?

my @array = qw( 1 2 3 4 );
my $five = '5';
if ( my $i = grep { $_ == $five } ( @array, $five ) ) {
    say "* $i: ok";
}
# *1: ok

if ( my ($i) = grep { $_ == $five } ( @array, $five ) ) {
    say "** $i: ok";
}
** 5: ok

Question 5

What is the output?

my $h = {
    0   => "0",
    001 => "001",
    1   => "1",
};
say $h->{"001"};

Answer 5

What is the output?

my $h = {
    0   => "0",
    001 => "001",
    1   => "1",
};
say $h->{"001"};
Use of uninitialized value in say

{
    0   0,
    1   1
}

Question 6

What is the output?

my $x = " ";
say "'$x' not empty" if $x;

Answer 6

What is the output?

my $x = " ";
say "'$x' not empty" if $x;
' ' not empty

Question 7

What is the output?

my $x = "0.00";
say "x is true" if $x;

Answer 7

What is the output?

my $x = "0.00";
say "x is true" if $x;
x is true
"0.00" is not an empty string, "0", or undef and so is considered false

Question 8

What is the output?

my $x = "";
say "'$x' < 1" if $x < 1;

Answer 8

What is the output?

my $x = "";
say "'$x' < 1" if $x < 1;
Argument "" isn't numeric in numeric lt (<)
'' < 1
An empty string "" is converted to 0 in a numeric context.

Question 9

What is the output?

my $x = 'x';
say "'$x' == 0" if $x == 0;

Answer 9

What is the output?

my $x = 'x';
say "'$x' == 0" if $x == 0;
Argument "x" isn't numeric in numeric eq (==)
'x' == 0
'x' is not a valid number so it's converted to 0 in a numeric context

Question 10

What is the output?

my $r = '0E0';
say $r == 0 ? "0" : "not 0";

Answer 10

What is the output?

my $r = '0E0';
say $r == 0 ? "0" : "not 0";
0

Question 11

If, unless or error?

my $x;
say "if" if $x->{ok};
say "unless" unless $x->{ok};

Answer 11

If, unless or error?

my $x;
say "if" if $x->{ok};
say "unless" unless $x->{ok};
unless

Question 12

What is the output?

my $h = { '❤' => 1 };
say $h->{❤};

Answer 12

What is the output?

my $h = { '❤' => 1 };
say $h->{❤};
Unrecognized character \x{2764}; marked by <-- HERE after say $h->{<-- HERE near column 10
Missing `use utf8;` 
use utf8;
my $h = { '❤' => 1 };
say $h->{❤};
1

Question 13

What is the output?

my $hashref = { a => 42 };
my $string = "something";
say "one" if $hashref->{b}->{stuff} ne $string;
say "two" if exists $hashref->{b} && $hashref->{b}->{stuff} ne $string;

Answer 13

What is the output?

my $hashref = { a => 42 };
my $string = "something";
say "one" if $hashref->{b}->{stuff} ne $string;
say "two" if exists $hashref->{b} && $hashref->{b}->{stuff} ne $string;
Use of uninitialized value in string ne
one
Use of uninitialized value in string ne
two
Beware autovivification!

Question 14

What is the output?

use List::MoreUtils qw( any );

my @data = qw( 1 3 42 );

for my $m ( qw( 1 2 3 ) ) {
    say "$m found with any" if any { $m eq $_ } @data;
}

Answer 14

What is the output?

use List::MoreUtils qw( any );

my @data = qw( 1 3 42 );

for my $m ( qw( 1 2 3 ) ) {
    say "$m found with any" if any { $m eq $_ } @data;
}
1 found with any
3 found with any

Question 15

What is the output?

use List::MoreUtils qw( any );

my @data = qw( 1 3 42 );

for my $m ( qw( 1 2 3 ) ) {
    say "$m found with any" if any { $m eq $_ } @data;
}
#1 found with any
#3 found with any
for my $m ( qw( 1 2 3 )  ) {
    say "$m found with grep" if grep { /$m/ } @data;
}

Answer 15

What is the output?

use List::MoreUtils qw( any );

my @data = qw( 1 3 42 );

for my $m ( qw( 1 2 3 ) ) {
    say "$m found with any" if any { $m eq $_ } @data;
}
#1 found with any
#3 found with any
for my $m ( qw( 1 2 3 )  ) {
    say "$m found with grep" if grep { /$m/ } @data;
}

1 found with grep
2 found with grep
3 found with grep

Question 16

What is the output?

use List::MoreUtils qw( any );

my @data = qw( 1 3 42 );

for my $m ( qw( 1 2 3 ) ) {
    say "$m found with any" if any { $m eq $_ } @data;
}
#1 found with any
#3 found with any
for my $m ( qw( 1 2 3 )  ) {
    say "$m found with grep" if grep { /$m/ } @data;
}
#1 found with grep
#2 found with grep
#3 found with grep
for my $m ( qw( 1 2 3 )  ) {
    say "$m found with grep eq" if grep { $m eq $_ } @data;
}

Answer 16

What is the output?

use List::MoreUtils qw( any );

my @data = qw( 1 3 42 );

for my $m ( qw( 1 2 3 ) ) {
    say "$m found with any" if any { $m eq $_ } @data;
}
#1 found with any
#3 found with any
for my $m ( qw( 1 2 3 )  ) {
    say "$m found with grep" if grep { /$m/ } @data;
}
#1 found with grep
#2 found with grep
#3 found with grep
for my $m ( qw( 1 2 3 )  ) {
    say "$m found with grep eq" if grep { $m eq $_ } @data;
}
1 found with grep eq
3 found with grep eq

Question 17

What is the output?

my $version = "0123456789";
say sprintf "{%10d%d}", $version, 10;

Answer 17

What is the output?

my $version = "0123456789";
say sprintf "{%10d%d}", $version, 10;
{ 12345678910}

Question 18

What is the output?

my %h = (
    1 => 0,
    2 => '',
    3 => 3,
    4 => undef,
);

for my $k ( sort keys %h ) {
    say "$k ne ''" if $h{$k} ne '';
    say "$k eq ''" if $h{$k} eq '';
}

Answer 18

What is the output?

my %h = (
    1 => 0,
    2 => '',
    3 => 3,
    4 => undef,
);

for my $k ( sort keys %h ) {
    say "$k ne ''" if $h{$k} ne '';
    say "$k eq ''" if $h{$k} eq '';
}
1 ne ''
2 eq ''
3 ne ''
Use of uninitialized value $h{"4"} in string ne
Use of uninitialized value $h{"4"} in string eq
4 eq ''
Care about warnings! Perl considers undef as an empty string in a string context

Tips 19

Did you know?

my @array = qw( 5 4 3 2 1 );
while ( my ( $i, $n ) = each @array ) {
    say sprintf "%s-%s", $i, $n;
}

Answer 19

Did you know?

my @array = qw( 5 4 3 2 1 );
while ( my ( $i, $n ) = each @array ) {
    say sprintf "%s-%s", $i, $n;
}
0-5
1-4
2-3
3-2
4-1
You can iterate over an array and get a counter variable. No need for a `my $i`.

Tips 20

Did you know?

# Destructure a hash
my %h = ( one => 1, two => 2 );
my ( $one, $two ) = @h{qw(one two)};
say "$one, $two";

# Destructure a hashref
my $hr = { three => 3, four => 4 };
( $one, $two ) = @{$hr}{qw(three four)};
say "$one, $two";

Answer 20

Did you know?

# Destructure a hash
my %h = ( one => 1, two => 2 );
my ( $one, $two ) = @h{qw(one two)};
say "$one, $two";

# Destructure a hashref
my $hr = { three => 3, four => 4 };
( $one, $two ) = @{$hr}{qw(three four)};
say "$one, $two";
1, 2
3, 4
Could replace our `$params`. Or... better... use signatures?

Question 21

Why we should not do that?

use Koha::Patron::Categories;
use Koha::DateUtils qw( dt_from_string );
sub get_expiry_date(){
    my ($date) = @_;
    return $date->add( months => 12 );
}
my $dt = dt_from_string;
my $c = Koha::Patron::Categories->find('S');
say $c->get_expiry_date($dt);

Answer 21

Why we should not do that?

use Koha::Patron::Categories;
use Koha::DateUtils qw( dt_from_string );
sub get_expiry_date(){
    my ($date) = @_;
    return $date->add( months => 12 );
}
my $dt = dt_from_string;
my $c = Koha::Patron::Categories->find('S');
say $c->get_expiry_date($dt);
Always clone the DateTime object if you modify it. 
sub get_expiry_date(){
    my ($date) = @_;
    return $date->clone->add( months => 12 );
}

Tips 22

Did you know?

use Time::Fake;
use Koha::DateUtils qw(dt_from_string);
my $now = dt_from_string;
say $now->ymd;
my $yesterday = $now->clone->subtract(days => 1);
Time::Fake->offset($yesterday->epoch);
say dt_from_string->ymd;

Answer 22

Did you know?

use Time::Fake;
use Koha::DateUtils qw(dt_from_string);
my $now = dt_from_string;
say $now->ymd;
my $yesterday = $now->clone->subtract(days => 1);
Time::Fake->offset($yesterday->epoch);
say dt_from_string->ymd;
2025-04-01
2025-03-31

Question 23

What is the output?

use Koha::Items;
say Koha::Items->search->empty->count;

Answer 23

What is the output?

use Koha::Items;
say Koha::Items->search->empty->count;
0
And with 
DBIC_TRACE=1 perl -MModern::Perl -MKoha::Items -e 'say Koha::Items->search->empty->count'
Still 0.

Question 24

What is the output?

use Koha::Libraries;
my $l = Koha::Libraries->search({ branchcode => 'does_not_exist' })->next;
say $l;

my $ll = Koha::Libraries->search({ branchcode => 'does_not_exist' });
say $ll->next;

Answer 24

What is the output?

use Koha::Libraries;
my $l = Koha::Libraries->search({ branchcode => 'does_not_exist' })->next;
say $l;

my $ll = Koha::Libraries->search({ branchcode => 'does_not_exist' });
say $ll->next;
Use of uninitialized value $l in say
Why? I don't know! Context?

Question 25

What is the output?

#MariaDB [koha_kohadev]> select issue_id from issues\G
#*************************** 1. row ***************************
#issue_id: 2
#1 row in set (0.001 sec)
use Koha::Checkouts;
say "max 1: "
    . Koha::Checkouts->search( {}, { columns => [ { max_issue_id => { max => 'issue_id' } } ] } )
    ->get_column('max_issue_id');
say "max 2: " . Koha::Checkouts->search()->_resultset->get_column('issue_id')->max;
say "max 3: " . Koha::Checkouts->_resultset->get_column('issue_id')->max;
say "max 4: " . Koha::Checkouts->search()->get_column('issue_id')->max;

Answer 25

What is the output?

#MariaDB [koha_kohadev]> select issue_id from issues\G
#*************************** 1. row ***************************
#issue_id: 2
#1 row in set (0.001 sec)
use Koha::Checkouts;
say "max 1: "
    . Koha::Checkouts->search( {}, { columns => [ { max_issue_id => { max => 'issue_id' } } ] } )
    ->get_column('max_issue_id');
say "max 2: " . Koha::Checkouts->search()->_resultset->get_column('issue_id')->max;
say "max 3: " . Koha::Checkouts->_resultset->get_column('issue_id')->max;
say "max 4: " . Koha::Checkouts->search()->get_column('issue_id')->max;
max 1: 1
max 2: 2
max 3: 2
Can't locate object method "max" via package "1" (perhaps you forgot to load "1"?)
Open a bug?

Question 26

What is the output?

use Koha::Patrons;
my $id="1<script>alert('booh!')</script>";
my $p = Koha::Patrons->find($id);
say $p ? "found" : "not found";

Answer 26

What is the output?

use Koha::Patrons;
my $id="1<script>alert('booh!')</script>";
my $p = Koha::Patrons->find($id);
say $p ? "found" : "not found";
found
Always sanitize!

Question 27

What is the output?

my $h = { href => { 'ends-with' => 123 } };
while ( my $k = keys %{ $h->{href} } ) {
    say $k;
}

Answer 27

What is the output?

my $h = { href => { 'ends-with' => 123 } };
while ( my $k = keys %{ $h->{href} } ) {
    say $k;
}
keys evaluated in scalar context, always true, print infinity of "1"
Do that instead: 
for my $k ( keys %{$h->{href}} ) {
    say $k;
}

Question 28

What is the output?

use Koha::Patrons;
while ( my $patron = Koha::Patrons->search->next ) {
    say $patron->id;
}

Answer 28

What is the output?

use Koha::Patrons;
while ( my $patron = Koha::Patrons->search->next ) {
    say $patron->id;
}
Always run search->next, print infinity of "1"

Question 29

What is the output?

use Koha::Patrons;
my $patrons = Koha::Patrons->search;
for my $patron ( $patrons->next ) {
    say $patron->id;
}

Answer 29

What is the output?

use Koha::Patrons;
my $patrons = Koha::Patrons->search;
for my $patron ( $patrons->next ) {
    say $patron->id;
}
1
print 1, first id

Question 30

How to know $patron has dirty columns?

use Koha::Patrons;
my $patron = Koha::Patrons->find(51);
$patron->userid("pouet");

Answer 30

How to know $patron has dirty columns?

use Koha::Patrons;
my $patron = Koha::Patrons->find(51);
$patron->userid("pouet");
$patron->is_changed;

Question 31

What is the output?

# There is no city in DB
use C4::Context;
my $dbh = C4::Context->dbh;
my $city = Koha::City->new({ city_name => 'name' })->store;
say $city->cityid;
say $dbh->last_insert_id( undef, undef, 'cities', undef );
say $dbh->last_insert_id( undef, undef, 'not_exist', undef );
say $dbh->last_insert_id( undef, undef, 'borrowers', undef );

Answer 31

What is the output?

# There is no city in DB
use C4::Context;
my $dbh = C4::Context->dbh;
my $city = Koha::City->new({ city_name => 'name' })->store;
say $city->cityid;
say $dbh->last_insert_id( undef, undef, 'cities', undef );
say $dbh->last_insert_id( undef, undef, 'not_exist', undef );
say $dbh->last_insert_id( undef, undef, 'borrowers', undef );
1
1
1
1
Never use last_insert_id!

Question 32

What is the output?

use C4::Context;
use Koha::Patrons;
my $dbh = C4::Context->dbh;
my $patron = Koha::Patron->new({ userid => 'foo', categorycode => 'S', branchcode => 'CPL' })->store;
say $patron->id;
say $dbh->last_insert_id( undef, undef, 'borrowers', undef );
say $dbh->last_insert_id( undef, undef, 'not_exist', undef );
say $dbh->last_insert_id( undef, undef, 'cities', undef );

Answer 32

What is the output?

use C4::Context;
use Koha::Patrons;
my $dbh = C4::Context->dbh;
my $patron = Koha::Patron->new({ userid => 'foo', categorycode => 'S', branchcode => 'CPL' })->store;
say $patron->id;
say $dbh->last_insert_id( undef, undef, 'borrowers', undef );
say $dbh->last_insert_id( undef, undef, 'not_exist', undef );
say $dbh->last_insert_id( undef, undef, 'cities', undef );
54
0
0
0
What?
Really, never use last_insert_id!

Question 33

What is the output?

my $foo = "foo";
say $foo->isa("Koha::Object");
use Koha::Patrons;
my $patron = Koha::Patrons->find(51);
say $patron->isa("Koha::Object");
say $patron->isa("Koha::Patron");
undef $foo;
say $foo->isa("Koha::Object");

Answer 33

What is the output?

my $foo = "foo";
say $foo->isa("Koha::Object");
use Koha::Patrons;
my $patron = Koha::Patrons->find(51);
say $patron->isa("Koha::Object");
say $patron->isa("Koha::Patron");
undef $foo;
say $foo->isa("Koha::Object");
 # Empty string
1
1
Can't call method "isa" on an undefined value

Question 34

Do you like 'and'?

my $x = 5;
my $r;
say "and";
$r = $x == 5 and $x == 42;
say $r;
say "&&";
$r = $x == 5 && $x == 42;
say $r;

Answer 34

Do you like 'and'?

my $x = 5;
my $r;
say "and";
$r = $x == 5 and $x == 42;
say $r;
say "&&";
$r = $x == 5 && $x == 42;
say $r;
Useless use of numeric eq (==) in void context
and
1
&&
Never use "and", or know what you are doing.
`and` has lower precedence than `==` Or always use parenthesis 
my $x = 5;
my $r;
say "and";
$r = ( $x == 5 and $x == 42 ) ? 1 : 0;
say $r;
say "&&";
$r = ( $x == 5 && $x == 42 ) ? 1 : 0;
say $r;
#and
#0
#&&
#0

Question 35

Do you want some regexs?

my $op = 'cud-add';
( my $x = $op ) =~ s|cud-||g;
say $x;

Answer 35

Do you want some regexs?

my $op = 'cud-add';
( my $x = $op ) =~ s|cud-||g;
say $x;
add

Question 36

Do you want some regexs?

$op = 'cud-add';
say $op =~ s/cud-//r;
say $op;

Answer 36

Do you want some regexs?

$op = 'cud-add';
say $op =~ s/cud-//r;
say $op;
add
cud-add
r - perform non-destructive substitution and return the new value 
my $h = { field => 'foo' };
my $k = 'items.field';
say $h->{ $k =~ s|items.||r };

Question 37

Do you want some regexs?

my $a = "abcde";
my ( $b ) = $a =~ /(.*)de/;
say sprintf "=%s=%s=", $a, $b;

my $x = "abcde";
( my $y = $x ) =~ s/de$//;
say sprintf "=%s=%s=", $x, $y;

my $xx = "abcde";
my ( $yy ) = $xx =~ s/de$//;
say sprintf "=%s=%s=", $xx, $yy;

Answer 37

Do you want some regexs?

my $a = "abcde";
my ( $b ) = $a =~ /(.*)de/;
say sprintf "=%s=%s=", $a, $b;

my $x = "abcde";
( my $y = $x ) =~ s/de$//;
say sprintf "=%s=%s=", $x, $y;

my $xx = "abcde";
my ( $yy ) = $xx =~ s/de$//;
say sprintf "=%s=%s=", $xx, $yy;
=abcde=abc=
=abcde=abc=
=abc=1=

Question 38

Do you want some references?

my $a = [ 1, 2, 3 ];

sub xxx {
    return $a;
}

sub yyy {
    return [@$a];
}

my $xxx = xxx();
for my $x (@$xxx) { $x += 1 }
say join ", ", @$a;

my $yyy = yyy();
for my $x (@$yyy) { $x += 1 }
say join ", ", @$a;
say join ", ", @$yyy;

Answer 38

Do you want some references?

my $a = [ 1, 2, 3 ];

sub xxx {
    return $a;
}

sub yyy {
    return [@$a];
}

my $xxx = xxx();
for my $x (@$xxx) { $x += 1 }
say join ", ", @$a;

my $yyy = yyy();
for my $x (@$yyy) { $x += 1 }
say join ", ", @$a;
say join ", ", @$yyy;
2, 3, 4
2, 3, 4
3, 4, 5

Question 39

Do you want some references?

my @x = (1, 2, 3);
my @y = @x;
$x[0] = 42;
say "@x";
say "@y";

Answer 39

Do you want some references?

my @x = (1, 2, 3);
my @y = @x;
$x[0] = 42;
say "@x";
say "@y";
42 2 3
1 2 3

Question 40

Do you want some references?

my @x = ( { a => 1 }, { a => 2 }, { a => 3 } );
my @y = @x;
$x[0]->{a} = 42;
say join ' ', map { $_->{a} } @x;
say join ' ', map { $_->{a} } @y;

Answer 40

Do you want some references?

my @x = ( { a => 1 }, { a => 2 }, { a => 3 } );
my @y = @x;
$x[0]->{a} = 42;
say join ' ', map { $_->{a} } @x;
say join ' ', map { $_->{a} } @y;
42 2 3
42 2 3
Because we copied the references of the hashref
How to avoid that?

Question 41

Do you want some references?

my @x = ( { a => 1 }, { a => 2 }, { a => 3 } );
my @y = map { { %{$_} } } @x;
$x[0]->{a} = 42;
say join ' ', map { $_->{a} } @x;
say join ' ', map { $_->{a} } @y;

Answer 41

Do you want some references?

my @x = ( { a => 1 }, { a => 2 }, { a => 3 } );
my @y = map { { %{$_} } } @x;
$x[0]->{a} = 42;
say join ' ', map { $_->{a} } @x;
say join ' ', map { $_->{a} } @y;
42 2 3
1 2 3
Or Using Clone::clone or Storable::dclone or Sereal

Tips 42

Some TestBuilder tricks

use t::lib::TestBuilder;
my $builder = t::lib::TestBuilder->new;
$builder->build_object({ class => 'Koha::Patrons' }) for 1..42;

my @branchcodes = Koha::Libraries->search->get_column('branchcode');
my $biblio = $builder->build_sample_biblio;
for my $i ( 1 .. 100 ) {
    say $i;
    my $branchcode = @branchcodes[ int( rand( scalar @branchcodes ) ) ];
    $builder->build_sample_item(
        {
            biblionumber => $biblio->biblionumber,
            library      => $branchcode,
            callnumber   => undef
        }
    );
}
say "biblionumber=".$biblio->biblionumber;

$builder->build_sample_item() for 1 .. 100;

Question 43

What is missing?

use C4::Circulation qw( AddIssue );
use Koha::Items;
use Koha::Patrons;
my $patron = Koha::Patrons->find(51);
my $item = Koha::Items->find(1);
AddIssue($patron, $item->barcode);
#Can't use an undefined value as a HASH reference at /kohadevbox/koha/C4/Circulation.pm line 1733.

Answer 43

What is missing?

use C4::Circulation qw( AddIssue );
use Koha::Items;
use Koha::Patrons;
my $patron = Koha::Patrons->find(51);
my $item = Koha::Items->find(1);
AddIssue($patron, $item->barcode);
#Can't use an undefined value as a HASH reference at /kohadevbox/koha/C4/Circulation.pm line 1733.
t::lib::Mocks::mock_userenv({patron => $patron});

Question 44

Does it do what you want?

sub a { say "a" };
sub b { say "b" };
my $h = {
    a => a(), b => b()
};
use Data::Printer colored => 1;
say p $h;

Answer 44

Does it do what you want?

sub a { say "a" };
sub b { say "b" };
my $h = {
    a => a(), b => b()
};
use Data::Printer colored => 1;
say p $h;
a
b
{
    a   1,
    b   1
}

Tips 45

Koha::Result::Boolean is awesome!

use Koha::Result::Boolean;

sub ok {
    return Koha::Result::Boolean->new(1)->add_message( { message => "this is not an error" } );
}

sub nok {
    return Koha::Result::Boolean->new(0)->add_message( { message => "this is an error" } );
}

my $ok = ok();

if ($ok) {
    say "all good";
    say @{ $ok->messages }[0]->message;
}
my $nok = nok();
unless ($nok) {
    say "there was an error";
    say @{ $nok->messages }[0]->message;
}

Answer 45

Koha::Result::Boolean is awesome!

use Koha::Result::Boolean;

sub ok {
    return Koha::Result::Boolean->new(1)->add_message( { message => "this is not an error" } );
}

sub nok {
    return Koha::Result::Boolean->new(0)->add_message( { message => "this is an error" } );
}

my $ok = ok();

if ($ok) {
    say "all good";
    say @{ $ok->messages }[0]->message;
}
my $nok = nok();
unless ($nok) {
    say "there was an error";
    say @{ $nok->messages }[0]->message;
}
all good
this is not an error
there was an error
this is an error

Question 46

Do you know BEGIN/END?

my @r = 1;
BEGIN { say "Starting " . scalar(@r); }
say "Running " . scalar(@r);
push @r, "42";
END { say "Ending " . scalar(@r); }

Answer 46

Do you know BEGIN/END?

my @r = 1;
BEGIN { say "Starting " . scalar(@r); }
say "Running " . scalar(@r);
push @r, "42";
END { say "Ending " . scalar(@r); }
Starting 0
Running 1
Ending 2

Question 47

What is the output?

my @c = ( 1, 2, 3 );
for my $c ( @c[ 1 .. $#c ] ) {
    say $c;
}

Answer 47

What is the output?

my @c = ( 1, 2, 3 );
for my $c ( @c[ 1 .. $#c ] ) {
    say $c;
}
2
3

Tips 48

Do you know fc?

use feature qw(fc);
my @x = qw( a B c A b C);
say join ', ', sort @x;
say join ', ', sort { fc($a) cmp fc($b) } @x;

Answer 48

Do you know fc?

use feature qw(fc);
my @x = qw( a B c A b C);
say join ', ', sort @x;
say join ', ', sort { fc($a) cmp fc($b) } @x;

A, B, C, a, b, c
a, A, B, b, c, C
Use fc to correctly sort! See bug 37870 for more details.

Tips 49

How to quickly benchmark?

use Benchmark qw(:all);
use Koha::Patrons;
timethese(
    100000,
    {
        with_new    => sub { Koha::Patrons->new->search->count },
        without_new => sub { Koha::Patrons->search->count },
        count       => sub { Koha::Patrons->count },
    }
);

Answer 49

How to quickly benchmark?

use Benchmark qw(:all);
use Koha::Patrons;
timethese(
    100000,
    {
        with_new    => sub { Koha::Patrons->new->search->count },
        without_new => sub { Koha::Patrons->search->count },
        count       => sub { Koha::Patrons->count },
    }
);
Benchmark: timing 100000 iterations of count, with_new, without_new...
     count: 136 wallclock secs (102.93 usr +  5.51 sys = 108.44 CPU) @ 922.17/s (n=100000)
  with_new: 145 wallclock secs (111.75 usr +  4.87 sys = 116.62 CPU) @ 857.49/s (n=100000)
without_new: 142 wallclock secs (109.61 usr +  4.48 sys = 114.09 CPU) @ 876.50/s (n=100000)

Tips 50

How to quickly debug a failing test?

perl -MCarp::Always t/test.t

Tips 51

How to log all DBIx::Class SQL queries?

# git show dbic_trace # git cherry-pick dbic_trace
    dbic_trace DBIC_TRACE
---
 Koha/Database.pm | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/Koha/Database.pm b/Koha/Database.pm
index 376f910c988..f4b1338e4ed 100644
--- a/Koha/Database.pm
+++ b/Koha/Database.pm
@@ -128,6 +128,8 @@ sub dbh {
 # returns it.
 sub _new_schema {

+    $ENV{DBIC_TRACE} = 1;
+    $ENV{DBIC_TRACE_PROFILE} = 'console';
     require Koha::Schema;

     my $schema = Koha::Schema->connect({