Bug 41253: Add new permission to superlibrarian test

Adds items_modification_by_age to the superlibrarian subtest in t/Koha/Auth/Permissions.t

Signed-off-by: Pedro Amorim <pedro.amorim@openfifth.co.uk>

.codespell-ignore

@@ -1,7 +1,6 @@
 ser
 thes
 nam
-rovider
 fo
 isnt
 wither
@@ -18,3 +17,12 @@ theses
 rouge
 connexion
 falsy
+aas
+carmel
+checkin
+laf
+lamba
+plack
+prfile
+requestor
+vai

.gitignore

@@ -13,12 +13,15 @@ koha-tmpl/opac-tmpl/bootstrap/css/print.css
 koha-tmpl/opac-tmpl/bootstrap/css/print-rtl.css
 koha-tmpl/opac-tmpl/bootstrap/css/sco.css
 koha-tmpl/opac-tmpl/bootstrap/css/sco-rtl.css
+koha-tmpl/opac-tmpl/bootstrap/js/vue/dist/
 
 koha-tmpl/intranet-tmpl/prog/css/maps/
 koha-tmpl/intranet-tmpl/prog/css/bookings.css
 koha-tmpl/intranet-tmpl/prog/css/bookings-rtl.css
 koha-tmpl/intranet-tmpl/prog/css/calendar.css
 koha-tmpl/intranet-tmpl/prog/css/calendar-rtl.css
+koha-tmpl/intranet-tmpl/prog/css/edifact_interchange.css
+koha-tmpl/intranet-tmpl/prog/css/edifact_interchange-rtl.css
 koha-tmpl/intranet-tmpl/prog/css/holds.css
 koha-tmpl/intranet-tmpl/prog/css/holds-rtl.css
 koha-tmpl/intranet-tmpl/prog/css/ill-requests.css

.mailmap

@@ -230,6 +230,8 @@ Lari Strand <lmstrand@gmail.com>                                <lmstrand@gmail.
 Larry Baerveldt                                                 <larry@bywatersolutions.com>
 Laura Escamilla                                                 <laura.escamilla@bywatersolutions.com>
 Laurence Rault <laurence.rault@biblibre.com>                    <laurence.rault@biblibre.com>
+Lawrence O'Regan-Lloyd <loreganlloyd@clamsnet.org>              <loreganlloyd@clamsnet.org>
+Lawrence O'Regan-Lloyd <loreganlloyd@clamsnet.org>              <hello@lawrenceol.dev>
 Leire Diez                                                      <leire@scanbit.net>
 Liz Rea                                                         <liz@catalyst.net.nz>
 Liz Rea <lrea@nekls.org>                                        <liz@nekls.org>

.nvmrc

@@ -0,0 +1 @@
+20

C4/Accounts.pm

@@ -28,12 +28,14 @@ BEGIN {
 }
 
 use C4::Context;
-use C4::Stats;
 use C4::Members;
 use Koha::Account;
 use Koha::Account::Lines;
 use Koha::Account::Offsets;
+use Koha::CirculationRules;
+use Koha::Checkouts;
 use Koha::Items;
+use Koha::Patrons;
 
 =head1 NAME
 
@@ -65,39 +67,70 @@ FIXME : if no replacement price, borrower just doesn't get charged?
 
 sub chargelostitem {
     my $dbh = C4::Context->dbh();
-    my ( $borrowernumber, $itemnumber, $replacementprice, $description ) = @_;
-    my $item  = Koha::Items->find($itemnumber);
-    my $itype = $item->itemtype;
+    my ( $borrowernumber, $itemnumber, $replacementprice, $description, $opts ) = @_;
+    $opts ||= {};
+
+    my $patron = Koha::Patrons->find($borrowernumber);
+    my $item   = Koha::Items->find($itemnumber);
+    my $itype  = $item->itemtype;
     $replacementprice //= 0;
+
     my $defaultreplacecost        = $itype->defaultreplacecost;
-    my $processfee                = $itype->processfee;
     my $usedefaultreplacementcost = C4::Context->preference("useDefaultReplacementCost");
     my $processingfeenote         = C4::Context->preference("ProcessingFeeNote");
 
+    my $lost_control_pref = C4::Context->preference('LostChargesControl');
+    my $lost_control_branch;
+    if ( defined $lost_control_pref && $lost_control_pref eq 'PatronLibrary' ) {
+        $lost_control_branch = $patron->branchcode;
+    } elsif ( defined $lost_control_pref && $lost_control_pref eq 'PickupLibrary' ) {
+        $lost_control_branch = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
+    } else {    # $lost_control_pref eq 'ItemHomeLibrary' or undefined
+        $lost_control_branch =
+            ( C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' )
+            ? $item->homebranch
+            : $item->holdingbranch;
+    }
+
+    my $interface  = $opts->{interface} // C4::Context->interface;
+    my $library_id = defined $opts->{library_id} ? $opts->{library_id} : $lost_control_branch;
+
+    my $issue_id = $opts->{issue_id};
+    if ( !defined $issue_id ) {
+        my $checkout = Koha::Checkouts->find( { itemnumber => $itemnumber } );
+        if ( !$checkout && $item->in_bundle ) {
+            my $host = $item->bundle_host;
+            $checkout = $host->checkout;
+        }
+        $issue_id = $checkout ? $checkout->issue_id : undef;
+    }
+
     if ( $usedefaultreplacementcost && $replacementprice == 0 && $defaultreplacecost ) {
         $replacementprice = $defaultreplacecost;
     }
-    my $checkout = Koha::Checkouts->find( { itemnumber => $itemnumber } );
-    if ( !$checkout && $item->in_bundle ) {
-        my $host = $item->bundle_host;
-        $checkout = $host->checkout;
-    }
-    my $issue_id = $checkout ? $checkout->issue_id : undef;
 
     my $account = Koha::Account->new( { patron_id => $borrowernumber } );
 
-    # first make sure the borrower hasn't already been charged for this item (for this issuance)
     my $existing_charges = $account->lines->search(
         {
             itemnumber      => $itemnumber,
             debit_type_code => 'LOST',
-            issue_id        => $issue_id
+            issue_id        => $issue_id,
         }
     )->count();
 
     # OK, they haven't
     unless ($existing_charges) {
 
+        my $processfee = Koha::CirculationRules->get_effective_rule_value(
+            {
+                rule_name    => "lost_item_processing_fee",
+                categorycode => undef,
+                itemtype     => $itype->itemtype,
+                branchcode   => $library_id,
+            }
+        ) // 0;
+
         #add processing fee
         if ( $processfee && $processfee > 0 ) {
             my $accountline = $account->add_debit(
@@ -106,11 +139,11 @@ sub chargelostitem {
                     description => $description,
                     note        => $processingfeenote,
                     user_id     => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
-                    interface   => C4::Context->interface,
-                    library_id  => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
+                    interface   => $interface,
+                    library_id  => $library_id,
                     type        => 'PROCESSING',
                     item_id     => $itemnumber,
-                    issue_id    => $issue_id,
+                    ( defined $issue_id ? ( issue_id => $issue_id ) : () ),
                 }
             );
         }
@@ -123,11 +156,11 @@ sub chargelostitem {
                     description => $description,
                     note        => undef,
                     user_id     => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
-                    interface   => C4::Context->interface,
-                    library_id  => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
+                    interface   => $interface,
+                    library_id  => $library_id,
                     type        => 'LOST',
                     item_id     => $itemnumber,
-                    issue_id    => $issue_id,
+                    ( defined $issue_id ? ( issue_id => $issue_id ) : () ),
                 }
             );
         }

C4/Acquisition.pm

@@ -69,7 +69,7 @@ BEGIN {
 use Carp qw( carp croak );
 use Text::CSV_XS;
 use C4::Context;
-use C4::Suggestions qw( GetSuggestion GetSuggestionFromBiblionumber ModSuggestion );
+use C4::Suggestions qw( ModSuggestion );
 use C4::Biblio      qw( GetMarcFromKohaField GetMarcStructure IsMarcStructureInternal );
 use C4::Contract    qw( GetContract );
 use C4::Log         qw( logaction );
@@ -1417,11 +1417,11 @@ sub ModReceiveOrder {
     $order->{invoice_unitprice} ||= $order->{unitprice};
     $order->{invoice_currency}  ||= Koha::Acquisition::Currencies->get_active->currency;
 
-    my $suggestionid = GetSuggestionFromBiblionumber($biblionumber);
-    if ($suggestionid) {
+    my $suggestion = Koha::Suggestions->search( { biblionumber => $biblionumber } )->single;
+    if ($suggestion) {
         ModSuggestion(
             {
-                suggestionid => $suggestionid,
+                suggestionid => $suggestion->suggestionid,
                 STATUS       => 'AVAILABLE',
                 biblionumber => $biblionumber
             }
@@ -2418,6 +2418,7 @@ sub GetInvoices {
     my $query = qq{
         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
             aqbooksellers.name AS suppliername,
+            aqbooksellers.invoiceincgst,
           COUNT(
             DISTINCT IF(
               aqorders.datereceived IS NOT NULL,
@@ -2432,7 +2433,20 @@ sub GetInvoices {
               NULL
             )
           ) AS is_linked_to_subscriptions,
-          SUM(aqorders.quantityreceived) AS receiveditems
+          SUM(aqorders.quantityreceived) AS receiveditems,
+          SUM(aqorders.quantity) AS itemsexpected,
+          COALESCE(
+            (SELECT SUM(o.unitprice_tax_excluded * o.quantity) FROM aqorders o WHERE o.invoiceid = aqinvoices.invoiceid),
+            0
+          ) AS total_tax_excluded,
+          COALESCE(
+            (SELECT SUM(o.unitprice_tax_included * o.quantity) FROM aqorders o WHERE o.invoiceid = aqinvoices.invoiceid),
+            0
+          ) AS total_tax_included,
+          COALESCE(
+            (SELECT SUM(adj.adjustment) FROM aqinvoice_adjustments adj WHERE adj.invoiceid = aqinvoices.invoiceid),
+            0
+          ) AS total_adj
         FROM aqinvoices
           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
@@ -2525,12 +2539,12 @@ sub GetInvoices {
     }
 
     $query .=
-        " GROUP BY aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id, aqbooksellers.name";
+        " GROUP BY aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id, aqbooksellers.name, aqbooksellers.invoiceincgst";
 
     if ( $args{order_by} ) {
         my ( $column, $direction ) = split / /, $args{order_by};
         if ( grep { $_ eq $column } @columns ) {
-            $direction ||= 'ASC';
+            $direction = ( uc( $direction // '' ) eq 'DESC' ) ? 'DESC' : 'ASC';
             $query .= " ORDER BY $column $direction";
         }
     }

C4/Auth.pm

@@ -194,8 +194,9 @@ sub get_template_and_user {
         $in->{query}->param( -name => 'login_password',     -values => [$AutoSelfCheckPass] );
         $in->{query}->param( -name => 'koha_login_context', -values => ['sco'] );
     } else {
-        my $request_method = $in->{query}->request_method // q{};
-        unless ( $request_method eq 'POST' && $in->{query}->param('op') eq 'cud-login' ) {
+        my $request_method = $in->{query}->request_method    // q{};
+        my $login_op       = $in->{query}->param('login_op') // q{};
+        unless ( $request_method eq 'POST' && $login_op eq 'cud-login' ) {
             for my $v (qw( login_userid login_password )) {
                 $in->{query}->param( $v, '' )
                     if $in->{query}->param($v);
@@ -274,15 +275,18 @@ sub get_template_and_user {
         }
 
         if ($kick_out) {
+            $session  = get_session("");
             $template = C4::Templates::gettemplate(
                 'opac-auth.tt', 'opac',
                 $in->{query}
             );
+            $template->param( sessionID => $session->id );
+
             $cookie = $cookie_mgr->replace_in_list(
                 $cookie,
                 $in->{query}->cookie(
                     -name     => 'CGISESSID',
-                    -value    => '',
+                    -value    => $session->id,
                     -HttpOnly => 1,
                     -secure   => ( C4::Context->https_enabled() ? 1 : 0 ),
                     -sameSite => 'Lax',
@@ -444,21 +448,24 @@ sub get_template_and_user {
 
     # Sysprefs disabled via URL param
     # Note that value must be defined in order to override via ENV
-    foreach my $syspref (
-        qw(
-        OPACUserCSS
-        OPACUserJS
-        IntranetUserCSS
-        IntranetUserJS
-        OpacAdditionalStylesheet
-        opaclayoutstylesheet
-        intranetcolorstylesheet
-        intranetstylesheet
-        )
-        )
-    {
-        $ENV{"OVERRIDE_SYSPREF_$syspref"} = q{}
-            if $in->{'query'}->param("DISABLE_SYSPREF_$syspref");
+    # Only allow syspref overrides for users with debug permission
+    if ( C4::Context->userenv && haspermission( C4::Context->userenv->{'id'}, { debug => 1 } ) ) {
+        foreach my $syspref (
+            qw(
+            OPACUserCSS
+            OPACUserJS
+            IntranetUserCSS
+            IntranetUserJS
+            OpacAdditionalStylesheet
+            opaclayoutstylesheet
+            intranetcolorstylesheet
+            intranetstylesheet
+            )
+            )
+        {
+            $ENV{"OVERRIDE_SYSPREF_$syspref"} = q{}
+                if $in->{'query'}->param("DISABLE_SYSPREF_$syspref");
+        }
     }
 
     # Anonymous opac search history
@@ -485,9 +492,6 @@ sub get_template_and_user {
         GoogleJackets                => C4::Context->preference("GoogleJackets"),
         OpenLibraryCovers            => C4::Context->preference("OpenLibraryCovers"),
         KohaAdminEmailAddress        => "" . C4::Context->preference("KohaAdminEmailAddress"),
-        LoginFirstname               => ( C4::Context->userenv ? C4::Context->userenv->{"firstname"} : "Bel" ),
-        LoginSurname                 => C4::Context->userenv ? C4::Context->userenv->{"surname"}      : "Inconnu",
-        emailaddress                 => C4::Context->userenv ? C4::Context->userenv->{"emailaddress"} : undef,
         TagsEnabled                  => C4::Context->preference("TagsEnabled"),
         hide_marc                    => C4::Context->preference("hide_marc"),
         item_level_itypes            => C4::Context->preference('item-level_itypes'),
@@ -741,6 +745,18 @@ has authenticated.
 
 =cut
 
+=head2 _version_check
+
+  _version_check( $type, $query );
+
+Checks whether the database version matches the code version. If the C<Version>
+system preference is missing (fresh install) or outdated, redirects to the web
+installer (staff) or the maintenance page (OPAC) and exits.
+
+C<$type> is C<"opac"> or C<"intranet">. C<$query> is the current CGI object.
+
+=cut
+
 sub _version_check {
     my $type  = shift;
     my $query = shift;
@@ -787,6 +803,17 @@ sub _version_check {
     }
 }
 
+=head2 _timeout_syspref
+
+  my $timeout = _timeout_syspref();
+
+Reads the C<timeout> system preference and returns the session timeout value in
+seconds. Understands plain integer values (already seconds), C<d> (days), and
+C<h> (hours) suffixes. Falls back to 600 seconds if the preference is unset or
+contains an unrecognised value.
+
+=cut
+
 sub _timeout_syspref {
     my $default_timeout = 600;
     my $timeout         = C4::Context->preference('timeout') || $default_timeout;
@@ -1236,7 +1263,7 @@ sub checkauth {
                             : Koha::Cash::Registers->search(
                             { branch => $branchcode, branch_default => 1 },
                             { rows   => 1 }
-                        )->single;
+                            )->single;
                         $register_id   = $register->id   if ($register);
                         $register_name = $register->name if ($register);
                     }
@@ -1415,6 +1442,7 @@ sub checkauth {
             $uri->query_param_delete('login_userid');
             $uri->query_param_delete('login_password');
             $uri->query_param_delete('koha_login_context');
+            $uri->query_param_delete('login_op');
             $uri->query_param_delete('op');
             $uri->query_param_delete('csrf_token');
             unless ( $params->{do_not_print} ) {
@@ -1942,6 +1970,16 @@ will be created.
 
 =cut
 
+=head2 _get_session_params
+
+  my $params = _get_session_params();
+
+Returns a hashref of parameters used to initialise a CGI::Session object
+(driver, datasource, and related options). Delegates to
+C<Koha::Session-E<gt>_get_session_params>. Kept for backwards compatibility.
+
+=cut
+
 #NOTE: We're keeping this for backwards compatibility
 sub _get_session_params {
     return Koha::Session->_get_session_params();
@@ -2113,23 +2151,12 @@ Missing POD for checkpw_internal.
 =cut
 
 sub checkpw_internal {
-    my ( $userid, $password, $no_set_userenv ) = @_;
+    my ( $identifier, $password, $no_set_userenv ) = @_;
 
     $password = Encode::encode( 'UTF-8', $password )
         if Encode::is_utf8($password);
 
-    my $patron = Koha::Patrons->find( { userid => $userid } );
-    if ($patron) {
-        if ( checkpw_hash( $password, $patron->password ) ) {
-            my $borrowernumber = $patron->borrowernumber;
-            C4::Context->set_userenv(
-                "$borrowernumber",  $patron->userid,  $patron->cardnumber,
-                $patron->firstname, $patron->surname, $patron->branchcode, $patron->library->branchname, $patron->flags
-            ) unless $no_set_userenv;
-            return 1, $patron->cardnumber, $patron->userid, $patron;
-        }
-    }
-    $patron = Koha::Patrons->find( { cardnumber => $userid } );
+    my $patron = Koha::Patrons->find_by_identifier($identifier);
     if ($patron) {
         if ( checkpw_hash( $password, $patron->password ) ) {
             my $borrowernumber = $patron->borrowernumber;
@@ -2338,6 +2365,17 @@ Returns member's flags or 0 if a permission is not met.
 
 =cut
 
+=head2 _dispatch
+
+  my $ok = _dispatch( $required, $flags );
+
+Recursively evaluates a permission requirement structure against the flags held
+by a patron. C<$required> may be a scalar permission name, an arrayref (OR
+semantics), or a hashref (AND semantics). C<'*'> matches any non-false value.
+Returns 1 if the requirement is satisfied, 0 otherwise.
+
+=cut
+
 sub _dispatch {
     my ( $required, $flags ) = @_;
 

C4/Auth_with_shibboleth.pm

@@ -312,7 +312,7 @@ Create some metadata for your koha instance (if you're in a single instance setu
 
 =item 2.
 
-Swap metadata with your Identidy Provider (IdP)
+Swap metadata with your Identify Provider (IdP)
 
 =item 3.
 
@@ -365,7 +365,7 @@ Note: The minimum you need here is a <matchpoint> block, containing a valid colu
 
 It should be as simple as that; you should now be able to login via shibboleth in the opac.
 
-If you need more help configuring your B<S>ervice B<P>rovider to authenticate against a chosen B<Id>entity B<P>rovider then it might be worth taking a look at the community wiki L<page|https://wiki.koha-community.org/wiki/Shibboleth_Configuration>
+If you need more help configuring your B<S>ervice B<P>rovider to authenticate against a chosen B<Id>entity B<P>rovider then it might be worth taking a look at the community wiki L<page|https://wiki.koha-community.org/wiki/Shibboleth_Configuration>  # codespell:ignore
 
 =head1 FUNCTIONS
 

C4/AuthoritiesMarc.pm

@@ -53,6 +53,7 @@ BEGIN {
 }
 
 use MARC::Field;
+use MARC::Record::MiJ;
 use Scalar::Util qw(blessed);
 use Try::Tiny    qw( try catch );
 
@@ -107,18 +108,25 @@ sub GetAuthMARCFromKohaField {
 
 =head2 SearchAuthorities 
 
-  (\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, 
-     $excluding, $operator, $value, $offset,$length,$authtypecode,
-     $sortby[, $skipmetadata])
+    ( \@finalresult, $nbresults ) = SearchAuthorities(
+        $tags,      $and_or,
+        $excluding, $operator, $value, $offset, $length, $authtypecode,
+        $sortby,    $skipmetadata
+    );
 
-returns ref to array result and count of results returned
+Note: The parameters and_or and excluding are not supported currently.
+The subexpressions in $tags are hardcoded with OR unless you pass the
+parameter authtypecode. In the latter case AND is used.
+
+Returns a results arrayref and a count of results
 
 =cut
 
 sub SearchAuthorities {
+
+    # NOTE: The parameters $and_or, $excluding below are UNUSED here.
     my ( $tags, $and_or, $excluding, $operator, $value, $offset, $length, $authtypecode, $sortby, $skipmetadata ) = @_;
 
-    # warn Dumper($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby);
     my $dbh = C4::Context->dbh;
     $sortby = "" unless $sortby;
     my $query;
@@ -134,7 +142,7 @@ sub SearchAuthorities {
         my @authtypecode;
         my @auths = split / /, $authtypecode;
         foreach my $auth (@auths) {
-            $query .= " \@attr 1=authtype \@attr 5=100 " . $auth;    ##No truncation on authtype
+            $query .= " \@attr 1=authtype \@attr 5=100 \@attr 6=3 " . $auth;    #5=100 No truncation, 6=3 Complete field
             push @authtypecode, $auth;
             $n++;
         }
@@ -612,16 +620,7 @@ sub AddAuthority {
         }
         my $date = POSIX::strftime( "%y%m%d", localtime );
         if ( !$record->field('008') ) {
-
-            # Get a valid default value for field 008
-            my $default_008 = C4::Context->preference('MARCAuthorityControlField008');
-            if ( !$default_008 or length($default_008) < 34 ) {
-                $default_008 = '|| aca||aabn           | a|a     d';
-            } else {
-                $default_008 = substr( $default_008, 0, 34 );
-            }
-
-            $record->insert_fields_ordered( MARC::Field->new( '008', $date . $default_008 ) );
+            $record->insert_fields_ordered( MARC::Field->new( '008', $date . Koha::Authority->default_marc21_008 ) );
         }
         if ( !$record->field('040') ) {
             $record->insert_fields_ordered(
@@ -685,7 +684,6 @@ sub AddAuthority {
         )->store();
         $authority->discard_changes();
         $authid = $authority->authid;
-        logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
     } else {
         $action    = 'modify';
         $authority = Koha::Authorities->find($authid);
@@ -715,6 +713,15 @@ sub AddAuthority {
     }
 
     _after_authority_action_hooks( { action => $action, authority_id => $authid } );
+
+    if ( $action eq 'create' && C4::Context->preference("AuthoritiesLog") ) {
+        $authority->discard_changes;
+        logaction(
+            "AUTHORITIES", "ADD", $authid, "authority", undef,
+            _authority_log_data( $authority, $record )
+        );
+    }
+
     return ($authid);
 }
 
@@ -745,6 +752,13 @@ sub DelAuthority {
         merge( { mergefrom => $authid } ) if !$skip_merge;
 
         my $authority = Koha::Authorities->find($authid);
+        my $deleted_marc;
+        $deleted_marc = eval { $authority->record } if C4::Context->preference("AuthoritiesLog");
+        my $deleted_data =
+            C4::Context->preference("AuthoritiesLog")
+            ? _authority_log_data( $authority, $deleted_marc )
+            : undef;
+
         $schema->txn_do(
             sub {
                 $authority->move_to_deleted;    #FIXME We should define 'move' ..
@@ -752,7 +766,8 @@ sub DelAuthority {
             }
         );
 
-        logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
+        logaction( "AUTHORITIES", "DELETE", $authid, "authority", undef, $deleted_data )
+            if C4::Context->preference("AuthoritiesLog");
         unless ($skip_record_index) {
             my $indexer = Koha::SearchEngine::Indexer->new( { index => $Koha::SearchEngine::AUTHORITIES_INDEX } );
             $indexer->index_records( $authid, "recordDelete", "authorityserver", undef );
@@ -784,13 +799,33 @@ sub ModAuthority {
     my $skip_record_index = $params->{skip_record_index} || 0;
 
     my $oldrecord = GetAuthority($authid);
+    my $original_data;
+    if ( C4::Context->preference("AuthoritiesLog") ) {
+        my $old_authority = Koha::Authorities->find($authid);
+        $original_data = _authority_log_data( $old_authority, $oldrecord );
+    }
 
     #Now rewrite the $record to table with an add
     $authid = AddAuthority( $record, $authid, $authtypecode, { skip_record_index => $skip_record_index } );
     merge( { mergefrom => $authid, MARCfrom => $oldrecord, mergeto => $authid, MARCto => $record } )
         if !$params->{skip_merge};
-    logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted )
-        if C4::Context->preference("AuthoritiesLog");
+
+    if ( C4::Context->preference("AuthoritiesLog") ) {
+        my $new_authority = Koha::Authorities->find($authid);
+
+        # Re-read the stored MARC so both sides of the diff come from the
+        # same XML parse path. The in-memory $record carries non-utf8 SVs
+        # for default indicators while GetAuthority/->record go through
+        # MARC::Record->new_from_xml which utf8-flags them; Struct::Diff
+        # treats those as different and emits phantom indicator entries.
+        my $new_record = eval { $new_authority->record } // $record;
+        logaction(
+            "AUTHORITIES", "MODIFY", $authid,
+            _authority_log_data( $new_authority, $new_record ),
+            undef, $original_data
+        );
+    }
+
     return $authid;
 }
 
@@ -1076,11 +1111,12 @@ sub BuildSummary {
                 };
             }
         }
-        foreach my $field ( $record->field('4..') ) {    #See From
+        my @fields = _marc21_sort_hierarchy_alpha( $record->field('4..') );
+        foreach my $field (@fields) {    #See From
             my $type = 'seefrom';
             $type = ( $marc21controlrefs{ substr $field->subfield('w'), 0, 1 } || '' ) if ( $field->subfield('w') );
             if ( $type eq 'notapplicable' ) {
-                $type = substr $field->subfield('w'), 2, 1;
+                $type = substr $field->subfield('w'), 2, 1 if length( $field->subfield('w') ) > 2;
                 $type = 'earlier' if $type && $type ne 'n';
             }
             if ( $type eq 'subfi' ) {
@@ -1099,11 +1135,12 @@ sub BuildSummary {
                 };
             }
         }
-        foreach my $field ( $record->field('5..') ) {    #See Also
+        @fields = _marc21_sort_hierarchy_alpha( $record->field('5..') );
+        foreach my $field (@fields) {    #See Also
             my $type = 'seealso';
             $type = ( $marc21controlrefs{ substr $field->subfield('w'), 0, 1 } || '' ) if ( $field->subfield('w') );
             if ( $type eq 'notapplicable' ) {
-                $type = substr $field->subfield('w'), 2, 1;
+                $type = substr $field->subfield('w'), 2, 1 if length( $field->subfield('w') ) > 2;
                 $type = 'earlier' if $type && $type ne 'n';
             }
             if ( $type eq 'subfi' ) {
@@ -1231,6 +1268,32 @@ sub BuildSummary {
     return \%summary;
 }
 
+=head2 _marc21_sort_hierarchy_alpha
+
+  my @sorted = _marc21_sort_hierarchy_alpha(@fields);
+
+sorts 4xx/5xx fields by hierarchy using subfield $w (g=broader, h=narrower,
+anything else between), then alphabetically by subfield $a.
+
+=cut
+
+sub _marc21_sort_hierarchy_alpha {
+    my @fields = @_;
+    return (
+        sort {
+            # Sort broader (g) - no hierarchy (tric:gh) - narrower (h)
+            # MARC21 $w has up to 4 positions; only position 0 encodes hierarchy.
+            my $a_hier = substr( $a->subfield('w') // q{}, 0, 1 );
+            $a_hier = 'gh' if $a_hier !~ /^[gh]$/;
+            my $b_hier = substr( $b->subfield('w') // q{}, 0, 1 );
+            $b_hier = 'gh' if $b_hier !~ /^[gh]$/;
+
+            # When hierarchy does not resolve, sort on $a
+            $a_hier cmp $b_hier || ( ( $a->subfield('a') // q{} ) cmp( $b->subfield('a') // q{} ) );
+        } @fields
+    );
+}
+
 =head2 GetAuthorizedHeading
 
   $heading = &GetAuthorizedHeading({ record => $record, authid => $authid })
@@ -1490,11 +1553,34 @@ sub GenerateHierarchy {
     return \@loophierarchies;
 }
 
+=head2 _get_authid_subfield
+
+Return the subfield that includes the authority id.
+
+=cut
+
 sub _get_authid_subfield {
     my ($field) = @_;
     return $field->subfield('9') || $field->subfield('3');
 }
 
+=head2 _authority_log_data
+
+Returns a hashref combining the authority columns that are independent of
+the MARC record with a C<_marc> key containing the record in MARC-in-JSON
+format, suitable for passing to C<logaction> as either the C<$infos> or
+C<$original> argument.
+
+=cut
+
+sub _authority_log_data {
+    my ( $authority, $marc_record ) = @_;
+    return {
+        %{ $authority->_unblessed_for_log },
+        _marc => ( $marc_record ? $marc_record->to_mij_structure : {} ),
+    };
+}
+
 =head2 GetHeaderAuthority
 
   $ref= &GetHeaderAuthority( $authid)
@@ -1685,6 +1771,7 @@ sub merge {
            C4::Context->preference('IncludeSeeFromInSearches')
         || C4::Context->preference('IncludeSeeAlsoFromInSearches')
         || 0;
+    my @biblios_to_index;
     while ( my $biblio = $biblios->next ) {
         my $marcrecord        = $biblio->metadata->record;
         my $update            = 0;
@@ -1784,16 +1871,29 @@ sub merge {
             && $reindex_if_needed
             && $syspref_include_see_from )
         {
-            my $indexer = Koha::SearchEngine::Indexer->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
-            $indexer->index_records( $biblio->biblionumber, "specialUpdate", "biblioserver" );
+            push( @biblios_to_index, $biblio->biblionumber );
         }
         next if !$update;
-        ModBiblio( $marcrecord, $biblio->biblionumber, $biblio->frameworkcode, { disable_autolink => 1 } );
+        ModBiblio(
+            $marcrecord, $biblio->biblionumber, $biblio->frameworkcode,
+            { disable_autolink => 1, skip_record_index => 1 }
+        );
+        push( @biblios_to_index, $biblio->biblionumber );
         $counteditedbiblio++;
     }
+    if (@biblios_to_index) {
+        my $indexer = Koha::SearchEngine::Indexer->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
+        $indexer->index_records( \@biblios_to_index, "specialUpdate", "biblioserver" );
+    }
     return $counteditedbiblio;
 }
 
+=head2 _merge_newtag
+
+Returns subfields for merging when changing authtypecode.
+
+=cut
+
 sub _merge_newtag {
 
     # Routine is only called for an (exceptional) authtypecode change

C4/Barcodes/ValueBuilder.pm

@@ -92,6 +92,33 @@ sub get_barcode {
     return $nextnum;
 }
 
+package C4::Barcodes::ValueBuilder::EAN13;
+use Modern::Perl;
+use C4::Context;
+use Algorithm::CheckDigits qw( CheckDigits );
+
+sub get_barcode {
+    my ($args) = @_;
+
+    # Filter to 13-digit barcodes only so non-EAN-13 items (e.g. 14-digit sample
+    # barcodes) do not dominate max() and prevent the sequence from advancing.
+    my $query = "SELECT max(cast(barcode as unsigned)) FROM items WHERE length(barcode) = 13";
+    my $sth   = C4::Context->dbh->prepare($query);
+    $sth->execute();
+    my ($nextnum) = $sth->fetchrow_array;
+
+    my $ean = CheckDigits('ean');
+    if ( $nextnum && $ean->is_valid($nextnum) ) {
+        my $next = $ean->basenumber($nextnum) + 1;
+        $nextnum = $ean->complete($next);
+        $nextnum = '0' x ( 13 - length($nextnum) ) . $nextnum;    # pad zeros
+    } else {
+        warn "ERROR: invalid EAN-13 " . ( $nextnum // '' ) . ", using increment";
+        $nextnum = ( $nextnum // 0 ) + 1;
+    }
+    return $nextnum;
+}
+
 1;
 
 =head1 Barcodes::ValueBuilder

C4/Biblio.pm

@@ -75,6 +75,7 @@ use Try::Tiny qw( catch try );
 use Encode;
 use List::MoreUtils qw( uniq );
 use MARC::Record;
+use MARC::Record::MiJ;
 use MARC::File::USMARC;
 use MARC::File::XML;
 use POSIX                     qw( strftime );
@@ -95,8 +96,10 @@ use C4::Linker;
 use C4::OAI::Sets;
 
 use Koha::Logger;
+use Koha::Cache::Memory::Lite;
 use Koha::Caches;
 use Koha::ClassSources;
+use Koha::Authority;
 use Koha::Authority::Types;
 use Koha::Acquisition::Currencies;
 use Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue;
@@ -299,6 +302,7 @@ sub AddBiblio {
                     {
                         skip_record_index => 1,
                         record_source_id  => $options->{record_source_id},
+                        ( ref $options->{warnings} eq 'ARRAY' ? ( warnings => $options->{warnings} ) : () ),
                     }
                 );
 
@@ -306,22 +310,36 @@ sub AddBiblio {
                 if ( C4::Context->preference("OAI-PMH:AutoUpdateSets") ) {
                     C4::OAI::Sets::UpdateOAISetsBiblio( $biblionumber, $record );
                 }
-
-                _after_biblio_action_hooks( { action => 'create', biblio_id => $biblionumber } );
-
-                logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
-
             }
         );
 
+        _after_biblio_action_hooks( { action => 'create', biblio_id => $biblionumber } );
+        if ( C4::Context->preference("CataloguingLog") ) {
+            my $new_biblio   = Koha::Biblios->find($biblionumber);
+            my $marc_for_log = eval { $new_biblio->metadata->record_strip_nonxml };
+            logaction(
+                "CATALOGUING", "ADD", $biblionumber, "biblio", undef,
+                {
+                    %{ $new_biblio->_unblessed_for_log },
+                    _marc => ( $marc_for_log ? $marc_for_log->to_mij_structure : {} )
+                }
+            );
+        }
+
         # We index now, after the transaction is committed
         unless ($skip_record_index) {
             my $indexer = Koha::SearchEngine::Indexer->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
             $indexer->index_records( $biblionumber, "specialUpdate", "biblioserver" );
         }
     } catch {
-        warn $_;
-        ( $biblionumber, $biblioitemnumber ) = ( undef, undef );
+        my $error = $_;
+        if ( ref($error) eq 'Koha::Exceptions::Metadata::Invalid' ) {
+            ( $biblionumber, $biblioitemnumber ) = ( undef, undef );
+            $error->rethrow;
+        } else {
+            warn $error;
+            ( $biblionumber, $biblioitemnumber ) = ( undef, undef );
+        }
     };
     return ( $biblionumber, $biblioitemnumber );
 }
@@ -389,7 +407,12 @@ sub ModBiblio {
               ( exists $options->{record_source_id} )
             ? ( record_source_id => $options->{record_source_id} )
             : ()
-        )
+        ),
+        (
+              ( ref $options->{warnings} eq 'ARRAY' )
+            ? ( warnings => $options->{warnings} )
+            : ()
+        ),
     };
 
     if ( !$record ) {
@@ -397,18 +420,11 @@ sub ModBiblio {
         return 0;
     }
 
+    my ( $original, $original_marc );
     if ( C4::Context->preference("CataloguingLog") ) {
-        my $biblio = Koha::Biblios->find($biblionumber);
-        my $record;
-        my $decoding_error = "";
-        eval { $record = $biblio->metadata->record };
-        if ($@) {
-            my $exception = $@;
-            $exception->rethrow unless ( $exception->isa('Koha::Exceptions::Metadata::Invalid') );
-            $decoding_error = "There was an error with this bibliographic record: " . $exception;
-            $record         = $biblio->metadata->record_strip_nonxml;
-        }
-        logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio $decoding_error BEFORE=>" . $record->as_formatted );
+        my $pre_biblio = Koha::Biblios->find($biblionumber);
+        $original      = $pre_biblio->_unblessed_for_log;
+        $original_marc = eval { $pre_biblio->metadata->record_strip_nonxml };
     }
 
     if ( !$options->{disable_autolink} && C4::Context->preference('AutoLinkBiblios') ) {
@@ -471,6 +487,20 @@ sub ModBiblio {
 
     _after_biblio_action_hooks( { action => 'modify', biblio_id => $biblionumber } );
 
+    if ( C4::Context->preference("CataloguingLog") ) {
+        my $updated_biblio   = Koha::Biblios->find($biblionumber);
+        my $updated_marc_log = eval { $updated_biblio->metadata->record_strip_nonxml };
+        logaction(
+            "CATALOGUING", "MODIFY", $biblionumber,
+            {
+                %{ $updated_biblio->_unblessed_for_log },
+                _marc => ( $updated_marc_log ? $updated_marc_log->to_mij_structure : {} )
+            },
+            undef,
+            { %{$original}, _marc => ( $original_marc ? $original_marc->to_mij_structure : {} ) }
+        );
+    }
+
     # update OAI-PMH sets
     if ( C4::Context->preference("OAI-PMH:AutoUpdateSets") ) {
         C4::OAI::Sets::UpdateOAISetsBiblio( $biblionumber, $record );
@@ -538,6 +568,11 @@ sub DelBiblio {
     my $dbh = C4::Context->dbh;
     my $error;                # for error handling
 
+    my $biblio_marc =
+        C4::Context->preference("CataloguingLog")
+        ? eval { $biblio->metadata->record_strip_nonxml }
+        : undef;
+
     # First make sure this biblio has no items attached
     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
     $sth->execute($biblionumber);
@@ -590,7 +625,10 @@ sub DelBiblio {
 
     _after_biblio_action_hooks( { action => 'delete', biblio_id => $biblionumber } );
 
-    logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
+    logaction(
+        "CATALOGUING", "DELETE", $biblionumber, "biblio", undef,
+        { %{ $biblio->_unblessed_for_log }, _marc => ( $biblio_marc ? $biblio_marc->to_mij_structure : {} ) }
+    ) if C4::Context->preference("CataloguingLog");
 
     Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue->new->enqueue( { biblio_ids => [$biblionumber] } )
         unless $params->{skip_holds_queue}
@@ -774,10 +812,47 @@ sub LinkBibHeadingsToAuthorities {
 
                     if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
                         my $userenv = C4::Context->userenv;
-                        my $library;
-                        if ( $userenv && $userenv->{'branch'} ) {
-                            $library = Koha::Libraries->find( $userenv->{'branch'} );
+
+                        # userenv's library could not exist because of a trick in misc/commit_file.pl
+                        # (see FIXME and set_userenv statement there)
+                        my $library =
+                            $userenv && $userenv->{branch} ? Koha::Libraries->find( $userenv->{branch} ) : undef;
+                        my $marcorgcode =
+                            $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode');
+
+                        # Bug 31925: code the new authority with the source heading's actual
+                        # thesaurus instead of relying on AddAuthority()'s LCSH-only default.
+                        # AddAuthority() only defaults 008/040 when they aren't already present
+                        # on the record, so pre-populating them here is sufficient - no change
+                        # to AddAuthority() itself is needed. Skip this when the heading's
+                        # thesaurus couldn't actually be identified (bug 31925 comment 30) - in
+                        # that case the site's own MARCAuthorityControlField008 default should
+                        # apply, the same as it always has, rather than being overridden. Also
+                        # skip it entirely when LinkerConsiderThesaurus is off (bug 31925 comment
+                        # 45): with thesaurus-aware matching disabled, headings from any thesaurus
+                        # can link to the same auto-created authority by text alone, so coding
+                        # that authority for whichever heading happened to create it would let its
+                        # thesaurus silently propagate onto unrelated bibs the next time the
+                        # authority is saved - only sites that opted into thesaurus-aware linking
+                        # (and so already search by thesaurus) should get thesaurus-aware creation.
+                        if (   C4::Context->preference('LinkerConsiderThesaurus')
+                            && Koha::Authority->has_known_thesaurus( $heading->{thesaurus} ) )
+                        {
+                            my $date = POSIX::strftime( '%y%m%d', localtime );
+                            $marcrecordauth->insert_fields_ordered(
+                                MARC::Field->new(
+                                    '008', $date . Koha::Authority->default_marc21_008( $heading->{thesaurus} )
+                                )
+                            );
+
+                            my @f040_subfields = ( 'a' => $marcorgcode, 'c' => $marcorgcode );
+                            push @f040_subfields, ( 'f' => $heading->{thesaurus} )
+                                unless exists
+                                $Koha::Authority::MARC21_THESAURUS_TO_CONTROL_FIELD_008_11->{ $heading->{thesaurus} };
+                            $marcrecordauth->insert_fields_ordered(
+                                MARC::Field->new( '040', '', '', @f040_subfields ) );
                         }
+
                         $marcrecordauth->insert_fields_ordered(
                             MARC::Field->new(
                                 '667', '', '',
@@ -788,10 +863,8 @@ sub LinkBibHeadingsToAuthorities {
                         $cite =~ s/^[\s\,]*//;
                         $cite =~ s/[\s\,]*$//;
                         $cite =
-                            C4::Context->preference('GenerateAuthorityField670') . ": ("
-                            . (
-                            $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') )
-                            . ")"
+                              C4::Context->preference('GenerateAuthorityField670') . ": ("
+                            . "$marcorgcode)"
                             . $bib->subfield( '999', 'c' ) . ": "
                             . $cite;
                         $marcrecordauth->insert_fields_ordered( MARC::Field->new( '670', '', '', 'a' => $cite ) );
@@ -1522,15 +1595,15 @@ sub GetAuthorisedValueDesc {
 
         #---- itemtypes
         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
-            my $lang = C4::Languages::getlanguage;
-            $lang //= 'en';
-            $cache_key = 'itemtype:description:' . $lang;
-            my $itypes = $cache->get_from_cache( $cache_key, { unsafe => 1 } );
-            if ( !$itypes ) {
-                $itypes = { map { $_->itemtype => $_->translated_description } Koha::ItemTypes->search()->as_list };
-                $cache->set_in_cache( $cache_key, $itypes );
+            my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
+            my $cache_key    = 'GetAuthorisedValueDesc:itemtypes';
+            my $itemtypes    = $memory_cache->get_from_cache($cache_key);
+            unless ($itemtypes) {
+                $itemtypes = { map { $_->itemtype => $_ } Koha::ItemTypes->as_list };
+                $memory_cache->set_in_cache( $cache_key, $itemtypes );
             }
-            return $itypes->{$value};
+            my $itemtype = $itemtypes->{$value};
+            return $itemtype ? $itemtype->translated_description : undef;
         }
 
         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "cn_source" ) {
@@ -1562,7 +1635,7 @@ sub GetAuthorisedValueDesc {
                     Koha::AuthorisedValues->search(
                     { category => $category },
                     { columns  => [ 'authorised_value', 'lib_opac', 'lib' ] }
-                )->as_list
+                    )->as_list
             };
             $cache->set_in_cache( $cache_key, $av_descriptions );
         }
@@ -1976,6 +2049,18 @@ sub TransformKohaToMarc {
     return $record;
 }
 
+=head2 _check_split
+
+  my $bool = _check_split( $params, $fld, $value );
+
+Checks whether C<$value> should be split into repeatable subfields. Returns
+true if the field is repeatable (consulting the passed framework when
+provided, otherwise falling back to the default framework structure), false
+otherwise. Returns undef if C<$value> contains no pipe character or splitting
+is disabled via C<$params->{no_split}>.
+
+=cut
+
 sub _check_split {
 
     # Checks if $value must be split; may consult passed framework
@@ -2315,7 +2400,7 @@ sub TransformHtmlToMarc {
 
                     # between 001 and 009 (included)
                 } elsif ( $fval ne '' ) {
-                    $fval     = StripNonXmlChars($fval);    #Strip out any non-XML characters like control characters
+                    $fval     = StripNonXmlChars($fval);
                     $newfield = MARC::Field->new( $tag, $fval, );
                 }
 
@@ -2340,7 +2425,7 @@ sub TransformHtmlToMarc {
                     if ( $fval ne '' && $newfield ) {
                         $newfield->add_subfields( $fkey => $fval );
                     } elsif ( $fval ne '' ) {
-                        $fval     = StripNonXmlChars($fval);   #Strip out any non-XML characters like control characters
+                        $fval     = StripNonXmlChars($fval);
                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
                     }
                     $j += 2;
@@ -2917,7 +3002,6 @@ sub ModBiblioMarc {
 
     # Clone record as it gets modified
     $record = $record->clone();
-    my $dbh      = C4::Context->dbh;
     my @fields   = $record->fields();
     my $encoding = C4::Context->preference("marcflavour");
 
@@ -2994,6 +3078,12 @@ sub ModBiblioMarc {
         }
     )->store;
 
+    if ( ref $options->{warnings} eq 'ARRAY' ) {
+        for my $msg ( grep { $_->type eq 'warning' } @{ $m_rs->object_messages } ) {
+            push @{ $options->{warnings} }, { type => $msg->message, message => $msg->payload };
+        }
+    }
+
     unless ($skip_record_index) {
         my $indexer = Koha::SearchEngine::Indexer->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
         $indexer->index_records( $biblionumber, "specialUpdate", "biblioserver" );

C4/Breeding.pm

@@ -155,7 +155,9 @@ sub Z3950Search {
     }
     my $xslh = Koha::XSLT::Base->new;
 
-    my $nremaining = $s;
+    my $nremaining    = $s;
+    my $hits_per_page = 20;    #TODO make configurable
+    my $total_hits    = 0;
     while ( $nremaining-- ) {
         my $k;
         my $event;
@@ -169,18 +171,22 @@ sub Z3950Search {
             my ($error) = $oConnection[$k]->error_x();    #ignores errmsg, addinfo, diagset
             if ($error) {
                 if ( $error =~ m/^(10000|10007)$/ ) {
-                    push( @errconn, { server => $servers[$k]->{host}, error => $error } );
+                    push( @errconn, { server => $servers[$k]->{host}, errcode => $error } );
                 }
             } else {
                 my $numresults = $oResult[$k]->size();
+                $total_hits += $numresults;
                 my $i;
                 my $res;
-                if ( $numresults > 0 and $numresults >= ( ( $page - 1 ) * 20 ) ) {
-                    $show_next   = 1                           if $numresults >= ( $page * 20 );
-                    $total_pages = int( $numresults / 20 ) + 1 if $total_pages < ( $numresults / 20 );
+                if ( $numresults > 0 and $numresults >= ( ( $page - 1 ) * $hits_per_page ) ) {
+                    $show_next   = 1 if $numresults >= ( $page * $hits_per_page );
+                    $total_pages = int( $numresults / $hits_per_page ) + 1
+                        if $total_pages < ( $numresults / $hits_per_page );
                     for (
-                        $i = ( $page - 1 ) * 20 ;
-                        $i < ( ( $numresults < ( $page * 20 ) ) ? $numresults : ( $page * 20 ) ) ;
+                        $i = ( $page - 1 ) * $hits_per_page ;
+                        $i < (
+                            ( $numresults < ( $page * $hits_per_page ) ) ? $numresults : ( $page * $hits_per_page )
+                            ) ;
                         $i++
                         )
                     {
@@ -191,14 +197,17 @@ sub Z3950Search {
                                 $xslh
                             );    #ignores error in sequence numbering
                             push @breeding_loop, $res if $res;
-                            push @errconn, { server => $servers[$k]->{servername}, error => $error, seq => $i + 1 }
+                            push @errconn, { server => $servers[$k]->{servername}, errcode => $error, seq => $i + 1 }
                                 if $error;
                         } else {
+                            my @diags = $oConnection[$k]->error_x();    # errcode, errmsg, addinfo, diagset
+                            next unless $diags[0];                      # Just silently ignore empty results
                             push @errconn,
                                 {
-                                'server'  => $servers[$k]->{servername},
-                                error     => ( ( $oConnection[$k]->error_x() )[0] ),
-                                error_msg => ( ( $oConnection[$k]->error_x() )[1] ), seq => $i + 1
+                                server  => $servers[$k]->{servername},
+                                errcode => $diags[0],
+                                errmsg  => $diags[1],
+                                seq     => $i + 1,
                                 };
                         }
                     }
@@ -212,6 +221,7 @@ sub Z3950Search {
             total_pages     => $total_pages,
             show_nextbutton => $show_next ? 1 : 0,
             show_prevbutton => $page != 1,
+            total_hits      => $total_hits,
         );
     }    # while nremaining
 

C4/Budgets.pm

@@ -62,7 +62,6 @@ BEGIN {
         GetBudgetChildren
         SetOwnerToFundHierarchy
         CheckBudgetParent
-        CheckBudgetParentPerm
 
         HideCols
         GetCols
@@ -136,30 +135,11 @@ sub GetCols {
 
 }
 
-=head2 CheckBudgetParentPerm
-
-Missing POD for CheckBudgetParentPerm.
-
-=cut
-
-sub CheckBudgetParentPerm {
-    my ( $budget, $borrower_id ) = @_;
-    my $depth     = $budget->{depth};
-    my $parent_id = $budget->{budget_parent_id};
-    while ($depth) {
-        my $parent = GetBudget($parent_id);
-        $parent_id = $parent->{budget_parent_id};
-        if ( $parent->{budget_owner_id} == $borrower_id ) {
-            return 1;
-        }
-        $depth--;
-    }
-    return 0;
-}
-
 =head2 AddBudgetPeriod
 
-Missing POD for AddBudgetPeriod.
+Create a BudgetPeriod period with given parameters
+
+    my $rs = AddBudgetPeriod({ budget_period_startdate => $start_date, budget_period_enddate => $budget_period_enddate });
 
 =cut
 

C4/Calendar.pm

@@ -21,6 +21,7 @@ use vars qw(@EXPORT);
 
 use Carp       qw( croak );
 use Date::Calc qw( Today );
+use Koha::Library::Calendar;
 
 use C4::Context;
 use Koha::Caches;
@@ -64,30 +65,32 @@ sub new {
     return $self;
 }
 
+=head2 _init
+
+Loads calendar data from the database for the given branch.
+
+=cut
+
 sub _init {
     my $self   = shift @_;
     my $branch = shift;
     defined($branch) or die "No branchcode sent to _init";    # must test for defined here and above to allow ""
-    my $dbh        = C4::Context->dbh();
-    my $repeatable = $dbh->prepare(
-        'SELECT *
-                                       FROM repeatable_holidays
-                                      WHERE ( branchcode = ? )
-                                        AND (ISNULL(weekday) = ?)'
-    );
-    $repeatable->execute( $branch, 0 );
-    my %week_days_holidays;
+    my $dbh = C4::Context->dbh();
 
-    while ( my $row = $repeatable->fetchrow_hashref ) {
+    my $weekly_sth = $dbh->prepare('SELECT * FROM library_weekly_closures WHERE library_id = ?');
+    $weekly_sth->execute($branch);
+    my %week_days_holidays;
+    while ( my $row = $weekly_sth->fetchrow_hashref ) {
         my $key = $row->{weekday};
         $week_days_holidays{$key}{title}       = $row->{title};
         $week_days_holidays{$key}{description} = $row->{description};
     }
     $self->{'week_days_holidays'} = \%week_days_holidays;
 
-    $repeatable->execute( $branch, 1 );
+    my $repeating_sth = $dbh->prepare('SELECT * FROM library_repeating_closures WHERE library_id = ?');
+    $repeating_sth->execute($branch);
     my %day_month_holidays;
-    while ( my $row = $repeatable->fetchrow_hashref ) {
+    while ( my $row = $repeating_sth->fetchrow_hashref ) {
         my $key = $row->{month} . "/" . $row->{day};
         $day_month_holidays{$key}{title}       = $row->{title};
         $day_month_holidays{$key}{description} = $row->{description};
@@ -96,29 +99,26 @@ sub _init {
     }
     $self->{'day_month_holidays'} = \%day_month_holidays;
 
-    my $special = $dbh->prepare(
-        'SELECT day, month, year, title, description
-                                    FROM special_holidays
-                                   WHERE ( branchcode = ? )
-                                     AND (isexception = ?)'
-    );
-    $special->execute( $branch, 1 );
+    my $exceptions_sth =
+        $dbh->prepare('SELECT date, title, description FROM library_closure_exceptions WHERE library_id = ?');
+    $exceptions_sth->execute($branch);
     my %exception_holidays;
-    while ( my ( $day, $month, $year, $title, $description ) = $special->fetchrow ) {
-        $exception_holidays{"$year/$month/$day"}{title}       = $title;
-        $exception_holidays{"$year/$month/$day"}{description} = $description;
-        $exception_holidays{"$year/$month/$day"}{date} =
-            sprintf( ISO_DATE_FORMAT, $year, $month, $day );
+    while ( my $row = $exceptions_sth->fetchrow_hashref ) {
+        my ( $year, $month, $day ) = map { $_ + 0 } split( /-/, $row->{date} );
+        $exception_holidays{"$year/$month/$day"}{title}       = $row->{title};
+        $exception_holidays{"$year/$month/$day"}{description} = $row->{description};
+        $exception_holidays{"$year/$month/$day"}{date}        = $row->{date};
     }
     $self->{'exception_holidays'} = \%exception_holidays;
 
-    $special->execute( $branch, 0 );
+    my $single_sth = $dbh->prepare('SELECT date, title, description FROM library_single_closures WHERE library_id = ?');
+    $single_sth->execute($branch);
     my %single_holidays;
-    while ( my ( $day, $month, $year, $title, $description ) = $special->fetchrow ) {
-        $single_holidays{"$year/$month/$day"}{title}       = $title;
-        $single_holidays{"$year/$month/$day"}{description} = $description;
-        $single_holidays{"$year/$month/$day"}{date} =
-            sprintf( ISO_DATE_FORMAT, $year, $month, $day );
+    while ( my $row = $single_sth->fetchrow_hashref ) {
+        my ( $year, $month, $day ) = map { $_ + 0 } split( /-/, $row->{date} );
+        $single_holidays{"$year/$month/$day"}{title}       = $row->{title};
+        $single_holidays{"$year/$month/$day"}{description} = $row->{description};
+        $single_holidays{"$year/$month/$day"}{date}        = $row->{date};
     }
     $self->{'single_holidays'} = \%single_holidays;
     return $self;
@@ -202,17 +202,13 @@ C<$description> Is the description to store for the holiday formed by $year/$mon
 sub insert_week_day_holiday {
     my $self    = shift @_;
     my %options = @_;
-
-    my $weekday = $options{weekday};
-    croak "Invalid weekday $weekday" unless $weekday =~ m/^[0-6]$/;
-
-    my $dbh           = C4::Context->dbh();
-    my $insertHoliday = $dbh->prepare(
-        "insert into repeatable_holidays (branchcode,weekday,day,month,title,description) values ( ?,?,NULL,NULL,?,? )"
+    Koha::Library::Calendar->new( branchcode => $self->{branchcode} )->add_weekly_closure(
+        {
+            weekday => $options{weekday}, title => $options{title}, description => $options{description},
+        }
     );
-    $insertHoliday->execute( $self->{branchcode}, $weekday, $options{title}, $options{description} );
-    $self->{'week_days_holidays'}->{$weekday}{title}       = $options{title};
-    $self->{'week_days_holidays'}->{$weekday}{description} = $options{description};
+    $self->{'week_days_holidays'}->{ $options{weekday} }{title}       = $options{title};
+    $self->{'week_days_holidays'}->{ $options{weekday} }{description} = $options{description};
     return $self;
 }
 
@@ -238,14 +234,11 @@ C<$description> Is the description to store for the holiday formed by $year/$mon
 sub insert_day_month_holiday {
     my $self    = shift @_;
     my %options = @_;
-
-    my $dbh           = C4::Context->dbh();
-    my $insertHoliday = $dbh->prepare(
-        "insert into repeatable_holidays (branchcode,weekday,day,month,title,description) values (?, NULL, ?, ?, ?,? )"
-    );
-    $insertHoliday->execute(
-        $self->{branchcode}, $options{day}, $options{month}, $options{title},
-        $options{description}
+    Koha::Library::Calendar->new( branchcode => $self->{branchcode} )->add_repeating_closure(
+        {
+            day         => $options{day}, month => $options{month}, title => $options{title},
+            description => $options{description},
+        }
     );
     $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{title}       = $options{title};
     $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{description} = $options{description};
@@ -277,28 +270,23 @@ C<$description> Is the description to store for the holiday formed by $year/$mon
 sub insert_single_holiday {
     my $self    = shift @_;
     my %options = @_;
-    @options{qw(year month day)} = ( $options{date} =~ m/(\d+)-(\d+)-(\d+)/o )
-        if $options{date} && !$options{day};
+    my $date    = $options{date};
+    unless ($date) {
+        $date = sprintf( ISO_DATE_FORMAT, $options{year}, $options{month}, $options{day} );
+    }
+    @options{qw(year month day)} = map { $_ + 0 } ( $date =~ m/(\d+)-(\d+)-(\d+)/ )
+        unless $options{day};
 
-    my $dbh           = C4::Context->dbh();
-    my $isexception   = 0;
-    my $insertHoliday = $dbh->prepare(
-        "insert into special_holidays (branchcode,day,month,year,isexception,title,description) values (?,?,?,?,?,?,?)"
-    );
-    $insertHoliday->execute(
-        $self->{branchcode}, $options{day}, $options{month}, $options{year}, $isexception,
-        $options{title},     $options{description}
+    Koha::Library::Calendar->new( branchcode => $self->{branchcode} )->add_single_closure(
+        {
+            date => $date, title => $options{title}, description => $options{description},
+        }
     );
+
     $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title}       = $options{title};
     $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
 
-    # changed the 'single_holidays' table, lets force/reset its cache
-    my $cache = Koha::Caches->get_instance();
-    my $key   = $self->{branchcode} . "_holidays";
-    $cache->clear_from_cache($key);
-
     return $self;
-
 }
 
 =head2 insert_exception_holiday
@@ -326,28 +314,23 @@ C<$description> Is the description to store for the holiday formed by $year/$mon
 sub insert_exception_holiday {
     my $self    = shift @_;
     my %options = @_;
+    my $date    = $options{date};
+    unless ($date) {
+        $date = sprintf( ISO_DATE_FORMAT, $options{year}, $options{month}, $options{day} );
+    }
+    @options{qw(year month day)} = map { $_ + 0 } ( $date =~ m/(\d+)-(\d+)-(\d+)/ )
+        unless $options{day};
 
-    @options{qw(year month day)} = ( $options{date} =~ m/(\d+)-(\d+)-(\d+)/o )
-        if $options{date} && !$options{day};
+    Koha::Library::Calendar->new( branchcode => $self->{branchcode} )->add_exception(
+        {
+            date => $date, title => $options{title}, description => $options{description},
+        }
+    );
 
-    my $dbh             = C4::Context->dbh();
-    my $isexception     = 1;
-    my $insertException = $dbh->prepare(
-        "insert into special_holidays (branchcode,day,month,year,isexception,title,description) values (?,?,?,?,?,?,?)"
-    );
-    $insertException->execute(
-        $self->{branchcode}, $options{day}, $options{month}, $options{year}, $isexception,
-        $options{title},     $options{description}
-    );
     $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title};
     $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} =
         $options{description};
 
-    # changed the 'single_holidays' table, lets force/reset its cache
-    my $cache = Koha::Caches->get_instance();
-    my $key   = $self->{branchcode} . "_holidays";
-    $cache->clear_from_cache($key);
-
     return $self;
 }
 
@@ -368,13 +351,10 @@ C<$description> Is the description to update for the holiday.
 sub ModWeekdayholiday {
     my $self    = shift @_;
     my %options = @_;
-
-    my $dbh = C4::Context->dbh();
-    my $updateHoliday =
-        $dbh->prepare("UPDATE repeatable_holidays SET title = ?, description = ? WHERE branchcode = ? AND weekday = ?");
-    $updateHoliday->execute( $options{title}, $options{description}, $self->{branchcode}, $options{weekday} );
-    $self->{'week_days_holidays'}->{ $options{weekday} }{title}       = $options{title};
-    $self->{'week_days_holidays'}->{ $options{weekday} }{description} = $options{description};
+    my $closure =
+        Koha::Library::Calendar::WeeklyClosures->search(
+        { library_id => $self->{branchcode}, weekday => $options{weekday} } )->next;
+    $closure->title( $options{title} )->description( $options{description} )->store if $closure;
     return $self;
 }
 
@@ -400,16 +380,9 @@ C<$description> The description to be update for the holiday.
 sub ModDaymonthholiday {
     my $self    = shift @_;
     my %options = @_;
-
-    my $dbh           = C4::Context->dbh();
-    my $updateHoliday = $dbh->prepare(
-        "UPDATE repeatable_holidays SET title = ?, description = ? WHERE month = ? AND day = ? AND branchcode = ?");
-    $updateHoliday->execute(
-        $options{title}, $options{description}, $options{month}, $options{day},
-        $self->{branchcode}
-    );
-    $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{title}       = $options{title};
-    $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{description} = $options{description};
+    my $closure = Koha::Library::Calendar::RepeatingClosures->search(
+        { library_id => $self->{branchcode}, day => $options{day}, month => $options{month} } )->next;
+    $closure->title( $options{title} )->description( $options{description} )->store if $closure;
     return $self;
 }
 
@@ -438,25 +411,12 @@ C<$description> Is the description to update for the holiday formed by $year/$mo
 sub ModSingleholiday {
     my $self    = shift @_;
     my %options = @_;
-
-    my $dbh         = C4::Context->dbh();
-    my $isexception = 0;
-
-    my $updateHoliday = $dbh->prepare( "
-UPDATE special_holidays SET title = ?, description = ?
-    WHERE day = ? AND month = ? AND year = ? AND branchcode = ? AND isexception = ?" );
-    $updateHoliday->execute(
-        $options{title},     $options{description}, $options{day}, $options{month}, $options{year},
-        $self->{branchcode}, $isexception
-    );
-    $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title}       = $options{title};
-    $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
-
-    # changed the 'single_holidays' table, lets force/reset its cache
-    my $cache = Koha::Caches->get_instance();
-    my $key   = $self->{branchcode} . "_holidays";
-    $cache->clear_from_cache($key);
-
+    my $date    = $options{date} || sprintf( ISO_DATE_FORMAT, $options{year}, $options{month}, $options{day} );
+    my $closure =
+        Koha::Library::Calendar::SingleClosures->search( { library_id => $self->{branchcode}, date => $date } )->next;
+    if ($closure) {
+        $closure->title( $options{title} )->description( $options{description} )->store;
+    }
     return $self;
 }
 
@@ -485,25 +445,12 @@ C<$description> Is the description to be modified for the holiday formed by $yea
 sub ModExceptionholiday {
     my $self    = shift @_;
     my %options = @_;
-
-    my $dbh           = C4::Context->dbh();
-    my $isexception   = 1;
-    my $updateHoliday = $dbh->prepare( "
-UPDATE special_holidays SET title = ?, description = ?
-    WHERE day = ? AND month = ? AND year = ? AND branchcode = ? AND isexception = ?" );
-    $updateHoliday->execute(
-        $options{title},     $options{description}, $options{day}, $options{month}, $options{year},
-        $self->{branchcode}, $isexception
-    );
-    $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title};
-    $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} =
-        $options{description};
-
-    # changed the 'single_holidays' table, lets force/reset its cache
-    my $cache = Koha::Caches->get_instance();
-    my $key   = $self->{branchcode} . "_holidays";
-    $cache->clear_from_cache($key);
-
+    my $date    = $options{date} || sprintf( ISO_DATE_FORMAT, $options{year}, $options{month}, $options{day} );
+    my $exception =
+        Koha::Library::Calendar::Exceptions->search( { library_id => $self->{branchcode}, date => $date } )->next;
+    if ($exception) {
+        $exception->title( $options{title} )->description( $options{description} )->store;
+    }
     return $self;
 }
 
@@ -529,67 +476,40 @@ C<$year> Is year to make the date to delete.
 sub delete_holiday {
     my $self    = shift @_;
     my %options = @_;
+    my $cal     = Koha::Library::Calendar->new( branchcode => $self->{branchcode} );
 
-    # Verify what kind of holiday that day is. For example, if it is
-    # a repeatable holiday, this should check if there are some exception
-    # for that holiday rule. Otherwise, if it is a regular holiday, it´s
-    # ok just deleting it.
+    if ( $options{day} && $options{month} && $options{year} ) {
+        my $date = sprintf( ISO_DATE_FORMAT, $options{year}, $options{month}, $options{day} );
 
-    my $dbh             = C4::Context->dbh();
-    my $isSingleHoliday = $dbh->prepare(
-        "SELECT id FROM special_holidays WHERE (branchcode = ?) AND (day = ?) AND (month = ?) AND (year = ?)");
-    $isSingleHoliday->execute( $self->{branchcode}, $options{day}, $options{month}, $options{year} );
-    if ( $isSingleHoliday->rows ) {
-        my $id = $isSingleHoliday->fetchrow;
-        $isSingleHoliday->finish;    # Close the last query
-
-        my $deleteHoliday = $dbh->prepare("DELETE FROM special_holidays WHERE id = ?");
-        $deleteHoliday->execute($id);
-        delete( $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"} );
-    } else {
-        $isSingleHoliday->finish;    # Close the last query
-
-        my $isWeekdayHoliday = $dbh->prepare("SELECT id FROM repeatable_holidays WHERE branchcode = ? AND weekday = ?");
-        $isWeekdayHoliday->execute( $self->{branchcode}, $options{weekday} );
-        if ( $isWeekdayHoliday->rows ) {
-            my $id = $isWeekdayHoliday->fetchrow;
-            $isWeekdayHoliday->finish;    # Close the last query
-
-            my $updateExceptions = $dbh->prepare(
-                "UPDATE special_holidays SET isexception = 0 WHERE (WEEKDAY(CONCAT(special_holidays.year,'-',special_holidays.month,'-',special_holidays.day)) = ?) AND (branchcode = ?)"
-            );
-            $updateExceptions->execute( $options{weekday}, $self->{branchcode} );
-            $updateExceptions->finish;    # Close the last query
-
-            my $deleteHoliday = $dbh->prepare("DELETE FROM repeatable_holidays WHERE id = ?");
-            $deleteHoliday->execute($id);
-            delete( $self->{'week_days_holidays'}->{ $options{weekday} } );
-        } else {
-            $isWeekdayHoliday->finish;    # Close the last query
-
-            my $isDayMonthHoliday = $dbh->prepare(
-                "SELECT id FROM repeatable_holidays WHERE (branchcode = ?) AND (day = ?) AND (month = ?)");
-            $isDayMonthHoliday->execute( $self->{branchcode}, $options{day}, $options{month} );
-            if ( $isDayMonthHoliday->rows ) {
-                my $id = $isDayMonthHoliday->fetchrow;
-                $isDayMonthHoliday->finish;
-                my $updateExceptions = $dbh->prepare(
-                    "UPDATE special_holidays SET isexception = 0 WHERE (special_holidays.branchcode = ?) AND (special_holidays.day = ?) and (special_holidays.month = ?)"
-                );
-                $updateExceptions->execute( $self->{branchcode}, $options{day}, $options{month} );
-                $updateExceptions->finish;    # Close the last query
-
-                my $deleteHoliday = $dbh->prepare("DELETE FROM repeatable_holidays WHERE (id = ?)");
-                $deleteHoliday->execute($id);
-                delete( $self->{'day_month_holidays'}->{"$options{month}/$options{day}"} );
-            }
+        # Try single closure first
+        if ( Koha::Library::Calendar::SingleClosures->search( { library_id => $self->{branchcode}, date => $date } )
+            ->count )
+        {
+            $cal->delete_single_closure( { date => $date } );
         }
+
+        # Also remove any exception for this date
+        Koha::Library::Calendar::Exceptions->search( { library_id => $self->{branchcode}, date => $date } )->delete;
     }
 
-    # changed the 'single_holidays' table, lets force/reset its cache
-    my $cache = Koha::Caches->get_instance();
-    my $key   = $self->{branchcode} . "_holidays";
-    $cache->clear_from_cache($key);
+    if (
+        defined $options{weekday}
+        && Koha::Library::Calendar::WeeklyClosures->search(
+            { library_id => $self->{branchcode}, weekday => $options{weekday} }
+        )->count
+        )
+    {
+        $cal->delete_weekly_closure( { weekday => $options{weekday} } );
+    } elsif (
+        $options{day}
+        && $options{month}
+        && Koha::Library::Calendar::RepeatingClosures->search(
+            { library_id => $self->{branchcode}, day => $options{day}, month => $options{month} }
+        )->count
+        )
+    {
+        $cal->delete_repeating_closure( { day => $options{day}, month => $options{month} } );
+    }
 
     return $self;
 }
@@ -613,17 +533,8 @@ C<$year> Is year to make the date to delete.
 sub delete_holiday_range {
     my $self    = shift;
     my %options = @_;
-
-    my $dbh = C4::Context->dbh();
-    my $sth = $dbh->prepare(
-        "DELETE FROM special_holidays WHERE (branchcode = ?) AND (day = ?) AND (month = ?) AND (year = ?)");
-    $sth->execute( $self->{branchcode}, $options{day}, $options{month}, $options{year} );
-
-    # changed the 'single_holidays' table, lets force/reset its cache
-    my $cache = Koha::Caches->get_instance();
-    my $key   = $self->{branchcode} . "_holidays";
-    $cache->clear_from_cache($key);
-
+    my $date    = $options{date} || sprintf( ISO_DATE_FORMAT, $options{year}, $options{month}, $options{day} );
+    Koha::Library::Calendar->new( branchcode => $self->{branchcode} )->delete_single_closure( { date => $date } );
 }
 
 =head2 delete_holiday_range_repeatable
@@ -642,15 +553,8 @@ C<$month> Is month to make the date to delete.
 sub delete_holiday_range_repeatable {
     my $self    = shift;
     my %options = @_;
-
-    my $dbh = C4::Context->dbh();
-    my $sth = $dbh->prepare("DELETE FROM repeatable_holidays WHERE (branchcode = ?) AND (day = ?) AND (month = ?)");
-    $sth->execute( $self->{branchcode}, $options{day}, $options{month} );
-
-    # changed the 'single_holidays' table, lets force/reset its cache
-    my $cache = Koha::Caches->get_instance();
-    my $key   = $self->{branchcode} . "_holidays";
-    $cache->clear_from_cache($key);
+    Koha::Library::Calendar->new( branchcode => $self->{branchcode} )
+        ->delete_repeating_closure( { day => $options{day}, month => $options{month} } );
 }
 
 =head2 delete_exception_holiday_range
@@ -673,17 +577,8 @@ C<$year> Is year to make the date to delete.
 sub delete_exception_holiday_range {
     my $self    = shift;
     my %options = @_;
-
-    my $dbh = C4::Context->dbh();
-    my $sth = $dbh->prepare(
-        "DELETE FROM special_holidays WHERE (branchcode = ?) AND (isexception = 1) AND (day = ?) AND (month = ?) AND (year = ?)"
-    );
-    $sth->execute( $self->{branchcode}, $options{day}, $options{month}, $options{year} );
-
-    # changed the 'single_holidays' table, lets force/reset its cache
-    my $cache = Koha::Caches->get_instance();
-    my $key   = $self->{branchcode} . "_holidays";
-    $cache->clear_from_cache($key);
+    my $date    = $options{date} || sprintf( ISO_DATE_FORMAT, $options{year}, $options{month}, $options{day} );
+    Koha::Library::Calendar->new( branchcode => $self->{branchcode} )->delete_exception( { date => $date } );
 }
 
 =head2 isHoliday
@@ -734,47 +629,7 @@ sub isHoliday {
 
 sub copy_to_branch {
     my ( $self, $target_branch ) = @_;
-
-    croak "No target_branch" unless $target_branch;
-
-    my $target_calendar = C4::Calendar->new( branchcode => $target_branch );
-
-    my ( $y, $m, $d ) = Today();
-    my $today = sprintf ISO_DATE_FORMAT, $y, $m, $d;
-
-    my $wdh        = $self->get_week_days_holidays;
-    my $target_wdh = $target_calendar->get_week_days_holidays;
-    foreach my $key ( keys %$wdh ) {
-        unless ( grep { $_ eq $key } keys %$target_wdh ) {
-            $target_calendar->insert_week_day_holiday( weekday => $key, %{ $wdh->{$key} } );
-        }
-    }
-
-    my $dmh        = $self->get_day_month_holidays;
-    my $target_dmh = $target_calendar->get_day_month_holidays;
-    foreach my $values ( values %$dmh ) {
-        unless ( grep { $_->{day} eq $values->{day} && $_->{month} eq $values->{month} } values %$target_dmh ) {
-            $target_calendar->insert_day_month_holiday( %{$values} );
-        }
-    }
-
-    my $exception_holidays = $self->get_exception_holidays;
-    my $target_exceptions  = $target_calendar->get_exception_holidays;
-    foreach my $values ( grep { $_->{date} gt $today } values %{$exception_holidays} ) {
-        unless ( grep { $_->{date} eq $values->{date} } values %$target_exceptions ) {
-            $target_calendar->insert_exception_holiday( %{$values} );
-        }
-    }
-
-    my $single_holidays = $self->get_single_holidays;
-    my $target_singles  = $target_calendar->get_single_holidays;
-    foreach my $values ( grep { $_->{date} gt $today } values %{$single_holidays} ) {
-        unless ( grep { $_->{date} eq $values->{date} } values %$target_singles ) {
-            $target_calendar->insert_single_holiday( %{$values} );
-        }
-    }
-
-    return 1;
+    return Koha::Library::Calendar->new( branchcode => $self->{branchcode} )->copy_to($target_branch);
 }
 
 1;

C4/ClassSplitRoutine/RegEx.pm

@@ -19,6 +19,9 @@ package C4::ClassSplitRoutine::RegEx;
 
 use Modern::Perl;
 
+use Koha::Logger;
+use Koha::Regex::Replacement;
+
 =head1 NAME
 
 C4::ClassSplitRoutine::RegEx - regex call number sorting key routine
@@ -41,13 +44,62 @@ sub split_callnumber {
     my ( $cn_item, $regexs ) = @_;
 
     for my $regex (@$regexs) {
-        eval "\$cn_item =~ $regex";    ## no critic (StringyEval)
+        _apply_substitution( \$cn_item, $regex );
     }
     my @lines = split "\n", $cn_item;
 
     return @lines;
 }
 
+=head2 _apply_substitution
+
+  _apply_substitution( \$string, $regex );
+
+Applies a single admin-configured s/// substitution to $string in place,
+without ever evaluating the input as code. The rule is parsed as
+C<s/PATTERN/REPLACEMENT/FLAGS> (any non-space delimiter is accepted); the pattern is compiled with
+qr// (so embedded-code assertions are treated as a runtime pattern and blocked
+by Perl), and the replacement is expanded as data via
+Koha::Regex::Replacement::expand_template. The
+/e flag is rejected and anything that is not a plain substitution is ignored.
+This replaces the previous C<eval "\$cn_item =~ $regex"> stringy eval, which
+executed arbitrary Perl.
+
+=cut
+
+sub _apply_substitution {
+    my ( $ref, $regex ) = @_;
+
+    return unless defined $regex;
+
+    # Parse  s<DELIM>PATTERN<DELIM>REPLACEMENT<DELIM>FLAGS, allowing any
+    # non-space delimiter and backslash-escaped delimiters inside the pattern
+    # and replacement. Anything that is not a well-formed plain substitution is
+    # ignored rather than executed.
+    return unless $regex =~ m{^s(\S)((?:\\.|(?!\1).)*)\1((?:\\.|(?!\1).)*)\1([a-z]*)\z}s;
+    my ( $pattern, $replacement, $flags ) = ( $2, $3, $4 );
+
+    return if $flags =~ /e/;    # never evaluate the replacement as code
+    my $global = $flags =~ /g/ ? 1      : 0;
+    my $ci     = $flags =~ /i/ ? '(?i)' : '';
+
+    my $compiled = eval { qr/$ci$pattern/ };
+    unless ( defined $compiled ) {
+        Koha::Logger->get->warn("C4::ClassSplitRoutine::RegEx: failed to compile pattern [$pattern]: $@");
+        return;
+    }
+
+    my $expand = sub { Koha::Regex::Replacement::expand_template( $replacement, [ @{^CAPTURE} ], {%+} ) };
+
+    if ($global) {
+        ${$ref} =~ s/$compiled/$expand->()/ge;
+    } else {
+        ${$ref} =~ s/$compiled/$expand->()/e;
+    }
+
+    return;
+}
+
 1;
 
 =head1 AUTHOR

C4/Context.pm

@@ -45,11 +45,16 @@ use YAML::XS;
 use ZOOM;
 use List::MoreUtils qw(any);
 
+use Koha;
 use Koha::Caches;
 use Koha::Config::SysPref;
 use Koha::Config::SysPrefs;
 use Koha::Config;
-use Koha;
+use Koha::Database;
+
+# NOTE: The below list should match the corresponding options in the .pref file
+# for CSVDelimiter
+use constant ALLOWED_CSV_DELIMITERS => ( ';', 'tabulation', ',', '/', '\\', '#' );
 
 =head1 NAME
 
@@ -397,12 +402,18 @@ sub set_preference {
     $variable = lc $variable;
 
     my $syspref = Koha::Config::SysPrefs->find($variable);
-    $type =
-          $type    ? $type
-        : $syspref ? $syspref->type
-        :            undef;
 
-    $value = 0 if ( $type && $type eq 'YesNo' && $value eq '' );
+    # Deal with Boolean syspref, set to 0 if passed an empty string
+    if ( $value eq '' ) {
+        my $yaml_prefs = Koha::Config::SysPrefs->get_all_from_yml;
+        my $yaml_pref  = $yaml_prefs->{$variable_case};
+        if ( $yaml_pref && $yaml_pref->{type} eq 'select' && ref( $yaml_pref->{choices} ) ) {
+            my @choices = sort keys %{ $yaml_pref->{choices} };
+            if ( scalar(@choices) == 2 && $choices[0] eq "0" && $choices[1] eq "1" ) {
+                $value = 0;
+            }
+        }
+    }
 
     # force explicit protocol on OPACBaseURL
     if ( $variable eq 'opacbaseurl' && $value && substr( $value, 0, 4 ) !~ /http/ ) {
@@ -478,6 +489,13 @@ sub delete_preference {
 
 sub csv_delimiter {
     my ( $self, $value ) = @_;
+
+    # Validate input against allowed delimiters
+    if ($value) {
+        my %allowed = map { $_ => 1 } ALLOWED_CSV_DELIMITERS;
+        $value = undef unless $allowed{$value};
+    }
+
     my $delimiter = $value || $self->preference('CSVDelimiter') || ',';
     $delimiter = "\t" if $delimiter eq 'tabulation';
     return $delimiter;
@@ -572,17 +590,19 @@ sub _new_Zconn {
     $syntax         = 'xml';
     $elementSetName = 'marcxml';
 
-    my $host       = _common_config( $server, 'listen' )->{content};
+    my $host = _common_config( $server, 'listen' );
+    $host = $host->{content};
     my $serverinfo = _common_config( $server, 'serverinfo' );
     my $user       = $serverinfo->{user};
     my $password   = $serverinfo->{password};
     eval {
         # set options
         my $o = ZOOM::Options->new();
-        $o->option( user                  => $user )     if $user && $password;
-        $o->option( password              => $password ) if $user && $password;
-        $o->option( async                 => 1 )         if $async;
-        $o->option( cqlfile               => _common_config( $server, 'server' )->{cql2rpn} );
+        $o->option( user     => $user )     if $user && $password;
+        $o->option( password => $password ) if $user && $password;
+        $o->option( async    => 1 )         if $async;
+        my $server_conf = _common_config( $server, 'server' );
+        $o->option( cqlfile               => $server_conf->{cql2rpn} );
         $o->option( cclfile               => $serverinfo->{ccl2rpn} );
         $o->option( preferredRecordSyntax => $syntax );
         $o->option( elementSetName        => $elementSetName ) if $elementSetName;
@@ -604,15 +624,6 @@ sub _new_Zconn {
     return $Zconn;
 }
 
-# _new_dbh
-# Internal helper function (not a method!). This creates a new
-# database connection from the data given in the current context, and
-# returns it.
-sub _new_dbh {
-
-    Koha::Database->schema( { new => 1 } )->storage->dbh;
-}
-
 =head2 dbh
 
   $dbh = C4::Context->dbh;
@@ -634,26 +645,6 @@ sub dbh {
     return Koha::Database->schema( { new => 1 } )->storage->dbh;
 }
 
-=head2 new_dbh
-
-  $dbh = C4::Context->new_dbh;
-
-Creates a new connection to the Koha database for the current context,
-and returns the database handle (a C<DBI::db> object).
-
-The handle is not saved anywhere: this method is strictly a
-convenience function; the point is that it knows which database to
-connect to so that the caller doesn't have to know.
-
-=cut
-
-#'
-sub new_dbh {
-    my $self = shift;
-
-    return &dbh( { new => 1 } );
-}
-
 =head2 userenv
 
   C4::Context->userenv;
@@ -906,7 +897,12 @@ variable to be set correctly.
 sub set_remote_address {
     if ( C4::Context->config('koha_trusted_proxies') ) {
         require CGI;
-        my $header = CGI->http('HTTP_X_FORWARDED_FOR');
+
+        # If no reverse_proxy_ip_header, just use HTTP_X_FORWARDED_FOR as the header to check, simplifies logic and is a bit faster that way
+        my $reverse_proxy_ip_header = C4::Context->config('reverse_proxy_ip_header') || 'HTTP_X_FORWARDED_FOR';
+
+        # Check the cgi for the custom header, if the custom header is not set, fall back to HTTP_X_FORWARDED_FOR
+        my $header = CGI->http($reverse_proxy_ip_header) || CGI->http('HTTP_X_FORWARDED_FOR');
 
         if ($header) {
             require Koha::Middleware::RealIP;
@@ -987,6 +983,26 @@ sub is_internal_PSGI_request {
     return $is_internal;
 }
 
+=head3 is_opac_suppressed
+
+    return if C4::Context->is_opac_suppressed;
+
+is_opac_suppressed returns true if and only if OPAC suppression is enabled for
+the current request, based on the sysprefs OpacSuppression and
+OpacSuppressionByIPRange.
+
+=cut
+
+sub is_opac_suppressed {
+    return 0 unless C4::Context->preference('OpacSuppression');
+
+    my $IPAddress = $ENV{'REMOTE_ADDR'};
+    my $IPRange   = C4::Context->preference('OpacSuppressionByIPRange');
+    return 1 unless $IPRange;
+
+    return $IPAddress !~ /^$IPRange/;
+}
+
 __END__
 
 =head1 ENVIRONMENT

C4/Creators/Lib.pm

@@ -272,7 +272,7 @@ ADD_LAYOUTS:
 
 This function returns an arrayref whose elements are hashes containing all profiles upon success and 1 upon failure. Errors are logged
 to the Apache log. Two parameters are accepted. The first limits the field(s) returned. This parameter should be string of comma separated
-fields. ie. "field_1, field_2, ...field_n" The second limits the records returned based on a string containing a valud SQL 'WHERE' filter.
+fields. ie. "field_1, field_2, ...field_n" The second limits the records returned based on a string containing a valid SQL 'WHERE' filter.
 
 NOTE: Do not pass in the keyword 'WHERE.'
 
@@ -320,7 +320,7 @@ sub get_all_image_names {
 
 This function returns an arrayref whose elements are hashes containing the batch_ids of current batches along with the item count
 for each batch upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
-One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
+One parameter is accepted which limits the records returned based on a string containing a valid SQL 'WHERE' filter.
 
 NOTE: Do not pass in the keyword 'WHERE.'
 
@@ -352,7 +352,7 @@ sub get_batch_summary {
 
 This function returns an arrayref whose elements are hashes containing the label_ids of current labels along with the item count
 for each label upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
-One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
+One parameter is accepted which limits the records returned based on a string containing a valid SQL 'WHERE' filter.
 
 NOTE: Do not pass in the keyword 'WHERE.'
 
@@ -405,7 +405,7 @@ sub get_label_summary {
 
 This function returns an arrayref whose elements are hashes containing the label_ids of current cards along with the item count
 for each card upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
-One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
+One parameter is accepted which limits the records returned based on a string containing a valid SQL 'WHERE' filter.
 
 NOTE: Do not pass in the keyword 'WHERE.'
 

C4/External/Amazon.pm

@@ -1,80 +0,0 @@
-package C4::External::Amazon;
-
-# Copyright (C) 2006 LibLime
-# <jmf at liblime dot com>
-#
-# This file is part of Koha.
-#
-# Koha is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 3 of the License, or
-# (at your option) any later version.
-#
-# Koha is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Koha; if not, see <https://www.gnu.org/licenses>.
-
-use strict;
-use warnings;
-
-use vars qw(@ISA @EXPORT);
-
-BEGIN {
-    require Exporter;
-    @ISA    = qw(Exporter);
-    @EXPORT = qw(
-        get_amazon_tld
-    );
-}
-
-sub get_amazon_tld {
-    my %tld = (
-        CA => '.ca',
-        DE => '.de',
-        FR => '.fr',
-        IN => '.in',
-        JP => '.jp',
-        UK => '.co.uk',
-        US => '.com',
-    );
-
-    my $locale = C4::Context->preference('AmazonLocale');
-    my $tld    = $tld{$locale} || '.com';                   # default top level domain is .com
-    return $tld;
-}
-
-=head1 NAME
-
-C4::External::Amazon - Functions for retrieving Amazon.com content in Koha
-
-=head2 FUNCTIONS
-
-This module provides facilities for retrieving Amazon.com content in Koha
-
-=over
-
-=item get_amazon_tld()
-
-Get Amazon Top Level Domain depending on Amazon local preference: AmazonLocal.
-For example, if AmazonLocal is 'UK', returns '.co.uk'.
-
-=back
-
-=cut
-
-1;
-__END__
-
-=head1 NOTES
-
-=cut
-
-=head1 AUTHOR
-
-Joshua Ferraro <jmf@liblime.com>
-
-=cut

C4/External/BakerTaylor.pm

@@ -1,169 +0,0 @@
-package C4::External::BakerTaylor;
-
-# Copyright (C) 2008 LibLime
-# <jmf at liblime dot com>
-#
-# This file is part of Koha.
-#
-# Koha is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 3 of the License, or
-# (at your option) any later version.
-#
-# Koha is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Koha; if not, see <https://www.gnu.org/licenses>.
-
-use Modern::Perl;
-use base 'Exporter';
-
-BEGIN {
-    our @EXPORT_OK = qw(availability content_cafe_url image_url link_url http_jacket_link);
-}
-
-use XML::Simple;
-use LWP::Simple qw( get );
-
-use C4::Context;
-
-use vars qw(%EXPORT_TAGS $VERSION);
-
-BEGIN {
-    $VERSION = 3.07.00.049;
-}
-
-# These variables are plack safe: they are initialized each time
-my ( $user, $pass, $agent, $image_url, $link_url );
-
-sub _initialize {
-    $user     = ( @_ ? shift : C4::Context->preference('BakerTaylorUsername') ) || '';    # LL17984
-    $pass     = ( @_ ? shift : C4::Context->preference('BakerTaylorPassword') ) || '';    # CC82349
-    $link_url = ( @_ ? shift : C4::Context->preference('BakerTaylorBookstoreURL') );
-    $image_url =
-        "https://contentcafe2.btol.com/ContentCafe/Jacket.aspx?UserID=$user&Password=$pass&Options=Y&Return=T&Type=S&Value=";
-    $agent = "Koha/$VERSION [en] (Linux)";
-
-    #"Mozilla/4.76 [en] (Win98; U)",    #  if for some reason you want to go stealth, you might prefer this
-}
-
-sub image_url {
-    _initialize();
-    ( $user and $pass ) or return;
-    my $isbn = ( @_ ? shift : '' );
-    $isbn =~ s/(p|-)//g;    # sanitize
-    return $image_url . $isbn;
-}
-
-sub link_url {
-    _initialize();
-    my $isbn = ( @_ ? shift : '' );
-    $isbn =~ s/(p|-)//g;    # sanitize
-    $link_url or return;
-    return $link_url . $isbn;
-}
-
-sub content_cafe_url {
-    _initialize();
-    ( $user and $pass ) or return;
-    my $isbn = ( @_ ? shift : '' );
-    $isbn =~ s/(p|-)//g;    # sanitize
-    return
-        "https://contentcafe2.btol.com/ContentCafeClient/ContentCafe.aspx?UserID=$user&Password=$pass&Options=Y&ItemKey=$isbn";
-}
-
-sub http_jacket_link {
-    _initialize();
-    my $isbn = shift or return;
-    $isbn =~ s/(p|-)//g;    # sanitize
-    my $image = availability($isbn);
-    my $alt   = "Buy this book";
-    $image and $image = qq(<img class="btjacket" alt="$alt" src="$image" />);
-    my $link = &link_url($isbn);
-    unless ($link) { return $image || ''; }
-    return sprintf qq(<a class="btlink" href="%s">%s</a>), $link, ( $image || $alt );
-}
-
-sub availability {
-    _initialize();
-    my $isbn = shift    or return;
-    ( $user and $pass ) or return;
-    $isbn =~ s/(p|-)//g;    # sanitize
-    my $url =
-        "https://contentcafe2.btol.com/ContentCafe/InventoryAvailability.asmx/CheckInventory?UserID=$user&Password=$pass&Value=$isbn";
-    my $content = get($url);
-    warn "could not retrieve $url" unless $content;
-    my $xmlsimple = XML::Simple->new();
-    my $result    = $xmlsimple->XMLin($content);
-
-    if ( $result->{Error} ) {
-        warn "Error returned to " . __PACKAGE__ . " : " . $result->{Error};
-    }
-    my $avail = $result->{Availability};
-    return ( $avail and $avail !~ /^false$/i ) ? &image_url($isbn) : 0;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-C4::External::BakerTaylor
-
-=head1 DESCRIPTION
-
-Functions for retrieving content from Baker and Taylor, inventory availability and "Content Cafe".
-
-The settings for this module are controlled by System Preferences:
-
-These can be overridden for testing purposes using the initialize function.
-
-=head1 FUNCTIONS
-
-=head2 image_url
-
-Missing POD for image_url.
-
-=head2 link_url
-
-Missing POD for link_url.
-
-=head2 content_cafe_url
-
-Missing POD for content_cafe_url.
-
-=head2 http_jacket_link
-
-Missing POD for http_jacket_link.
-
-=head2 availability($isbn);
-
-$isbn is a isbn string
-
-=head1 NOTES
-
-A request with failed authentication might see this back from Baker + Taylor: 
-
- <?xml version="1.0" encoding="utf-8"?>
- <InventoryAvailability xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" DateTime="2008-03-07T22:01:25.6520429-05:00" xmlns="http://ContentCafe2.btol.com">
-   <Key Type="Undefined">string</Key>
-   <Availability>false</Availability>
-   <Error>Invalid UserID</Error>
- </InventoryAvailability>
-
-Such response will trigger a warning for each request (potentially many).  Point being, do not leave this module configured with incorrect username and password in production.
-
-=head1 SEE ALSO
-
-LWP::UserAgent
-
-=head1 AUTHOR
-
-Joe Atzberger
-atz AT liblime DOT com
-
-=cut

C4/Form/MessagingPreferences.pm

@@ -93,7 +93,7 @@ OPTION: foreach my $option (@$messaging_options) {
         }
 
         if ( $option->{'takes_days'} ) {
-            if ( defined $query->param( $option->{'message_attribute_id'} . '-DAYS' ) ) {
+            if ( $query->param( $option->{'message_attribute_id'} . '-DAYS' ) ) {
                 $updater->{'days_in_advance'} = $query->param( $option->{'message_attribute_id'} . '-DAYS' );
             }
         }
@@ -135,7 +135,7 @@ PREF: foreach my $option (@$messaging_options) {
             $option->{days_in_advance} = $days_in_advance;
             @{ $option->{'select_days'} } = map {
                 {
-                    day      => $_,
+                    day      => $_ || q{},
                     selected => $_ == $days_in_advance
                 }
             } ( 0 .. MAX_DAYS_IN_ADVANCE );
@@ -173,7 +173,7 @@ sub restore_form_values {
             $option->{days_in_advance} = $days_in_advance;
             @{ $option->{'select_days'} } = map {
                 {
-                    day      => $_,
+                    day      => $_ || q{},
                     selected => $_ == $days_in_advance
                 }
             } ( 0 .. MAX_DAYS_IN_ADVANCE );

C4/HoldsQueue.pm

@@ -48,6 +48,7 @@ use Koha::Patrons;
 use List::Util         qw( shuffle );
 use List::MoreUtils    qw( any );
 use Algorithm::Munkres qw();
+use Parallel::ForkManager;
 
 =head1 FUNCTIONS
 
@@ -438,6 +439,15 @@ sub _checkHoldPolicy {
 
 }
 
+=head2 _allocateWithTransportCostMatrix
+
+    _allocateWithTransportCostMatrix( $hold_requests, $available_items, $branches_to_use, $libraries,
+        $transport_cost_matrix, $allocated_items, $items_by_itemnumber )
+
+    given a list of  holds and items attempt to fill the holds in the 'least cost' order
+
+=cut
+
 sub _allocateWithTransportCostMatrix {
     my (
         $hold_requests, $available_items, $branches_to_use, $libraries, $transport_cost_matrix, $allocated_items,
@@ -466,7 +476,6 @@ sub _allocateWithTransportCostMatrix {
 
     my @m = map { [ (undef) x $num_tasks ] } ( 1 .. $num_agents );
 
-    my $inf = -1;    # Initially represent infinity with a negative value.
     my $max = 0;
 
     # If some candidate holds requests cannot be filled and there are
@@ -483,7 +492,8 @@ sub _allocateWithTransportCostMatrix {
 
 RETRY:
     while (1) {
-        return [] if $num_agents == 0 || $num_tasks == 0;
+        my $inf = -1;    # Initially represent infinity with a negative value.
+        return [] if $num_agents == 0 || $num_tasks + scalar(@remaining) == 0;
 
         if ( $num_tasks < $num_agents && @remaining ) {
 
@@ -658,20 +668,32 @@ RETRY:
 
         if ( $retries-- > 0 && @unallocated && @remaining ) {
 
+            # @unallocated is built by iterating agents (rows), so its
+            # entries are not necessarily in column order: Munkres'
+            # row-to-column assignment is a permutation, not a monotonic
+            # mapping. The matrix compaction below scans columns in
+            # ascending order and expects to consume @unallocated in that
+            # same order, so it must be sorted first.
+            my @unallocated_sorted = sort { $a <=> $b } @unallocated;
+
             # Remove the transport cost of unfilled holds and compact the matrix.
             # Also remove the hold request from the array.
             for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
                 my $u = 0;
                 for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {
-                    if ( $u < scalar(@unallocated) && $unallocated[$u] == $j ) {
+                    if ( $u < scalar(@unallocated_sorted) && $unallocated_sorted[$u] == $j ) {
                         $u++;
                     } elsif ( $u > 0 ) {
                         $m[$i][ $j - $u ] = $m[$i][$j];
                     }
                 }
             }
-            for ( my $u = 0 ; $u < scalar(@unallocated) ; $u++ ) {
-                splice @requests, $unallocated[$u], 1;
+
+            # Indices must be spliced out in reverse order, otherwise removing
+            # a lower index shifts the position of any higher index still to
+            # be removed.
+            for my $u ( reverse @unallocated_sorted ) {
+                splice @requests, $u, 1;
             }
             $num_tasks = scalar(@requests);
 
@@ -703,7 +725,8 @@ RETRY:
   about the hold it has been mapped to.
 
   This routine attempts to match the holds in the following priority
-  1 - If local holds priority is enabled we check all requests to see if local matches can be found
+  1 - If local holds priority is enabled, and LocalHoldsPriorityScope includes the holds queue,
+      we check all requests to see if local matches can be found
   2 - We check for item level matches and fill those
   3 - We now loop the remaining requests in priority order attempting to fill with
       a - Items where HoldsQueuePrioritizeBranch matches either from items held at the pickup branch, or at the least cost branch (if Transport Cost Matrix is being used)
@@ -738,8 +761,9 @@ sub MapItemsToHoldRequests {
 
     # Look for Local Holds Priority matches first
 
-    my $LocalHoldsPriority = C4::Context->preference('LocalHoldsPriority');
-    if ( $LocalHoldsPriority ne 'None' ) {
+    my $LocalHoldsPriority      = C4::Context->preference('LocalHoldsPriority');
+    my $LocalHoldsPriorityScope = C4::Context->preference('LocalHoldsPriorityScope');
+    if ( $LocalHoldsPriority ne 'None' && $LocalHoldsPriorityScope eq 'capture_and_queue' ) {
         my $LocalHoldsPriorityPatronControl = C4::Context->preference('LocalHoldsPriorityPatronControl');
         my $LocalHoldsPriorityItemControl   = C4::Context->preference('LocalHoldsPriorityItemControl');
         foreach my $request (@$hold_requests) {
@@ -887,6 +911,7 @@ sub MapItemsToHoldRequests {
             $item_map{ $allocation->[0] } = $allocation->[1];
             $num_items_remaining--;
         }
+        _flag_local_holdgroup_matches( \%item_map, \%items_by_itemnumber );
         return \%item_map;
     }
 
@@ -898,7 +923,10 @@ sub MapItemsToHoldRequests {
         push @{ $items_by_branch{ $item->{holdingbranch} } }, $item
             unless exists $allocated_items{ $item->{itemnumber} };
     }
-    return \%item_map unless keys %items_by_branch;
+    unless ( keys %items_by_branch ) {
+        _flag_local_holdgroup_matches( \%item_map, \%items_by_itemnumber );
+        return \%item_map;
+    }
 
     # now handle the title-level requests
     $num_items_remaining = scalar(@$available_items) - scalar( keys %allocated_items );
@@ -1010,9 +1038,63 @@ sub MapItemsToHoldRequests {
             $num_items_remaining--;
         }
     }
+    _flag_local_holdgroup_matches( \%item_map, \%items_by_itemnumber );
     return \%item_map;
 }
 
+=head2 _flag_local_holdgroup_matches
+
+  _flag_local_holdgroup_matches( $item_map, $items_by_itemnumber );
+
+For each mapped item that does not already have local_holdgroup_match set,
+check whether the item and the patron belong to the same library hold group
+using the LocalHoldsExclusivity* system preferences.  This runs independently
+of LocalHoldsPriority so that the exclusivity feature can operate on its own.
+
+=cut
+
+sub _flag_local_holdgroup_matches {
+    my ( $item_map, $items_by_itemnumber ) = @_;
+
+    my $excl_period = C4::Context->preference('LocalHoldsExclusivityPeriod');
+    return unless $excl_period;
+
+    my $patron_control = C4::Context->preference('LocalHoldsExclusivityPatronControl') || 'PickupLibrary';
+    my $item_control   = C4::Context->preference('LocalHoldsExclusivityItemControl')   || 'holdingbranch';
+
+    foreach my $itemnumber ( keys %$item_map ) {
+        my $mapped = $item_map->{$itemnumber};
+        next if $mapped->{local_holdgroup_match};
+
+        my $item_branchcode =
+              $items_by_itemnumber->{$itemnumber}
+            ? $items_by_itemnumber->{$itemnumber}->{$item_control}
+            : undef;
+
+        unless ($item_branchcode) {
+            my $item_obj = Koha::Items->find($itemnumber);
+            $item_branchcode = $item_obj->$item_control if $item_obj;
+        }
+        next unless $item_branchcode;
+
+        my $patron_branchcode =
+              ( $patron_control eq 'PickupLibrary' ) ? $mapped->{pickup_branch}
+            : ( $patron_control eq 'HomeLibrary' )   ? Koha::Patrons->find( $mapped->{borrowernumber} )->branchcode
+            :                                          undef;
+        next unless $patron_branchcode;
+
+        if ( $item_branchcode eq $patron_branchcode ) {
+            $mapped->{local_holdgroup_match} = 1;
+            next;
+        }
+
+        my $item_library = Koha::Libraries->find( { branchcode => $item_branchcode } );
+        if ( $item_library && $item_library->validate_hold_sibling( { branchcode => $patron_branchcode } ) ) {
+            $mapped->{local_holdgroup_match} = 1;
+        }
+    }
+}
+
 =head2 _can_item_fill_request
 
   my $bool = _can_item_fill_request( $item, $request, $libraries );
@@ -1064,19 +1146,20 @@ sub CreatePicklistFromItemMap {
     my $sth_load = $dbh->prepare( "
         INSERT INTO tmp_holdsqueue (biblionumber,itemnumber,barcode,surname,firstname,phone,borrowernumber,
                                     cardnumber,reservedate,title, itemcallnumber,
-                                    holdingbranch,pickbranch,notes, item_level_request)
-        VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+                                    holdingbranch,pickbranch,notes, hold_group_id, item_level_request, local_holdgroup_match)
+        VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
     " );
 
     foreach my $itemnumber ( sort keys %$item_map ) {
-        my $mapped_item    = $item_map->{$itemnumber};
-        my $biblionumber   = $mapped_item->{biblionumber};
-        my $borrowernumber = $mapped_item->{borrowernumber};
-        my $pickbranch     = $mapped_item->{pickup_branch};
-        my $holdingbranch  = $mapped_item->{holdingbranch};
-        my $reservedate    = $mapped_item->{reservedate};
-        my $reservenotes   = $mapped_item->{reservenotes};
-        my $item_level     = $mapped_item->{item_level};
+        my $mapped_item           = $item_map->{$itemnumber};
+        my $biblionumber          = $mapped_item->{biblionumber};
+        my $borrowernumber        = $mapped_item->{borrowernumber};
+        my $pickbranch            = $mapped_item->{pickup_branch};
+        my $holdingbranch         = $mapped_item->{holdingbranch};
+        my $reservedate           = $mapped_item->{reservedate};
+        my $reservenotes          = $mapped_item->{reservenotes};
+        my $item_level            = $mapped_item->{item_level};
+        my $local_holdgroup_match = $mapped_item->{local_holdgroup_match} ? 1 : 0;
 
         my $item           = Koha::Items->find($itemnumber);
         my $barcode        = $item->barcode;
@@ -1091,10 +1174,17 @@ sub CreatePicklistFromItemMap {
         my $biblio = Koha::Biblios->find($biblionumber);
         my $title  = $biblio->title;
 
+        my $hold_group_id;
+        if ( C4::Context->preference("DisplayAddHoldGroups") ) {
+            my $reserve_id = $mapped_item->{reserve_id};
+            my $hold       = Koha::Holds->find($reserve_id);
+            $hold_group_id = $hold ? $hold->hold_group_id : undef;
+        }
+
         $sth_load->execute(
             $biblionumber,  $itemnumber,  $barcode,      $surname, $firstname, $phone, $borrowernumber,
             $cardnumber,    $reservedate, $title,        $itemcallnumber,
-            $holdingbranch, $pickbranch,  $reservenotes, $item_level
+            $holdingbranch, $pickbranch,  $reservenotes, $hold_group_id, $item_level, $local_holdgroup_match
         );
     }
 }
@@ -1110,7 +1200,7 @@ sub AddToHoldTargetMap {
     my $schema = Koha::Database->new->schema;
 
     my $insert_sql = q(
-        INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request, reserve_id) VALUES (?, ?, ?, ?, ?, ?)
+        INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request, reserve_id, local_holdgroup_match) VALUES (?, ?, ?, ?, ?, ?, ?)
     );
     my $sth_insert = $dbh->prepare($insert_sql);
 
@@ -1121,7 +1211,8 @@ sub AddToHoldTargetMap {
                 $dbh->do( 'DELETE FROM hold_fill_targets WHERE itemnumber = ?', {}, $itemnumber );
                 $sth_insert->execute(
                     $mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, $itemnumber,
-                    $mapped_item->{holdingbranch},  $mapped_item->{item_level},   $mapped_item->{reserve_id}
+                    $mapped_item->{holdingbranch},  $mapped_item->{item_level},   $mapped_item->{reserve_id},
+                    $mapped_item->{local_holdgroup_match} ? 1 : 0,
                 );
             }
         );
@@ -1130,6 +1221,12 @@ sub AddToHoldTargetMap {
 
 # Helper functions, not part of any interface
 
+=head2 _trim
+
+Remove leading and trailing spaces
+
+=cut
+
 sub _trim {
     return $_[0] unless $_[0];
     $_[0] =~ s/^\s+//;
@@ -1162,7 +1259,8 @@ sub load_branches_to_pull_from {
 
     my $today = dt_from_string();
     if ( C4::Context->preference('HoldsQueueSkipClosed') ) {
-        @branches_to_use = grep { !Koha::Calendar->new( branchcode => $_ )->is_holiday($today) } @branches_to_use;
+        @branches_to_use =
+            grep { !Koha::Library::Calendar->new( branchcode => $_ )->is_holiday($today) } @branches_to_use;
     }
 
     return \@branches_to_use;

C4/ImportBatch.pm

@@ -73,6 +73,7 @@ BEGIN {
 
 use C4::Context;
 use C4::Koha   qw( GetNormalizedISBN );
+use JSON       qw( encode_json decode_json );
 use C4::Biblio qw(
     AddBiblio
     DelBiblio
@@ -1547,7 +1548,7 @@ sub GetImportRecordMatches {
     # FIXME currently biblio only
     my $sth = $dbh->prepare_cached(
         "SELECT title, author, biblionumber,
-                                    candidate_match_id, score, record_type,
+                                    candidate_match_id, score, composite_scores, record_type,
                                     chosen
                                     FROM import_records
                                     JOIN import_record_matches USING (import_record_id)
@@ -1563,6 +1564,10 @@ sub GetImportRecordMatches {
             $row->{'authorized_heading'} = GetAuthorizedHeading( { authid => $row->{'candidate_match_id'} } );
         }
         next if ( $row->{'record_type'} eq 'biblio' && not $row->{'biblionumber'} );
+        $row->{'composite_scores'} =
+            $row->{'composite_scores'}
+            ? decode_json( $row->{'composite_scores'} )
+            : {};
         push @$results, $row;
         last if $best_only;
     }
@@ -1588,12 +1593,16 @@ sub SetImportRecordMatches {
     $delsth->finish();
 
     my $sth = $dbh->prepare(
-        "INSERT INTO import_record_matches (import_record_id, candidate_match_id, score, chosen)
-                                    VALUES (?, ?, ?, ?)"
+        "INSERT INTO import_record_matches (import_record_id, candidate_match_id, score, composite_scores, chosen)
+                                    VALUES (?, ?, ?, ?, ?)"
     );
     my $chosen = 1;    #The first match is defaulted to be chosen
     foreach my $match (@matches) {
-        $sth->execute( $import_record_id, $match->{'record_id'}, $match->{'score'}, $chosen );
+        my $composite_json =
+            $match->{'composite_scores'}
+            ? encode_json( $match->{'composite_scores'} )
+            : undef;
+        $sth->execute( $import_record_id, $match->{'record_id'}, $match->{'score'}, $composite_json, $chosen );
         $chosen = 0;    #After the first we do not default to other matches
     }
 }
@@ -1710,6 +1719,16 @@ sub RecordsFromMarcPlugin {
 
 # internal functions
 
+=head2 _create_import_record
+
+  my $import_record_id = _create_import_record($batch_id, $record_sequence,
+                             $marc_record, $record_type, $encoding, $marc_type);
+
+Inserts a new row into C<import_records> for the given MARC record and returns
+the new C<import_record_id>.
+
+=cut
+
 sub _create_import_record {
     my ( $batch_id, $record_sequence, $marc_record, $record_type, $encoding, $marc_type ) = @_;
 
@@ -1728,6 +1747,15 @@ sub _create_import_record {
     return $import_record_id;
 }
 
+=head2 _add_auth_fields
+
+  _add_auth_fields($import_record_id, $marc_record);
+
+Extracts authority-specific fields from C<$marc_record> and stores them
+in C<import_auths>.
+
+=cut
+
 sub _add_auth_fields {
     my ( $import_record_id, $marc_record ) = @_;
 
@@ -1743,6 +1771,15 @@ sub _add_auth_fields {
     $sth->finish();
 }
 
+=head2 _add_biblio_fields
+
+  _add_biblio_fields($import_record_id, $marc_record);
+
+Extracts bibliographic fields (title, author, ISBN) from C<$marc_record> and
+inserts them into C<import_biblios>.
+
+=cut
+
 sub _add_biblio_fields {
     my ( $import_record_id, $marc_record ) = @_;
 
@@ -1758,6 +1795,15 @@ sub _add_biblio_fields {
 
 }
 
+=head2 _update_biblio_fields
+
+  _update_biblio_fields($import_record_id, $marc_record);
+
+Updates the C<import_biblios> row for an already-staged bibliographic record
+with freshly parsed field values.
+
+=cut
+
 sub _update_biblio_fields {
     my ( $import_record_id, $marc_record ) = @_;
 
@@ -1777,6 +1823,16 @@ sub _update_biblio_fields {
     $sth->finish();
 }
 
+=head2 _parse_biblio_fields
+
+  my ($title, $author, $isbn, $issn, $lccn, $biblionumber) =
+      _parse_biblio_fields($marc_record);
+
+Extracts key bibliographic fields from a MARC::Record object and returns
+them as a list.
+
+=cut
+
 sub _parse_biblio_fields {
     my ($marc_record) = @_;
 
@@ -1791,6 +1847,15 @@ sub _parse_biblio_fields {
 
 }
 
+=head2 _update_batch_record_counts
+
+  _update_batch_record_counts($batch_id);
+
+Recalculates and updates the record-count summary columns on the
+C<import_batches> row for C<$batch_id>.
+
+=cut
+
 sub _update_batch_record_counts {
     my ($batch_id) = @_;
 
@@ -1819,6 +1884,18 @@ sub _update_batch_record_counts {
     );
 }
 
+=head2 _get_commit_action
+
+  my ($biblio_action, $item_action, $match_id) =
+      _get_commit_action($overlay_action, $nomatch_action, $item_action,
+                         $overlay_status, $import_record_id, $record_type);
+
+Determines the appropriate commit action (C<create_new>, C<replace>,
+C<ignore>) for a record based on the batch overlay/nomatch settings and
+the record's current overlay status.
+
+=cut
+
 sub _get_commit_action {
     my ( $overlay_action, $nomatch_action, $item_action, $overlay_status, $import_record_id, $record_type ) = @_;
 
@@ -1859,6 +1936,16 @@ sub _get_commit_action {
     }
 }
 
+=head2 _get_revert_action
+
+  my ($bib_result, $item_result) =
+      _get_revert_action($overlay_action, $overlay_status, $status);
+
+Determines the appropriate revert action for a record based on the batch
+overlay action and the record's current overlay/import status.
+
+=cut
+
 sub _get_revert_action {
     my ( $overlay_action, $overlay_status, $status ) = @_;
 

C4/InstallAuth.pm

@@ -111,7 +111,7 @@ sub get_template_and_user {
     my $template  = C4::Templates->new( $interface, $filename, $tmplbase, $query );
 
     my $request_method = $in->{query}->request_method // q{};
-    unless ( $request_method eq 'POST' && $in->{query}->param('op') eq 'cud-login' ) {
+    unless ( $request_method eq 'POST' && $in->{query}->param('login_op') eq 'cud-login' ) {
         $in->{query}->param( 'login_userid',   '' );
         $in->{query}->param( 'login_password', '' );
     }
@@ -236,7 +236,6 @@ sub checkauth {
     my $type            = shift;
     $type = 'intranet' unless $type;
 
-    my $dbh = C4::Context->dbh();
     my $template_name;
     $template_name = "installer/auth.tt";
 
@@ -352,7 +351,7 @@ sub checkauth {
     # else we have a problem...
     # get the inputs from the incoming query
     my @inputs = ();
-    foreach my $name ( param $query) {
+    foreach my $name ( param $query ) {
         (next) if ( $name eq 'userid' || $name eq 'password' );
         my $value = $query->param($name);
         push @inputs, { name => $name, value => $value };

C4/Installer.pm

@@ -388,6 +388,7 @@ sub load_sql_in_order {
     push @fnames, "$global_mandatory_dir/userflags.sql",
         "$global_mandatory_dir/userpermissions.sql",
         "$global_mandatory_dir/audio_alerts.sql",
+        "$global_mandatory_dir/record_sources.sql",
         ;
     my $localization_file =
         C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/localization/$langchoice/custom.sql";
@@ -460,10 +461,8 @@ sub set_marcflavour_syspref {
     # marc_cleaned finds the marcflavour, without the variant.
     my $marc_cleaned = 'MARC21';
     $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
-    my $request =
-        $self->{'dbh'}->prepare(
-        "INSERT IGNORE INTO `systempreferences` (variable,value,explanation,options,type) VALUES('marcflavour','$marc_cleaned','Define global MARC flavor (MARC21 or UNIMARC) used for character encoding','MARC21|UNIMARC','Choice');"
-        );
+    my $request = $self->{'dbh'}
+        ->prepare("INSERT IGNORE INTO `systempreferences` (variable, value) VALUES('marcflavour', '$marc_cleaned')");
     $request->execute;
 }
 
@@ -754,14 +753,8 @@ Missing POD for TableExists.
 
 sub TableExists {    # Could be renamed table_exists for consistency
     my $table = shift;
-    eval {
-        my $dbh = C4::Context->dbh;
-        local $dbh->{PrintError} = 0;
-        local $dbh->{RaiseError} = 1;
-        $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
-    };
-    return 1 unless $@;
-    return 0;
+    require Koha::Database;
+    return Koha::Database->table_exists( C4::Context->dbh, $table );
 }
 
 =head2 version_from_file

C4/Items.pm

@@ -38,6 +38,7 @@ BEGIN {
         SearchItems
         PrepareItemrecordDisplay
         ToggleNewStatus
+        GetAutomaticItemModificationAgeFields
     );
 }
 
@@ -58,6 +59,7 @@ use Try::Tiny qw( catch try );
 use Koha::AuthorisedValues;
 use Koha::DateUtils qw( dt_from_string );
 use Koha::Database;
+use Koha::Logger;
 
 use Koha::Biblios;
 use Koha::Biblioitems;
@@ -599,7 +601,7 @@ sub GetItemsForInventory {
     my $max_cnsort = GetClassSort( $class_source, undef, $maxlocation );
 
     my $select_columns = q{
-        SELECT DISTINCT(items.itemnumber), barcode, itemcallnumber, title, author, biblio.biblionumber, biblio.frameworkcode, datelastseen, homebranch, location, notforloan, damaged, itemlost, withdrawn, stocknumber, items.cn_sort, ccode
+        SELECT DISTINCT(items.itemnumber), barcode, itemcallnumber, title, author, biblio.biblionumber, biblio.frameworkcode, datelastseen, homebranch, location, notforloan, damaged, itemlost, withdrawn, stocknumber, items.cn_sort, ccode, enumchron
 
     };
     my $select_count = q{SELECT COUNT(DISTINCT(items.itemnumber))};
@@ -1655,6 +1657,25 @@ sub PrepareItemrecordDisplay {
     };
 }
 
+=head2 GetAutomaticItemModificationAgeFields
+
+    my @fields = GetAutomaticItemModificationAgeFields();
+
+Returns the fixed, C<items.>-prefixed list of date columns that are valid
+"age field" values for automatic item modification rules (see
+ToggleNewStatus below). This is the single source of truth for that
+allow-list; it is shared with F<tools/automatic_item_modification_by_age.pl>
+so the two cannot drift apart.
+
+=cut
+
+sub GetAutomaticItemModificationAgeFields {
+    return (
+        'items.dateaccessioned', 'items.replacementpricedate', 'items.datelastborrowed', 'items.datelastseen',
+        'items.damaged_on',      'items.itemlost_on',          'items.withdrawn_on'
+    );
+}
+
 =head2 ToggleNewStatus
 
 Missing POD for ToggleNewStatus.
@@ -1671,17 +1692,32 @@ sub ToggleNewStatus {
     my @item_columns       = map { "items.$_" } Koha::Items->columns;
     my @biblioitem_columns = map { "biblioitems.$_" } Koha::Biblioitems->columns;
     my @biblio_columns     = map { "biblio.$_" } Koha::Biblios->columns;
+    my @age_fields         = GetAutomaticItemModificationAgeFields();
     my $report;
     for my $rule (@rules) {
         my $age = $rule->{age};
 
         # Default to using items.dateaccessioned if there's an old item modification rule
-        # missing an agefield value
-        my $agefield      = $rule->{agefield} ? $rule->{agefield} : 'items.dateaccessioned';
+        # missing an agefield value, or if the stored value is not (or is no longer) a
+        # recognised age field - values are only trusted from a fixed allow-list since
+        # this is spliced directly into the SQL below and cannot be bound as a placeholder.
+        my $agefield = $rule->{agefield} // '';
+        unless ( grep { $_ eq $agefield } @age_fields ) {
+            Koha::Logger->get->warn(qq{Rejecting invalid agefield "$agefield" in automatic item modification rule})
+                if length $agefield;
+            $agefield = 'items.dateaccessioned';
+        }
         my $conditions    = $rule->{conditions};
         my $substitutions = $rule->{substitutions};
-        foreach (@$substitutions) {
-            ( $_->{item_field} ) = ( $_->{field} =~ /items\.(.*)/ );
+        foreach my $substitution (@$substitutions) {
+            my $field = $substitution->{field} // '';
+            if ( grep { $_ eq $field } @item_columns ) {
+                ( $substitution->{item_field} ) = ( $field =~ /^items\.(.*)/ );
+            } else {
+                Koha::Logger->get->warn(
+                    qq{Rejecting invalid substitution field "$field" in automatic item modification rule})
+                    if length $field;
+            }
         }
         my @params;
 
@@ -1706,6 +1742,9 @@ sub ToggleNewStatus {
                     $query .= qq| AND $condition->{field} = ?|;
                     push @params, $condition->{value};
                 }
+            } else {
+                Koha::Logger->get->warn(
+                    qq{Rejecting invalid condition field "$condition->{field}" in automatic item modification rule});
             }
         }
         if ( defined $age ) {
@@ -1722,6 +1761,7 @@ sub ToggleNewStatus {
                 my $field = $substitution->{item_field};
                 my $value = $substitution->{value};
                 next unless $substitution->{field};
+                next unless defined $field;
                 next
                     if ( defined $values->{ $substitution->{item_field} }
                     and $values->{ $substitution->{item_field} } eq $substitution->{value} );

C4/Koha.pm

@@ -33,10 +33,7 @@ BEGIN {
         getitemtypeimagesrc
         getitemtypeimagelocation
         GetAuthorisedValues
-        GetNormalizedUPC
         GetNormalizedISBN
-        GetNormalizedEAN
-        GetNormalizedOCLCNumber
         xml_escape
 
         GetVariationsOfISBN
@@ -508,37 +505,51 @@ C<$opac> If set to a true value, displays OPAC descriptions rather than normal o
 sub GetAuthorisedValues {
     my $category = shift // '';      # optional parameter
     my $opac     = shift ? 1 : 0;    # normalise to be safe
+    my $options  = shift // '';
+    my $no_limit;
+    if ($options) { $no_limit = $options->{'no_limit'}; }    #optional parameter to ignore library limitation
+    $no_limit = $no_limit ? 1 : 0;
 
     # Is this cached already?
     my $branch_limit = C4::Context::mybranch();
-    my $cache_key    = "AuthorisedValues-$category-$opac-$branch_limit";
+    my $cache_key    = "AuthorisedValues-$category-$opac-$branch_limit-$no_limit";
     my $cache        = Koha::Caches->get_instance();
     my $result       = $cache->get_from_cache($cache_key);
     return $result if $result;
 
     my @results;
-    my $dbh   = C4::Context->dbh;
+    my $dbh = C4::Context->dbh;
+
+    my $select_clause = 'SELECT av.*';
+    my @where_args;
+    if ( $branch_limit && $no_limit ) {
+        $select_clause .= ', MIN(IF (branchcode = ? OR branchcode IS NULL, 0, 1)) as restricted';
+        push @where_args, $branch_limit;
+    }
+
     my $query = qq{
-        SELECT DISTINCT av.*
+        $select_clause
         FROM authorised_values av
     };
     $query .= qq{
           LEFT JOIN authorised_values_branches ON ( id = av_id )
     } if $branch_limit;
     my @where_strings;
-    my @where_args;
-
     if ($category) {
         push @where_strings, "category = ?";
         push @where_args,    $category;
     }
-    if ($branch_limit) {
+
+    if ( $branch_limit && !$no_limit ) {
         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
         push @where_args,    $branch_limit;
     }
+
     if ( @where_strings > 0 ) {
         $query .= " WHERE " . join( " AND ", @where_strings );
     }
+    $query .= ' GROUP BY av.id, av.category, av.authorised_value, av.lib, av.lib_opac, av.imageurl'
+        if $branch_limit && $no_limit;
     $query .= ' ORDER BY category, '
         . (
         $opac
@@ -601,39 +612,6 @@ sub display_marc_indicators {
     return $indicators;
 }
 
-=head2 GetNormalizedUPC
-
-Missing POD for GetNormalizedUPC.
-
-=cut
-
-sub GetNormalizedUPC {
-    my ( $marcrecord, $marcflavour ) = @_;
-
-    $marcflavour ||= C4::Context->preference('marcflavour');
-
-    return unless $marcrecord;
-    if ( $marcflavour eq 'UNIMARC' ) {
-        my @fields = $marcrecord->field('072');
-        foreach my $field (@fields) {
-            my $upc = _normalize_match_point( $field->subfield('a') );
-            if ($upc) {
-                return $upc;
-            }
-        }
-
-    } else {    # assume marc21 if not unimarc
-        my @fields = $marcrecord->field('024');
-        foreach my $field (@fields) {
-            my $indicator = $field->indicator(1);
-            my $upc       = _normalize_match_point( $field->subfield('a') );
-            if ( $upc && $indicator eq '1' ) {
-                return $upc;
-            }
-        }
-    }
-}
-
 # Normalizes and returns the first valid ISBN found in the record
 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
 
@@ -674,64 +652,6 @@ sub GetNormalizedISBN {
     }
 }
 
-=head2 GetNormalizedEAN
-
-Missing POD for GetNormalizedEAN.
-
-=cut
-
-sub GetNormalizedEAN {
-    my ( $marcrecord, $marcflavour ) = @_;
-
-    return unless $marcrecord;
-
-    if ( $marcflavour eq 'UNIMARC' ) {
-        my @fields = $marcrecord->field('073');
-        foreach my $field (@fields) {
-            my $ean = _normalize_match_point( $field->subfield('a') );
-            if ($ean) {
-                return $ean;
-            }
-        }
-    } else {    # assume marc21 if not unimarc
-        my @fields = $marcrecord->field('024');
-        foreach my $field (@fields) {
-            my $indicator = $field->indicator(1);
-            my $ean       = _normalize_match_point( $field->subfield('a') );
-            if ( $ean && $indicator eq '3' ) {
-                return $ean;
-            }
-        }
-    }
-}
-
-=head2 GetNormalizedOCLCNumber
-
-Missing POD for GetNormalizedOCLCNumber.
-
-=cut
-
-sub GetNormalizedOCLCNumber {
-    my ( $marcrecord, $marcflavour ) = @_;
-    return unless $marcrecord;
-
-    $marcflavour ||= C4::Context->preference('marcflavour');
-
-    if ( $marcflavour ne 'UNIMARC' ) {
-        my @fields = $marcrecord->field('035');
-        foreach my $field (@fields) {
-            my $oclc = $field->subfield('a');
-            if ( $oclc && $oclc =~ /OCoLC/ ) {
-                $oclc =~ s/\(OCoLC\)//;
-                return $oclc;
-            }
-        }
-    } else {
-
-        # TODO for UNIMARC
-    }
-}
-
 sub _normalize_match_point {
     my $match_point = shift;
     ( my $normalized_match_point ) = $match_point =~ /([\d-]*[X]*)/;
@@ -742,13 +662,28 @@ sub _normalize_match_point {
 
 sub _isbn_cleanup {
     my ($isbn) = @_;
-    return NormalizeISBN(
-        {
-            isbn          => $isbn,
-            format        => 'ISBN-10',
-            strip_hyphens => 1,
-        }
-    ) if $isbn;
+
+    return unless $isbn;
+
+    if ( $isbn =~ /^979/ ) {
+
+        # ISBNs starting with 979 cannot be converted to ISBN-10 format, but all other valid ISBNs can
+        return NormalizeISBN(
+            {
+                isbn          => $isbn,
+                format        => 'ISBN-13',
+                strip_hyphens => 1,
+            }
+        );
+    } else {
+        return NormalizeISBN(
+            {
+                isbn          => $isbn,
+                format        => 'ISBN-10',
+                strip_hyphens => 1,
+            }
+        );
+    }
 }
 
 =head2 NormalizeISBN

C4/Languages.pm

@@ -34,7 +34,7 @@ BEGIN {
 
 use Carp qw( carp );
 use CGI;
-use List::MoreUtils qw( any );
+use List::MoreUtils qw( any uniq );
 use C4::Context;
 use Koha::Caches;
 use Koha::Cache::Memory::Lite;
@@ -123,6 +123,10 @@ sub getTranslatedLanguages {
         } elsif ( $interface eq 'opac' ) {
             @enabled_languages = split ",", C4::Context->preference('OPACLanguages');
         }
+    } else {
+        @enabled_languages = split ",",
+            join( ',', C4::Context->preference( 'StaffInterfaceLanguages', C4::Context->preference('OPACLanguages') ) );
+        @enabled_languages = uniq @enabled_languages;
     }
 
     my $cache     = Koha::Caches->get_instance;
@@ -152,9 +156,7 @@ sub getTranslatedLanguages {
         $htdocs = C4::Context->config('opachtdocs');
         push @languages, _get_opac_language_dirs($htdocs);
 
-        my %seen;
-        $seen{$_}++ for @languages;
-        @languages = keys %seen;
+        @languages = uniq @languages;
     }
     return _build_languages_arrayref( \@languages, $current_language, \@enabled_languages );
 }
@@ -369,14 +371,16 @@ FIXME: this could be rewritten and simplified using map
 
 sub _build_languages_arrayref {
     my ( $translated_languages, $current_language, $enabled_languages ) = @_;
+
     $current_language //= '';
     my @translated_languages = @$translated_languages;
     my @languages_loop;    # the final reference to an array of hashrefs
     my @enabled_languages = @$enabled_languages;
 
     # how many languages are enabled, if one, take note, some contexts won't need to display it
-    my $language_groups;
-    my $track_language_groups;
+    my $language_groups       = {};
+    my $track_language_groups = {};
+
     my $current_language_regex = regex_lang_subtags($current_language);
 
     # Loop through the translated languages
@@ -443,9 +447,15 @@ sub _build_languages_arrayref {
                 }
             }
         }
-        ( exists $idx{$aa} and exists $idx{$bb} and ( $idx{$aa} cmp $idx{$bb} ) )
-            || ( exists $idx{$aa} and exists $idx{$bb} )
-            || exists $idx{$bb}
+        if ( exists $idx{$aa} and exists $idx{$bb} ) {
+            return $idx{$aa} cmp $idx{$bb};
+        } elsif ( exists $idx{$aa} ) {
+            return -1;
+        } elsif ( exists $idx{$bb} ) {
+            return 1;
+        } else {
+            return $a cmp $b;    # Finally order by lang code
+        }
     } keys %$language_groups;
 
     for my $key (@ordered_keys) {
@@ -480,6 +490,13 @@ Missing POD for language_get_description.
 
 sub language_get_description {
     my ( $script, $lang, $type ) = @_;
+
+    my $script_key   = $script || "undef";
+    my $memory_cache = Koha::Cache::Memory::Lite->get_instance;
+    my $cache_key    = "Language_descriptions:$script_key:$lang:$type";
+    my $cached       = $memory_cache->get_from_cache($cache_key);
+    return $cached if $cached;
+
     my $dbh = C4::Context->dbh;
     my $desc;
     my $sth = $dbh->prepare("SELECT description FROM language_descriptions WHERE subtag=? AND lang=? AND type=?");
@@ -496,6 +513,7 @@ sub language_get_description {
             $desc = $descriptions->{'description'};
         }
     }
+    $memory_cache->set_in_cache( $cache_key, $desc );
     return $desc;
 }
 
@@ -797,11 +815,17 @@ sub getlanguage {
 
 sub get_rfc4646_from_iso639 {
 
-    my $iso_code = shift;
+    my $iso_code     = shift;
+    my $memory_cache = Koha::Cache::Memory::Lite->get_instance;
+    my $cache_key    = "RFC4646ByISO639:$iso_code";
+    my $cached       = $memory_cache->get_from_cache($cache_key);
+    return $cached if $cached;
     my $rfc_subtag =
         Koha::Database->new()->schema->resultset('LanguageRfc4646ToIso639')->find( { iso639_2_code => $iso_code } );
     if ($rfc_subtag) {
-        return $rfc_subtag->rfc4646_subtag;
+        my $subtag = $rfc_subtag->rfc4646_subtag;
+        $memory_cache->set_in_cache( $cache_key, $subtag );
+        return $subtag;
     } else {
         return;
     }

C4/Letters.pm

@@ -214,8 +214,8 @@ sub GetLettersAvailableForALibrary {
     }
 
     return [
-        map      { $letters{$_} }
-            sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
+        map  { $letters{$_} }
+        sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
             keys %letters
     ];
 
@@ -338,7 +338,7 @@ sub SendAlerts {
             );
 
             if ( $letter->{is_html} ) {
-                $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
+                $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title}, 'email' ) );
             } else {
                 $mail->text_body( $letter->{content} );
             }
@@ -510,7 +510,7 @@ sub SendAlerts {
         );
 
         if ( $letter->{is_html} ) {
-            $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
+            $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title}, 'email' ) );
         } else {
             $mail->text_body( "" . $letter->{content} );
         }
@@ -620,24 +620,19 @@ sub GetPreparedLetter {
     }
 
     # add plugin-generated objects
-    if ( C4::Context->config("enable_plugins") ) {
-        my @plugins = Koha::Plugins->new->GetPlugins(
-            {
-                method => 'notices_content',
-            }
-        );
+    my @plugins = Koha::Plugins->get_enabled_plugins();
+    @plugins = grep { $_->can('notices_content') } @plugins;
 
-        foreach my $plugin (@plugins) {
-            my $namespace = $plugin->get_metadata()->{namespace};
-            if ($namespace) {
-                try {
-                    if ( my $content = $plugin->notices_content( \%params ) ) {
-                        $objects->{plugin_content}->{$namespace} = $content;
-                    }
-                } catch {
-                    next;
-                };
-            }
+    foreach my $plugin (@plugins) {
+        my $namespace = $plugin->get_metadata()->{namespace};
+        if ($namespace) {
+            try {
+                if ( my $content = $plugin->notices_content( \%params ) ) {
+                    $objects->{plugin_content}->{$namespace} = $content;
+                }
+            } catch {
+                next;
+            };
         }
     }
 
@@ -753,6 +748,14 @@ sub GetPreparedLetter {
     return $letter;
 }
 
+=head2 _substitute_tables
+
+  _substitute_tables( $letter, $tables );
+
+Substitute placeholders in the letter with values from the given tables.
+
+=cut
+
 sub _substitute_tables {
     my ( $letter, $tables ) = @_;
     while ( my ( $table, $param ) = each %$tables ) {
@@ -780,6 +783,14 @@ sub _substitute_tables {
     }
 }
 
+=head2 _parseletter_sth
+
+  my $sth = _parseletter_sth( $table );
+
+Return a prepared statement handle for retrieving values from the given table.
+
+=cut
+
 sub _parseletter_sth {
     my $table = shift;
     my $sth;
@@ -1021,6 +1032,7 @@ sub EnqueueLetter {
         message_id => $id,
         borrowernumber => $who_letter_is_for,
         letter_code => $letter_code, # can be scalar or arrayref
+        exclude_letter_code => $exclude_letter_code, # can be scalar or arrayref
         type => $type, # can be scalar or arrayref
         limit => 50,
         verbose => 1,
@@ -1033,6 +1045,10 @@ The (optional) message_id, borrowernumber, letter_code, type and where
 parameter are used to select which pending messages will be processed. The
 limit parameter determines the volume of results, i.e. sent messages.
 
+The optional exclude_letter_code parameter processes all pending messages
+except those with the given letter code(s). It cannot be combined with
+letter_code; passing both raises a Koha::Exceptions::BadParameter exception.
+
 The optional verbose parameter can be used to generate debugging output.
 
 Returns number of messages sent.
@@ -1047,6 +1063,18 @@ sub SendQueuedMessages {
     Koha::Exceptions::BadParameter->throw("Parameter message_id cannot be empty if passed.")
         if ( exists( $params->{message_id} ) && !$params->{message_id} );
 
+    my $has_letter_code =
+        ref( $params->{letter_code} ) ? scalar @{ $params->{letter_code} } : $params->{letter_code};
+    my $has_exclude_letter_code =
+        ref( $params->{exclude_letter_code} )
+        ? scalar @{ $params->{exclude_letter_code} }
+        : $params->{exclude_letter_code};
+
+    # letter_code and exclude_letter_code build the same search key ('letter_code'); passing both
+    # would let one silently clobber the other in the hash literal built below.
+    Koha::Exceptions::BadParameter->throw("Parameters letter_code and exclude_letter_code are mutually exclusive.")
+        if ( $has_letter_code && $has_exclude_letter_code );
+
     if ( C4::Context->config("enable_plugins") ) {
         my @plugins = Koha::Plugins->new->GetPlugins(
             {
@@ -1073,10 +1101,17 @@ sub SendQueuedMessages {
             $params->{message_id}     ? ( message_id     => $params->{message_id} )     : (),
             $params->{borrowernumber} ? ( borrowernumber => $params->{borrowernumber} ) : (),
 
-            # Check for scalar or array in letter_code and type
-            ref( $params->{letter_code} )
-                && @{ $params->{letter_code} } ? ( letter_code => $params->{letter_code} ) : (),
-            !ref( $params->{letter_code} ) && $params->{letter_code} ? ( letter_code => $params->{letter_code} ) : (),
+            # letter_code and exclude_letter_code can each be scalar or arrayref; guaranteed
+            # mutually exclusive above, so they never both contribute a letter_code key here.
+            $has_letter_code ? ( letter_code => $params->{letter_code} ) : (),
+            $has_exclude_letter_code
+            ? (
+                letter_code => ref( $params->{exclude_letter_code} )
+                ? { '-not_in' => $params->{exclude_letter_code} }
+                : { '!='      => $params->{exclude_letter_code} }
+                )
+            : (),
+
             ref( $params->{type} )
                 && @{ $params->{type} }
             ? ( message_transport_type => $params->{type} )
@@ -1211,7 +1246,7 @@ sub GetQueuedMessages {
     my $params = shift;
 
     my $dbh       = C4::Context->dbh();
-    my $statement = << 'ENDSQL';
+    my $statement = <<'ENDSQL';
 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code, from_address, to_address, cc_address
 FROM message_queue
 ENDSQL
@@ -1311,7 +1346,7 @@ sub ResendMessage {
     return $rv;
 }
 
-=head2 _add_attachements
+=head2 _add_attachments
 
   _add_attachments({ letter => $letter, attachments => $attachments });
 
@@ -1340,7 +1375,7 @@ sub _add_attachments {
     my $message = Koha::Email->new;
 
     if ( $letter->{is_html} ) {
-        $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
+        $message->html_body( _wrap_html( $letter->{content}, $letter->{title}, 'email' ) );
     } else {
         $message->text_body( $letter->{content} );
     }
@@ -1433,6 +1468,15 @@ sub _get_unsent_messages {
     return $sth->fetchall_arrayref( {} );
 }
 
+=head2 _send_message_by_email
+
+  _send_message_by_email( $message, $username, $password, $method, $smtp_transports );
+
+Send a queued message via email. Handles SMTP transport selection, attachments,
+guarantor copies, and message status updates.
+
+=cut
+
 sub _send_message_by_email {
     my $message = shift or return;
     my ( $username, $password, $method, $smtp_transports ) = @_;
@@ -1569,7 +1613,7 @@ sub _send_message_by_email {
         } else {
             $email = Koha::Email->create($params);
             if ($is_html) {
-                $email->html_body( _wrap_html( $content, $subject ) );
+                $email->html_body( _wrap_html( $content, $subject, 'email' ) );
             } else {
                 $email->text_body($content);
             }
@@ -1650,11 +1694,36 @@ sub _send_message_by_email {
     };
 }
 
-sub _wrap_html {
-    my ( $content, $title ) = @_;
+=head2 _wrap_html
 
-    my $css = C4::Context->preference("NoticeCSS") || '';
-    $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
+  my $html = _wrap_html( $content, $title, $type );
+
+Wrap letter content in an HTML document with appropriate stylesheets based
+on the message type ('email' or 'print').
+
+=cut
+
+sub _wrap_html {
+    my ( $content, $title, $type ) = @_;
+    my $stylesheets = '';
+
+    my $all_stylesheets = C4::Context->preference("AllNoticeStylesheet") || '';
+    $stylesheets .= qq{<link rel="stylesheet" type="text/css" href="$all_stylesheets">} if $all_stylesheets;
+    my $all_style_pref = C4::Context->preference("AllNoticeCSS");
+    $stylesheets .= qq{<style type="text/css">$all_style_pref</style>} if $all_style_pref;
+    if ( $type eq 'email' ) {
+        my $email_stylesheet = C4::Context->preference("EmailNoticeStylesheet") || '';
+        $stylesheets .= qq{<link rel="stylesheet" type="text/css" href="$email_stylesheet">} if $email_stylesheet;
+        my $email_style_pref = C4::Context->preference("EmailNoticeCSS");
+        $stylesheets .= qq{<style type="text/css">$email_style_pref</style>} if $email_style_pref;
+    }
+    if ( $type eq 'print' ) {
+        my $print_stylesheet = C4::Context->preference("PrintNoticeStylesheet") || '';
+        $stylesheets .= qq{<link rel="stylesheet" type="text/css" href="$print_stylesheet">} if $print_stylesheet;
+        my $print_style_pref = C4::Context->preference("PrintNoticeCSS");
+        $stylesheets .= qq{<style type="text/css">$print_style_pref</style>} if $print_style_pref;
+    }
+    $stylesheets =~ s/\n+\z//;
     return <<EOS;
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
     "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
@@ -1662,7 +1731,7 @@ sub _wrap_html {
 <head>
 <title>$title</title>
 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
-$css
+$stylesheets
 </head>
 <body>
 $content
@@ -1671,6 +1740,15 @@ $content
 EOS
 }
 
+=head2 _is_duplicate
+
+  my $is_dup = _is_duplicate( $message );
+
+Check whether an identical message has already been sent today for the same
+patron, transport type, and letter code.
+
+=cut
+
 sub _is_duplicate {
     my ($message) = @_;
     my $dbh       = C4::Context->dbh;
@@ -1689,6 +1767,14 @@ sub _is_duplicate {
     return $count;
 }
 
+=head2 _send_message_by_sms
+
+  _send_message_by_sms( $message );
+
+Send a queued message via SMS using the patron's SMS alert number.
+
+=cut
+
 sub _send_message_by_sms {
     my $message = shift or return;
     my $patron  = Koha::Patrons->find( $message->{borrowernumber} );
@@ -1744,24 +1830,56 @@ sub _send_message_by_sms {
     return $success;
 }
 
+=head2 _update_message_to_address
+
+  _update_message_to_address( $message_id, $to_address );
+
+Update the to_address field for a queued message.
+
+=cut
+
 sub _update_message_to_address {
     my ( $id, $to ) = @_;
     my $dbh = C4::Context->dbh();
     $dbh->do( 'UPDATE message_queue SET to_address=? WHERE message_id=?', undef, ( $to, $id ) );
 }
 
+=head2 _update_message_from_address
+
+  _update_message_from_address( $message_id, $from_address );
+
+Update the from_address field for a queued message.
+
+=cut
+
 sub _update_message_from_address {
     my ( $message_id, $from_address ) = @_;
     my $dbh = C4::Context->dbh();
     $dbh->do( 'UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ( $from_address, $message_id ) );
 }
 
+=head2 _update_message_cc_address
+
+  _update_message_cc_address( $message_id, $cc_address );
+
+Update the cc_address field for a queued message.
+
+=cut
+
 sub _update_message_cc_address {
     my ( $message_id, $cc_address ) = @_;
     my $dbh = C4::Context->dbh();
     $dbh->do( 'UPDATE message_queue SET cc_address = ? WHERE message_id = ?', undef, ( $cc_address, $message_id ) );
 }
 
+=head2 _set_message_status
+
+  _set_message_status({ message_id => $id, status => $status, failure_code => $code });
+
+Update the status and optional failure_code for a queued message.
+
+=cut
+
 sub _set_message_status {
     my $params = shift or return;
 
@@ -1780,6 +1898,23 @@ sub _set_message_status {
     return $result;
 }
 
+=head2 _process_tt
+
+  my $output = _process_tt({
+      content    => $content,
+      tables     => $tables,
+      loops      => $loops,
+      objects    => $objects,
+      substitute => $substitute,
+      lang       => $lang,
+  });
+
+Process Template Toolkit content with the given parameters, returning the
+rendered output. Runs inside a database transaction that is rolled back
+after processing.
+
+=cut
+
 sub _process_tt {
     my ($params) = @_;
 
@@ -1802,8 +1937,14 @@ sub _process_tt {
     my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
     my $template           = Template->new(
         {
-            EVAL_PERL    => 0,
-            ABSOLUTE     => 0,
+            EVAL_PERL => 0,
+            ABSOLUTE  => 0,
+            RELATIVE  => 0,
+            PLUGINS   => {
+                cgi       => 'Koha::Template::Plugin::noop',
+                directory => 'Koha::Template::Plugin::noop',
+                file      => 'Koha::Template::Plugin::noop',
+            },
             PLUGIN_BASE  => 'Koha::Template::Plugin',
             COMPILE_EXT  => $use_template_cache ? '.ttc'                                    : '',
             COMPILE_DIR  => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
@@ -1832,6 +1973,16 @@ sub _process_tt {
     return $output;
 }
 
+=head2 _get_tt_params
+
+  my $params = _get_tt_params( $tables, $is_a_loop );
+
+Build a hashref of Template Toolkit parameters from the given table
+specifications. Each table entry is resolved to its corresponding
+Koha::Object(s) for use in notice templates.
+
+=cut
+
 sub _get_tt_params {
     my ( $tables, $is_a_loop ) = @_;
 

C4/Log.pm

@@ -38,7 +38,7 @@ use vars qw(@ISA @EXPORT);
 BEGIN {
     require Exporter;
     @ISA    = qw(Exporter);
-    @EXPORT = qw(logaction cronlogaction);
+    @EXPORT = qw(logaction cronlogaction logscriptaction);
 }
 
 =head1 NAME
@@ -94,6 +94,17 @@ sub logaction {
         }
     } else {
         $updated = $infos;
+        my %record_log_prefix = (
+            CATALOGUING => 'biblio',
+            AUTHORITIES => 'authority',
+        );
+        if (   $record_log_prefix{$modulename}
+            && ref $original eq 'HASH'
+            && $actionname ne 'ADD' )
+        {
+            my $prefix = ref $infos eq 'HASH' ? $record_log_prefix{$modulename} : $infos;
+            $infos = "$prefix " . to_json( $original, { utf8 => 1, pretty => 1 } );
+        }
     }
 
     my $script =
@@ -123,13 +134,28 @@ sub logaction {
     if ( $actionname =~ /^(ADD|CREATE)$/ ) {
 
         # Log diff against empty hashref for newly created objects
-        $updated  = $is_object ? $original->unblessed : $original;
+        $updated = $is_object ? $original->unblessed : $original;
+        for my $key ( keys %{$updated} ) {
+
+            if ( defined $updated->{$key} && $updated->{$key} ne '' ) {
+                $updated->{$key} = "$updated->{$key}" if blessed( $updated->{$key} );
+            } else {
+                delete $updated->{$key};
+            }
+        }
         $original = {};
     } elsif ( $actionname eq 'DELETE' ) {
 
         # Log diff for deleted objects against empty hashref
         $original = $is_object ? $original->unblessed : $original;
-        $updated  = {};
+        for my $key ( keys %{$original} ) {
+            if ( defined $original->{$key} && $original->{$key} ne '' ) {
+                $original->{$key} = "$original->{$key}" if blessed( $original->{$key} );
+            } else {
+                delete $original->{$key};
+            }
+        }
+        $updated = {};
     } else {
 
         # Log diff against hashref of pre-modified object if passed in
@@ -140,7 +166,9 @@ sub logaction {
     $diff //= encode_json( diff( $original, $updated, noU => 1 ) )
         if $original && ref $updated eq 'HASH';
 
-    Koha::ActionLog->new(
+    $infos = encode_json($infos) if ( ref $infos eq 'HASH' );
+
+    my $action_log = Koha::ActionLog->new(
         {
             timestamp => \'NOW()',
             user      => $usernumber,
@@ -174,6 +202,8 @@ sub logaction {
             );
         }
     );
+
+    return $action_log;
 }
 
 =item cronlogaction
@@ -185,17 +215,41 @@ Logs the path and name of the calling script plus the information provided by pa
 
 =cut
 
-#'
 sub cronlogaction {
     my $params = shift;
     my $info   = $params->{info};
     my $action = $params->{action};
     $action ||= "Run";
-    my $loginfo = ( caller(0) )[1];
+
+    # $0 is a special Perl variable containing the program that is currently running
+    # https://perldoc.perl.org/variables/$0
+    my $loginfo = $0;
+
     $loginfo .= ' ' . $info                        if $info;
     logaction( 'CRONJOBS', $action, $$, $loginfo ) if C4::Context->preference('CronjobLog');
 }
 
+=item logscriptaction
+
+  &logscriptaction({ info => $info, action => $action });
+
+Convenience routine to add a record into the action_logs table for a
+non-cron Koha script. Logs the path of the running script plus any
+additional information provided in C<info>. Only logs when the
+C<ScriptLog> system preference is enabled.
+
+=cut
+
+sub logscriptaction {
+    my $params = shift;
+    my $info   = $params->{info};
+    my $action = $params->{action};
+    $action ||= "Run";
+    my $loginfo = $0;
+    $loginfo .= ' ' . $info                       if $info;
+    logaction( 'SCRIPTS', $action, $$, $loginfo ) if C4::Context->preference('ScriptLog');
+}
+
 1;
 __END__
 

C4/MarcModificationTemplates.pm

@@ -34,6 +34,7 @@ use Koha::SimpleMARC qw(
 );
 use Koha::MoreUtils;
 use Koha::DateUtils qw( dt_from_string );
+use JSON            qw( encode_json decode_json );
 
 use vars qw(@ISA @EXPORT);
 
@@ -54,6 +55,9 @@ BEGIN {
 
         ModifyRecordsWithTemplate
         ModifyRecordWithTemplate
+
+        ExportModificationTemplates
+        ImportModificationTemplates
     );
 }
 
@@ -636,7 +640,7 @@ sub ModifyRecordWithTemplate {
                             {
                                 record   => $record,
                                 field    => $from_field,
-                                subfield => $from_subfield,
+                                subfield => $from_field < 10 ? undef : $from_subfield,
                             }
                         );
                     }
@@ -735,6 +739,192 @@ sub ModifyRecordWithTemplate {
 
     return;
 }
+
+=head2
+  ExportModificationTemplates
+
+  my $json = ExportModificationTemplates( $template_ids );
+
+  Exports MARC modification templates to JSON format.
+  If $template_ids is provided, only export those templates.
+  If not provided, export all templates.
+
+  Returns a JSON string containing the exported templates.
+=cut
+
+sub ExportModificationTemplates {
+    my ($template_ids) = @_;
+
+    my $dbh = C4::Context->dbh;
+
+    my @templates;
+    if ( $template_ids && @$template_ids ) {
+        my $placeholders = join( ',', ('?') x @$template_ids );
+        my $sth          = $dbh->prepare(
+            "SELECT * FROM marc_modification_templates WHERE template_id IN ($placeholders) ORDER BY name");
+        $sth->execute(@$template_ids);
+        while ( my $template = $sth->fetchrow_hashref() ) {
+            push( @templates, $template );
+        }
+    } else {
+        my $sth = $dbh->prepare("SELECT * FROM marc_modification_templates ORDER BY name");
+        $sth->execute();
+        while ( my $template = $sth->fetchrow_hashref() ) {
+            push( @templates, $template );
+        }
+    }
+
+    my $export_data = {
+        version   => 1,
+        templates => [],
+    };
+
+    foreach my $template (@templates) {
+        my $template_id = $template->{'template_id'};
+        my @actions     = GetModificationTemplateActions($template_id);
+
+        my $template_export = {
+            template_id => $template_id,
+            name        => $template->{'name'},
+            actions     => [],
+        };
+
+        foreach my $action (@actions) {
+            my $action_export = {
+                mmta_id                => $action->{'mmta_id'},
+                ordering               => $action->{'ordering'},
+                action                 => $action->{'action'},
+                field_number           => $action->{'field_number'},
+                from_field             => $action->{'from_field'},
+                from_subfield          => $action->{'from_subfield'},
+                field_value            => $action->{'field_value'},
+                to_field               => $action->{'to_field'},
+                to_subfield            => $action->{'to_subfield'},
+                to_regex_search        => $action->{'to_regex_search'},
+                to_regex_replace       => $action->{'to_regex_replace'},
+                to_regex_modifiers     => $action->{'to_regex_modifiers'},
+                conditional            => $action->{'conditional'},
+                conditional_field      => $action->{'conditional_field'},
+                conditional_subfield   => $action->{'conditional_subfield'},
+                conditional_comparison => $action->{'conditional_comparison'},
+                conditional_value      => $action->{'conditional_value'},
+                conditional_regex      => $action->{'conditional_regex'},
+                description            => $action->{'description'},
+            };
+
+            push( @{ $template_export->{actions} }, $action_export );
+        }
+
+        push( @{ $export_data->{templates} }, $template_export );
+    }
+
+    return encode_json($export_data);
+}
+
+=head2
+  ImportModificationTemplates
+
+  my $result = ImportModificationTemplates( $json, $skip_existing );
+
+  Imports MARC modification templates from JSON format.
+  $json is the JSON string to import.
+  $skip_existing: if true, skip templates that already exist (default: false)
+
+  Returns a hashref with:
+    - success: number of successfully imported templates
+    - skipped: number of skipped templates
+    - errors: arrayref of error messages
+=cut
+
+sub ImportModificationTemplates {
+    my ( $json, $skip_existing ) = @_;
+
+    my $result = {
+        success   => 0,
+        skipped   => 0,
+        overwrote => 0,
+        errors    => [],
+    };
+
+    my $data;
+    eval { $data = decode_json($json); };
+    if ($@) {
+        push( @{ $result->{errors} }, "Failed to parse JSON: $@" );
+        return $result;
+    }
+
+    my $version = $data->{version} || 0;
+    if ( $version != 1 ) {
+        push( @{ $result->{errors} }, "Unsupported export version: $version" );
+        return $result;
+    }
+
+    my $templates = $data->{templates} || [];
+    my $dbh       = C4::Context->dbh;
+
+    foreach my $template_data (@$templates) {
+        my $template_name = $template_data->{name};
+        my $actions       = $template_data->{actions} || [];
+
+        # Check if template already exists
+        my $sth = $dbh->prepare("SELECT template_id FROM marc_modification_templates WHERE name = ?");
+        $sth->execute($template_name);
+        my $existing = $sth->fetchrow_hashref();
+
+        if ( $existing && $skip_existing ) {
+            $result->{skipped}++;
+            next;
+        }
+
+        my $template_id;
+        if ($existing) {
+            $template_id = $existing->{template_id};
+
+            # Delete existing actions for this template
+            $sth = $dbh->prepare("DELETE FROM marc_modification_template_actions WHERE template_id = ?");
+            $sth->execute($template_id);
+            $result->{overwrote}++;
+        } else {
+
+            # Create new template
+            $sth = $dbh->prepare("INSERT INTO marc_modification_templates (name) VALUES (?)");
+            $sth->execute($template_name);
+
+            $sth = $dbh->prepare("SELECT template_id FROM marc_modification_templates WHERE name = ?");
+            $sth->execute($template_name);
+            my $row = $sth->fetchrow_hashref();
+            $template_id = $row->{template_id};
+        }
+
+        # Add new actions
+        foreach my $action_data (@$actions) {
+            AddModificationTemplateAction(
+                $template_id,
+                $action_data->{action},
+                $action_data->{field_number},
+                $action_data->{from_field},
+                $action_data->{from_subfield},
+                $action_data->{field_value},
+                $action_data->{to_field},
+                $action_data->{to_subfield},
+                $action_data->{to_regex_search},
+                $action_data->{to_regex_replace},
+                $action_data->{to_regex_modifiers},
+                $action_data->{conditional},
+                $action_data->{conditional_field},
+                $action_data->{conditional_subfield},
+                $action_data->{conditional_comparison},
+                $action_data->{conditional_value},
+                $action_data->{conditional_regex},
+                $action_data->{description},
+            );
+        }
+
+        $result->{success}++;
+    }
+
+    return $result;
+}
 1;
 __END__
 

C4/Matcher.pm

@@ -204,6 +204,15 @@ sub fetch {
     return $self;
 }
 
+=head3 _fetch_matchpoint
+
+  my $matchpoint = $self->_fetch_matchpoint($matchpoint_id);
+
+Loads a matchpoint and its components from the database and returns a
+hashref with C<index>, C<score>, and C<components>.
+
+=cut
+
 sub _fetch_matchpoint {
     my $self          = shift;
     my $matchpoint_id = shift;
@@ -271,6 +280,15 @@ sub store {
     return $self->{'id'};
 }
 
+=head3 _del_matcher_components
+
+  $self->_del_matcher_components();
+
+Deletes all matchpoint component and norm rows for the current matcher
+from the database (used before re-saving).
+
+=cut
+
 sub _del_matcher_components {
     my $self = shift;
 
@@ -285,6 +303,14 @@ sub _del_matcher_components {
     # matchpoint_component_norms
 }
 
+=head3 _update_marc_matchers
+
+  $self->_update_marc_matchers();
+
+Updates the C<marc_matchers> row for the current matcher object.
+
+=cut
+
 sub _update_marc_matchers {
     my $self = shift;
 
@@ -303,6 +329,14 @@ sub _update_marc_matchers {
     );
 }
 
+=head3 _new_marc_matchers
+
+  $self->_new_marc_matchers();
+
+Inserts a new row into C<marc_matchers> and sets C<$self-E<gt>{'id'}>.
+
+=cut
+
 sub _new_marc_matchers {
     my $self = shift;
 
@@ -316,6 +350,14 @@ sub _new_marc_matchers {
     $self->{'id'} = $dbh->{'mysql_insertid'};
 }
 
+=head3 _store_matcher_components
+
+  $self->_store_matcher_components($matchpoint_id, \@components);
+
+Persists the component and norm rows for a matchpoint to the database.
+
+=cut
+
 sub _store_matcher_components {
     my $self = shift;
 
@@ -343,6 +385,14 @@ sub _store_matcher_components {
 
 }
 
+=head3 _store_matchpoint
+
+  my $matchpoint_id = $self->_store_matchpoint($matchpoint);
+
+Inserts a matchpoint record into the database and returns its new ID.
+
+=cut
+
 sub _store_matchpoint {
     my $self       = shift;
     my $matchpoint = shift;
@@ -722,6 +772,7 @@ sub get_matches {
                         ? $target_record->field($biblionumber_tag)->subfield($biblionumber_subfield)
                         : $target_record->field($biblionumber_tag)->data();
                     $matches->{$id}->{score} += $matchpoint->{score};
+                    $matches->{$id}->{composite_scores}{ $matchpoint->{'index'} } += $matchpoint->{'score'};
                     $matches->{$id}->{record} = $target_record;
                 }
             }
@@ -752,9 +803,19 @@ sub get_matches {
             my ( $authresults, $total ) = $searcher->search_auth_compat( $search_query, 0, 20 );
 
             foreach my $result (@$authresults) {
-                my $id            = $result->{authid};
-                my $target_record = Koha::Authorities->find($id)->record;
+                my $id          = $result->{authid};
+                my $target_auth = Koha::Authorities->find($id);
+                next unless $target_auth;
+                my $target_record  = eval { $target_auth->record };
+                my $invalid_record = $@ || !$target_record;
+                if ($invalid_record) {
+                    warn
+                        "Error parsing matched authority record $id, attempting to clean record, record will be skipped if it fails";
+                    $target_record = eval { $target_auth->record_strip_nonxml };
+                }
+                next unless $target_record;
                 $matches->{$id}->{score} += $matchpoint->{'score'};
+                $matches->{$id}->{composite_scores}{ $matchpoint->{'index'} } += $matchpoint->{'score'};
                 $matches->{$id}->{record} = $target_record;
             }
         }
@@ -779,8 +840,9 @@ sub get_matches {
 
         foreach my $id ( keys %$matches ) {
             push @results, {
-                record_id => $id,
-                score     => $matches->{$id}->{score}
+                record_id        => $id,
+                score            => $matches->{$id}->{score},
+                composite_scores => $matches->{$id}->{composite_scores},
             };
         }
     } elsif ( $self->{'record_type'} eq 'authority' ) {
@@ -797,8 +859,9 @@ sub get_matches {
 
         foreach my $id ( keys %$matches ) {
             push @results, {
-                record_id => $id,
-                score     => $matches->{$id}->{score}
+                record_id        => $id,
+                score            => $matches->{$id}->{score},
+                composite_scores => $matches->{$id}->{composite_scores},
             };
         }
     }
@@ -841,6 +904,15 @@ sub dump {
     return $result;
 }
 
+=head3 _passes_required_checks
+
+  my $ok = _passes_required_checks($source_record, $target_record, \@matchchecks);
+
+Returns true if the candidate C<$target_record> passes all required field
+equality checks against C<$source_record>.
+
+=cut
+
 sub _passes_required_checks {
     my ( $source_record, $target_record, $matchchecks ) = @_;
 
@@ -855,6 +927,15 @@ sub _passes_required_checks {
     return 1;
 }
 
+=head3 _get_match_keys
+
+  my @keys = _get_match_keys($source_record, $matchpoint);
+
+Extracts and normalises the set of match key strings from C<$source_record>
+for the given C<$matchpoint> definition.
+
+=cut
+
 sub _get_match_keys {
 
     my $source_record           = shift;
@@ -945,6 +1026,15 @@ sub _get_match_keys {
     return @keys;
 }
 
+=head3 _parse_match_component
+
+  my $component = _parse_match_component($input_component);
+
+Parses a matchpoint component definition hashref and returns a normalised
+component structure including tag, subfields, offset, length, and norms.
+
+=cut
+
 sub _parse_match_component {
     my $input_component = shift;
 

C4/Members.pm

@@ -94,10 +94,6 @@ The following will be set where applicable:
  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
 
- $flags->{WAITING}                  Set if any of patron's reserves are available
- $flags->{WAITING}->{message}       Message -- deprecated
- $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
-
 =over
 
 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
@@ -108,10 +104,6 @@ biblioitems, and items tables of the Koha database.
 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
 the overdue items, one per line.  Deprecated.
 
-=item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
-available items. Each element is a reference-to-hash whose keys are
-fields from the reserves table of the Koha database.
-
 =back
 
 All the "message" fields that include language generated in this function are deprecated,
@@ -203,14 +195,6 @@ sub patronflags {
         $flags{'ODUES'} = \%flaginfo;
     }
 
-    my $waiting_holds = $patron->holds->search( { found => 'W' } );
-    my $nowaiting     = $waiting_holds->count;
-    if ( $nowaiting > 0 ) {
-        my %flaginfo;
-        $flaginfo{'message'}  = "Reserved items available";
-        $flaginfo{'itemlist'} = $waiting_holds->unblessed;
-        $flags{'WAITING'}     = \%flaginfo;
-    }
     return ( \%flags );
 }
 

C4/Members/Messaging.pm

@@ -140,8 +140,8 @@ sub SetMessagingPreference {
             return;
         }
     }
-    $params->{'days_in_advance'} = undef unless exists( $params->{'days_in_advance'} );
-    $params->{'wants_digest'}    = 0     unless exists( $params->{'wants_digest'} );
+    $params->{'days_in_advance'} = undef if !exists $params->{'days_in_advance'} || $params->{'days_in_advance'} <= 0;
+    $params->{'wants_digest'}    = 0 unless exists( $params->{'wants_digest'} );
 
     my $dbh = C4::Context->dbh();
 
@@ -160,7 +160,9 @@ END_SQL
     my $sth     = $dbh->prepare($delete_sql);
     my $deleted = $sth->execute(@bind_params);
 
-    if ( $params->{'message_transport_types'} ) {
+    if ( $params->{'message_transport_types'}
+        && !( $params->{'message_attribute_id'} == 2 && !$params->{'days_in_advance'} ) )
+    {
         my $insert_bmp = <<'END_SQL';
 INSERT INTO borrower_message_preferences
 (borrower_message_preference_id, borrowernumber, categorycode, message_attribute_id, days_in_advance, wants_digest)

C4/Output.pm

@@ -45,6 +45,7 @@ use URI::Escape;
 use C4::Auth qw( get_template_and_user );
 use C4::Context;
 use C4::Templates;
+use Koha::Exceptions;
 
 =head1 NAME
 
@@ -391,12 +392,19 @@ Missing POD for output_error.
 =cut
 
 sub output_error {
-    my ( $query, $error ) = @_;
+    my ( $query, $error, $params ) = @_;
+
+    if ( !$error || $error =~ /\D/ ) {
+        Koha::Exceptions::WrongParameter->throw('output_error requires $error to be an integer');
+    }
+    my $interface = 'intranet';
+    $interface = 'opac' if ( $params && $params->{interface} eq 'opac' );
+
     my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
         {
             template_name   => 'errors/errorpage.tt',
             query           => $query,
-            type            => 'intranet',
+            type            => $interface,
             authnotrequired => 1,
         }
     );
@@ -405,7 +413,9 @@ sub output_error {
         admin => $admin,
         errno => $error,
     );
-    output_with_http_headers $query, $cookie, $template->output, 'html', '404 Not Found';
+
+    #NOTE: Technically, it is enough to just include the status code. You don't have to include the reason phrase.
+    output_with_http_headers $query, $cookie, $template->output, 'html', $error;
 }
 
 =item parametrized_url
@@ -428,8 +438,7 @@ sub parametrized_url {
 
 =item redirect_if_opac_suppressed
 
-    redirect_if_opac_suppressed( $query, $biblio )
-        if C4::Context->preference('OpacSuppression');
+    redirect_if_opac_suppressed( $query, $biblio );
 
 For a given I<Koha::Biblio> object, it handles redirection if it is suppressed
 from the OPAC.
@@ -446,20 +455,9 @@ sub redirect_if_opac_suppressed {
     } else {
         $redirect_url = "/cgi-bin/koha/errors/404.pl";
     }
-    if ( $biblio->opac_suppressed() ) {
-
-        # if OPAC suppression by IP address
-        if ( C4::Context->preference('OpacSuppressionByIPRange') ) {
-            my $IPAddress = $ENV{'REMOTE_ADDR'};
-            my $IPRange   = C4::Context->preference('OpacSuppressionByIPRange');
-            if ( $IPAddress !~ /^$IPRange/ ) {
-                print $query->redirect($redirect_url);
-                C4::Auth::safe_exit();
-            }
-        } else {
-            print $query->redirect($redirect_url);
-            C4::Auth::safe_exit();
-        }
+    if ( C4::Context->is_opac_suppressed && $biblio->opac_suppressed() ) {
+        print $query->redirect($redirect_url);
+        C4::Auth::safe_exit();
     }
 }
 

C4/Overdues.pm

@@ -32,14 +32,11 @@ BEGIN {
         GetBranchcodesWithOverdueRules
         get_chargeable_units
         GetOverduesForBranch
-        GetOverdueMessageTransportTypes
         parse_overdues_letter
         GetIssuesIteminfo
     );
 }
 
-use Date::Calc                    qw( Today );
-use Date::Manip                   qw( UnixDate );
 use List::MoreUtils               qw( uniq );
 use POSIX                         qw( ceil floor );
 use Locale::Currency::Format 1.28 qw( currency_format FMT_SYMBOL );
@@ -346,9 +343,12 @@ sub get_chargeable_units {
 
     my $charge_units = 0;
     my $charge_duration;
+
+    $unit //= 'days';
+
     if ( $unit eq 'hours' ) {
         if ( C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed' ) {
-            my $calendar = Koha::Calendar->new( branchcode => $branchcode );
+            my $calendar = Koha::Library::Calendar->new( branchcode => $branchcode );
             $charge_duration = $calendar->hours_between( $date_due, $date_returned );
         } else {
             $charge_duration = $date_returned->delta_ms($date_due);
@@ -359,7 +359,7 @@ sub get_chargeable_units {
         return $charge_duration->in_units('hours');
     } else {    # days
         if ( C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed' ) {
-            my $calendar = Koha::Calendar->new( branchcode => $branchcode );
+            my $calendar = Koha::Library::Calendar->new( branchcode => $branchcode );
             $charge_duration = $calendar->days_between( $date_due, $date_returned );
         } else {
             $charge_duration = $date_returned->delta_days($date_due);
@@ -368,131 +368,6 @@ sub get_chargeable_units {
     }
 }
 
-=head2 GetSpecialHolidays
-
-    &GetSpecialHolidays($date_dues,$itemnumber);
-
-return number of special days  between date of the day and date due
-
-C<$date_dues> is the envisaged date of book return.
-
-C<$itemnumber> is the book's item number.
-
-=cut
-
-sub GetSpecialHolidays {
-    my ( $date_dues, $itemnumber ) = @_;
-
-    # calcul the today date
-    my $today = join "-", &Today();
-
-    # return the holdingbranch
-    my $iteminfo = GetIssuesIteminfo($itemnumber);
-
-    # use sql request to find all date between date_due and today
-    my $dbh   = C4::Context->dbh;
-    my $query = qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') as date
-FROM `special_holidays`
-WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
-AND   DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
-AND branchcode=?
-|;
-    my @result = GetWdayFromItemnumber($itemnumber);
-    my @result_date;
-    my $wday;
-    my $dateinsec;
-    my $sth = $dbh->prepare($query);
-    $sth->execute( $date_dues, $today, $iteminfo->{'branchcode'} )
-        ;    # FIXME: just use NOW() in SQL instead of passing in $today
-
-    while ( my $special_date = $sth->fetchrow_hashref ) {
-        push( @result_date, $special_date );
-    }
-
-    my $specialdaycount = scalar(@result_date);
-
-    for ( my $i = 0 ; $i < scalar(@result_date) ; $i++ ) {
-        $dateinsec = UnixDate( $result_date[$i]->{'date'}, "%o" );
-        ( undef, undef, undef, undef, undef, undef, $wday, undef, undef ) = localtime($dateinsec);
-        for ( my $j = 0 ; $j < scalar(@result) ; $j++ ) {
-            if ( $wday == ( $result[$j]->{'weekday'} ) ) {
-                $specialdaycount--;
-            }
-        }
-    }
-
-    return $specialdaycount;
-}
-
-=head2 GetRepeatableHolidays
-
-    &GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
-
-return number of day closed between date of the day and date due
-
-C<$date_dues> is the envisaged date of book return.
-
-C<$itemnumber> is item number.
-
-C<$difference> numbers of between day date of the day and date due
-
-=cut
-
-sub GetRepeatableHolidays {
-    my ( $date_dues, $itemnumber, $difference ) = @_;
-    my $dateinsec = UnixDate( $date_dues, "%o" );
-    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime($dateinsec);
-    my @result = GetWdayFromItemnumber($itemnumber);
-    my @dayclosedcount;
-    my $j;
-
-    for ( my $i = 0 ; $i < scalar(@result) ; $i++ ) {
-        my $k = $wday;
-
-        for ( $j = 0 ; $j < $difference ; $j++ ) {
-            if ( $result[$i]->{'weekday'} == $k ) {
-                push( @dayclosedcount, $k );
-            }
-            $k++;
-            ( $k = 0 ) if ( $k eq 7 );
-        }
-    }
-    return scalar(@dayclosedcount);
-}
-
-=head2 GetWayFromItemnumber
-
-    &Getwdayfromitemnumber($itemnumber);
-
-return the different week day from repeatable_holidays table
-
-C<$itemnumber> is  item number.
-
-=cut
-
-=head2 GetWdayFromItemnumber
-
-Missing POD for GetWdayFromItemnumber.
-
-=cut
-
-sub GetWdayFromItemnumber {
-    my ($itemnumber) = @_;
-    my $iteminfo = GetIssuesIteminfo($itemnumber);
-    my @result;
-    my $query = qq|SELECT weekday
-    FROM repeatable_holidays
-    WHERE branchcode=?
-|;
-    my $sth = C4::Context->dbh->prepare($query);
-
-    $sth->execute( $iteminfo->{'branchcode'} );
-    while ( my $weekday = $sth->fetchrow_hashref ) {
-        push( @result, $weekday );
-    }
-    return @result;
-}
-
 =head2 GetIssuesIteminfo
 
     &GetIssuesIteminfo($itemnumber);
@@ -647,7 +522,17 @@ sub UpdateFine {
             };
             my $desc = $letter ? $letter->{content} : sprintf( "Item %s - due %s", $itemnum, output_pref($due) );
 
-            my $account = Koha::Account->new( { patron_id => $borrowernumber } );
+            my $account   = Koha::Account->new( { patron_id => $borrowernumber } );
+            my $item_obj  = Koha::Items->find($itemnum);
+            my $issue_obj = Koha::Checkouts->find($issue_id);
+
+            my $rule_branch = Koha::Checkout->branch_for_fee_context(
+                fee_type => 'OVERDUE',
+                patron   => $patron,
+                item     => $item_obj,
+                issue    => $issue_obj,
+            );
+
             $accountline = $account->add_debit(
                 {
                     amount      => $amount,
@@ -655,7 +540,7 @@ sub UpdateFine {
                     note        => undef,
                     user_id     => undef,
                     interface   => C4::Context->interface,
-                    library_id  => undef,       #FIXME: Should we grab the checkout or circ-control branch here perhaps?
+                    library_id  => $rule_branch,
                     type        => 'OVERDUE',
                     item_id     => $itemnum,
                     issue_id    => $issue_id,
@@ -707,21 +592,19 @@ returns a list of branch codes for branches with overdue rules defined.
 =cut
 
 sub GetBranchcodesWithOverdueRules {
-    my $dbh         = C4::Context->dbh;
-    my $branchcodes = $dbh->selectcol_arrayref(
-        q|
-        SELECT DISTINCT(branchcode)
-        FROM overduerules
-        WHERE delay1 IS NOT NULL
-        ORDER BY branchcode
-    |
-    );
-    if ( defined $branchcodes->[0] && $branchcodes->[0] eq '' ) {
-
-        # If a default rule exists, all branches should be returned
-        return Koha::Libraries->search( {}, { order_by => 'branchname' } )->get_column('branchcode');
+    my @branchcodes = Koha::CirculationRules->search(
+        { rule_name => 'overdue_1_delay' },
+        {
+            order_by => 'branchcode',
+            columns  => ['branchcode'],
+            distinct => 1,
+        }
+    )->get_column('branchcode');
+    if ( @branchcodes && !defined $branchcodes[0] ) {
+        @branchcodes = Koha::Libraries->search( {}, { order_by => 'branchname' } )->get_column('branchcode');
     }
-    return @$branchcodes;
+
+    return @branchcodes;
 }
 
 =head2 GetOverduesForBranch
@@ -788,39 +671,6 @@ sub GetOverduesForBranch {
     }
 }
 
-=head2 GetOverdueMessageTransportTypes
-
-    my $message_transport_types = GetOverdueMessageTransportTypes( $branchcode, $categorycode, $letternumber);
-
-    return a arrayref with all message_transport_type for given branchcode, categorycode and letternumber(1,2 or 3)
-
-=cut
-
-sub GetOverdueMessageTransportTypes {
-    my ( $branchcode, $categorycode, $letternumber ) = @_;
-    return unless $categorycode and $letternumber;
-    my $dbh = C4::Context->dbh;
-    my $sth = $dbh->prepare( "
-        SELECT message_transport_type
-        FROM overduerules odr LEFT JOIN overduerules_transport_types ott USING (overduerules_id)
-        WHERE branchcode = ?
-          AND categorycode = ?
-          AND letternumber = ?
-    " );
-    $sth->execute( $branchcode, $categorycode, $letternumber );
-    my @mtts;
-    while ( my $mtt = $sth->fetchrow ) {
-        push @mtts, $mtt;
-    }
-
-    # Put 'print' in first if exists
-    # It avoid to sent a print notice with an email or sms template is no email or sms is defined
-    @mtts = uniq( 'print', @mtts )
-        if grep { $_ eq 'print' } @mtts;
-
-    return \@mtts;
-}
-
 =head2 parse_overdues_letter
 
 parses the letter template, replacing the placeholders with data

C4/Record.pm

@@ -919,9 +919,11 @@ sub marc2cites {
                 $author = $field->subfield("a");
             }
             if ( $author =~ /([^,]+),?(.*)/ ) {
+                my $surname   = $1;
+                my $forenames = $2;
                 my %a;
-                ( $a{'surname'} = $1 ) =~ s/$re_clean//g;
-                $a{'forenames'} = [ map { my $t = $_; $t =~ s/$re_clean//g; $t } split ' ', $2 ];
+                ( $a{'surname'} = $surname ) =~ s/$re_clean//g;
+                $a{'forenames'} = [ map { my $t = $_; $t =~ s/$re_clean//g; $t } split ' ', $forenames ];
                 push( @authors, \%a );
             }
         }
@@ -931,6 +933,7 @@ sub marc2cites {
     if ( $marcflavour eq "UNIMARC" ) {
         %publication = (
             title     => $record->subfield( "200", "a" ) || "",
+            subtitle  => $record->subfield( "200", "e" ) || "",
             place     => $record->subfield( "210", "a" ) || "",
             publisher => $record->subfield( "210", "c" ) || "",
             date      => $record->subfield( "210", "d" ) || $record->subfield( "210", "h" ) || ""
@@ -938,6 +941,7 @@ sub marc2cites {
     } else {
         %publication = (
             title     => $record->subfield( "245", "a" ) || "",
+            subtitle  => $record->subfield( "245", "b" ) || "",
             place     => $record->subfield( "264", "a" ) || $record->subfield( "260", "a" ) || "",
             publisher => $record->subfield( "264", "b" ) || $record->subfield( "260", "b" ) || "",
             date      => $record->subfield( "264", "c" )
@@ -978,13 +982,16 @@ sub marc2cites {
     if ( $publication{date} ) {
         $cites{'Harvard'} .= ' (' . $publication{'date'} . '). ';
         $cites{'Chicago'} .= ' ' . $publication{'date'} . '. ';
-        $cites{'MLA'}     .= ' ' . $publication{'title'} . '. ';
-        $cites{'APA'}     .= ' (' . $publication{'date'} . '). ';
+        $cites{'MLA'} .=
+            ' ' . $publication{'title'} . ( $publication{'subtitle'} ? ': ' . $publication{'subtitle'} : '' ) . '. ';
+        $cites{'APA'} .= ' (' . $publication{'date'} . '). ';
     }
-    $cites{'Harvard'} .= $publication{'title'} . '. ';
-    $cites{'Chicago'} .= $publication{'title'} . '. ';
-    $cites{'MLA'}     .= $publication{'place'} . ': ';
-    $cites{'APA'}     .= $publication{'title'} . '. ';
+    $cites{'Harvard'} .=
+        $publication{'title'} . ( $publication{'subtitle'} ? ': ' . $publication{'subtitle'} : '' ) . '. ';
+    $cites{'Chicago'} .=
+        $publication{'title'} . ( $publication{'subtitle'} ? ': ' . $publication{'subtitle'} : '' ) . '. ';
+    $cites{'MLA'} .= $publication{'place'} . ': ';
+    $cites{'APA'} .= $publication{'title'} . ( $publication{'subtitle'} ? ': ' . $publication{'subtitle'} : '' ) . '. ';
     $cites{'Harvard'} .= $publication{'place'} . ': ';
     $cites{'Chicago'} .= $publication{'place'} . ': ';
     $cites{'MLA'}     .= $publication{'publisher'} . '. ';

C4/Reports.pm

@@ -49,18 +49,10 @@ This will return a list of all the available delimiters.
 =cut
 
 sub GetDelimiterChoices {
-    my $dbh = C4::Context->dbh;
+    my $default = C4::Context->preference('CSVDelimiter');
 
-    my $sth = $dbh->prepare( "
-      SELECT options, value
-      FROM systempreferences
-      WHERE variable = 'CSVDelimiter'
-    " );
-
-    $sth->execute();
-
-    my ( $choices, $default ) = $sth->fetchrow;
-    my @dels = split /\|/, $choices;
+    # Use the centralized list of allowed delimiters from C4::Context
+    my @dels = C4::Context::ALLOWED_CSV_DELIMITERS;
 
     return {
         values  => \@dels,

C4/Reports/Guided.pm

@@ -54,9 +54,11 @@ use Koha::Logger;
 use Koha::Notice::Templates;
 use Koha::Patron::Categories;
 use Koha::Patrons;
+use Koha::Report;
 use Koha::Reports;
 use Koha::SharedContent;
 use Koha::TemplateUtils qw( process_tt );
+use C4::Letters         qw( GetPreparedLetter );
 
 =head1 NAME
 
@@ -604,6 +606,7 @@ sub execute_query {
 
     my ( $is_sql_valid, $errors ) = Koha::Report->new( { savedsql => $sql } )->is_sql_valid;
     return ( undef, @{$errors}[0] ) unless $is_sql_valid;
+    $sql = Koha::Report->apply_execution_time_limit($sql);
 
     foreach my $sql_param (@$sql_params) {
         if ( $sql_param =~ m/\n/ ) {
@@ -878,7 +881,54 @@ sub get_saved_reports {
 
     my $result = $dbh->selectall_arrayref( $query, { Slice => {} }, @args );
 
-    return $result;
+    my $limit_pref_enabled = C4::Context->preference('LimitReportsByLibrary');
+
+    return $result unless $limit_pref_enabled;
+
+    # Preference enabled AND showing all: attach library limits metadata, but do not filter
+    if ( $filter->{show_all_reports} ) {
+        foreach my $report (@$result) {
+            my $report_obj = Koha::Reports->find( $report->{id} );
+            if ($report_obj) {
+                my $limits_rs = $report_obj->get_library_limits;
+                if ($limits_rs) {
+                    my @branches =
+                        map { { branchcode => $_->branchcode, branchname => $_->branchname } } $limits_rs->as_list;
+                    $report->{library_limits} = \@branches;
+                } else {
+                    $report->{library_limits} = [];
+                }
+            } else {
+                $report->{library_limits} = [];
+            }
+        }
+        return $result;
+    }
+
+    # Preference enabled AND not showing all: apply library limits filtering
+    my $limited_reports = Koha::Reports->search_with_library_limits( {}, {}, C4::Context::mybranch() );
+    my %allowed         = map  { $_->{id} => 1 } @{ $limited_reports->unblessed };
+    my @limited         = grep { $allowed{ $_->{id} } } @$result;
+
+    # Attach library limits data for the filtered list
+    foreach my $report (@limited) {
+        my $report_obj = Koha::Reports->find( $report->{id} );
+        if ($report_obj) {
+            my $limits_rs = $report_obj->get_library_limits;
+            if ($limits_rs) {
+                my @branches =
+                    map { { branchcode => $_->branchcode, branchname => $_->branchname } } $limits_rs->as_list;
+                $report->{library_limits} = \@branches;
+            } else {
+                $report->{library_limits} = [];
+            }
+        } else {
+            $report->{library_limits} = [];
+        }
+    }
+
+    return \@limited;
+
 }
 
 =head2 get_column_type($column)
@@ -1168,8 +1218,7 @@ sub EmailReport {
     my ( $sth, $errors ) = execute_query( { sql => $sql, report_id => $report_id } );
     return ( undef, [ { FATAL => "REPORT_FAIL" } ] ) if $errors;
 
-    my $counter  = 1;
-    my $template = $letter->{content};
+    my $counter = 1;
 
     while ( my $row = $sth->fetchrow_hashref() ) {
         my $email;
@@ -1182,13 +1231,16 @@ sub EmailReport {
 
         my $from_address = $from || $row->{from};
         my $to_address   = $row->{$email_col};
-        push( @errors, { NOT_PARSE => $counter } ) unless my $content = process_tt( $template, $row );
+        my $letter       = {%$letter};              # GetPreparedLetter mutates, so make a local copy beforehand
+        push( @errors, { NOT_PARSE => $counter } ) unless my $rendered = GetPreparedLetter(
+            letter  => $letter,
+            objects => $row
+        );
         $counter++;
-        next if scalar @errors > $err_count;    #If any problems, try next
+        next if scalar @errors > $err_count;        #If any problems, try next
 
-        $letter->{content}       = $content;
         $email->{borrowernumber} = $row->{borrowernumber};
-        $email->{letter}         = {%$letter};
+        $email->{letter}         = $rendered;
         $email->{from_address}   = $from_address;
         $email->{to_address}     = $to_address;
 

C4/Reserves.pm

@@ -1,7 +1,7 @@
 package C4::Reserves;
 
 # Copyright 2000-2002 Katipo Communications
-#           2006 SAN Ouest Provence
+#           2006 SAN Ouest Provence  # codespell:ignore
 #           2007-2010 BibLibre Paul POULAIN
 #           2011 Catalyst IT
 #
@@ -29,9 +29,6 @@ BEGIN {
 
         GetReserveStatus
 
-        ChargeReserveFee
-        GetReserveFee
-
         ModReserveAffect
         ModReserve
         ModReserveStatus
@@ -60,6 +57,8 @@ BEGIN {
         GetMaxPatronHoldsForRecord
 
         MergeHolds
+
+        FixPriority
     );
 }
 
@@ -67,7 +66,8 @@ use JSON qw( to_json );
 
 use C4::Accounts;
 use C4::Biblio      qw( GetMarcFromKohaField );
-use C4::Circulation qw( CheckIfIssuedToPatron GetAgeRestriction GetBranchItemRule );
+use C4::Circulation qw( CheckIfIssuedToPatron GetBranchItemRule );
+use Koha::Policy::Biblio::AgeRestriction;
 use C4::Context;
 use C4::Items qw( CartToShelf get_hostitemnumbers_of );
 use C4::Letters;
@@ -77,7 +77,7 @@ use C4::Members;
 use Koha::Account::Lines;
 use Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue;
 use Koha::Biblios;
-use Koha::Calendar;
+use Koha::Library::Calendar;
 use Koha::Cache::Memory::Lite;
 use Koha::CirculationRules;
 use Koha::Database;
@@ -111,10 +111,10 @@ This modules provides some functions to deal with reservations.
   - priority >0      : then the reserve is at 1st stage, and not yet affected to any item.
              =0      : then the reserve is being dealt
   - found : NULL         : means the patron requested the 1st available, and we haven't chosen the item
-            T(ransit)    : the reserve is linked to an item but is in transit to the pickup branch
-            W(aiting)    : the reserve is linked to an item, is at the pickup branch, and is waiting on the hold shelf
-            F(inished)   : the reserve has been completed, and is done
-            P(rocessing) : reserved item has been returned using self-check machine and reserve needs to be confirmed
+            T (Transit)    : the reserve is linked to an item but is in transit to the pickup branch
+            W (Waiting)    : the reserve is linked to an item, is at the pickup branch, and is waiting on the hold shelf
+            F (Finished)   : the reserve has been completed, and is done
+            P (Processing) : reserved item has been returned using self-check machine and reserve needs to be confirmed
                            by librarian before notice is send and status changed to waiting.
                            Applicable only if HoldsNeedProcessingSIP system preference is set.
   - itemnumber : empty : the reserve is still unaffected to an item
@@ -144,18 +144,20 @@ This modules provides some functions to deal with reservations.
 
     AddReserve(
         {
-            branchcode       => $branchcode,
-            borrowernumber   => $borrowernumber,
-            biblionumber     => $biblionumber,
-            priority         => $priority,
-            reservation_date => $reservation_date,
-            expiration_date  => $expiration_date,
-            notes            => $notes,
-            title            => $title,
-            itemnumber       => $itemnumber,
-            found            => $found,
-            itemtype         => $itemtype,
-            item_group_id    => $item_group_id
+            branchcode          => $branchcode,
+            borrowernumber      => $borrowernumber,
+            biblionumber        => $biblionumber,
+            priority            => $priority,
+            reservation_date    => $reservation_date,
+            expiration_date     => $expiration_date,
+            notes               => $notes,
+            title               => $title,
+            itemnumber          => $itemnumber,
+            found               => $found,
+            itemtype            => $itemtype,
+            item_group_id       => $item_group_id,
+            supplyill           => $iso18626_request_id;
+            iso18626_payload    => $payload_hash;
         }
     );
 
@@ -194,6 +196,8 @@ sub AddReserve {
     my $item_group_id          = $params->{item_group_id};
     my $confirmations          = $params->{confirmations};
     my $forced                 = $params->{forced};
+    my $supplyill              = $params->{supplyill};
+    my $iso18626_payload       = $params->{iso18626_payload};
 
     $resdate ||= dt_from_string;
 
@@ -258,6 +262,9 @@ sub AddReserve {
             non_priority           => $non_priority ? 1 : 0,
         }
     )->store();
+
+    $hold->iso18626_attach_hold_and_biblio($supplyill);
+
     $hold->set_waiting() if $found && $found eq 'W';
 
     # record patron activity
@@ -265,32 +272,39 @@ sub AddReserve {
 
     # Log the hold creation
     if ( C4::Context->preference('HoldsLog') ) {
-        my $info = $hold->id;
-        if ( defined($confirmations) || defined($forced) ) {
-            $info = to_json(
-                {
-                    hold          => $hold->id,
-                    branchcode    => $hold->branchcode,
-                    biblionumber  => $hold->biblionumber,
-                    itemnumber    => $hold->itemnumber,
-                    confirmations => $confirmations,
-                    forced        => $forced
-                },
-                { pretty => 1, canonical => 1 }
-            );
-        }
+        my $info = to_json(
+            {
+                hold                   => $hold->id,
+                branchcode             => $hold->branchcode,
+                biblionumber           => $hold->biblionumber,
+                borrowernumber         => $hold->borrowernumber,
+                itemnumber             => $hold->itemnumber,
+                desk_id                => $hold->desk_id,
+                hold_group_id          => $hold->hold_group_id,
+                item_group_id          => $hold->item_group_id,
+                item_level_hold        => $hold->item_level_hold,
+                itemtype               => $hold->itemtype,
+                lowestPriority         => $hold->lowestPriority,
+                non_priority           => $hold->non_priority,
+                patron_expiration_date => $hold->patron_expiration_date,
+                priority               => $hold->priority,
+                reservenotes           => $hold->reservenotes,
+                confirmations          => $confirmations || [],
+                forced                 => $forced        || []
+            },
+            { pretty => 1, canonical => 1 }
+        );
         logaction( 'HOLDS', 'CREATE', $hold->id, $info );
     }
 
     my $reserve_id = $hold->id();
 
     # add a reserve fee if needed
-    if ( C4::Context->preference('HoldFeeMode') ne 'any_time_is_collected' ) {
-        my $reserve_fee = GetReserveFee( $borrowernumber, $biblionumber );
-        ChargeReserveFee( $borrowernumber, $reserve_fee, $title );
+    if ( $hold->should_charge('placement') ) {
+        $hold->charge_hold_fee();
     }
 
-    _FixPriority( { biblionumber => $biblionumber } );
+    FixPriority( { biblionumber => $biblionumber } );
 
     # Send e-mail to librarian if syspref is active
     if ( C4::Context->preference("emailLibrarianWhenHoldIsPlaced") ) {
@@ -354,6 +368,8 @@ sub AddReserve {
         }
     }
 
+    $hold->progress_iso18626_request( 'hold_created', $iso18626_payload );
+
     Koha::Plugins->call( 'after_hold_create', $hold );
     Koha::Plugins->call(
         'after_hold_action',
@@ -428,7 +444,7 @@ sub CanBookBeReserved {
             {
                 -or => [
                     biblionumber => $biblionumber,
-                    itemnumber   => { -in => @hostitemnumbers }
+                    itemnumber   => { -in => \@hostitemnumbers }
                 ]
             }
         );
@@ -471,6 +487,16 @@ sub CanBookBeReserved {
 
 our $CanItemBeReserved_cache_key;
 
+=head2 _cache
+
+    _cache($return);
+
+Internal helper that stores C<$return> in the memory cache under
+C<$CanItemBeReserved_cache_key> and returns it. Used by C<CanItemBeReserved>
+to avoid redundant lookups within the same request.
+
+=cut
+
 sub _cache {
     my ($return) = @_;
     my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
@@ -512,9 +538,9 @@ sub CanItemBeReserved {
         my $biblio = $item->biblio;
 
         # Check for the age restriction
-        my $ageRestriction = C4::Circulation::GetAgeRestriction( $biblio->biblioitem->agerestriction );
+        my $age_check = Koha::Policy::Biblio::AgeRestriction->check( $biblio, $patron );
         return _cache { status => 'ageRestricted' }
-            if $ageRestriction && $patron->dateofbirth && $ageRestriction > $patron->get_age();
+            if !$age_check;
     }
 
     # Check that the patron doesn't have an item level hold on this item already
@@ -609,9 +635,10 @@ sub CanItemBeReserved {
         }
         if ( !$params->{ignore_hold_counts} ) {
 
-            # we retrieve count
+            # we retrieve count, treating each hold group as a single unit
             my $querycount = q{
-                SELECT count(*) AS count
+                SELECT COUNT( CASE WHEN reserves . hold_group_id IS NULL THEN 1 END ) +
+                    COUNT( DISTINCT reserves.hold_group_id ) AS count
                   FROM reserves
              LEFT JOIN items USING (itemnumber)
              LEFT JOIN biblioitems ON (reserves.biblionumber=biblioitems.biblionumber)
@@ -663,7 +690,7 @@ sub CanItemBeReserved {
         }
     );
     if ( !$params->{ignore_hold_counts} && $rule && defined( $rule->rule_value ) && $rule->rule_value ne '' ) {
-        my $total_holds_count = Koha::Holds->search( { borrowernumber => $patron->borrowernumber } )->count();
+        my $total_holds_count = Koha::Holds->count_holds( { borrowernumber => $patron->borrowernumber } );
 
         return _cache { status => 'tooManyReserves', limit => $rule->rule_value }
             if $total_holds_count >= $rule->rule_value;
@@ -722,84 +749,6 @@ sub CanItemBeReserved {
     return _cache { status => 'OK' };
 }
 
-=head2 ChargeReserveFee
-
-    $fee = ChargeReserveFee( $borrowernumber, $fee, $title );
-
-    Charge the fee for a reserve (if $fee > 0)
-
-=cut
-
-sub ChargeReserveFee {
-    my ( $borrowernumber, $fee, $title ) = @_;
-    return if !$fee || $fee == 0;    # the last test is needed to include 0.00
-    Koha::Account->new( { patron_id => $borrowernumber } )->add_debit(
-        {
-            amount       => $fee,
-            description  => $title,
-            note         => undef,
-            user_id      => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
-            library_id   => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
-            interface    => C4::Context->interface,
-            invoice_type => undef,
-            type         => 'RESERVE',
-            item_id      => undef
-        }
-    );
-}
-
-=head2 GetReserveFee
-
-    $fee = GetReserveFee( $borrowernumber, $biblionumber );
-
-    Calculate the fee for a reserve (if applicable).
-
-=cut
-
-sub GetReserveFee {
-    my ( $borrowernumber, $biblionumber ) = @_;
-    my $borquery = qq{
-SELECT reservefee FROM borrowers LEFT JOIN categories ON borrowers.categorycode = categories.categorycode WHERE borrowernumber = ?
-    };
-    my $issue_qry = qq{
-SELECT COUNT(*) FROM items
-LEFT JOIN issues USING (itemnumber)
-WHERE items.biblionumber=? AND issues.issue_id IS NULL
-    };
-    my $holds_qry = qq{
-SELECT COUNT(*) FROM reserves WHERE biblionumber=? AND borrowernumber<>?
-    };
-
-    my $dbh = C4::Context->dbh;
-    my ($fee) = $dbh->selectrow_array( $borquery, undef, ($borrowernumber) );
-    $fee += 0;
-    my $hold_fee_mode = C4::Context->preference('HoldFeeMode') || 'not_always';
-    if ( $fee and $fee > 0 and $hold_fee_mode eq 'not_always' ) {
-
-        # This is a reconstruction of the old code:
-        # Compare number of items with items issued, and optionally check holds
-        # If not all items are issued and there are no holds: charge no fee
-        # NOTE: Lost, damaged, not-for-loan, etc. are just ignored here
-        my ( $notissued, $reserved );
-        ($notissued) = $dbh->selectrow_array(
-            $issue_qry, undef,
-            ($biblionumber)
-        );
-        if ( $notissued == 0 ) {
-
-            # all items are issued
-            ($reserved) = $dbh->selectrow_array(
-                $holds_qry, undef,
-                ( $biblionumber, $borrowernumber )
-            );
-            $fee = 0 if $reserved == 0;
-        } else {
-            $fee = 0;
-        }
-    }
-    return $fee;
-}
-
 =head2 GetReserveStatus
 
   $reservestatus = GetReserveStatus($itemnumber);
@@ -947,6 +896,54 @@ sub CheckReserves {
                     }
                 }
 
+                # Local holds exclusivity period: when the queue has
+                # targeted a local-group item for this hold and we're still
+                # within the exclusivity window, skip non-local items so the
+                # targeted local item can fulfil it.  If the queue has not yet
+                # run for this reserve (no hold_fill_targets row), we fall
+                # through and let the hold be filled normally.
+                # This is independent of LocalHoldsPriority.
+                my $excl_period = C4::Context->preference('LocalHoldsExclusivityPeriod');
+                if ( $excl_period && $res->{reserve_id} ) {
+                    my $excl_item_control =
+                        C4::Context->preference('LocalHoldsExclusivityItemControl') || 'holdingbranch';
+                    my $excl_patron_control =
+                        C4::Context->preference('LocalHoldsExclusivityPatronControl') || 'PickupLibrary';
+
+                    my $excl_item_branchcode = $item->$excl_item_control;
+                    $patron //= Koha::Patrons->find( $res->{borrowernumber} );
+                    my $excl_patron_branchcode =
+                          ( $excl_patron_control eq 'PickupLibrary' ) ? $res->{branchcode}
+                        : ( $excl_patron_control eq 'HomeLibrary' )   ? $patron->branchcode
+                        :                                               undef;
+
+                    my $is_local_for_exclusivity = 0;
+                    if ( $excl_item_branchcode && $excl_patron_branchcode ) {
+                        if ( $excl_item_branchcode eq $excl_patron_branchcode ) {
+                            $is_local_for_exclusivity = 1;
+                        } else {
+                            my $excl_library = Koha::Libraries->find( { branchcode => $excl_item_branchcode } );
+                            $is_local_for_exclusivity = 1
+                                if $excl_library
+                                && $excl_library->validate_hold_sibling( { branchcode => $excl_patron_branchcode } );
+                        }
+                    }
+
+                    if ( !$is_local_for_exclusivity ) {
+                        my $reservedate_dt = eval { dt_from_string( $res->{reservedate} ) };
+                        if ($reservedate_dt) {
+                            my $age_days = dt_from_string->delta_days($reservedate_dt)->in_units('days');
+                            if ( $age_days < $excl_period ) {
+                                my $target =
+                                    Koha::Database->new->schema->resultset('HoldFillTarget')
+                                    ->search( { reserve_id => $res->{reserve_id} }, { rows => 1 } )
+                                    ->next;
+                                next if $target && $target->local_holdgroup_match;
+                            }
+                        }
+                    }
+                }
+
                 # See if this item is more important than what we've got so far
                 if (   ( $res->{'priority'} && $res->{'priority'} < $priority )
                     || $local_hold_match
@@ -1092,7 +1089,7 @@ sub CancelExpiredReserves {
         my $cache_key = sprintf "Calendar_CancelExpiredReserves:%s", $hold->branchcode;
         my $calendar  = $cache->get_from_cache($cache_key);
         if ( !$calendar ) {
-            $calendar = Koha::Calendar->new( branchcode => $hold->branchcode );
+            $calendar = Koha::Library::Calendar->new( branchcode => $hold->branchcode );
             $cache->set_in_cache( $cache_key, $calendar );
         }
 
@@ -1186,6 +1183,8 @@ for a bib.
 
 If C<$rank> is 'del', the hold request is cancelled.
 
+If C<$rank> is 'recall', the hold request is converted to a recall request.
+
 If C<$rank> is an integer greater than zero, the priority of
 the request is set to that value.  Since priority != 0 means
 that the item is not waiting on the hold shelf, setting the
@@ -1219,6 +1218,7 @@ sub ModReserve {
     my $biblionumber        = $params->{'biblionumber'};
     my $cancellation_reason = $params->{'cancellation_reason'};
     my $date                = $params->{expirationdate};
+    my $skip_fixup_priority = $params->{skip_fixup_priority};
 
     return if defined $rank && $rank eq "n";
 
@@ -1242,6 +1242,43 @@ sub ModReserve {
 
     if ( $rank eq "del" ) {
         $hold->cancel( { cancellation_reason => $cancellation_reason } );
+    } elsif ( $rank eq "recall" ) {
+        if ( !$biblionumber ) {
+            $biblionumber = $hold->biblionumber;
+        }
+        my $biblio = Koha::Biblios->find($biblionumber);
+        if ( !$borrowernumber ) {
+            $borrowernumber = $hold->borrowernumber;
+        }
+        my $patron = Koha::Patrons->find($borrowernumber);
+        if ( $hold->item_level_hold ) {
+            if ( $hold->item->can_be_recalled( { patron => $patron, hold_convert => 1 } ) ) {
+                Koha::Recalls->add_recall(
+                    {
+                        patron         => $patron,
+                        biblio         => $biblio,
+                        branchcode     => $hold->branchcode,
+                        expirationdate => $date,
+                        interface      => 'intranet',
+                        item           => $hold->item,
+                    }
+                );
+                $hold->cancel( { cancellation_reason => $cancellation_reason } );
+            }
+        } else {
+            if ( $biblio->can_be_recalled( { patron => $patron, hold_convert => 1 } ) ) {
+                Koha::Recalls->add_recall(
+                    {
+                        patron         => $patron,
+                        biblio         => $biblio,
+                        branchcode     => $hold->branchcode,
+                        expirationdate => $date,
+                        interface      => 'intranet',
+                    }
+                );
+                $hold->cancel( { cancellation_reason => $cancellation_reason } );
+            }
+        }
     } elsif ( $hold->found && $hold->priority eq '0' && $date ) {
 
         # The only column that can be updated for a found hold is the expiration date
@@ -1263,6 +1300,9 @@ sub ModReserve {
         if ( exists $params->{expirationdate} ) {
             $properties->{expirationdate} = $params->{expirationdate} || undef;
         }
+        if ( exists $params->{item_level_hold} ) {
+            $properties->{item_level_hold} = $params->{item_level_hold};
+        }
 
         $hold->set($properties)->store();
 
@@ -1277,7 +1317,7 @@ sub ModReserve {
             }
         }
 
-        _FixPriority( { reserve_id => $reserve_id, rank => $rank } );
+        FixPriority( { reserve_id => $reserve_id, rank => $rank } ) unless $skip_fixup_priority;
 
         logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, $hold, undef, $original )
             if C4::Context->preference('HoldsLog');
@@ -1390,7 +1430,7 @@ sub ModReserveAffect {
 
     _koha_notify_hold_changed($hold) if $notify_library;
 
-    _FixPriority( { biblionumber => $biblionumber } );
+    FixPriority( { biblionumber => $biblionumber } );
     my $item = Koha::Items->find($itemnumber);
     if (   $item->location
         && $item->location eq 'CART'
@@ -1477,7 +1517,7 @@ sub ModReserveMinusPriority {
     $sth_upd->execute( $itemnumber, $reserve_id );
 
     # second step update all others reserves
-    _FixPriority( { reserve_id => $reserve_id, rank => '0' } );
+    FixPriority( { reserve_id => $reserve_id, rank => '0' } );
 }
 
 =head2 IsAvailableForItemLevelRequest
@@ -1548,9 +1588,9 @@ sub IsAvailableForItemLevelRequest {
 
     my $on_shelf_holds = Koha::CirculationRules->get_onshelfholds_policy( { item => $item, patron => $patron } );
 
-    if ( $on_shelf_holds == 1 ) {
+    if ( $on_shelf_holds == 1 ) {    # Allow
         return 1;
-    } elsif ( $on_shelf_holds == 2 ) {
+    } elsif ( $on_shelf_holds == 2 ) {    # If all unavailable
 
         # These calculations work at the biblio level, and can be expensive
         # we use the in-memory cache to avoid calling once per item when looping items on a biblio
@@ -1566,7 +1606,7 @@ sub IsAvailableForItemLevelRequest {
         $memory_cache->set_in_cache( $cache_key, $any_available );
         return $any_available ? 0 : 1;
 
-    } else {  # on_shelf_holds == 0 "If any unavailable" (the description is rather cryptic and could still be improved)
+    } else {    # on_shelf_holds == 0 [If any unavailable]
         return $item->notforloan < 0 || $item->onloan || $item->holds->filter_by_found->count;
     }
 }
@@ -1634,14 +1674,14 @@ sub AlterPriority {
 
     if ( $where eq 'up' ) {
         return unless $prev_priority;
-        _FixPriority( { reserve_id => $reserve_id, rank => $prev_priority } );
+        FixPriority( { reserve_id => $reserve_id, rank => $prev_priority } );
     } elsif ( $where eq 'down' ) {
         return unless $next_priority;
-        _FixPriority( { reserve_id => $reserve_id, rank => $next_priority } );
+        FixPriority( { reserve_id => $reserve_id, rank => $next_priority } );
     } elsif ( $where eq 'top' ) {
-        _FixPriority( { reserve_id => $reserve_id, rank => $first_priority } );
+        FixPriority( { reserve_id => $reserve_id, rank => $first_priority } );
     } elsif ( $where eq 'bottom' ) {
-        _FixPriority( { reserve_id => $reserve_id, rank => $last_priority } );
+        FixPriority( { reserve_id => $reserve_id, rank => $last_priority } );
     }
 
     Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue->new->enqueue( { biblio_ids => [ $hold->biblionumber ] } )
@@ -1652,21 +1692,27 @@ sub AlterPriority {
 
 =head2 ToggleLowestPriority
 
-  ToggleLowestPriority( $borrowernumber, $biblionumber );
+  ToggleLowestPriority( $reserve_id, $is_lowestPriority );
 
-This function sets the lowestPriority field to true if is false, and false if it is true.
+This function sets the lowestPriority field to true if is false, and false if it is true
+and then reorders the holds on the record.
+
+A hold toggled to lowest priority will go the bottom.
+A hold toggled to NOT lowest priority will go to the bottom of other non-lowest priority holds.
 
 =cut
 
 sub ToggleLowestPriority {
-    my ($reserve_id) = @_;
+    my ( $reserve_id, $is_lowestPriority ) = @_;
 
     my $dbh = C4::Context->dbh;
 
+    my $rank = $is_lowestPriority ? undef : '999999';
+
     my $sth = $dbh->prepare("UPDATE reserves SET lowestPriority = NOT lowestPriority WHERE reserve_id = ?");
     $sth->execute($reserve_id);
 
-    _FixPriority( { reserve_id => $reserve_id, rank => '999999' } );
+    FixPriority( { reserve_id => $reserve_id, rank => $rank } );
 }
 
 =head2 SuspendAll
@@ -1709,17 +1755,16 @@ sub SuspendAll {
     }
 }
 
-=head2 _FixPriority
+=head2 FixPriority
 
-  _FixPriority({
+  FixPriority({
     reserve_id => $reserve_id,
     [rank => $rank,]
-    [ignoreSetLowestRank => $ignoreSetLowestRank]
   });
 
   or
 
-  _FixPriority({ biblionumber => $biblionumber});
+ FixPriority({ biblionumber => $biblionumber});
 
 This routine adjusts the priority of a hold request and holds
 on the same bib.
@@ -1736,116 +1781,114 @@ then have reserves.priority set so that the first non-captured hold
 has its priority set to 1, the second non-captured hold has its priority
 set to 2, and so forth.
 
-In both cases, holds that have the lowestPriority flag on are have their
+In both cases, holds that have the lowestPriority flag on have their
 priority adjusted to ensure that they remain at the end of the line.
 
-Note that the ignoreSetLowestRank parameter is meant to be used only
-when _FixPriority calls itself.
-
 =cut
 
-sub _FixPriority {
-    my ($params)            = @_;
-    my $reserve_id          = $params->{reserve_id};
-    my $rank                = $params->{rank} // '';
-    my $ignoreSetLowestRank = $params->{ignoreSetLowestRank};
-    my $biblionumber        = $params->{biblionumber};
+sub FixPriority {
+    my ($params) = @_;
 
-    my $dbh = C4::Context->dbh;
+    Koha::Database->new->schema->txn_do(
+        sub {
+            my $reserve_id   = $params->{reserve_id};
+            my $rank         = $params->{rank} // '';
+            my $biblionumber = $params->{biblionumber};
 
-    my $hold;
-    if ($reserve_id) {
-        $hold = Koha::Holds->find($reserve_id);
-        if ( !defined $hold ) {
+            my $dbh = C4::Context->dbh;
 
-            # may have already been checked out and hold fulfilled
-            require Koha::Old::Holds;
-            $hold = Koha::Old::Holds->find($reserve_id);
-        }
-        return unless $hold;
-    }
+            my $hold;
+            if ($reserve_id) {
+                $hold = Koha::Holds->find($reserve_id);
+                if ( !defined $hold ) {
 
-    unless ($biblionumber) {    # FIXME This is a very weird API
-        $biblionumber = $hold->biblionumber;
-    }
-
-    if ( $rank eq "del" ) {     # FIXME will crash if called without $hold
-        $hold->cancel;
-    } elsif ( $reserve_id && ( $rank eq "W" || $rank eq "0" ) ) {
-
-        # make sure priority for waiting or in-transit items is 0
-        my $query = "
-            UPDATE reserves
-            SET    priority = 0
-            WHERE reserve_id = ?
-            AND found IN ('W', 'T', 'P')
-        ";
-        my $sth = $dbh->prepare($query);
-        $sth->execute($reserve_id);
-    }
-    my @priority;
-
-    # get what's left
-    my $query = "
-        SELECT reserve_id, borrowernumber, reservedate
-        FROM   reserves
-        WHERE  biblionumber   = ?
-          AND  ((found <> 'W' AND found <> 'T' AND found <> 'P') OR found IS NULL)
-        ORDER BY priority ASC
-    ";
-    my $sth = $dbh->prepare($query);
-    $sth->execute($biblionumber);
-    while ( my $line = $sth->fetchrow_hashref ) {
-        push( @priority, $line );
-    }
-
-    # FIXME This whole sub must be rewritten, especially to highlight what is done when reserve_id is not given
-    # To find the matching index
-    my $i;
-    my $key = -1;    # to allow for 0 to be a valid result
-    for ( $i = 0 ; $i < @priority ; $i++ ) {
-        if ( $reserve_id && $reserve_id == $priority[$i]->{'reserve_id'} ) {
-            $key = $i;    # save the index
-            last;
-        }
-    }
-
-    # if index exists in array then move it to new position
-    if ( $key > -1 && $rank ne 'del' && $rank > 0 ) {
-        my $new_rank    = $rank - 1;                      # $new_rank is what you want the new index to be in the array
-        my $moving_item = splice( @priority, $key, 1 );
-        $new_rank = scalar @priority if $new_rank > scalar @priority;
-        splice( @priority, $new_rank, 0, $moving_item );
-    }
-
-    # now fix the priority on those that are left....
-    $query = "
-        UPDATE reserves
-        SET    priority = ?
-        WHERE  reserve_id = ?
-    ";
-    $sth = $dbh->prepare($query);
-    for ( my $j = 0 ; $j < @priority ; $j++ ) {
-        $sth->execute(
-            $j + 1,
-            $priority[$j]->{'reserve_id'}
-        );
-    }
-
-    unless ($ignoreSetLowestRank) {
-        $sth = $dbh->prepare(
-            "SELECT reserve_id FROM reserves WHERE lowestPriority = 1 AND biblionumber = ? ORDER BY priority");
-        $sth->execute($biblionumber);
-        while ( my $res = $sth->fetchrow_hashref() ) {
-            _FixPriority(
-                {
-                    reserve_id          => $res->{'reserve_id'},
-                    rank                => '999999',
-                    ignoreSetLowestRank => 1
+                    # may have already been checked out and hold fulfilled
+                    require Koha::Old::Holds;
+                    $hold = Koha::Old::Holds->find($reserve_id);
                 }
-            );
+                return unless $hold;
+            }
+
+            unless ($biblionumber) {    # FIXME This is a very weird API
+                $biblionumber = $hold->biblionumber;
+            }
+
+            if ( $rank eq "del" ) {     # FIXME will crash if called without $hold
+                $hold->cancel;
+            } elsif ( $reserve_id && ( $rank eq "W" || $rank eq "0" ) ) {
+
+                # make sure priority for waiting or in-transit items is 0
+                my $query = "
+                    UPDATE reserves
+                    SET    priority = 0
+                    WHERE reserve_id = ?
+                    AND found IN ('W', 'T', 'P')
+                ";
+                my $sth = $dbh->prepare($query);
+                $sth->execute($reserve_id);
+            }
+            my @priority;
+
+            # Lock all active holds for this bib so concurrent FixPriority calls
+            # for the same hold set cannot interleave their read-modify-write cycle.
+            # FOR UPDATE is effective inside the enclosing txn_do transaction.
+            my $query = "
+                SELECT reserve_id, borrowernumber, reservedate, lowestPriority
+                FROM   reserves
+                WHERE  biblionumber   = ?
+                  AND  ((found <> 'W' AND found <> 'T' AND found <> 'P') OR found IS NULL)
+                ORDER BY lowestPriority ASC, priority ASC
+                FOR UPDATE
+            ";
+            my $sth = $dbh->prepare($query);
+            $sth->execute($biblionumber);
+            while ( my $line = $sth->fetchrow_hashref ) {
+                push( @priority, $line );
+            }
+
+            # FIXME This whole sub must be rewritten, especially to highlight what is done when reserve_id is not given
+            # To find the matching index
+            my $i;
+            my $key = -1;    # to allow for 0 to be a valid result
+            for ( $i = 0 ; $i < @priority ; $i++ ) {
+                if ( $reserve_id && $reserve_id == $priority[$i]->{'reserve_id'} ) {
+                    $key = $i;    # save the index
+                    last;
+                }
+            }
+
+            # if this hold is marked lowest priority, we can only move it so far;
+            # cap rank to just after the last non-lowestPriority hold using the
+            # already-fetched @priority array (avoids a second DB query and stale data)
+            if ( $hold && $hold->lowestPriority && $rank ne 'del' && $rank > 0 ) {
+                my $non_lowest_count = scalar grep { !$_->{lowestPriority} } @priority;
+                $rank = $non_lowest_count + 1 if $non_lowest_count && $rank <= $non_lowest_count;
+            }
+
+            # if index exists in array then move it to new position
+            if ( $key > -1 && $rank ne 'del' && $rank && $rank > 0 ) {
+                my $new_rank    = $rank - 1;    # $new_rank is what you want the new index to be in the array
+                my $moving_item = splice( @priority, $key, 1 );
+                $new_rank = scalar @priority if $new_rank > scalar @priority;
+                splice( @priority, $new_rank, 0, $moving_item );
+            }
+
+            # now fix the priority on those that are left....
+            # only updating if changed
+            $query = "
+                UPDATE reserves
+                SET    priority = ?
+                WHERE  reserve_id = ? AND priority != ?
+            ";
+            $sth = $dbh->prepare($query);
+            for ( my $j = 0 ; $j < @priority ; $j++ ) {
+                $sth->execute(
+                    $j + 1,
+                    $priority[$j]->{'reserve_id'}, $j + 1
+                );
+            }
         }
-    }
+    );
 }
 
 =head2 _Findgroupreserve
@@ -2054,25 +2097,24 @@ sub _koha_notify_reserve {
     };
 
     while ( my ( $mtt, $letter_code ) = each %{ $messagingprefs->{transports} } ) {
-        next
-            if (
+        if (
             ( $mtt eq 'email'  and not $to_address )                # No email address
             or ( $mtt eq 'sms' and not $patron->smsalertnumber )    # No SMS number
             or ( $mtt eq 'itiva'
                 and C4::Context->preference('TalkingTechItivaPhoneNotification')
             )                                                       # Notice is handled by TalkingTech_itiva_outbound.pl
             or ( $mtt eq 'phone' and not $patron->phone )           # No phone number to call
-            );
+            )
+        {
+            unless ($notification_sent) {
+                $notification_sent++;
+                &$send_notification( 'print', 'HOLD' );
+            }
+            next;
+        }
 
         &$send_notification( $mtt, $letter_code, $messagingprefs->{wants_digest} );
-        $notification_sent++;
     }
-
-    #Making sure that a print notification is sent if no other transport types can be utilized.
-    if ( !$notification_sent ) {
-        &$send_notification( 'print', 'HOLD' );
-    }
-
 }
 
 =head2 _koha_notify_hold_changed
@@ -2198,13 +2240,13 @@ sub MoveReserve {
     my $lookahead = C4::Context->preference('ConfirmFutureHolds');    #number of days to look for future holds
     my ( $restype, $res, undef ) = CheckReserves( $item, $lookahead );
 
+    my $hold;
     if ( $res && $res->{borrowernumber} == $patron->borrowernumber ) {
-        my $hold = Koha::Holds->find( $res->{reserve_id} );
-        $hold->fill( { item_id => $item->id } );
+        $hold = Koha::Holds->find( $res->{reserve_id} );
     } else {
 
-        # The item is reserved by someone else.
-        # Find this item in the reserves
+        # The next reserve is for someone else,
+        # Check if this patron has a reserve on this biblio/item
 
         my $lookahead_date = output_pref(
             {
@@ -2212,7 +2254,7 @@ sub MoveReserve {
                 dateformat => 'iso', dateonly => 1
             }
         );
-        my $hold = $patron->holds->search(
+        $hold = $patron->holds->search(
             {
                 biblionumber => $item->biblionumber,
                 reservedate  => { '<=' => $lookahead_date },
@@ -2220,18 +2262,41 @@ sub MoveReserve {
             },
             { order_by => 'priority' }
         )->next();
+    }
 
-        if ($hold) {
+    if ($hold) {
+        if ( $hold->itemnumber && $hold->itemnumber == $item->id ) {
 
             # The item is reserved by the current patron
             $hold->fill( { item_id => $item->id } );
-        }
+        } else {
+            my $controlbranch = $patron->branchcode;
+            if ( C4::Context->preference('ReservesControlBranch') eq 'ItemHomeLibrary' ) {
+                $controlbranch = $item->homebranch;
+            }
 
+            # If no rule is set, the default behavior is to fill the hold
+            my $fill_other_biblio_holds_policy = Koha::CirculationRules->get_effective_rule_value(
+                {
+                    categorycode => undef,
+                    itemtype     => $item->itype,
+                    branchcode   => $controlbranch,
+                    rule_name    => 'fill_other_biblio_holds_policy',
+                }
+            ) // 1;
+
+            $hold->fill( { item_id => $item->id } ) if $fill_other_biblio_holds_policy;
+        }
+    }
+
+    if ( $cancelreserve && $res ) {
         $hold = Koha::Holds->find( $res->{reserve_id} );
-        if ( $cancelreserve eq 'revert' ) {
-            $hold->revert_found();
-        } elsif ( $cancelreserve eq 'cancel' || $cancelreserve ) {    # cancel reserves on this item
-            $hold->cancel;
+        if ($hold) {
+            if ( $cancelreserve eq 'revert' ) {
+                $hold->revert_found();
+            } else {    # cancel reserves on this item
+                $hold->cancel;
+            }
         }
     }
 }

C4/SIP/ILS.pm

@@ -358,7 +358,7 @@ sub end_patron_session {
 sub pay_fee {
     my (
         $self, $patron_id, $patron_pwd, $fee_amt, $fee_type, $pay_type, $fee_id, $trans_id, $currency, $is_writeoff,
-        $disallow_overpayment, $register_id
+        $disallow_overpayment, $register_id, $inst_id
     ) = @_;
 
     my $trans = C4::SIP::ILS::Transaction::FeePayment->new();
@@ -372,7 +372,7 @@ sub pay_fee {
     }
     my $trans_result = $trans->pay(
         $patron->{borrowernumber}, $fee_amt, $pay_type, $fee_id, $is_writeoff, $disallow_overpayment,
-        $register_id
+        $register_id, $inst_id
     );
     my $ok = $trans_result->{ok};
     $trans->ok($ok);

C4/SIP/ILS/Item.pm

@@ -106,7 +106,10 @@ sub new {
     my $it = $item->effective_itemtype;
     $self->{itemtype} = $it;
     my $itemtype = Koha::Database->new()->schema()->resultset('Itemtype')->find($it);
-    $self->{sip_media_type} = $itemtype->sip_media_type() if $itemtype;
+    if ($itemtype) {
+        $self->{sip_media_type} = $itemtype->sip_media_type;
+        $self->{magnetic_media} = $itemtype->sip_magnetic;
+    }
 
     # check if its on issue and if so get the borrower
     my $issue = Koha::Checkouts->find( { itemnumber => $item->itemnumber } );

C4/SIP/ILS/Patron.pm

@@ -131,10 +131,17 @@ sub new {
     }
 
     # Get currency 3 chars max
-    my $currency = substr Koha::Acquisition::Currencies->get_active->currency, 0, 3;
+    my $currency = Koha::Acquisition::Currencies->get_active;
+    if ($currency) {
+        $currency = substr $currency->currency, 0, 3;
+    }
 
     my $circ_blocked =
         ( C4::Context->preference('OverduesBlockCirc') ne "noblock" && defined $flags->{ODUES}->{itemlist} ) ? 1 : 0;
+
+    # Fetch holds once and derive hold_items and unavail_holds from the result
+    my @holds = $patron->holds->as_list;
+
     {
         no warnings;    # any of these $kp->{fields} being concat'd could be undef
         %ilspatron = (
@@ -165,7 +172,7 @@ sub new {
             screen_msg     => 'Greetings from Koha. ' . $kp->{opacnote} . $fines_msg,
             print_line     => '',
             items          => [],
-            hold_items     => $flags->{WAITING}->{itemlist},
+            hold_items     => [ map { $_->unblessed } @holds ],
             overdue_items  => $flags->{ODUES}->{itemlist},
             too_many_overdue => $circ_blocked,
             fine_items       => [],
@@ -212,7 +219,7 @@ sub new {
         while ( my $message = $patron_messages->next ) {
             my $messagedt      = dt_from_string( $message->message_date, 'iso' );
             my $formatted_date = output_pref( { dt => $messagedt, dateonly => 1 } );
-            push @messages_array, $formatted_date . ": " . $message->message;
+            push @messages_array, $formatted_date . ": " . $message->message_without_newlines;
         }
         if (@messages_array) {
             $ilspatron{screen_msg} .= " Messages for you: " . join( ' / ', @messages_array );
@@ -220,7 +227,7 @@ sub new {
     }
 
     # FIXME: populate recall_items
-    $ilspatron{unavail_holds} = _get_outstanding_holds( $kp->{borrowernumber} );
+    $ilspatron{unavail_holds} = _get_outstanding_holds( \@holds );
 
     my $pending_checkouts = $patron->pending_checkouts;
     my @barcodes;
@@ -241,6 +248,7 @@ sub new {
 my %fields = (
     id                    => 0,
     borrowernumber        => 0,
+    branchcode            => 0,
     name                  => 0,
     address               => 0,
     email_addr            => 0,
@@ -691,12 +699,12 @@ sub _get_address {
 }
 
 sub _get_outstanding_holds {
-    my $borrowernumber = shift;
+    my $holds = shift;
 
-    my $patron = Koha::Patrons->find($borrowernumber);
-    my $holds  = $patron->holds->search( { -or => [ { found => undef }, { found => { '!=' => 'W' } } ] } );
     my @holds;
-    while ( my $hold = $holds->next ) {
+    foreach my $hold ( @{$holds} ) {
+        next if ( $hold->found // '' ) eq 'W';
+
         my $item;
         if ( $hold->itemnumber ) {
             $item = $hold->item;
@@ -917,9 +925,6 @@ __END__
     {message}     "Yes"
     {itemlist}    ref-to-array: list of overdue books
     {itemlisttext}    Text list of overdue items
- {WAITING}         Set if there are items available that the patron reserved
-    {message}     Message to this effect
-    {itemlist}    ref-to-array: list of available items
 
 =cut
 

C4/SIP/ILS/Transaction/Checkin.pm

@@ -124,6 +124,7 @@ sub do_checkin {
         unless $human_required || $checkin_blocked_by_holds;
 
     if ($checked_in_ok) {
+        delete $messages->{TransferArrived};
         delete $messages->{ItemLocationUpdated};
         delete $messages->{NotIssued};
         delete $messages->{LocalUse};

C4/SIP/ILS/Transaction/Checkout.pm

@@ -74,18 +74,23 @@ sub do_checkout {
             last;
         }
     } else {
+        my $hold_pref = C4::Context->preference("AllowItemsOnHoldCheckoutSIP") || 0;
         foreach my $confirmation ( keys %{$needsconfirmation} ) {
             if ( $confirmation eq 'RENEW_ISSUE' ) {
                 $self->screen_msg("Item already checked out to you: renewing item.");
-            } elsif ( $confirmation eq 'RESERVED' and !C4::Context->preference("AllowItemsOnHoldCheckoutSIP") ) {
+            } elsif ( $confirmation eq 'RESERVED' ) {
+                if ( $hold_pref >= 1 ) {
+                    next;
+                }
                 $self->screen_msg("Item is reserved for another patron upon return.");
                 $noerror = 0;
-            } elsif ( $confirmation eq 'RESERVED' and C4::Context->preference("AllowItemsOnHoldCheckoutSIP") ) {
-                next;
             } elsif ( $confirmation eq 'RESERVE_WAITING'
                 or $confirmation eq 'TRANSFERRED'
                 or $confirmation eq 'PROCESSING' )
             {
+                if ( $hold_pref >= 2 ) {
+                    next;
+                }
                 $self->screen_msg("Item is on hold for another patron.");
                 $noerror = 0;
             } elsif ( $confirmation eq 'ISSUED_TO_ANOTHER' and C4::Context->preference("AllowItemsOnLoanCheckoutSIP") )

C4/SIP/ILS/Transaction/FeePayment.pm

@@ -50,6 +50,7 @@ sub pay {
     my $is_writeoff          = shift;
     my $disallow_overpayment = shift;
     my $register_id          = shift;
+    my $inst_id              = shift;
 
     my $type = $is_writeoff ? 'WRITEOFF' : 'PAYMENT';
 
@@ -66,6 +67,7 @@ sub pay {
         payment_type  => 'SIP' . $sip_type,
         interface     => C4::Context->interface,
         cash_register => $register_id,
+        library_id    => $inst_id,
     };
 
     if ($fee_id) {

C4/SIP/SIPServer.pm

@@ -55,6 +55,10 @@ my %transports = (
 # Read configuration
 #
 my $config = C4::SIP::Sip::Configuration->new( $ARGV[0] );
+
+# Per-process record of when this worker loaded $config. Not shared since $config is per-process.
+our $sip2_config_read_timestamp = Koha::Caches->get_instance->get_from_cache('sip2_resource_last_modified');
+
 my @params;
 
 #
@@ -87,7 +91,11 @@ if ( defined( $config->{'server-params'} ) ) {
 
 # Add user and group to prevent warn from Net::Server.
 push @params, 'user=' . $>;
-push @params, 'group=' . $>;
+
+# $) can contain supplementary groups like "1010 1010" -> Net::Server tries setgroups() and fails.
+my ($egid) = split /\s+/, $);
+$egid ||= $(;    # fallback to real gid just in case
+push @params, 'group=' . $egid;
 
 #
 # This is the main event.
@@ -230,13 +238,15 @@ sub _config_up_to_date {
 
     my $cache                       = Koha::Caches->get_instance();
     my $sip2_resource_last_modified = $cache->get_from_cache("sip2_resource_last_modified");
-    my $sip2_config_read_timestamp  = $cache->get_from_cache("sip2_config_read_timestamp");
 
     unless ($sip2_resource_last_modified) {
-        siplog( "LOG_WARNING", "Couldn't find sip2_resource_last_modified, considering configuration not up to date" );
+        siplog( "LOG_INFO", "Couldn't find sip2_resource_last_modified, considering configuration not up to date" );
         return 0;
     }
-    return $sip2_config_read_timestamp >= $sip2_resource_last_modified;
+
+    return 0 unless defined $sip2_config_read_timestamp;
+
+    return $sip2_config_read_timestamp >= $sip2_resource_last_modified ? 1 : 0;
 }
 
 #
@@ -256,15 +266,17 @@ sub process_request {
     my ( $sockaddr, $port, $proto );
     my $transport;
 
+    # Flush L1 before the freshness check so it sees the current shared value, not a stale one inherited at fork.
+    Koha::Caches->flush_L1_caches();
+
     $self->{config} = $config;
     unless ( $self->_config_up_to_date() ) {
         $self->{config} = C4::SIP::Sip::Configuration->get_configuration( undef, $self->{config} );
+        $sip2_config_read_timestamp = Koha::Caches->get_instance->get_from_cache('sip2_resource_last_modified');
     }
 
-    # Flushing L1 to make sure the request will be processed using the correct data
-    Koha::Caches->flush_L1_caches();
-
     $self->{account} = undef;    # Clear out the account from the last request, it may be different
+    $self->{ils}     = undef;    # And the ILS handle, so a reused worker can't reuse a prior session's connection
     $self->{logger}  = set_logger( Koha::Logger->get( { interface => 'sip' } ) );
 
     # Flush previous MDCs to prevent accidentally leaking incorrect MDC-entries
@@ -464,12 +476,12 @@ sub telnet_transport {
             $pwd = get_clean_string($pwd);
             siplog( "LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd) );
 
-            # Check if user is authorized for SIP access, then authenticate via login_core
-            if ( exists( $config->{accounts}->{$uid} ) ) {
+            # Only log the terminal in once login_core actually authenticates it
+            if ( exists( $config->{accounts}->{$uid} )
+                && C4::SIP::Sip::MsgType::login_core( $self, $uid, $pwd ) )
+            {
                 $account = $config->{accounts}->{$uid};
-                if ( C4::SIP::Sip::MsgType::login_core( $self, $uid, $pwd ) ) {
-                    last;
-                }
+                last;
             }
             siplog( "LOG_WARNING", "Invalid login attempt: '%s'", ( $uid || '' ) );
             print("Invalid login$CRLF");
@@ -584,8 +596,11 @@ sub read_request {
         $raw_length = length $buffer;
         $buffer =~ s/^\s*[^A-z0-9]+//s;
 
-        # Every line must start with a "real" character.  Not whitespace, control chars, etc.
-        $buffer =~ s/[^A-z0-9]+$//s;
+        # Remove leading/trailing control characters and whitespace.
+        # SIP2 messages should be a single printable line; this defensively
+        # cleans up stray CR/LF or junk from buggy or long-lived client connections.
+        $buffer =~ s/^[[:cntrl:]\s]+//;
+        $buffer =~ s/[[:cntrl:]\s]+$//;
 
         # Same for the end.  Note this catches the problem some clients have sending empty fields at the end, like |||
         $buffer =~ s/\015?\012//g;     # Extra line breaks must die

C4/SIP/Sip.pm

@@ -97,6 +97,7 @@ sub add_field {
         );
         $value = '';
     }
+
     $value =~ s/\r\n|\r|\n/ /g;    # CR or LF terminates a sip message
                                    # Protect against them in sip text fields
 
@@ -140,7 +141,7 @@ sub maybe_add {
     }
 
     return ( defined($value) && length($value) )
-        ? add_field( $fid, $value )
+        ? add_field( $fid, $value, $server )
         : '';
 }
 

C4/SIP/Sip/Configuration.pm

@@ -41,13 +41,13 @@ my $parser = XML::Simple->new(
 sub get_configuration {
     my ( $class, $config_file, $current_config ) = @_;
 
-    my $cache                       = Koha::Caches->get_instance();
-    my $sip2_resource_last_modified = $cache->get_from_cache("sip2_resource_last_modified");
+    my $cache = Koha::Caches->get_instance();
 
-    if ($sip2_resource_last_modified) {
-        $cache->set_in_cache( 'sip2_config_read_timestamp', $sip2_resource_last_modified );
-    } else {
-        $cache->set_in_cache( 'sip2_config_read_timestamp', dt_from_string()->epoch );
+    unless ( $cache->get_from_cache("sip2_resource_last_modified") ) {
+
+        # Seed sip2_resource_last_modified so the configuration is not re-read
+        # from the database on every request while the value is missing.
+        $cache->set_in_cache( 'sip2_resource_last_modified', dt_from_string()->epoch );
     }
 
     my $cfg;

C4/SIP/Sip/MsgType.pm

@@ -24,7 +24,8 @@ use Koha::Patrons;
 use Koha::Patron::Attributes;
 use Koha::Plugins;
 use Koha::Items;
-use Koha::DateUtils qw( output_pref );
+use Koha::DateUtils     qw( output_pref );
+use Koha::TemplateUtils qw( process_tt );
 
 use UNIVERSAL::can;
 
@@ -516,6 +517,9 @@ sub build_patron_status {
         $resp .= $patron->build_custom_field_string($server);
         $resp .= $patron->build_patron_attributes_string($server);
 
+        my $branchcode =
+            $server->{account}->{patron_branchcode_in_ao} ? $patron->branchcode : $fields->{ (FID_INST_ID) };
+        $resp .= add_field( FID_INST_ID, $branchcode, $server );
     } else {
 
         # Invalid patron (cardnumber)
@@ -533,9 +537,10 @@ sub build_patron_status {
             and $resp .= add_field( FID_VALID_PATRON, 'N', $server );
 
         $resp .= maybe_add( FID_SCREEN_MSG, INVALID_CARD, $server );
+
+        $resp .= add_field( FID_INST_ID, $fields->{ (FID_INST_ID) }, $server );
     }
 
-    $resp .= add_field( FID_INST_ID, $fields->{ (FID_INST_ID) }, $server );
     return $resp;
 }
 
@@ -621,10 +626,10 @@ sub handle_checkout {
         $resp .= timestamp;
 
         # Now for the variable fields
-        $resp .= add_field( FID_INST_ID,   $inst,           $server );
-        $resp .= add_field( FID_PATRON_ID, $patron_id,      $server );
-        $resp .= add_field( FID_ITEM_ID,   $item_id,        $server );
-        $resp .= add_field( FID_TITLE_ID,  $item->title_id, $server );
+        $resp .= add_field( FID_INST_ID,   $inst,                                                 $server );
+        $resp .= add_field( FID_PATRON_ID, $patron_id,                                            $server );
+        $resp .= add_field( FID_ITEM_ID,   $item_id,                                              $server );
+        $resp .= add_field( FID_TITLE_ID,  _format_title( { item => $item, server => $server } ), $server );
         if ( $item->due_date ) {
             my $due_date =
                 $account->{format_due_date}
@@ -659,7 +664,7 @@ sub handle_checkout {
 
         # If the item is valid, provide the title, otherwise
         # leave it blank
-        $resp .= add_field( FID_TITLE_ID, $item ? $item->title_id : '', $server );
+        $resp .= add_field( FID_TITLE_ID, $item ? _format_title( { item => $item, server => $server } ) : "", $server );
 
         # Due date is required.  Since it didn't get checked out,
         # it's not due, so leave the date blank
@@ -752,14 +757,14 @@ sub handle_checkin {
         $resp .= 'U';
     }
 
-    $resp .= $status->alert ? 'Y' : 'N';
+    $resp .= ( $status->alert || $item->magnetic_media ) ? 'Y' : 'N';
     $resp .= timestamp;
     $resp .= add_field( FID_INST_ID, $inst_id, $server );
     $resp .= add_field( FID_ITEM_ID, $item_id, $server );
 
     if ($item) {
         $resp .= add_field( FID_PERM_LOCN, $item->permanent_location, $server );
-        $resp .= maybe_add( FID_TITLE_ID, $item->title_id, $server );
+        $resp .= maybe_add( FID_TITLE_ID, _format_title( { item => $item, server => $server } ), $server );
         $resp .= $item->build_additional_item_fields_string($server);
     } else {
         $resp .= add_field( FID_PERM_LOCN, "", $server );
@@ -928,19 +933,19 @@ sub login_core {
     my $pwd    = shift;
     my $status = 1;                 # Assume it all works
 
+    # Clear any session state up front, including anything left over from a previous connection
+    # on this preforked worker, so no login_core exit path can leave the caller acting as an
+    # authenticated terminal. Only a successful api_auth below re-establishes the session.
+    delete $server->{$_} foreach qw( account ils institution policy sip_username sip_password );
+
     # Check if this userid is authorized for SIP access
     if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {
         siplog( "LOG_WARNING", "MsgType::login_core: SIP access not authorized for user '$uid'" );
         return 0;
     }
 
-    # Store the active account configuration
-    $server->{account} = $server->{config}->{accounts}->{$uid};
-    my $inst = $server->{account}->{institution};
-    $server->{institution}  = $server->{config}->{institutions}->{$inst};
-    $server->{policy}       = $server->{institution}->{policy};
-    $server->{sip_username} = $uid;
-    $server->{sip_password} = $pwd;
+    # Authenticate before storing the account on the session
+    my $inst = $server->{config}->{accounts}->{$uid}->{institution};
 
     # Authenticate using Koha's internal authentication (checks hashed password in borrowers table)
     my $auth_status = api_auth( $uid, $pwd, $inst );
@@ -952,6 +957,13 @@ sub login_core {
         return 0;
     }
 
+    # Store the active account configuration now user has authenticated
+    $server->{account}      = $server->{config}->{accounts}->{$uid};
+    $server->{institution}  = $server->{config}->{institutions}->{$inst};
+    $server->{policy}       = $server->{institution}->{policy};
+    $server->{sip_username} = $uid;
+    $server->{sip_password} = $pwd;
+
     siplog( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );
 
     #
@@ -1090,7 +1102,8 @@ sub handle_patron_info {
         $resp .= add_count( 'patron_info/recall_items',  scalar @{ $patron->recall_items } );
         $resp .= add_count( 'patron_info/unavail_holds', scalar @{ $patron->unavail_holds } );
 
-        $resp .= add_field( FID_INST_ID, ( $ils->institution_id || 'SIP2' ), $server );
+        my $branchcode = $server->{account}->{patron_branchcode_in_ao} ? $patron->branchcode : $ils->institution_id;
+        $resp .= add_field( FID_INST_ID, ( $branchcode || 'SIP2' ), $server );
 
         # while the patron ID we got from the SC is valid, let's
         # use the one returned from the ILS, just in case...
@@ -1124,13 +1137,6 @@ sub handle_patron_info {
         $resp .= maybe_add( FID_FEE_AMT,  $patron->fee_amount, $server );
         $resp .= add_field( FID_FEE_LMT, $patron->fee_limit, $server );
 
-        # TODO: zero or more item details for 2.0 can go here:
-        #          hold_items
-        #       overdue_items
-        #       charged_items
-        #          fine_items
-        #        recall_items
-
         $resp .= summary_info( $ils, $patron, $summary, $start, $end, $server );
 
         $resp .= maybe_add( FID_HOME_ADDR,  $patron->address,    $server );
@@ -1237,8 +1243,8 @@ sub handle_fee_paid {
     $ils->check_inst_id( $inst_id, "handle_fee_paid" );
 
     my $pay_result = $ils->pay_fee(
-        $patron_id,   $patron_pwd,           $fee_amt, $fee_type, $pay_type, $fee_id, $trans_id, $currency,
-        $is_writeoff, $disallow_overpayment, $register_id
+        $patron_id,   $patron_pwd,           $fee_amt,     $fee_type, $pay_type, $fee_id, $trans_id, $currency,
+        $is_writeoff, $disallow_overpayment, $register_id, $ils->institution
     );
     $status = $pay_result->{status};
     my $pay_response = $pay_result->{pay_response};
@@ -1253,7 +1259,7 @@ sub handle_fee_paid {
         "auto_account_expired" =>
             "Scheduled for automatic renewal and cannot be renewed because the patron's account has expired",
         "auto_renew"                  => "Scheduled for automatic renewal",
-        "auto_too_much_oweing"        => "Scheduled for automatic renewal",
+        "auto_too_much_owing"         => "Scheduled for automatic renewal",
         "on_reserve"                  => "On hold for another patron",
         "patron_restricted"           => "Patron is currently restricted",
         "item_denied_renewal"         => "Item is not allowed renewal",
@@ -1338,8 +1344,8 @@ sub handle_item_information {
             $resp .= maybe_add( FID_SCREEN_MSG, "Item is damaged", $server );
         }
 
-        $resp .= add_field( FID_ITEM_ID,  $item->id,       $server );
-        $resp .= add_field( FID_TITLE_ID, $item->title_id, $server );
+        $resp .= add_field( FID_ITEM_ID,  $item->id,                                             $server );
+        $resp .= add_field( FID_TITLE_ID, _format_title( { item => $item, server => $server } ), $server );
 
         $resp .= maybe_add( FID_MEDIA_TYPE,   $item->sip_media_type,      $server );
         $resp .= maybe_add( FID_PERM_LOCN,    $item->permanent_location,  $server );
@@ -1424,8 +1430,8 @@ sub handle_item_status_update {
         $resp .= $status->ok ? '1' : '0';
         $resp .= timestamp;
 
-        $resp .= add_field( FID_ITEM_ID,  $item->id,       $server );
-        $resp .= add_field( FID_TITLE_ID, $item->title_id, $server );
+        $resp .= add_field( FID_ITEM_ID,  $item->id,                                             $server );
+        $resp .= add_field( FID_TITLE_ID, _format_title( { item => $item, server => $server } ), $server );
         $resp .= maybe_add( FID_ITEM_PROPS, $item->sip_item_properties, $server );
     }
 
@@ -1546,10 +1552,10 @@ sub handle_hold {
 
         ( $status->expiration_date )
             and $resp .= maybe_add( FID_EXPIRATION, timestamp( $status->expiration_date ), $server );
-        $resp .= maybe_add( FID_QUEUE_POS,   $status->queue_position,  $server );
-        $resp .= maybe_add( FID_PICKUP_LOCN, $status->pickup_location, $server );
-        $resp .= maybe_add( FID_ITEM_ID,     $status->item->id,        $server );
-        $resp .= maybe_add( FID_TITLE_ID,    $status->item->title_id,  $server );
+        $resp .= maybe_add( FID_QUEUE_POS,   $status->queue_position,                                       $server );
+        $resp .= maybe_add( FID_PICKUP_LOCN, $status->pickup_location,                                      $server );
+        $resp .= maybe_add( FID_ITEM_ID,     $status->item->id,                                             $server );
+        $resp .= maybe_add( FID_TITLE_ID,    _format_title( { item => $status->item, server => $server } ), $server );
     } else {
 
         # Not ok.  still need required fields
@@ -1613,9 +1619,9 @@ sub handle_renew {
         }
         $resp .= sipbool( desensitize( { status => $status, patron => $patron, server => $server } ) );
         $resp .= timestamp;
-        $resp .= add_field( FID_PATRON_ID, $patron->id,     $server );
-        $resp .= add_field( FID_ITEM_ID,   $item->id,       $server );
-        $resp .= add_field( FID_TITLE_ID,  $item->title_id, $server );
+        $resp .= add_field( FID_PATRON_ID, $patron->id,                                           $server );
+        $resp .= add_field( FID_ITEM_ID,   $item->id,                                             $server );
+        $resp .= add_field( FID_TITLE_ID,  _format_title( { item => $item, server => $server } ), $server );
         if ( $item->due_date ) {
             $resp .= add_field( FID_DUE_DATE, timestamp( $item->due_date ), $server );
         } else {
@@ -1636,10 +1642,13 @@ sub handle_renew {
         # If we found the patron or the item, the return the ILS
         # information, otherwise echo back the information we received
         # from the terminal
-        $resp .= add_field( FID_PATRON_ID, $patron ? $patron->id     : $patron_id, $server );
-        $resp .= add_field( FID_ITEM_ID,   $item   ? $item->id       : $item_id,   $server );
-        $resp .= add_field( FID_TITLE_ID,  $item   ? $item->title_id : $title_id,  $server );
-        $resp .= add_field( FID_DUE_DATE,  '', $server );
+        $resp .= add_field( FID_PATRON_ID, $patron ? $patron->id : $patron_id, $server );
+        $resp .= add_field( FID_ITEM_ID,   $item   ? $item->id   : $item_id,   $server );
+        $resp .= add_field(
+            FID_TITLE_ID, $item ? _format_title( { item => $item, server => $server } ) : $title_id,
+            $server
+        );
+        $resp .= add_field( FID_DUE_DATE, '', $server );
     }
 
     if ( $status->fee_amount ) {
@@ -1895,6 +1904,19 @@ sub desensitize {
     return 1;
 }
 
+sub _format_title {
+    my ($params) = @_;
+    my $server   = $params->{server};
+    my $item     = $params->{item};
+    if ( defined $server->{account}->{aj_field_template} && $server->{account}->{aj_field_template} ne '' ) {
+        return process_tt(
+            $server->{account}->{aj_field_template},
+            { biblio => $item->{object}->biblio, item => $item->{object} }
+        );
+    } else {
+        return $item->title_id;
+    }
+}
 1;
 __END__
 

C4/Scrubber.pm

@@ -88,6 +88,44 @@ my %scrubbertypes = (
             },
         ],
     },
+    opac_virtual_card => {
+        allow => [
+            qw(
+                div span h1 h2 h3 h4 h5 h6 p br
+                ul ol li dl dt dd
+                a img svg
+                strong b em i u
+                hr
+            )
+        ],
+        rules => [
+            div => {
+                class => qr/^[\w\s\-_]+$/,
+                id    => qr/^[\w\-_]+$/,
+            },
+
+            span => {
+                class => qr/^[\w\s\-_]+$/,
+                id    => qr/^[\w\-_]+$/,
+            },
+            p => {
+                class => qr/^[\w\s\-_]+$/,
+                id    => qr/^[\w\-_]+$/,
+            },
+            'svg' => {
+                'id'                  => qr/^[\w\-_]+$/,
+                'class'               => qr/^[\w\s\-_]+$/,
+                'data-barcode'        => qr/^[\w\-_]+$/,
+                'data-barcode-format' => qr/^[\w\-_]+$/,
+            },
+            'img' => {
+                'src'   => qr/^(?:https?:\/\/|\/)/i,
+                'alt'   => 1,
+                'class' => qr/^[\w\s\-_]+$/,
+                'id'    => qr/^[\w\-_]+$/,
+            },
+        ],
+    }
 );
 
 sub new {

C4/Search.pm

@@ -35,8 +35,8 @@ BEGIN {
 
 use C4::Context;
 use C4::Biblio qw( TransformMarcToKoha GetMarcFromKohaField GetFrameworkCode GetAuthorisedValueDesc GetBiblioData );
-use C4::Koha
-    qw( getFacets GetVariationsOfISBN GetNormalizedUPC GetNormalizedEAN GetNormalizedOCLCNumber GetNormalizedISBN getitemtypeimagelocation );
+use C4::Koha   qw( getFacets GetVariationsOfISBN GetNormalizedISBN getitemtypeimagelocation );
+use Koha::Biblio::Metadata::Extractor;
 use Koha::DateUtils;
 use Koha::Libraries;
 use Koha::SearchEngine::QueryBuilder;
@@ -88,8 +88,7 @@ This function attempts to find duplicate records using a hard-coded, fairly simp
 
 sub FindDuplicate {
     my ($record) = @_;
-    my $dbh      = C4::Context->dbh;
-    my $result   = TransformMarcToKoha( { record => $record } );
+    my $result = TransformMarcToKoha( { record => $record } );
     my $sth;
     my $query;
 
@@ -592,6 +591,8 @@ sub getRecords {
                 if ($sorted_facets) {
                     $f->{facets} = $sorted_facets;
                 }
+            } elsif ( C4::Context->preference('FacetOrder') eq 'Stringwise' ) {
+                @{ $f->{facets} } = sort { $a->{facet_label_value} cmp $b->{facet_label_value} } @{ $f->{facets} };
             }
         }
     }
@@ -1659,7 +1660,6 @@ Format results in a form suitable for passing to the template
 # building the HTML output for the template
 sub searchResults {
     my ( $search_context, $searchdesc, $hits, $results_per_page, $offset, $scan, $marcresults, $xslt_variables ) = @_;
-    my $dbh = C4::Context->dbh;
     my @newresults;
 
     require C4::Items;
@@ -1768,9 +1768,10 @@ sub searchResults {
         my $oldbiblio = TransformMarcToKoha( { record => $marcrecord, limit_table => 'no_items' } );
         $oldbiblio->{result_number} = $i + 1;
 
-        $oldbiblio->{normalized_upc}  = GetNormalizedUPC( $marcrecord, $marcflavour );
-        $oldbiblio->{normalized_ean}  = GetNormalizedEAN( $marcrecord, $marcflavour );
-        $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber( $marcrecord, $marcflavour );
+        my $extractor = Koha::Biblio::Metadata::Extractor->new( { metadata => $marcrecord } );
+        $oldbiblio->{normalized_upc}  = $extractor->get_normalized_upc;
+        $oldbiblio->{normalized_ean}  = $extractor->get_normalized_ean;
+        $oldbiblio->{normalized_oclc} = $extractor->get_normalized_oclc;
         $oldbiblio->{normalized_isbn} = GetNormalizedISBN( $oldbiblio->{isbn}, $marcrecord, $marcflavour )
             ;    # Use existing ISBN from record if we got one
         $oldbiblio->{content_identifier_exists} = 1
@@ -1955,6 +1956,7 @@ sub searchResults {
                 # is item a waiting recall?
                 my $recallstatus = '';
 
+                # Check some statuses before checking transfer info, respect MaxSearchResultsItemsPerRecordStatusCheck
                 unless (
                        $item->{withdrawn}
                     || $item->{itemlost}
@@ -1965,20 +1967,12 @@ sub searchResults {
                     )
                 {
 
-                    # A couple heuristics to limit how many times
-                    # we query the database for item transfer information, sacrificing
-                    # accuracy in some cases for speed;
-                    #
-                    # 1. don't query if item has one of the other statuses
-                    # 2. don't check transit status if the bib has
-                    #    more than 20 items
-                    #
-                    # FIXME: to avoid having the query the database like this, and to make
-                    #        the in transit status count as unavailable for search limiting,
-                    #        should map transit status to record indexed in Zebra.
-
-                    my $item_object = Koha::Items->find( $item->{itemnumber} );
-                    my $transfer    = defined($item_object) ? $item_object->get_transfer : undef;
+                    # NOTE: We are bypassing an expected Koha::Item->get_transfer call here for speed.
+                    # TODO: Could we index the transfer status ?
+                    my $transfer = Koha::Item::Transfers->search(
+                        { itemnumber => $item->{itemnumber}, datearrived => undef, datecancelled => undef },
+                        { order_by   => [ { '-desc' => 'datesent' }, { '-asc' => 'daterequested' } ] }
+                    )->next;
                     ( $transfertwhen, $transfertfrom, $transfertto ) = defined($transfer)
                         ? (
                         $transfer->datesent, $transfer->frombranch,
@@ -1986,7 +1980,7 @@ sub searchResults {
                         )
                         : ( '', '', '' );
                     $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} );
-                    if ( C4::Context->preference('UseRecalls') ) {
+                    if ( C4::Context->preference('UseRecalls') ne "off" ) {
                         if ( Koha::Recalls->search( { item_id => $item->{itemnumber}, status => 'waiting' } )->count ) {
                             $recallstatus = 'Waiting';
                         }

C4/Serials.pm

@@ -325,7 +325,8 @@ sub GetFullSubscription {
             aqbooksellers.name as aqbooksellername,
             biblio.title as bibliotitle,
             subscription.branchcode AS branchcode,
-            subscription.subscriptionid AS subscriptionid
+            subscription.subscriptionid AS subscriptionid,
+            subscription.preselect_issues_in_collections_table AS preselect_issues_in_collections_table
   FROM      serial 
   LEFT JOIN subscription ON 
           (serial.subscriptionid=subscription.subscriptionid )
@@ -351,13 +352,13 @@ sub GetFullSubscription {
 
 =head2 PrepareSerialsData
 
-   $array_ref = PrepareSerialsData($serialinfomation)
-   where serialinformation is a hashref array
+   $array_ref = PrepareSerialsData($serialinfomation, $add_itemnumbers)
+   where serialinformation is a hashref array and add_itemnumbers is a boolean
 
 =cut
 
 sub PrepareSerialsData {
-    my ($lines) = @_;
+    my ( $lines, $add_itemnumbers ) = @_;
 
     return unless ($lines);
 
@@ -370,9 +371,15 @@ sub PrepareSerialsData {
 
     foreach my $subs ( @{$lines} ) {
         $subs->{ "status" . $subs->{'status'} } = 1;
-        if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
+        if ( $subs->{preselect_issues_in_collections_table} && grep { $_ == $subs->{status} }
+            ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) )
+        {
             $subs->{"checked"} = 1;
         }
+        if ($add_itemnumbers) {
+            my $serialitem = Koha::Serial::Items->find( { serialid => $subs->{'serialid'} } );
+            $subs->{"itemnumber"} = $serialitem->itemnumber if $serialitem;
+        }
 
         if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
             $year = $subs->{'year'};
@@ -466,7 +473,8 @@ sub GetFullSubscriptionsFromBiblionumber {
             biblio.title as bibliotitle,
             subscription.branchcode AS branchcode,
             subscription.subscriptionid AS subscriptionid,
-            subscription.location AS location
+            subscription.location AS location,
+            subscription.preselect_issues_in_collections_table AS preselect_issues_in_collections_table
   FROM      serial 
   LEFT JOIN subscription ON 
           (serial.subscriptionid=subscription.subscriptionid)
@@ -810,7 +818,7 @@ sub GetPreviousSerialid {
     my (
         $nextseq,       $newlastvalue1, $newlastvalue2, $newlastvalue3,
         $newinnerloop1, $newinnerloop2, $newinnerloop3
-    ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate, $count_forward );
+    ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate, $nextpublisheddate, $count_forward );
 
 $subscription is a hashref containing all the attributes of the table
 'subscription'.
@@ -818,13 +826,14 @@ $pattern is a hashref containing all the attributes of the table
 'subscription_numberpatterns'.
 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
 $planneddate is a date string in iso format.
+$nextpublishedddate is a date string in iso format.
 $count_forward is the number of issues to count forward, defaults to 1 if omitted
 This function get the next issue for the subscription given on input arg
 
 =cut
 
 sub GetNextSeq {
-    my ( $subscription, $pattern, $frequency, $planneddate, $count_forward ) = @_;
+    my ( $subscription, $pattern, $frequency, $planneddate, $nextpublisheddate, $count_forward ) = @_;
 
     return unless ( $subscription and $pattern );
 
@@ -915,7 +924,7 @@ sub GetNextSeq {
             $calculated =~ s/\{Z\}/$newlastvalue3string/g;
         }
 
-        my $dt = dt_from_string($planneddate);
+        my $dt = dt_from_string($nextpublisheddate);
         $calculated =~ s/\{Month\}/$dt->month/eg;
         $calculated =~ s/\{MonthName\}/$dt->month_name/eg;
         $calculated =~ s/\{Year\}/$dt->year/eg;
@@ -1167,15 +1176,16 @@ sub ModSerialStatus {
         my $pattern      = C4::Serials::Numberpattern::GetSubscriptionNumberpattern( $subscription->{numberpattern} );
         my $frequency    = C4::Serials::Frequency::GetSubscriptionFrequency( $subscription->{periodicity} );
 
+        # next date (calculated from actual date & frequency parameters)
+        my $nextpublisheddate = GetNextDate( $subscription, $publisheddate, $frequency, 1 );
+        my $nextpubdate       = $nextpublisheddate;
+
         # next issue number
         my (
             $newserialseq,  $newlastvalue1, $newlastvalue2, $newlastvalue3,
             $newinnerloop1, $newinnerloop2, $newinnerloop3
-        ) = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate, $count );
+        ) = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate, $nextpublisheddate, $count );
 
-        # next date (calculated from actual date & frequency parameters)
-        my $nextpublisheddate = GetNextDate( $subscription, $publisheddate, $frequency, 1 );
-        my $nextpubdate       = $nextpublisheddate;
         $query =
             "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
                     WHERE  subscriptionid = ?";
@@ -1207,7 +1217,7 @@ sub _handle_seqno {
 
     my ( $seq, $list, $op ) = @_;    # op = ADD | REMOVE | CHECK (default: ADD)
     my $seq_r = $seq;
-    $seq_r =~ s/([()])/\\$1/g;       # Adjust disturbing parentheses for regex, maybe extend in future
+    $seq_r =~ s/([(){}])/\\$1/g;     # Adjust disturbing parentheses for regex, maybe extend in future
 
     if ( !$op or $op eq 'ADD' ) {
         $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
@@ -1337,58 +1347,59 @@ returns the number of rows affected
 
 sub ModSubscription {
     my (
-        $auser,         $branchcode,       $aqbooksellerid,    $cost,          $aqbudgetid, $startdate,
-        $periodicity,   $firstacquidate,   $irregularity,      $numberpattern, $locale,
-        $numberlength,  $weeklength,       $monthlength,       $lastvalue1,    $innerloop1,
-        $lastvalue2,    $innerloop2,       $lastvalue3,        $innerloop3,    $status,
-        $biblionumber,  $callnumber,       $notes,             $letter,        $manualhistory,
-        $internalnotes, $serialsadditems,  $staffdisplaycount, $opacdisplaycount,
-        $graceperiod,   $location,         $enddate,           $subscriptionid, $skip_serialseq,
-        $itemtype,      $previousitemtype, $mana_id,           $ccode,          $published_on_template
+        $auser,         $branchcode,      $aqbooksellerid,    $cost,          $aqbudgetid, $startdate,
+        $periodicity,   $firstacquidate,  $irregularity,      $numberpattern, $locale,
+        $numberlength,  $weeklength,      $monthlength,       $lastvalue1,    $innerloop1,
+        $lastvalue2,    $innerloop2,      $lastvalue3,        $innerloop3,    $status,
+        $biblionumber,  $callnumber,      $notes,             $letter,        $manualhistory,
+        $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
+        $graceperiod,   $location,        $enddate,           $subscriptionid, $skip_serialseq,
+        $itemtype, $previousitemtype, $mana_id, $ccode, $published_on_template, $preselect_issues_in_collections_table
     ) = @_;
 
     my $subscription = Koha::Subscriptions->find($subscriptionid);
     $subscription->set(
         {
-            librarian             => $auser,
-            branchcode            => $branchcode,
-            aqbooksellerid        => $aqbooksellerid,
-            cost                  => $cost,
-            aqbudgetid            => $aqbudgetid,
-            biblionumber          => $biblionumber,
-            startdate             => $startdate,
-            periodicity           => $periodicity,
-            numberlength          => $numberlength,
-            weeklength            => $weeklength,
-            monthlength           => $monthlength,
-            lastvalue1            => $lastvalue1,
-            innerloop1            => $innerloop1,
-            lastvalue2            => $lastvalue2,
-            innerloop2            => $innerloop2,
-            lastvalue3            => $lastvalue3,
-            innerloop3            => $innerloop3,
-            status                => $status,
-            notes                 => $notes,
-            letter                => $letter,
-            firstacquidate        => $firstacquidate,
-            irregularity          => $irregularity,
-            numberpattern         => $numberpattern,
-            locale                => $locale,
-            callnumber            => $callnumber,
-            manualhistory         => $manualhistory,
-            internalnotes         => $internalnotes,
-            serialsadditems       => $serialsadditems,
-            staffdisplaycount     => $staffdisplaycount,
-            opacdisplaycount      => $opacdisplaycount,
-            graceperiod           => $graceperiod,
-            location              => $location,
-            enddate               => $enddate,
-            skip_serialseq        => $skip_serialseq,
-            itemtype              => $itemtype,
-            previousitemtype      => $previousitemtype,
-            mana_id               => $mana_id,
-            ccode                 => $ccode,
-            published_on_template => $published_on_template,
+            librarian                             => $auser,
+            branchcode                            => $branchcode,
+            aqbooksellerid                        => $aqbooksellerid,
+            cost                                  => $cost,
+            aqbudgetid                            => $aqbudgetid,
+            biblionumber                          => $biblionumber,
+            startdate                             => $startdate,
+            periodicity                           => $periodicity,
+            numberlength                          => $numberlength,
+            weeklength                            => $weeklength,
+            monthlength                           => $monthlength,
+            lastvalue1                            => $lastvalue1,
+            innerloop1                            => $innerloop1,
+            lastvalue2                            => $lastvalue2,
+            innerloop2                            => $innerloop2,
+            lastvalue3                            => $lastvalue3,
+            innerloop3                            => $innerloop3,
+            status                                => $status,
+            notes                                 => $notes,
+            letter                                => $letter,
+            firstacquidate                        => $firstacquidate,
+            irregularity                          => $irregularity,
+            numberpattern                         => $numberpattern,
+            locale                                => $locale,
+            callnumber                            => $callnumber,
+            manualhistory                         => $manualhistory,
+            internalnotes                         => $internalnotes,
+            serialsadditems                       => $serialsadditems,
+            staffdisplaycount                     => $staffdisplaycount,
+            opacdisplaycount                      => $opacdisplaycount,
+            graceperiod                           => $graceperiod,
+            location                              => $location,
+            enddate                               => $enddate,
+            skip_serialseq                        => $skip_serialseq,
+            itemtype                              => $itemtype,
+            previousitemtype                      => $previousitemtype,
+            mana_id                               => $mana_id,
+            ccode                                 => $ccode,
+            published_on_template                 => $published_on_template,
+            preselect_issues_in_collections_table => $preselect_issues_in_collections_table || 0,
         }
     )->store;
 
@@ -1421,58 +1432,59 @@ the id of this new subscription
 
 sub NewSubscription {
     my (
-        $auser,           $branchcode,        $aqbooksellerid,   $cost,          $aqbudgetid, $biblionumber,
-        $startdate,       $periodicity,       $numberlength,     $weeklength,    $monthlength,
-        $lastvalue1,      $innerloop1,        $lastvalue2,       $innerloop2,    $lastvalue3,
-        $innerloop3,      $status,            $notes,            $letter,        $firstacquidate, $irregularity,
-        $numberpattern,   $locale,            $callnumber,       $manualhistory, $internalnotes,
-        $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
-        $location,        $enddate,           $skip_serialseq,   $itemtype, $previousitemtype, $mana_id, $ccode,
-        $published_on_template,
+        $auser,                 $branchcode,        $aqbooksellerid,   $cost,          $aqbudgetid, $biblionumber,
+        $startdate,             $periodicity,       $numberlength,     $weeklength,    $monthlength,
+        $lastvalue1,            $innerloop1,        $lastvalue2,       $innerloop2,    $lastvalue3,
+        $innerloop3,            $status,            $notes,            $letter,        $firstacquidate, $irregularity,
+        $numberpattern,         $locale,            $callnumber,       $manualhistory, $internalnotes,
+        $serialsadditems,       $staffdisplaycount, $opacdisplaycount, $graceperiod,
+        $location,              $enddate,           $skip_serialseq,   $itemtype, $previousitemtype, $mana_id, $ccode,
+        $published_on_template, $preselect_issues_in_collections_table
     ) = @_;
     my $dbh = C4::Context->dbh;
 
     my $subscription = Koha::Subscription->new(
         {
-            librarian             => $auser,
-            branchcode            => $branchcode,
-            aqbooksellerid        => $aqbooksellerid,
-            cost                  => $cost,
-            aqbudgetid            => $aqbudgetid,
-            biblionumber          => $biblionumber,
-            startdate             => $startdate,
-            periodicity           => $periodicity,
-            numberlength          => $numberlength,
-            weeklength            => $weeklength,
-            monthlength           => $monthlength,
-            lastvalue1            => $lastvalue1,
-            innerloop1            => $innerloop1,
-            lastvalue2            => $lastvalue2,
-            innerloop2            => $innerloop2,
-            lastvalue3            => $lastvalue3,
-            innerloop3            => $innerloop3,
-            status                => $status,
-            notes                 => $notes,
-            letter                => $letter,
-            firstacquidate        => $firstacquidate,
-            irregularity          => $irregularity,
-            numberpattern         => $numberpattern,
-            locale                => $locale,
-            callnumber            => $callnumber,
-            manualhistory         => $manualhistory,
-            internalnotes         => $internalnotes,
-            serialsadditems       => $serialsadditems,
-            staffdisplaycount     => $staffdisplaycount,
-            opacdisplaycount      => $opacdisplaycount,
-            graceperiod           => $graceperiod,
-            location              => $location,
-            enddate               => $enddate,
-            skip_serialseq        => $skip_serialseq,
-            itemtype              => $itemtype,
-            previousitemtype      => $previousitemtype,
-            mana_id               => $mana_id,
-            ccode                 => $ccode,
-            published_on_template => $published_on_template,
+            librarian                             => $auser,
+            branchcode                            => $branchcode,
+            aqbooksellerid                        => $aqbooksellerid,
+            cost                                  => $cost,
+            aqbudgetid                            => $aqbudgetid,
+            biblionumber                          => $biblionumber,
+            startdate                             => $startdate,
+            periodicity                           => $periodicity,
+            numberlength                          => $numberlength,
+            weeklength                            => $weeklength,
+            monthlength                           => $monthlength,
+            lastvalue1                            => $lastvalue1,
+            innerloop1                            => $innerloop1,
+            lastvalue2                            => $lastvalue2,
+            innerloop2                            => $innerloop2,
+            lastvalue3                            => $lastvalue3,
+            innerloop3                            => $innerloop3,
+            status                                => $status,
+            notes                                 => $notes,
+            letter                                => $letter,
+            firstacquidate                        => $firstacquidate,
+            irregularity                          => $irregularity,
+            numberpattern                         => $numberpattern,
+            locale                                => $locale,
+            callnumber                            => $callnumber,
+            manualhistory                         => $manualhistory,
+            internalnotes                         => $internalnotes,
+            serialsadditems                       => $serialsadditems,
+            staffdisplaycount                     => $staffdisplaycount,
+            opacdisplaycount                      => $opacdisplaycount,
+            graceperiod                           => $graceperiod,
+            location                              => $location,
+            enddate                               => $enddate,
+            skip_serialseq                        => $skip_serialseq,
+            itemtype                              => $itemtype,
+            previousitemtype                      => $previousitemtype,
+            mana_id                               => $mana_id,
+            ccode                                 => $ccode,
+            published_on_template                 => $published_on_template,
+            preselect_issues_in_collections_table => $preselect_issues_in_collections_table || 0,
         }
     )->store;
     $subscription->discard_changes;

C4/ShelfBrowser.pm

@@ -28,7 +28,7 @@ BEGIN {
 
 use C4::Biblio qw( GetAuthorisedValueDesc );
 use C4::Context;
-use C4::Koha qw( GetNormalizedUPC GetNormalizedOCLCNumber GetNormalizedISBN GetNormalizedEAN );
+use C4::Koha qw( GetNormalizedISBN );
 use Koha::Biblios;
 use Koha::Libraries;
 
@@ -235,10 +235,10 @@ sub GetShelfInfo {
         $item->{part_number}   = $biblio->part_number;
         $item->{part_name}     = $biblio->part_name;
         my $this_record = $biblio->metadata->record;
-        $item->{'browser_normalized_upc'}  = GetNormalizedUPC( $this_record, $marcflavour );
-        $item->{'browser_normalized_oclc'} = GetNormalizedOCLCNumber( $this_record, $marcflavour );
+        $item->{'browser_normalized_upc'}  = $biblio->normalized_upc;
+        $item->{'browser_normalized_oclc'} = $biblio->normalized_oclc;
         $item->{'browser_normalized_isbn'} = GetNormalizedISBN( undef, $this_record, $marcflavour );
-        $item->{'browser_normalized_ean'}  = GetNormalizedEAN( $this_record, $marcflavour );
+        $item->{'browser_normalized_ean'}  = $biblio->normalized_ean;
         push @valid_items, $item;
     }
     return @valid_items;

C4/SocialData.pm

@@ -110,7 +110,7 @@ sub update_data {
             $i++;
         }
     }
-    say "$i data insered or updated";
+    say "$i data inserted or updated";
 }
 
 =head2 get_report

C4/Suggestions.pm

@@ -23,16 +23,10 @@ use base 'Exporter';
 
 BEGIN {
     our @EXPORT = qw(
-        ConnectSuggestionAndBiblio
         DelSuggestion
         GetSuggestion
-        GetSuggestionByStatus
-        GetSuggestionFromBiblionumber
-        GetSuggestionInfoFromBiblionumber
-        GetSuggestionInfo
         ModStatus
         ModSuggestion
-        DelSuggestionsOlderThan
         GetUnprocessedSuggestions
         MarcRecordFromNewSuggestion
     );
@@ -73,168 +67,6 @@ Suggestions done by other borrowers can be seen when not "AVAILABLE"
 
 =head1 FUNCTIONS
 
-=head2 GetSuggestion
-
-\%sth = &GetSuggestion($suggestionid)
-
-this function get the detail of the suggestion $suggestionid (input arg)
-
-return :
-    the result of the SQL query as a hash : $sth->fetchrow_hashref.
-
-=cut
-
-sub GetSuggestion {
-    my ($suggestionid) = @_;
-    my $dbh            = C4::Context->dbh;
-    my $query          = q{
-        SELECT *
-        FROM   suggestions
-        WHERE  suggestionid=?
-    };
-    my $sth = $dbh->prepare($query);
-    $sth->execute($suggestionid);
-    return ( $sth->fetchrow_hashref );
-}
-
-=head2 GetSuggestionFromBiblionumber
-
-$ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
-
-Get a suggestion from it's biblionumber.
-
-return :
-the id of the suggestion which is related to the biblionumber given on input args.
-
-=cut
-
-sub GetSuggestionFromBiblionumber {
-    my ($biblionumber) = @_;
-    my $query = q{
-        SELECT suggestionid
-        FROM   suggestions
-        WHERE  biblionumber=? LIMIT 1
-    };
-    my $dbh = C4::Context->dbh;
-    my $sth = $dbh->prepare($query);
-    $sth->execute($biblionumber);
-    my ($suggestionid) = $sth->fetchrow;
-    return $suggestionid;
-}
-
-=head2 GetSuggestionInfoFromBiblionumber
-
-Get a suggestion and borrower's information from it's biblionumber.
-
-return :
-all information (suggestion and borrower) of the suggestion which is related to the biblionumber given.
-
-=cut
-
-sub GetSuggestionInfoFromBiblionumber {
-    my ($biblionumber) = @_;
-    my $query = q{
-        SELECT suggestions.*,
-            U1.surname          AS surnamesuggestedby,
-            U1.firstname        AS firstnamesuggestedby,
-            U1.borrowernumber   AS borrnumsuggestedby
-        FROM suggestions
-            LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
-        WHERE biblionumber=?
-        LIMIT 1
-    };
-    my $dbh = C4::Context->dbh;
-    my $sth = $dbh->prepare($query);
-    $sth->execute($biblionumber);
-    return $sth->fetchrow_hashref;
-}
-
-=head2 GetSuggestionInfo
-
-Get a suggestion and borrower's information from it's suggestionid
-
-return :
-all information (suggestion and borrower) of the suggestion which is related to the suggestionid given.
-
-=cut
-
-sub GetSuggestionInfo {
-    my ($suggestionid) = @_;
-    my $query = q{
-        SELECT suggestions.*,
-            U1.surname          AS surnamesuggestedby,
-            U1.firstname        AS firstnamesuggestedby,
-            U1.borrowernumber   AS borrnumsuggestedby
-        FROM suggestions
-            LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
-        WHERE suggestionid=?
-        LIMIT 1
-    };
-    my $dbh = C4::Context->dbh;
-    my $sth = $dbh->prepare($query);
-    $sth->execute($suggestionid);
-    return $sth->fetchrow_hashref;
-}
-
-=head2 GetSuggestionByStatus
-
-$aqorders = &GetSuggestionByStatus($status,[$branchcode])
-
-Get a suggestion from it's status
-
-return :
-all the suggestion with C<$status>
-
-=cut
-
-sub GetSuggestionByStatus {
-    my $status     = shift;
-    my $branchcode = shift;
-    my $dbh        = C4::Context->dbh;
-    my @sql_params = ($status);
-    my $query      = q{
-        SELECT suggestions.*,
-            U1.surname          AS surnamesuggestedby,
-            U1.firstname        AS firstnamesuggestedby,
-            U1.branchcode       AS branchcodesuggestedby,
-            B1.branchname       AS branchnamesuggestedby,
-            U1.borrowernumber   AS borrnumsuggestedby,
-            U1.categorycode     AS categorycodesuggestedby,
-            C1.description      AS categorydescriptionsuggestedby,
-            U2.surname          AS surnamemanagedby,
-            U2.firstname        AS firstnamemanagedby,
-            U2.borrowernumber   AS borrnummanagedby
-        FROM suggestions
-            LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
-            LEFT JOIN borrowers     AS U2 ON managedby=U2.borrowernumber
-            LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
-            LEFT JOIN branches      AS B1 on B1.branchcode=U1.branchcode
-        WHERE status = ?
-        ORDER BY suggestionid
-    };
-
-    # filter on branch
-    if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
-        my $userenv = C4::Context->userenv;
-        if ($userenv) {
-            unless ( C4::Context->IsSuperLibrarian() ) {
-                push @sql_params, $userenv->{branch};
-                $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
-            }
-        }
-        if ($branchcode) {
-            push @sql_params, $branchcode;
-            $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
-        }
-    }
-
-    my $sth = $dbh->prepare($query);
-    $sth->execute(@sql_params);
-    my $results;
-    $results = $sth->fetchall_arrayref( {} );
-    return $results;
-}
-
 =head2 ModSuggestion
 
 &ModSuggestion($suggestion)
@@ -267,14 +99,14 @@ sub ModSuggestion {
     {
 
         # fetch the entire updated suggestion so that we can populate the letter
-        my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
+        my $full_suggestion = Koha::Suggestions->find( $suggestion->{suggestionid} )->unblessed();
 
         my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
 
         my $transport =
                ( C4::Context->preference("FallbackToSMSIfNoEmail") )
             && ( $patron->smsalertnumber )
-            && ( !$patron->email ) ? 'sms' : 'email';
+            && ( !$patron->notice_email_address ) ? 'sms' : 'email';
 
         if (
             my $letter = C4::Letters::GetPreparedLetter(
@@ -306,26 +138,6 @@ sub ModSuggestion {
     return 1;    # No useful if the exception is raised earlier
 }
 
-=head2 ConnectSuggestionAndBiblio
-
-&ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
-
-connect a suggestion to an existing biblio
-
-=cut
-
-sub ConnectSuggestionAndBiblio {
-    my ( $suggestionid, $biblionumber ) = @_;
-    my $dbh   = C4::Context->dbh;
-    my $query = q{
-        UPDATE suggestions
-        SET    biblionumber=?
-        WHERE  suggestionid=?
-    };
-    my $sth = $dbh->prepare($query);
-    $sth->execute( $biblionumber, $suggestionid );
-}
-
 =head2 DelSuggestion
 
 &DelSuggestion($borrowernumber,$ordernumber)
@@ -351,41 +163,20 @@ sub DelSuggestion {
     $borrowernumber //= '';
 
     if ( defined $type && $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
+        my $suggestion = Koha::Suggestions->find($suggestionid);
+        if ( C4::Context->preference("SuggestionsLog") ) {
+            logaction( 'SUGGESTION', 'DELETE', $suggestionid, $suggestion, undef, $suggestion );
+        }
         my $queryDelete = q{
             DELETE FROM suggestions
             WHERE suggestionid=?
         };
         $sth = $dbh->prepare($queryDelete);
         my $suggestiondeleted = $sth->execute($suggestionid);
-        if ( C4::Context->preference("SuggestionsLog") ) {
-            logaction( 'SUGGESTION', 'DELETE', $suggestionid, '' );
-        }
         return $suggestiondeleted;
     }
 }
 
-=head2 DelSuggestionsOlderThan
-    &DelSuggestionsOlderThan($days)
-
-    Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
-    We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
-
-=cut
-
-sub DelSuggestionsOlderThan {
-    my ($days) = @_;
-    return unless $days && $days > 0;
-    my $dbh = C4::Context->dbh;
-    my $sth = $dbh->prepare(
-        q{
-        DELETE FROM suggestions
-        WHERE STATUS<>'ASKED'
-            AND manageddate < ADDDATE(NOW(), ?)
-    }
-    );
-    $sth->execute("-$days");
-}
-
 =head2 GetUnprocessedSuggestions
 
 Missing POD for GetUnprocessedSuggestions.

C4/Tags.pm

@@ -22,6 +22,8 @@ use Modern::Perl;
 use base 'Exporter';
 use C4::Context;
 
+use Module::Load::Conditional qw( check_install );
+
 BEGIN {
     our @EXPORT_OK = qw(
         get_tags get_tag_rows
@@ -54,7 +56,6 @@ BEGIN {
 
 use Carp qw( carp );
 
-use Module::Load::Conditional qw( check_install );
 use Koha::Tags;
 use Koha::Tags::Approvals;
 use Koha::Tags::Indexes;

C4/Templates.pm

@@ -179,10 +179,6 @@ C4::Templates - Functions for managing templates
 
 =cut
 
-# FIXME: this is a quick fix to stop rc1 installing broken
-# Still trying to figure out the correct fix.
-my $path = C4::Context->config('intrahtdocs') . "/prog/en/includes/";
-
 #---------------------------------------------------------------------------------------------------------
 # FIXME - POD
 

C4/UsageStats.pm

@@ -160,11 +160,11 @@ sub _shared_preferences {
         PrefillItem
         z3950NormalizeAuthor
         SpineLabelAutoPrint
-        SpineLabelShowPrintOnBibDetails
         BlockReturnOfLostItems
         BlockReturnOfWithdrawnItems
         CalculateFinesOnReturn
         AgeRestrictionOverride
+        PatronAgeRestriction
         AllFinesNeedOverride
         AllowFineOverride
         AllowItemsOnHoldCheckoutSIP
@@ -180,7 +180,8 @@ sub _shared_preferences {
         IssueLostItem
         IssuingInProcess
         OverduesBlockCirc
-        RenewalPeriodBase
+        ManualRenewalPeriodBase
+        AutomaticRenewalPeriodBase
         RenewalSendNotice
         ReturnBeforeExpiry
         TransfersMaxDaysWarning
@@ -193,7 +194,14 @@ sub _shared_preferences {
         RefundLostOnReturnControl
         WhenLostChargeReplacementFee
         WhenLostForgiveFine
+        FineNoRenewals
+        FineNoRenewalsBlockAutoRenew
+        FineNoRenewalsBlockSelfCheckRenew
+        FineNoRenewalsIncludeCredits
         AllowHoldDateInFuture
+        OPACAllowHoldDateInFuture
+        ConfirmFutureHolds
+        FutureHoldsBlockRenewals
         AllowHoldItemTypeSelection
         AllowHoldPolicyOverride
         AllowHoldsOnDamagedItems
@@ -204,7 +212,6 @@ sub _shared_preferences {
         DisplayMultiPlaceHold
         emailLibrarianWhenHoldIsPlaced
         ExpireReservesMaxPickUpDelay
-        OPACAllowHoldDateInFuture
         OPACAllowUserToChooseBranch
         ReservesControlBranch
         ReservesNeedReturns
@@ -234,7 +241,7 @@ sub _shared_preferences {
         AmazonCoverImages
         OPACAmazonCoverImages
         Babeltheque
-        BakerTaylorEnabled
+        EnableZotero
         GoogleJackets
         HTML5MediaEnabled
         LibraryThingForLibrariesEnabled
@@ -314,6 +321,7 @@ sub _shared_preferences {
         autoMemberNum
         BorrowerRenewalPeriodBase
         EnableBorrowerFiles
+        LimitReportsByLibrary
         EnhancedMessagingPreferences
         ExtendedPatronAttributes
         intranetreadinghistory
@@ -351,6 +359,7 @@ sub _shared_preferences {
         ILS-DI
         OAI-PMH
         version
+        UseRecalls
         /;
 
     return \@preferences;

C4/Utils/DataTables/VirtualShelves.pm

@@ -16,7 +16,7 @@ sub search {
     my $start    = $params->{start};
     my $length   = $params->{length};
 
-    # If not logged in user, be carreful and set the borrowernumber to 0
+    # If not logged in user, be careful and set the borrowernumber to 0
     # to prevent private lists lack
     my $loggedinuser = C4::Context->userenv->{'number'} || 0;
 

C4/XISBN.pm

@@ -51,7 +51,6 @@ This module provides facilities for retrieving ThingISBN and XISBN content in Ko
 
 sub _get_biblio_from_xisbn {
     my $xisbn = shift;
-    my $dbh   = C4::Context->dbh;
 
     my $searcher = Koha::SearchEngine::Search->new( { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
     my ( $errors, $results, $total_hits ) = $searcher->simple_search_compat( "nb=$xisbn", 0, 1 );

C4/XSLT.pm

@@ -39,6 +39,7 @@ use C4::Koha   qw( xml_escape );
 use C4::Biblio qw( GetAuthorisedValueDesc GetFrameworkCode GetMarcStructure );
 use Koha::AuthorisedValues;
 use Koha::ItemTypes;
+use Koha::Plugins;
 use Koha::RecordProcessor;
 use Koha::Libraries;
 use Koha::Recalls;
@@ -65,6 +66,12 @@ The helper function _get_best_default_xslt_filename is used in a unit test.
 
 =cut
 
+=head2 _get_best_default_xslt_filename
+
+Find the default file, trying a few standard variations, until the file is located
+
+=cut
+
 sub _get_best_default_xslt_filename {
     my ( $htdocs, $theme, $lang, $base_xslfile ) = @_;
 
@@ -197,10 +204,23 @@ sub XSLTParse4Display {
 
     my $xslfilename = get_xsl_filename($xslsyspref);
 
-    my $frameworkcode    = GetFrameworkCode($biblionumber) || '';
+    my $frameworkcode = GetFrameworkCode($biblionumber) || '';
+    my $filters       = ['ExpandCodedFields'];
+
+    Koha::Plugins->call(
+        'xslt_record_processor_filters',
+        {
+            filters       => $filters,
+            interface     => $interface,
+            frameworkcode => $frameworkcode,
+            xsl_syspref   => $xslsyspref,
+            biblionumber  => $biblionumber,
+        }
+    );
+
     my $record_processor = Koha::RecordProcessor->new(
         {
-            filters => ['ExpandCodedFields'],
+            filters => $filters,
             options => {
                 interface     => $interface,
                 frameworkcode => $frameworkcode
@@ -365,7 +385,7 @@ sub buildKohaItemsNamespace {
         my $substatus = '';
         my $recalls_count;
 
-        if ( C4::Context->preference('UseRecalls') ) {
+        if ( C4::Context->preference('UseRecalls') ne "off" ) {
             $recalls_count = Koha::Recalls->search( { item_id => $item->itemnumber, status => 'waiting' } )->count;
         }
 

Koha.pm

@@ -29,7 +29,7 @@ use vars qw{ $VERSION };
 # - #4 : the developer version. The 4th number is the database subversion.
 #        used by developers when the database changes. updatedatabase take care of the changes itself
 #        and is automatically called by Auth.pm when needed.
-$VERSION = "25.11.00.000";
+$VERSION = "26.06.00.030";
 
 sub version {
     return $VERSION;

Koha/Account.pm

@@ -25,7 +25,6 @@ use Try::Tiny    qw( catch try );
 
 use C4::Letters;
 use C4::Log      qw( logaction );
-use C4::Stats    qw( UpdateStats );
 use C4::Overdues qw(GetFine);
 use C4::Context;
 
@@ -38,6 +37,7 @@ use Koha::Account::DebitTypes;
 use Koha::Exceptions;
 use Koha::Exceptions::Account;
 use Koha::Plugins;
+use Koha::Statistics;
 
 =head1 NAME
 
@@ -286,7 +286,7 @@ sub add_credit {
                     }
                 )->store();
 
-                C4::Stats::UpdateStats(
+                Koha::Statistic->new(
                     {
                         branch         => $library_id,
                         type           => lc($credit_type),
@@ -294,7 +294,8 @@ sub add_credit {
                         borrowernumber => $self->{patron_id},
                         interface      => $interface,
                     }
-                ) if grep { $credit_type eq $_ } ( 'PAYMENT', 'WRITEOFF' );
+                )->store()
+                    if grep { $credit_type eq $_ } ( 'PAYMENT', 'WRITEOFF' );
 
                 Koha::Plugins->call(
                     'after_account_action',

Koha/Account/Line.pm

@@ -28,6 +28,9 @@ use Koha::Database;
 use Koha::DateUtils qw( dt_from_string );
 use Koha::Exceptions::Account;
 use Koha::Patron::Debarments;
+use Koha::Notice::Templates;
+use C4::Letters;
+use C4::Scrubber;
 
 use base qw(Koha::Object Koha::Object::Mixin::AdditionalFields);
 
@@ -848,15 +851,32 @@ sub adjust {
 
             # Catch cases that require patron refunds
             if ( $new_outstanding < 0 ) {
-                my $account = Koha::Patrons->find( $self->borrowernumber )->account;
-                my $credit  = $account->add_credit(
-                    {
-                        amount    => $new_outstanding * -1,
-                        type      => 'OVERPAYMENT',
-                        interface => $interface,
-                        ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : () ),
-                    }
-                );
+
+                # Only generate an OVERPAYMENT credit for reversible payments
+                # (e.g. cash payments). Non-reversible credits such as writeoffs,
+                # discounts and cancellations should simply be absorbed when the
+                # fine is adjusted downward - they must not produce a refund
+                # credit for the patron.
+                my $total_non_reversible = 0;
+                if ( my $debit_offsets = $self->debit_offsets ) {
+                    my $nr_offsets = $debit_offsets->filter_by_non_reversible;
+                    $total_non_reversible += abs( $_->amount ) for $nr_offsets->as_list;
+                }
+                my $total_applied      = $amount_before - $amount_outstanding_before;
+                my $total_reversible   = $total_applied - $total_non_reversible;
+                my $overpayment_amount = $total_reversible - $amount;
+
+                if ( $overpayment_amount > 0 ) {
+                    my $account = Koha::Patrons->find( $self->borrowernumber )->account;
+                    $account->add_credit(
+                        {
+                            amount    => $overpayment_amount,
+                            type      => 'OVERPAYMENT',
+                            interface => $interface,
+                            ( $update_type eq 'overdue_update' ? ( item_id => $self->itemnumber ) : () ),
+                        }
+                    );
+                }
                 $new_outstanding = 0;
             }
 
@@ -1097,6 +1117,48 @@ sub store {
         }
     }
 
+    #if there is a matching debit description letter, pull that content and render it for the accountline.description
+    if ( $self->is_debit && !$self->in_storage ) {
+        my $debit_type = Koha::Account::DebitTypes->find( $self->debit_type_code );
+        if ($debit_type) {
+
+            # get the patron's prederred lang
+            my $patron = $self->patron;
+            my $lang   = $patron ? $patron->lang : 'default';
+
+            # check to make sure the custom notice exists
+            my $notice_exists = Koha::Notice::Templates->search(
+                {
+                    module                 => 'debit_description',
+                    code                   => $debit_type->code,
+                    message_transport_type => 'email',
+                    lang                   => $lang,
+                }
+            )->count;
+
+            if ($notice_exists) {
+                my $letter = C4::Letters::GetPreparedLetter(
+                    module                 => 'debit_description',
+                    letter_code            => $debit_type->code,
+                    message_transport_type => 'email',
+                    lang                   => $lang,
+                    tables                 => {
+                        borrowers => $self->borrowernumber,
+                        branches  => $self->branchcode,
+                    },
+                    substitute => {
+                        accountline => $self,
+                    },
+                );
+
+                if ( $letter && $letter->{content} ) {
+                    my $scrubber = C4::Scrubber->new('note');
+                    $self->description( $scrubber->scrub( $letter->{content} ) );
+                }
+            }
+        }
+    }
+
     return $self->SUPER::store();
 }
 

Koha/Acquisition/Basket.pm

@@ -309,6 +309,7 @@ sub to_api_mapping {
     return {
         basketno                => 'basket_id',
         basketname              => 'name',
+        note                    => 'internal_note',
         booksellernote          => 'vendor_note',
         contractnumber          => 'contract_id',
         creationdate            => 'creation_date',

Koha/Acquisition/Bookseller.pm

@@ -25,7 +25,7 @@ use Koha::Subscriptions;
 
 use C4::Contract qw( GetContracts );
 
-use base qw( Koha::Object );
+use base qw( Koha::Object::Mixin::AdditionalFields Koha::Object );
 
 =head1 NAME
 
@@ -46,8 +46,7 @@ Returns the list of baskets for the vendor
 
 sub baskets {
     my ($self) = @_;
-    my $baskets_rs = $self->_result->aqbaskets;
-    return Koha::Acquisition::Baskets->_new_from_dbic($baskets_rs);
+    return Koha::Acquisition::Baskets->_new_from_dbic( scalar $self->_result->baskets );
 }
 
 =head3 contacts
@@ -112,8 +111,7 @@ Returns the list of subscriptions for the vendor
 
 sub subscriptions {
     my ($self) = @_;
-    my $rs = $self->_result->subscriptions;
-    return Koha::Subscriptions->_new_from_dbic($rs);
+    return Koha::Subscriptions->_new_from_dbic( scalar $self->_result->subscriptions );
 }
 
 =head3 aliases
@@ -198,8 +196,7 @@ Returns the list of invoices for the vendor
 
 sub invoices {
     my ($self) = @_;
-    my $invoices_rs = $self->_result->aqinvoices;
-    return Koha::Acquisition::Invoices->_new_from_dbic($invoices_rs);
+    return Koha::Acquisition::Invoices->_new_from_dbic( scalar $self->_result->invoices );
 }
 
 =head3 to_api_mapping

Koha/Acquisition/Booksellers.pm

@@ -19,7 +19,7 @@ use Modern::Perl;
 
 use Koha::Acquisition::Bookseller;
 
-use base qw( Koha::Objects );
+use base qw( Koha::Object::Mixin::AdditionalFields Koha::Objects );
 
 =head1 NAME
 

Koha/Acquisition/Order.pm

@@ -654,6 +654,7 @@ sub to_api_mapping {
         parent_ordernumber            => 'parent_order_id',
         quantityreceived              => 'quantity_received',
         replacementprice              => 'replacement_price',
+        servicing_instruction         => undef,                       # EDIFACT related
         sort1                         => 'statistics_1',
         sort1_authcat                 => 'statistics_1_authcat',
         sort2                         => 'statistics_2',

Koha/Acquisition/Orders.pm

@@ -160,6 +160,7 @@ on this order (checking quantity and quantityreceived).
 
 sub filter_by_active {
     my ($self) = @_;
+    my $source_alias = $self->_resultset->current_source_alias;
     return $self->search(
         {
             '-or' => [
@@ -169,7 +170,7 @@ sub filter_by_active {
                 },
                 { 'orderstatus' => [ 'ordered', 'partial' ] }
             ],
-            quantityreceived => { '<', \['COALESCE(me.quantity,0)'] },
+            quantityreceived => { '<', \["COALESCE($source_alias.quantity,0)"] },
         },
         { join => 'basket' }
     );

Koha/ActionLog.pm

@@ -19,8 +19,15 @@ package Koha::ActionLog;
 
 use Modern::Perl;
 
+use JSON qw( decode_json );
+
 use C4::Context;
 
+# Avoid `use Koha::Patrons` here: Koha::ActionLog is loaded transitively by
+# C4::Log very early in the dependency chain, before Koha::Patron has been
+# fully defined. The accessors below reach for Koha::Patron (and Koha::Items)
+# at call time, by which point they are reliably available.
+
 use base qw(Koha::Object);
 
 =head1 NAME
@@ -31,8 +38,76 @@ Koha::ActionLog - Koha ActionLog Object class
 
 =head2 Class methods
 
+=head3 librarian
+
+    my $librarian = $log->librarian;
+
+Returns the related I<Koha::Patron> object for the librarian who performed
+the action, or I<undef> if the C<user> column was not set (e.g. cron jobs).
+
 =cut
 
+sub librarian {
+    my ($self) = @_;
+    my $rs = $self->_result->librarian;
+    return unless $rs;
+    return Koha::Patron->_new_from_dbic($rs);
+}
+
+=head3 patron
+
+    my $patron = $log->patron;
+
+Returns the related I<Koha::Patron> object joined on the C<object> column.
+Only meaningful for rows where C<object> is a borrowernumber (MEMBERS,
+CIRCULATION, FINES and APIKEYS modules); for other modules the join may
+match an unrelated patron and the caller must filter by C<module>.
+
+=cut
+
+sub patron {
+    my ($self) = @_;
+    my $rs = $self->_result->patron;
+    return unless $rs;
+    return Koha::Patron->_new_from_dbic($rs);
+}
+
+=head3 item
+
+    my $item = $log->item;
+
+Returns the related I<Koha::Item> for a CIRCULATION log entry, or I<undef>.
+
+The itemnumber is not stored in a dedicated column; it lives inside the
+C<info> field, which for circulation is either a JSON payload carrying an
+C<itemnumber> key (ISSUE, RENEWAL) or a bare itemnumber string (RETURN).
+Returns I<undef> for non-circulation rows, when no itemnumber can be
+derived, or when the item has since been deleted.
+
+=cut
+
+sub item {
+    my ($self) = @_;
+
+    return unless ( $self->module // q{} ) eq 'CIRCULATION';
+
+    my $info = $self->info;
+    return unless defined $info;
+
+    my $itemnumber;
+    my $decoded = eval { decode_json($info) };
+    if ( ref($decoded) eq 'HASH' && $decoded->{itemnumber} ) {
+        $itemnumber = $decoded->{itemnumber};
+    } elsif ( $info =~ /^\s*(\d+)\s*$/ ) {
+        $itemnumber = $1;
+    }
+
+    return unless $itemnumber;
+
+    require Koha::Items;
+    return Koha::Items->find($itemnumber);
+}
+
 =head2 Internal methods
 
 =head3 _type

Koha/AdditionalContents.pm

@@ -95,17 +95,32 @@ sub search_for_display {
     my ( $self, $params ) = @_;
     my $lang = $params->{lang} || q{};
 
-    # If lang is not default, we will search for entries matching $lang but fallback to default if $lang is not found
-    # Then we need a subquery count in where clause; DBIx::Class/SQL::Abstract does not support it, fallback to literal SQL
-    my $subquery =
-        qq|(SELECT COUNT(*) FROM additional_contents_localizations WHERE lang='$lang' AND additional_content_id=me.additional_content_id)=0|;
-
     my $search_params = get_public_query_search_params($params);
     $search_params->{lang} = 'default' if !$lang || $lang eq 'default';
-    $search_params->{-or} = [ { 'lang' => $lang }, '-and' => [ 'lang', 'default', \$subquery ] ]
-        if !$search_params->{lang};
 
-    my $attribs = { prefetch => 'additional_content', order_by => 'additional_content.number' };
+    unless ( $search_params->{lang} ) {
+        $search_params->{-or} = [
+            { lang => $lang },
+            {
+                -and => [
+                    { lang => 'default' },
+                    \[
+                        '(SELECT COUNT(*) FROM additional_contents_localizations WHERE lang = ? AND additional_content_id = me.additional_content_id) = 0',
+                        $lang
+                    ]
+                ]
+            }
+        ];
+    }
+
+    my $attribs = {
+        prefetch => 'additional_content',
+        order_by => [
+            \['ISNULL(additional_content.number)'],
+            { -asc  => 'additional_content.number' },
+            { -desc => 'additional_content.published_on' },
+        ],
+    };
     return Koha::AdditionalContentsLocalizations->search( $search_params, $attribs );
 }
 

Koha/AdditionalField.pm

@@ -55,14 +55,17 @@ sub to_api {
     my ( $self, $params ) = @_;
 
     my $table_to_resource = {
-        'accountlines:credit' => 'credit',
-        'accountlines:debit'  => 'debit',
-        'aqbasket'            => 'basket',
-        'aqinvoices'          => 'invoice',
-        'erm_licenses'        => 'license',
-        'erm_agreements'      => 'agreement',
-        'erm_packages'        => 'package',
-        'aqorders'            => 'order',
+        'accountlines:credit'   => 'credit',
+        'accountlines:debit'    => 'debit',
+        'aqbasket'              => 'basket',
+        'aqinvoices'            => 'invoice',
+        'erm_licenses'          => 'license',
+        'erm_agreements'        => 'agreement',
+        'erm_packages'          => 'package',
+        'aqorders'              => 'order',
+        'aqbooksellers:vendor'  => 'vendor',
+        'erm_titles'            => 'title',
+        'erm_agreement_periods' => 'agreement_period'
     };
 
     my $json = $self->SUPER::to_api($params);

Koha/AdditionalFieldValue.pm

@@ -28,6 +28,23 @@ sub field {
     return Koha::AdditionalField->_new_from_dbic( $self->_result()->field() );
 }
 
+=head3 to_api
+
+Overloaded to_api method to exclude internal fields from API representation
+
+=cut
+
+sub to_api {
+    my ( $self, $params ) = @_;
+
+    my $json = $self->SUPER::to_api($params);
+
+    # Remove internal database optimization fields that shouldn't be exposed via API
+    delete $json->{record_table};
+
+    return $json;
+}
+
 =head2 Internal methods
 
 =head3 _type

Koha/ApiKey.pm

@@ -19,7 +19,10 @@ package Koha::ApiKey;
 
 use Modern::Perl;
 
+use Clone           qw( clone );
+use C4::Log         qw( logaction );
 use Koha::AuthUtils qw(hash_password);
+use Koha::Exceptions::ApiKey;
 use Koha::Exceptions::Object;
 
 use List::MoreUtils qw(any);
@@ -44,9 +47,12 @@ Overloaded I<store> method.
 =cut
 
 sub store {
-    my ($self) = @_;
+    my ( $self, $params ) = @_;
+    $params //= {};
 
-    if ( $self->in_storage ) {
+    my $is_new = !$self->in_storage;
+
+    if ( !$is_new ) {
         my %dirty_columns = $self->_result->get_dirty_columns;
 
         # only allow 'description' and 'active' to be updated
@@ -60,11 +66,27 @@ sub store {
             {
                 secret    => Koha::AuthUtils::hash_password( $self->{_plain_text_secret} ),
                 client_id => $self->_generate_unused_uuid('client_id'),
+                active    => 1,
             }
         );
     }
 
-    return $self->SUPER::store();
+    my $log = !$params->{skip_log} && C4::Context->preference('ApiKeyLog');
+    my $original;
+
+    # Log the action unless explicitly skipped
+    $original = $is_new ? undef : $self->get_from_storage()
+        if $log;
+
+    $self->SUPER::store();
+
+    if ( $log && $is_new ) {
+        logaction( 'APIKEYS', 'CREATE', $self->patron_id, $self, undef );
+    } elsif ($log) {
+        logaction( 'APIKEYS', 'MODIFY', $self->patron_id, $self, undef, $original );
+    }
+
+    return $self;
 }
 
 =head3 validate_secret
@@ -103,6 +125,80 @@ sub plain_text_secret {
     return;
 }
 
+=head3 delete
+
+    $api_key->delete;
+
+Overloaded delete method to add logging.
+
+=cut
+
+sub delete {
+    my ($self) = @_;
+
+    my $patron_id = $self->patron_id;
+    my $result    = $self->SUPER::delete();
+
+    logaction( 'APIKEYS', 'DELETE', $patron_id )
+        if C4::Context->preference('ApiKeyLog');
+
+    return $result;
+}
+
+=head3 revoke
+
+    $api_key->revoke;
+
+Revokes the API key by setting active to 0.
+Throws an exception if the key is already revoked.
+
+=cut
+
+sub revoke {
+    my ($self) = @_;
+
+    Koha::Exceptions::ApiKey::AlreadyRevoked->throw
+        if !$self->active;
+
+    my $log      = C4::Context->preference('ApiKeyLog');
+    my $original = $log ? clone( $self->unblessed ) : undef;
+
+    $self->active(0);
+    $self->store( { skip_log => 1 } );
+
+    logaction( 'APIKEYS', 'REVOKE', $self->patron_id, $self, undef, $original )
+        if $log;
+
+    return $self;
+}
+
+=head3 activate
+
+    $api_key->activate;
+
+Activates the API key by setting active to 1.
+Throws an exception if the key is already active.
+
+=cut
+
+sub activate {
+    my ($self) = @_;
+
+    Koha::Exceptions::ApiKey::AlreadyActive->throw
+        if $self->active;
+
+    my $log      = C4::Context->preference('ApiKeyLog');
+    my $original = $log ? clone( $self->unblessed ) : undef;
+
+    $self->active(1);
+    $self->store( { skip_log => 1 } );
+
+    logaction( 'APIKEYS', 'ACTIVATE', $self->patron_id, $self, undef, $original )
+        if $log;
+
+    return $self;
+}
+
 =head2 Internal methods
 
 =cut

Koha/App/Controller/CGI.pm

@@ -80,9 +80,10 @@ sub _render_script {
         return $c->reply->not_found;
     }
 
-    my $sub      = CGI::Compile->compile($script);
-    my $app      = CGI::Emulate::PSGI->handler($sub);
-    my $response = $app->( $c->_psgi_env() );
+    my $abs_script = $c->app->home->rel_file($script);
+    my $sub        = CGI::Compile->compile($abs_script);
+    my $app        = CGI::Emulate::PSGI->handler($sub);
+    my $response   = $app->( $c->_psgi_env() );
 
     $c->res->code( $response->[0] );
     $c->res->headers->from_hash( { @{ $response->[1] } } );

Koha/App/Plugin/CSRF.pm

@@ -73,18 +73,27 @@ sub register {
 
             my $method = $c->req->method;
             if ( $method eq 'GET' || $method eq 'HEAD' || $method eq 'OPTIONS' || $method eq 'TRACE' ) {
-                my $op = $c->req->param('op');
+                my $op       = $c->req->param('op');
+                my $login_op = $c->req->param('login_op');
                 if ( $op && $op =~ /^cud-/ ) {
                     return $c->reply->exception(
                         'Incorrect use of a safe HTTP method with an `op` parameter that starts with "cud-"')
                         ->rendered(400);
+                } elsif ( defined $login_op ) {
+                    return $c->reply->exception('Incorrect use of a safe HTTP method with a `login_op` parameter')
+                        ->rendered(400);
                 }
             } else {
-                my $op = $c->req->param('op');
-                if ( $op && $op !~ /^cud-/ ) {
+                my $op       = $c->req->param('op');
+                my $login_op = $c->req->param('login_op');
+                if ( ( $op && $op !~ /^cud-/ ) && !$login_op ) {
                     return $c->reply->exception(
                         'Incorrect use of an unsafe HTTP method with an `op` parameter that does not start with "cud-"')
                         ->rendered(400);
+                } elsif ( defined $login_op && $login_op !~ /^cud-login$/ ) {
+                    return $c->reply->exception(
+                        'Incorrect use of an unsafe HTTP method with a `login_op` parameter that does not contain cud-login'
+                    )->rendered(400);
                 }
 
                 if ( $c->cookie('CGISESSID') && !$self->is_csrf_valid( $c->req ) ) {

Koha/Auth/Client/OAuth.pm

@@ -72,13 +72,7 @@ sub _get_data_and_patron {
                 if defined $claim->{$pkey};
         }
 
-        my $value = $mapped_data->{$matchpoint};
-
-        my $matchpoint_rs = Koha::Patrons->search( { $matchpoint => $value } );
-
-        if ( defined $value and $matchpoint_rs->count ) {
-            $patron = $matchpoint_rs->next;
-        }
+        $patron = $self->_find_patron_by_matchpoint( $matchpoint, $mapped_data->{$matchpoint} );
     }
 
     if ( defined $config->{userinfo_url} ) {
@@ -88,10 +82,7 @@ sub _get_data_and_patron {
         my $code         = $tx->res->code || 'No response';
 
         return if $code ne '200';
-        my $claim =
-              $tx->res->headers->content_type =~ m!^(application/json|text/javascript)(;\s*charset=\S+)?$!
-            ? $tx->res->json
-            : Mojo::Parameters->new( $tx->res->body )->to_hash;
+        my $claim = $tx->res->json // Mojo::Parameters->new( $tx->res->body )->to_hash;
 
         foreach my $key ( keys %$mapping ) {
             my $pkey  = $mapping->{$key};
@@ -101,13 +92,7 @@ sub _get_data_and_patron {
         }
 
         unless ($patron) {
-            my $value = $mapped_data->{$matchpoint};
-
-            my $matchpoint_rs = Koha::Patrons->search( { $matchpoint => $value } );
-
-            if ( defined $value and $matchpoint_rs->count ) {
-                $patron = $matchpoint_rs->next;
-            }
+            $patron = $self->_find_patron_by_matchpoint( $matchpoint, $mapped_data->{$matchpoint} );
         }
 
     }
@@ -115,4 +100,23 @@ sub _get_data_and_patron {
     return ( $mapped_data, $patron );
 }
 
+=head3 _find_patron_by_matchpoint
+
+    my $patron = $client->_find_patron_by_matchpoint( $matchpoint, $value );
+
+Internal method to find a patron by the given matchpoint and value.
+Returns the patron object if found, undef otherwise.
+
+=cut
+
+sub _find_patron_by_matchpoint {
+    my ( $self, $matchpoint, $value ) = @_;
+
+    return unless defined $value;
+
+    my $matchpoint_rs = Koha::Patrons->search( { $matchpoint => $value } );
+
+    return $matchpoint_rs->count ? $matchpoint_rs->next : undef;
+}
+
 1;

Koha/Auth/Identity/Provider.pm

@@ -19,14 +19,10 @@ package Koha::Auth::Identity::Provider;
 
 use Modern::Perl;
 
-use base qw(Koha::Object);
-
-use JSON qw( decode_json encode_json );
-use Try::Tiny;
+use base qw(Koha::Object Koha::Object::JSONFields);
 
 use Koha::Auth::Identity::Provider::Domains;
 use Koha::Exceptions;
-use Koha::Exceptions::Object;
 
 =head1 NAME
 
@@ -61,11 +57,7 @@ Returns a I<hashref> containing the configuration parameters for the provider.
 sub get_config {
     my ($self) = @_;
 
-    return try {
-        return decode_json( Encode::encode_utf8( $self->config ) );
-    } catch {
-        Koha::Exceptions::Object::BadValue->throw("Error reading JSON data: $_");
-    };
+    return $self->decode_json_field( { field => 'config' } );
 }
 
 =head3 set_config
@@ -104,14 +96,7 @@ sub set_config {
         }
     }
 
-    try {
-        my $encoded_config = encode_json($config);
-        $self->config($encoded_config);
-    } catch {
-        Koha::Exceptions::Object::BadValue->throw("Error serializing data into JSON: $_");
-    };
-
-    return $self;
+    return $self->set_encoded_json_field( { data => $config, field => 'config' } );
 }
 
 =head3 get_mapping
@@ -125,11 +110,7 @@ Returns a I<hashref> containing the attribute mapping for the provider.
 sub get_mapping {
     my ($self) = @_;
 
-    return try {
-        return decode_json( Encode::encode_utf8( $self->mapping ) );
-    } catch {
-        Koha::Exceptions::Object::BadValue->throw("Error reading JSON data: $_");
-    };
+    return $self->decode_json_field( { field => 'mapping' } );
 }
 
 =head3 set_mapping
@@ -143,14 +124,7 @@ This method stores the passed mappings in JSON format.
 sub set_mapping {
     my ( $self, $mapping ) = @_;
 
-    try {
-        my $encoded_mapping = encode_json($mapping);
-        $self->mapping($encoded_mapping);
-    } catch {
-        Koha::Exceptions::Object::BadValue->throw("Error serializing data into JSON: $_");
-    };
-
-    return $self;
+    return $self->set_encoded_json_field( { data => $mapping, field => 'mapping' } );
 }
 
 =head3 upgrade_class

Koha/Authority.pm

@@ -19,12 +19,17 @@ package Koha::Authority;
 
 use Modern::Perl;
 
+use Scalar::Util qw( blessed );
+
+use C4::Context;
+
 use base qw(Koha::Object);
 
 use Koha::Authority::ControlledIndicators;
 use Koha::SearchEngine::Search;
 
 use C4::Heading qw( new_from_field );
+use C4::Charset qw( StripNonXmlChars );
 
 =head1 NAME
 
@@ -289,6 +294,112 @@ sub record_schema {
         : 'MARC21';
 }
 
+=head3 $MARC21_THESAURUS_TO_CONTROL_FIELD_008_11
+
+    my $code = $Koha::Authority::MARC21_THESAURUS_TO_CONTROL_FIELD_008_11->{$thesaurus};
+
+The mapping of a subject heading's thesaurus name (as derived by
+C4::Heading from MARC indicator 2 / subfield $2, e.g. 'lcsh', 'mesh', or a
+raw $2 code such as 'fast') to its MARC21 authority 008/11 code ("Subject
+heading system/thesaurus"), per
+L<https://www.loc.gov/marc/authority/ad008.html>.
+
+Note that C<sears> and C<aat> map to 008/11 values here but never appear
+as a thesaurus name derived by C4::Heading, because they don't have their
+own MARC21 indicator 2 value (see the LOC list linked above).
+
+=cut
+
+our $MARC21_THESAURUS_TO_CONTROL_FIELD_008_11 = {
+    lcsh          => 'a',
+    lcac          => 'b',
+    mesh          => 'c',
+    nal           => 'd',
+    notapplicable => 'n',
+    cash          => 'k',
+    rvm           => 'v',
+    aat           => 'r',
+    sears         => 's',
+    notdefined    => 'z',
+    notspecified  => '|',
+};
+
+# The subset of $MARC21_THESAURUS_TO_CONTROL_FIELD_008_11 keys that
+# C4::Heading uses to mean "no specific thesaurus could be identified from
+# the source heading's indicators" (a blank/unrecognised indicator 2, or
+# indicator 2 = 4), rather than a genuine, named thesaurus. Kept private -
+# callers should go through has_known_thesaurus() rather than consulting
+# this directly.
+my $UNDEFINED_THESAURUS_VALUES = {
+    notdefined   => 1,
+    notspecified => 1,
+};
+
+=head3 has_known_thesaurus
+
+    if ( Koha::Authority->has_known_thesaurus($thesaurus) ) { ... }
+
+Returns true if C<$thesaurus> (as derived by C4::Heading from MARC
+indicator 2 / subfield $2, e.g. 'lcsh', 'mesh', or a raw $2 code such as
+'fast') identifies an actual thesaurus. Returns false if C<$thesaurus> is
+undefined, or is one of the placeholder values C4::Heading returns when
+no thesaurus could be identified from the source heading's indicators
+('notdefined', 'notspecified').
+
+Callers that want to code a new authority's 008/11 (and 040$f) from a
+heading's thesaurus should check this first, and leave the site's own
+default (I<MARCAuthorityControlField008>) in place otherwise.
+
+=cut
+
+sub has_known_thesaurus {
+    my ( $class, $thesaurus ) = @_;
+
+    return 0 unless defined $thesaurus;
+    return $UNDEFINED_THESAURUS_VALUES->{$thesaurus} ? 0 : 1;
+}
+
+=head3 default_marc21_008
+
+    my $default_008 = Koha::Authority->default_marc21_008;
+    my $default_008 = Koha::Authority->default_marc21_008($thesaurus);
+
+Returns the default 34-character body (i.e. everything after the
+6-character date) to use for a new MARC21 authority record's 008 field,
+honouring the I<MARCAuthorityControlField008> system preference and
+falling back to Koha's hardcoded default when it isn't set to a valid (at
+least 34 character) value.
+
+If C<$thesaurus> is passed, position 11 ("Subject heading
+system/thesaurus") is set from
+L<$MARC21_THESAURUS_TO_CONTROL_FIELD_008_11> instead of whatever the
+default/syspref value carries, falling back to 'z' (Other) for a
+thesaurus with no dedicated code -- consistent with how Elasticsearch
+indexing already reconciles 008/11 vs 040$f (see
+Koha::SearchEngine::Elasticsearch::_process_mappings, where a 'z' is
+dropped in favour of a genuine 040$f value).
+
+=cut
+
+sub default_marc21_008 {
+    my ( $class, $thesaurus ) = @_;
+
+    my $default_008 = C4::Context->preference('MARCAuthorityControlField008');
+    if ( !$default_008 or length($default_008) < 34 ) {
+        $default_008 = '|| aca||aabn           | a|a     d';
+    } else {
+        $default_008 = substr( $default_008, 0, 34 );
+    }
+
+    if ( defined $thesaurus ) {
+
+        # Position 11 is absolute (over date + body); within the 34-char body alone that's index 11 - 6 = 5.
+        substr( $default_008, 5, 1, $MARC21_THESAURUS_TO_CONTROL_FIELD_008_11->{$thesaurus} // 'z' );
+    }
+
+    return $default_008;
+}
+
 =head3 to_api_mapping
 
 This method returns the mapping for representing a Koha::Authority object
@@ -324,16 +435,89 @@ sub move_to_deleted {
     delete $data->{modification_time};    # trigger new timestamp
 
     # Set leader 05 (deleted)
-    my $format = C4::Context->preference('marcflavour') eq 'UNIMARC' ? 'UNIMARCAUTH' : 'MARC21';
-    my $record = $self->record;
-    $record->leader( substr( $record->leader, 0, 5 ) . 'd' . substr( $record->leader, 6, 18 ) );
-    $data->{marcxml} = $record->as_xml_record($format);
+    my $format         = C4::Context->preference('marcflavour') eq 'UNIMARC' ? 'UNIMARCAUTH' : 'MARC21';
+    my $record         = eval { $self->record };
+    my $invalid_record = $@ || !$record;
+    if ($invalid_record) {
+        $record = $self->record_strip_nonxml;
+    }
+
+    # We don't do this for biblios, and deleted authorities aren't accessible outside the DB
+    # not in OAI, export, REST, etc. so we should just use the marcxml if we cannot update it
+    # i.e. it is more important to allow the deletion than to force this
+    $record->leader( substr( $record->leader, 0, 5 ) . 'd' . substr( $record->leader, 6, 18 ) ) if $record;
+    $data->{marcxml} = $record ? $record->as_xml_record($format) : $self->marcxml;
 
     return Koha::Database->new->schema->resultset('DeletedauthHeader')->create($data);
 }
 
+=head3 record_strip_nonxml
+
+my $record = $authority->record_strip_nonxml;
+
+This subroutine is intended for cases where we encounter a record that cannot be parsed, but want
+to make a good effort to present the record (for harvesting, deletion, editing) rather than throwing
+an exception
+
+Will return undef if the record cannot be built
+
+=cut
+
+sub record_strip_nonxml {
+
+    my ( $self, $params ) = @_;
+    $params //= {};
+
+    my $record;
+    my $marcxml_error;
+
+    my $flavour = $self->record_schema;
+    eval {
+        $record = MARC::Record->new_from_xml(
+            StripNonXmlChars( $self->marcxml ), 'UTF-8',
+            $flavour
+        );
+    };
+    if ($@) {
+        $marcxml_error = $@;
+        chomp $marcxml_error;
+        warn $marcxml_error;
+        return;
+    }
+
+    return $record;
+}
+
 =head2 Internal methods
 
+=head3 _unblessed_for_log
+
+Returns a plain hashref of authority column values that are independent of
+the attached MARC record, for use in action log diffing.
+
+Columns derived from MARC (C<heading>, C<authtrees>), the raw C<marcxml>
+blob, and system-managed timestamps (C<datecreated>, C<modification_time>)
+are omitted because they either duplicate MARC data already captured in
+the C<_marc> key of the log entry or add no diff signal. Only columns
+carrying independent Koha metadata are retained: C<authtypecode>,
+C<origincode>, and C<linkid>.
+
+=cut
+
+# auth_header columns that exist independently of the MARC record.
+my @_LOG_FIELDS = qw( authtypecode origincode linkid );
+
+sub _unblessed_for_log {
+    my ($self) = @_;
+    my $full = $self->unblessed;
+    my %data;
+    for my $key (@_LOG_FIELDS) {
+        next unless exists $full->{$key} && defined $full->{$key};
+        $data{$key} = blessed( $full->{$key} ) ? "$full->{$key}" : $full->{$key};
+    }
+    return \%data;
+}
+
 =head3 _type
 
 =cut

Koha/BackgroundJob.pm

@@ -121,10 +121,12 @@ sub enqueue {
     my $job_type    = $self->job_type;
     my $job_size    = $params->{job_size};
     my $job_args    = $params->{job_args};
-    my $job_context = $params->{job_context} // C4::Context->userenv;
+    my $job_context = $params->{job_context} // C4::Context->userenv // {};
     my $job_queue   = $params->{job_queue}   // 'default';
     my $json        = $self->json;
 
+    $job_context = {%$job_context};
+
     # session_id must not be logged
     delete $job_context->{session_id};
 
@@ -189,12 +191,6 @@ sub process {
 
     return {} if ref($self) ne 'Koha::BackgroundJob';
 
-    # Our background jobs are called in forked processes
-    # to ensure we have all plugin hooks and data we call
-    # get_enabled_plugins at the star of processing
-    # to populate the cache
-    Koha::Plugins->get_enabled_plugins();
-
     my $derived_class = $self->_derived_class;
 
     $args ||= {};
@@ -459,6 +455,7 @@ sub core_types_to_classes {
         marc_import_revert_batch            => 'Koha::BackgroundJob::MARCImportRevertBatch',
         pseudonymize_statistic              => 'Koha::BackgroundJob::PseudonymizeStatistic',
         import_from_kbart_file              => 'Koha::BackgroundJob::ImportKBARTFile',
+        patron_import                       => 'Koha::BackgroundJob::PatronImport',
         file_transport_test                 => 'Koha::BackgroundJob::TestTransport',
     };
 }
@@ -475,7 +472,6 @@ sub plugin_types_to_classes {
     my ($self) = @_;
 
     unless ( exists $self->{_plugin_mapping} ) {
-        require Koha::Plugins;
         my @plugins = Koha::Plugins->new()->GetPlugins( { method => 'background_tasks', } );
 
         foreach my $plugin (@plugins) {

Koha/BackgroundJob/BatchUpdateBiblioHoldsQueue.pm

@@ -70,6 +70,7 @@ sub process {
     my $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix");
     my $transport_cost_matrix     = $use_transport_cost_matrix ? TransportCostMatrix() : undef;
     my $branches_to_use           = load_branches_to_pull_from($use_transport_cost_matrix);
+    my $unallocated               = C4::Context->preference('RealTimeHoldsQueueUnallocated');
 
     my @messages;
 
@@ -82,8 +83,9 @@ sub process {
                 {
                     biblio_id             => $biblio_id,
                     branches_to_use       => $branches_to_use,
-                    delete                => 1,
-                    transport_cost_matrix => $transport_cost_matrix
+                    delete                => $unallocated ? 0 : 1,
+                    transport_cost_matrix => $transport_cost_matrix,
+                    unallocated           => $unallocated,
                 }
             );
             push @messages,

Koha/BackgroundJob/BatchUpdateItem.pm

@@ -104,7 +104,7 @@ sub process {
     };
 
     try {
-        my ($results) = Koha::Items->search( { itemnumber => \@record_ids } )->batch_update(
+        my ($results) = Koha::Items->search( { itemnumber => { -in => \@record_ids } } )->batch_update(
             {
                 regex_mod                         => $regex_mod,
                 new_values                        => $new_values,

Koha/BackgroundJob/MARCImportCommitBatch.pm

@@ -84,11 +84,10 @@ sub process {
                 progress_callback => sub { my $job_progress = shift; $self->progress($job_progress)->store },
             }
             );
-        my $count = $num_added + $num_updated;
-        if ($count) {
-            $self->set( { progress => $count, size => $count } );
-        } else {    # TODO Refine later
-            $self->set( { progress => 0, status => 'failed' } );
+        my $count = $num_added + $num_updated + $num_ignored;
+        $self->set( { progress => $count } );
+        if ( $count != $size ) {
+            $self->set( { status => 'failed' } );
         }
     } catch {
         warn $_;

Koha/BackgroundJob/PatronImport.pm

@@ -0,0 +1,138 @@
+package Koha::BackgroundJob::PatronImport;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <https://www.gnu.org/licenses>.
+
+use Modern::Perl;
+use Try::Tiny qw( catch try );
+
+use Koha::List::Patron qw( AddPatronList AddPatronsToList );
+use Koha::Patrons::Import;
+use Koha::UploadedFiles;
+
+use base 'Koha::BackgroundJob';
+
+=head1 NAME
+
+Koha::BackgroundJob::PatronImport - Import patrons from a CSV file as a background job
+
+This is a subclass of Koha::BackgroundJob.
+
+=head1 API
+
+=head2 Class methods
+
+=head3 job_type
+
+Define the job type of this job: patron_import
+
+=cut
+
+sub job_type { return 'patron_import' }
+
+=head3 process
+
+Process the job.
+
+=cut
+
+sub process {
+    my ( $self, $args ) = @_;
+
+    return if $self->status eq 'cancelled';
+
+    $self->start;
+
+    my $upload = Koha::UploadedFiles->find( $args->{uploaded_file_id} );
+    unless ($upload) {
+        $self->status('failed')->store;
+        return;
+    }
+    my $fh = $upload->file_handle;
+
+    my $result = try {
+        Koha::Patrons::Import->new->import_patrons(
+            {
+                file                            => $fh,
+                defaults                        => $args->{defaults},
+                matchpoint                      => $args->{matchpoint},
+                overwrite_cardnumber            => $args->{overwrite_cardnumber},
+                overwrite_passwords             => $args->{overwrite_passwords},
+                preserve_extended_attributes    => $args->{preserve_extended_attributes},
+                preserve_fields                 => $args->{preserve_fields},
+                update_dateexpiry               => $args->{update_dateexpiry},
+                update_dateexpiry_from_today    => $args->{update_dateexpiry_from_today},
+                update_dateexpiry_from_existing => $args->{update_dateexpiry_from_existing},
+                send_welcome                    => $args->{send_welcome},
+                step_callback                   => sub { $self->step },
+            }
+        );
+    } catch {
+        $self->status('failed')->store;
+        return;
+    };
+
+    my $data = $self->decoded_data;
+
+    if ($result) {
+        if ( $args->{createpatronlist} && @{ $result->{imported_borrowers} // [] } ) {
+            my $list = AddPatronList( { name => $args->{patronlistname} } );
+            AddPatronsToList( { list => $list, borrowernumbers => $result->{imported_borrowers} } );
+            $data->{patron_list_name} = $args->{patronlistname};
+        }
+
+        $data->{feedback}      = $result->{feedback};
+        $data->{errors}        = $result->{errors};
+        $data->{imported}      = $result->{imported};
+        $data->{overwritten}   = $result->{overwritten};
+        $data->{already_in_db} = $result->{already_in_db};
+        $data->{invalid}       = $result->{invalid};
+        $data->{total} = $result->{imported} + $result->{overwritten} + $result->{already_in_db} + $result->{invalid};
+    }
+
+    $self->finish($data);
+}
+
+=head3 enqueue
+
+Enqueue the new job.
+
+=cut
+
+sub enqueue {
+    my ( $self, $args ) = @_;
+
+    return unless $args->{uploaded_file_id};
+
+    my $upload = Koha::UploadedFiles->find( $args->{uploaded_file_id} );
+    return unless $upload;
+
+    my $fh         = $upload->file_handle;
+    my $line_count = 0;
+    while ( my $line = <$fh> ) {
+        $line_count++ if $line =~ /\S/;
+    }
+    close $fh;
+
+    $self->SUPER::enqueue(
+        {
+            job_size  => $line_count > 1 ? $line_count - 1 : 1,
+            job_args  => $args,
+            job_queue => 'long_tasks',
+        }
+    );
+}
+
+1;

Koha/BackgroundJob/PseudonymizeStatistic.pm

@@ -18,6 +18,7 @@ package Koha::BackgroundJob::PseudonymizeStatistic;
 use Modern::Perl;
 
 use Koha::PseudonymizedTransactions;
+use Koha::Statistics;
 
 use base 'Koha::BackgroundJob';
 
@@ -53,6 +54,8 @@ sub process {
     my $statistic   = $args->{statistic};
     my $stat_object = Koha::Statistic->new($statistic);
     Koha::PseudonymizedTransaction->create_from_statistic($stat_object);
+    $self->progress(1)
+        ;    #We could use step here, but we are going to save the object during finish and this saves a DB write
     $self->finish( { data => "" } );    # We want to clear the job data to avoid storing patron information
 
 }

Koha/BackgroundJob/TestTransport.pm

@@ -53,7 +53,10 @@ sub process {
 
     my $transport = Koha::File::Transports->find( $args->{transport_id} );
     $transport->test_connection;
-    my $status   = { status => 'ok' };
+    my $status = {
+        status            => 'ok', transport_id => $transport->id, transport_name => $transport->name,
+        background_job_id => $self->id
+    };
     my $messages = $transport->object_messages;
     for my $message (@$messages) {
         $status->{status} = 'errors' if $message->{type} eq 'error';

Koha/Biblio.pm

@@ -20,11 +20,12 @@ package Koha::Biblio;
 use Modern::Perl;
 
 use List::MoreUtils qw( any );
+use Scalar::Util    qw( blessed );
 use URI;
 use URI::Escape qw( uri_escape_utf8 );
 use Try::Tiny;
 
-use C4::Koha        qw( GetNormalizedISBN GetNormalizedUPC GetNormalizedOCLCNumber );
+use C4::Koha        qw( GetNormalizedISBN );
 use C4::Biblio      qw( DelBiblio );
 use C4::Serials     qw( CountSubscriptionFromBiblionumber );
 use C4::Reserves    qw( MergeHolds );
@@ -42,6 +43,7 @@ use Koha::Biblio::Metadatas;
 use Koha::Biblio::Metadata::Extractor;
 use Koha::Biblio::ItemGroups;
 use Koha::Biblioitems;
+use Koha::BiblioFrameworks;
 use Koha::Cache::Memory::Lite;
 use Koha::Bookings;
 use Koha::Checkouts;
@@ -329,8 +331,13 @@ sub can_be_edited {
     Koha::Exceptions::MissingParameter->throw( error => "The patron parameter is missing or invalid" )
         unless $patron && ref($patron) eq 'Koha::Patron';
 
+    my $is_fast_add =
+        defined $self->frameworkcode && $self->frameworkcode ne ''
+        ? Koha::BiblioFrameworks->find( $self->frameworkcode )->is_fast_add
+        : 0;
+
     my $editcatalogue =
-        $self->frameworkcode eq 'FA'
+        $is_fast_add
         ? [ 'fast_cataloging', 'edit_catalogue' ]
         : 'edit_catalogue';
 
@@ -394,10 +401,25 @@ sub check_booking {
         ? $existing_bookings->search( { booking_id => { '!=' => $booking_id } } )->count
         : $existing_bookings->count;
 
+    # Only count checkouts on bookable items; checkouts on non-bookable
+    # sibling items should not reduce the pool of available bookable items.
+    my $bookable_item_ids = [ $bookable_items->reset->get_column('itemnumber') ];
+
     my $checkouts = $self->current_checkouts->search(
         {
-            date_due        => { '>='      => $dtf->format_datetime($start_date) },
-            "me.itemnumber" => { '-not_in' => $existing_bookings->_resultset->get_column('item_id')->as_query }
+            date_due        => { '>=' => $dtf->format_datetime($start_date) },
+            "me.itemnumber" => {
+                '-not_in' => $existing_bookings->_resultset->get_column('item_id')->as_query,
+                '-in'     => $bookable_item_ids,
+            },
+
+            # A checkout linked to the booking under consideration must not
+            # block that booking's own updates (see Koha::Item->check_booking)
+            (
+                defined($booking_id)
+                ? ( "me.booking_id" => [ undef, { '!=' => $booking_id } ] )
+                : ()
+            ),
         }
     );
     $booked_count += $checkouts->count;
@@ -785,7 +807,7 @@ return the current holds placed on this record
 sub holds {
     my ( $self, $params, $attributes ) = @_;
     $attributes->{order_by} = 'priority' unless exists $attributes->{order_by};
-    my $hold_rs = $self->_result->reserves->search( $params, $attributes );
+    my $hold_rs = $self->_result->holds->search( $params, $attributes );
     return Koha::Holds->_new_from_dbic($hold_rs);
 }
 
@@ -1610,7 +1632,9 @@ sub get_marc_authors {
     if ( $marcflavour eq "UNIMARC" ) {
         $fields_filter = '200';
     } else {    # marc21/normarc
-        $fields_filter = '100';
+        $fields_filter = '1..';
+        $mintag        = '100';
+        $maxtag        = '111';
     }
 
     my @first_authors = @{
@@ -1687,6 +1711,19 @@ sub normalized_upc {
     return $self->metadata_extractor->get_normalized_upc;
 }
 
+=head3 normalized_ean
+
+    my $normalized_ean = $biblio->normalized_ean
+
+Normalizes and returns the EAN found in the MARC record.
+
+=cut
+
+sub normalized_ean {
+    my ($self) = @_;
+    return $self->metadata_extractor->get_normalized_ean;
+}
+
 =head3 normalized_oclc
 
     my $normalized_oclc = $biblio->normalized_oclc
@@ -2138,6 +2175,51 @@ sub link_marc_host {
     return $self;
 }
 
+=head3 age_restriction
+
+    my $age = $biblio->age_restriction;
+
+Extracts the numeric age restriction from the biblio's agerestriction field
+using the AgeRestrictionMarker system preference.
+
+Returns the age (integer) or undef if no restriction is found.
+
+=cut
+
+sub age_restriction {
+    my ($self) = @_;
+
+    my $restriction_string = $self->biblioitem->agerestriction;
+    return unless $restriction_string;
+
+    my @values = split ' ', uc($restriction_string);
+    return unless @values;
+
+    my @markers = map { my $m = uc($_); $m =~ s/^\s+//; $m =~ s/\s+$//; $m }
+        @{ C4::Context->multivalue_preference('AgeRestrictionMarker') };
+    return unless @markers;
+
+    my $index           = 0;
+    my $restriction_age = 0;
+    for my $value (@values) {
+        $index++;
+        for my $marker (@markers) {
+            if ( $marker eq $value ) {
+                if ( $index <= $#values ) {
+                    $restriction_age += $values[$index];
+                }
+                last;
+            } elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
+                $restriction_age += $1;
+                last;
+            }
+        }
+        last if ( $restriction_age > 0 );
+    }
+
+    return $restriction_age || undef;
+}
+
 =head3 recalls
 
     my $recalls = $biblio->recalls;
@@ -2157,12 +2239,14 @@ sub recalls {
 
 Does biblio-level checks and returns the items attached to this biblio that are available for recall
 
+If hold_convert $param is included, this is a check to convert a hold to a recall, so we should not check for an existing hold.
+
 =cut
 
 sub can_be_recalled {
     my ( $self, $params ) = @_;
 
-    return 0 if !( C4::Context->preference('UseRecalls') );
+    return 0 if ( C4::Context->preference('UseRecalls') eq "off" );
 
     my $patron = $params->{patron};
 
@@ -2182,7 +2266,7 @@ sub can_be_recalled {
     my @all_itemnumbers;
     foreach my $item (@all_items) {
         push( @all_itemnumbers, $item->itemnumber );
-        if ( $item->can_be_recalled( { patron => $patron } ) ) {
+        if ( $item->can_be_recalled( { patron => $patron, hold_convert => $params->{hold_convert} } ) ) {
             push( @itemtypes,   $item->effective_itemtype );
             push( @itemnumbers, $item->itemnumber );
             push( @items,       $item );
@@ -2395,7 +2479,35 @@ sub merge_with {
 
 =head2 Internal methods
 
-=head3 type
+=head3 _unblessed_for_log
+
+Returns a plain hashref of biblio column values that are not derived from
+the attached MARC record, for use in action log diffing.
+
+Fields such as C<author>, C<title>, C<subtitle> etc. are omitted because
+they are denormalised copies of MARC data and would duplicate what is
+already captured in the C<_marc> key of the log entry. Only fields that
+carry independent Koha metadata are retained: C<frameworkcode>,
+C<opac_suppressed>, and C<serial>. The C<timestamp> and C<datecreated>
+columns are also excluded as they are system-managed and add no signal.
+
+=cut
+
+# Biblio table columns that exist independently of the MARC record.
+my @_LOG_FIELDS = qw( frameworkcode opac_suppressed serial );
+
+sub _unblessed_for_log {
+    my ($self) = @_;
+    my $full = $self->unblessed;
+    my %data;
+    for my $key (@_LOG_FIELDS) {
+        next unless exists $full->{$key} && defined $full->{$key};
+        $data{$key} = blessed( $full->{$key} ) ? "$full->{$key}" : $full->{$key};
+    }
+    return \%data;
+}
+
+=head3 _type
 
 =cut
 

Koha/Biblio/Metadata.pm

@@ -24,14 +24,19 @@ use C4::Biblio  qw( GetMarcFromKohaField );
 use C4::Charset qw( StripNonXmlChars );
 use C4::Items   qw( GetMarcItem );
 
+use Koha::Biblio::Metadata::Error;
+use Koha::Biblio::Metadata::Errors;
 use Koha::Database;
 use Koha::Exceptions::Metadata;
+use Koha::Logger;
 use Koha::RecordSources;
 
 use base qw(Koha::Object);
 
 =head1 NAME
 
+=encoding utf-8
+
 Koha::Metadata - Koha Metadata Object class
 
 =head1 API
@@ -40,6 +45,188 @@ Koha::Metadata - Koha Metadata Object class
 
 =cut
 
+=head3 store
+
+Metadata specific store method to catch errant characters prior
+to committing to the database.
+
+If the MARCXML cannot be parsed but can be recovered, the recovered version is
+saved and an error row per fault is written to C<biblio_metadata_errors> so
+callers and the UI can notify the user. Two recoverable faults are currently
+handled, and either or both may apply to the same record:
+
+=over 4
+
+=item * non-XML characters (recorded as C<nonxml_stripped>, recovered via
+C<StripNonXmlChars>)
+
+=item * datafields with no subfields at all, which C<MARC::File::XML> refuses
+to parse (recorded as C<empty_datafield_stripped>, recovered by removing the
+empty datafield)
+
+=back
+
+Any pre-existing error row is left alone when the record parses cleanly - they
+are review flags requiring explicit human resolution and should not be
+silently cleared by a routine re-save.
+
+If the MARCXML cannot be recovered at all, a
+I<Koha::Exceptions::Metadata::Invalid> exception is thrown.
+
+=cut
+
+sub store {
+    my $self = shift;
+
+    # Reset messages so object_messages reflects only this store call
+    $self->{_messages} = [];
+
+    my %recoveries;    # error_type => arrayref of occurrences, for faults that were fixed
+
+    # Check marcxml will roundtrip
+    if ( $self->format eq 'marcxml' ) {
+
+        my $marcxml = eval {
+            MARC::Record::new_from_xml(
+                $self->metadata, 'UTF-8',
+                $self->schema
+            );
+        };
+        my $marcxml_error = $@;
+        chomp $marcxml_error;
+
+        unless ($marcxml) {
+            my ( $stripped_record, $stripped_metadata, $stripped_recoveries ) =
+                $self->repair_marcxml( $self->metadata, $self->schema );
+
+            if ($stripped_record) {
+
+                Koha::Logger->get->warn(
+                    sprintf(
+                        "Metadata for bibliographic record (biblionumber=%s) was automatically repaired before saving: %s",
+                        $self->biblionumber // 'N/A', $marcxml_error
+                    )
+                );
+                $self->metadata($stripped_metadata);
+                %recoveries = %$stripped_recoveries;
+            } else {
+
+                # Truly unrecoverable
+                Koha::Logger->get->warn($marcxml_error);
+                Koha::Exceptions::Metadata::Invalid->throw(
+                    id             => $self->id,
+                    biblionumber   => $self->biblionumber,
+                    format         => $self->format,
+                    schema         => $self->schema,
+                    decoding_error => $marcxml_error,
+                );
+            }
+        }
+    }
+
+    $self->SUPER::store;
+
+    # If this save triggered a fresh repair, record each fault as a DB error row and
+    # signal the event via object_messages. A fault already on record for this metadata_id
+    # (same error_type and message) is left as-is rather than duplicated, so re-harvesting or
+    # re-importing a source record that is still dirty doesn't pile up repeat rows for the
+    # same underlying issue.
+    for my $error_type ( sort keys %recoveries ) {
+        my $occurrences = $recoveries{$error_type};
+        my $formatter   = _error_message_formatter($error_type);
+        if (@$occurrences) {
+            for my $occ (@$occurrences) {
+                $self->_add_error_once( $error_type, $formatter->($occ), $occ );
+            }
+        } else {
+
+            # Fallback: couldn't pinpoint individual occurrences – store a generic message
+            $self->_add_error_once( $error_type, 'details unavailable' );
+        }
+
+        $self->add_message(
+            {
+                message => $error_type,
+                type    => 'warning',
+                payload => ( join( "\n", map { $formatter->($_) } @$occurrences ) || 'details unavailable' ),
+            }
+        );
+    }
+
+    return $self;
+}
+
+=head3 metadata_errors
+
+    my $errors = $metadata->metadata_errors;
+
+Returns a I<Koha::Biblio::Metadata::Errors> resultset for errors associated
+with this metadata record.
+
+=cut
+
+sub metadata_errors {
+    my ($self) = @_;
+    return Koha::Biblio::Metadata::Errors->_new_from_dbic( scalar $self->_result->biblio_metadata_errors );
+}
+
+=head3 _add_error_once
+
+    $self->_add_error_once( $error_type, $message, $occurrence );
+
+Records a C<biblio_metadata_errors> row for this metadata record, unless an
+identical row (same C<error_type> and C<message>) already exists - so
+re-triggering the same fault on a source record that stays dirty across
+repeated saves doesn't pile up duplicate rows. C<$occurrence> is the optional
+occurrence hashref produced by C<_find_nonxml_chars>/C<_find_empty_datafields>;
+when its C<field> key looks like C<TAG$sub> or C<TAG>, the C<tag>/C<subfield>
+columns are populated so callers (e.g. the cataloguing UI) don't need to parse
+them back out of the free-text message.
+
+=cut
+
+sub _add_error_once {
+    my ( $self, $error_type, $message, $occurrence ) = @_;
+
+    return
+        if Koha::Biblio::Metadata::Errors->search(
+        {
+            metadata_id => $self->id,
+            error_type  => $error_type,
+            message     => $message,
+        }
+        )->count;
+
+    my ( $tag, $subfield ) =
+        ( $occurrence && $occurrence->{field} ) ? _split_field_ref( $occurrence->{field} ) : ( undef, undef );
+
+    Koha::Biblio::Metadata::Error->new(
+        {
+            metadata_id => $self->id,
+            error_type  => $error_type,
+            message     => $message,
+            tag         => $tag,
+            subfield    => $subfield,
+        }
+    )->store;
+}
+
+=head3 _split_field_ref
+
+    my ( $tag, $subfield ) = _split_field_ref( $field_ref );
+
+Splits a human-readable field reference such as C<245$a> into its tag and
+subfield parts. Field references with no subfield (control fields, or a
+datafield reported as a whole e.g. from C<_find_empty_datafields>) return an
+undefined subfield.
+
+=cut
+
+sub _split_field_ref {
+    my ($field_ref) = @_;
+    return $field_ref =~ /^(\w+)\$(\w)$/ ? ( $1, $2 ) : ( $field_ref, undef );
+}
+
 =head3 record
 
 my $record = $metadata->record;
@@ -255,6 +442,249 @@ sub _embed_items {
     return $record;
 }
 
+=head3 _context_snippet
+
+    my $snippet = _context_snippet( \@chars, $pos_0, $char_ord );
+
+Given an array-ref of characters C<\@chars>, a 0-based position C<$pos_0> of
+a bad character, and its ordinal C<$char_ord>, returns a two-line string:
+
+=over 4
+
+=item * Line 1 – up to 30 characters of context either side of the bad
+character, with the bad character replaced by a visible glyph (Unicode
+Control Pictures U+2400–U+241F for C0 controls, C<␡> for DEL, C<?>
+otherwise) and ellipses when the window is truncated.
+
+=item * Line 2 – a caret (C<^>) aligned beneath the visible glyph.
+
+=back
+
+Example output (4-space indent):
+
+    t $xtac arr␈\ $btxt V $2rdacontent
+               ^
+
+=cut
+
+sub _context_snippet {
+    my ( $chars_ref, $pos_0, $char_ord ) = @_;
+
+    # Visible stand-in for the removed character:
+    #   C0 controls (U+0000–U+001F) → Unicode Control Pictures (U+2400–U+241F)
+    #   DEL (U+007F)                → U+2421 SYMBOL FOR DELETE (␡)
+    #   anything else               → U+FFFD REPLACEMENT CHARACTER (?)
+    my $visible =
+          $char_ord <= 0x1F ? chr( $char_ord + 0x2400 )
+        : $char_ord == 0x7F ? "\x{2421}"
+        :                     "\x{FFFD}";
+
+    my $last = $#{$chars_ref};
+    my $win  = 30;
+
+    my $pre_start = ( $pos_0 > $win )         ? $pos_0 - $win : 0;
+    my $post_end  = ( $pos_0 + $win < $last ) ? $pos_0 + $win : $last;
+
+    my $pre  = $pos_0 > 0     ? join( '', @{$chars_ref}[ $pre_start .. $pos_0 - 1 ] ) : '';
+    my $post = $pos_0 < $last ? join( '', @{$chars_ref}[ $pos_0 + 1 .. $post_end ] )  : '';
+
+    my $prefix = ( $pos_0 > $win )         ? '...' : '';
+    my $suffix = ( $pos_0 + $win < $last ) ? '...' : '';
+
+    my $indent    = '    ';
+    my $line      = "$indent$prefix$pre$visible$post$suffix";
+    my $caret_col = length($indent) + length($prefix) + length($pre);
+
+    return "$line\n" . ( ' ' x $caret_col ) . '^';
+}
+
+=head3 repair_marcxml
+
+    my ( $record, $repaired_xml, $recoveries ) =
+        Koha::Biblio::Metadata->repair_marcxml( $marcxml, $marc_schema );
+
+Attempts to repair a MARCXML string that fails to parse, by stripping
+whichever of the known-recoverable faults (non-XML characters,
+subfield-less datafields) are present. This is the same recovery logic used
+by C<store>, exposed as a class method so other callers that parse MARCXML
+ahead of a C<Koha::Biblio::Metadata> save - such as C<Koha::Import::Record>
+staging records - benefit from the same repair capability instead of
+re-implementing a weaker version of it.
+
+Returns, on success, the repaired C<MARC::Record>, the repaired XML string,
+and a hashref of C<< error_type => \@occurrences >> (see
+C<_find_nonxml_chars>/C<_find_empty_datafields>) describing what was fixed.
+Returns an empty list if the XML has none of the known-recoverable faults,
+or if it still doesn't parse once they're stripped.
+
+=cut
+
+sub repair_marcxml {
+    my ( $class, $marcxml, $marc_schema ) = @_;
+
+    my @nonxml_chars     = _find_nonxml_chars($marcxml);
+    my @empty_datafields = _find_empty_datafields($marcxml);
+
+    return unless @nonxml_chars || @empty_datafields;
+
+    my $stripped_metadata = $marcxml;
+    $stripped_metadata = StripNonXmlChars($stripped_metadata)        if @nonxml_chars;
+    $stripped_metadata = _strip_empty_datafields($stripped_metadata) if @empty_datafields;
+
+    my $stripped_record = eval { MARC::Record::new_from_xml( $stripped_metadata, 'UTF-8', $marc_schema ); };
+    return unless $stripped_record;
+
+    my %recoveries;
+    $recoveries{ Koha::Biblio::Metadata::Error::NONXML_STRIPPED() }          = \@nonxml_chars     if @nonxml_chars;
+    $recoveries{ Koha::Biblio::Metadata::Error::EMPTY_DATAFIELD_STRIPPED() } = \@empty_datafields if @empty_datafields;
+
+    return ( $stripped_record, $stripped_metadata, \%recoveries );
+}
+
+=head3 _find_nonxml_chars
+
+    my @occurrences = _find_nonxml_chars( $marcxml_string );
+
+Scans a raw MARC XML string for every individual character that is illegal
+in XML 1.0.  Returns a list of hashrefs (one per character occurrence) with
+the following keys:
+
+=over 4
+
+=item * C<field> - human-readable field reference, e.g. C<245$a> or C<001>
+
+=item * C<char_ord> - ordinal (decimal) value of the bad character
+
+=item * C<position> - 1-based character offset within the field value
+
+=item * C<snippet> - two-line string with context window and caret pointer (see C<_context_snippet>)
+
+=back
+
+The same character class is used as L<C4::Charset/StripNonXmlChars>, so
+every occurrence returned here is exactly one that would be stripped.
+
+=cut
+
+sub _find_nonxml_chars {
+    my ($marcxml) = @_;
+
+    # Characters illegal in XML 1.0 – identical to the set stripped by StripNonXmlChars
+    my $non_xml_re = qr/[^\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]/;
+
+    my @occurrences;
+
+    my $scan = sub {
+        my ( $field_ref, $val ) = @_;
+        my @chars = split //, $val;
+        for my $i ( 0 .. $#chars ) {
+            if ( $chars[$i] =~ $non_xml_re ) {
+                push @occurrences, {
+                    field    => $field_ref,
+                    char_ord => ord( $chars[$i] ),
+                    position => $i + 1,
+                    snippet  => _context_snippet( \@chars, $i, ord( $chars[$i] ) ),
+                };
+            }
+        }
+    };
+
+    # Scan every subfield inside every datafield
+    while ( $marcxml =~ m{<datafield\b[^>]*\btag="(\w+)"[^>]*>(.*?)</datafield>}gs ) {
+        my ( $tag, $content ) = ( $1, $2 );
+        while ( $content =~ m{<subfield\b[^>]*\bcode="(\w)"[^>]*>(.*?)</subfield>}gs ) {
+            $scan->( "$tag\$$1", $2 );
+        }
+    }
+
+    # Scan control fields
+    while ( $marcxml =~ m{<controlfield\b[^>]*\btag="(\w+)"[^>]*>(.*?)</controlfield>}gs ) {
+        $scan->( $1, $2 );
+    }
+
+    return @occurrences;
+}
+
+=head3 _find_empty_datafields
+
+    my @occurrences = _find_empty_datafields( $marcxml_string );
+
+Scans a raw MARC XML string for C<< <datafield> >> elements with no
+C<< <subfield> >> children at all. C<MARC::File::XML> refuses to parse such
+a field (it dies with "Field NNN must have at least one subfield"), which
+happens with legacy data saved before this validation existed.
+
+Returns a list of hashrefs (one per occurrence) with the single key
+C<field>, the datafield's tag.
+
+=cut
+
+sub _find_empty_datafields {
+    my ($marcxml) = @_;
+
+    my @occurrences;
+    while ( $marcxml =~ m{<datafield\b([^>]*)>\s*</datafield>|<datafield\b([^>]*)/>}gs ) {
+        my $attrs = defined $1 ? $1 : $2;
+        my ($tag) = $attrs =~ /\btag="(\w+)"/;
+        push @occurrences, { field => $tag // 'unknown' };
+    }
+
+    return @occurrences;
+}
+
+=head3 _strip_empty_datafields
+
+    my $cleaned_marcxml = _strip_empty_datafields( $marcxml_string );
+
+Removes every C<< <datafield> >> element with no C<< <subfield> >> children
+from a raw MARC XML string, so the record can be parsed and saved. The
+removed field's data cannot be recovered - callers should record an error
+row (see C<_find_empty_datafields>) so a cataloguer can review and re-add it.
+
+=cut
+
+sub _strip_empty_datafields {
+    my ($marcxml) = @_;
+
+    return $marcxml unless defined $marcxml;
+    $marcxml =~ s{<datafield\b[^>]*>\s*</datafield>}{}gs;
+    $marcxml =~ s{<datafield\b[^>]*/>}{}gs;
+
+    return $marcxml;
+}
+
+=head3 _error_message_formatter
+
+    my $formatter = _error_message_formatter( $error_type );
+    my $message   = $formatter->( $occurrence );
+
+Returns a coderef that turns one occurrence hashref (as produced by
+C<_find_nonxml_chars> or C<_find_empty_datafields>) into a human-readable
+message line for the given C<$error_type>.
+
+=cut
+
+sub _error_message_formatter {
+    my ($error_type) = @_;
+
+    return sub {
+        my ($occ) = @_;
+        return sprintf(
+            "%s: invalid char value %d (U+%04X) at position %d\n%s",
+            $occ->{field}, $occ->{char_ord}, $occ->{char_ord}, $occ->{position}, $occ->{snippet}
+        );
+        }
+        if $error_type eq Koha::Biblio::Metadata::Error::NONXML_STRIPPED;
+
+    return sub {
+        my ($occ) = @_;
+        return sprintf( "%s: field removed, it had no subfields", $occ->{field} );
+        }
+        if $error_type eq Koha::Biblio::Metadata::Error::EMPTY_DATAFIELD_STRIPPED;
+
+    return sub { 'details unavailable' };
+}
+
 =head3 _type
 
 =cut

Koha/Biblio/Metadata/Error.pm

@@ -0,0 +1,70 @@
+package Koha::Biblio::Metadata::Error;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <https://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Koha::Exceptions;
+
+use base qw(Koha::Object);
+
+=head1 NAME
+
+Koha::Biblio::Metadata::Error - Koha Biblio Metadata Error object class
+
+=head1 Constants
+
+=cut
+
+use constant {
+    NONXML_STRIPPED          => 'nonxml_stripped',
+    EMPTY_DATAFIELD_STRIPPED => 'empty_datafield_stripped',
+};
+
+my %VALID_ERROR_TYPES = map { $_ => 1 } ( NONXML_STRIPPED, EMPTY_DATAFIELD_STRIPPED );
+
+=head1 API
+
+=head2 Class methods
+
+=head3 store
+
+Rejects an C<error_type> outside the known set, so a typo in a future caller
+fails loudly at store time rather than silently writing an unrecognised value
+into the database.
+
+=cut
+
+sub store {
+    my ($self) = @_;
+
+    Koha::Exceptions::BadParameter->throw( parameter => 'error_type' )
+        unless $VALID_ERROR_TYPES{ $self->error_type // '' };
+
+    return $self->SUPER::store;
+}
+
+=head2 Internal methods
+
+=head3 _type
+
+=cut
+
+sub _type {
+    return 'BiblioMetadataError';
+}
+
+1;

Koha/Biblio/Metadata/Errors.pm

@@ -0,0 +1,64 @@
+package Koha::Biblio::Metadata::Errors;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <https://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Koha::Biblio::Metadata::Error;
+
+use base qw(Koha::Objects);
+
+=head1 NAME
+
+Koha::Biblio::Metadata::Errors - Koha Biblio Metadata Errors object set class
+
+=head1 API
+
+=head2 Class methods
+
+=head3 by_type
+
+    my $errors = Koha::Biblio::Metadata::Errors->search(...)->by_type('nonxml_stripped');
+
+Filters the resultset down to a single C<error_type>. See
+L<Koha::Biblio::Metadata::Error> for the known type constants.
+
+=cut
+
+sub by_type {
+    my ( $self, $error_type ) = @_;
+    return $self->search( { error_type => $error_type } );
+}
+
+=head2 Internal methods
+
+=head3 _type
+
+=cut
+
+sub _type {
+    return 'BiblioMetadataError';
+}
+
+=head3 object_class
+
+=cut
+
+sub object_class {
+    return 'Koha::Biblio::Metadata::Error';
+}
+
+1;

Koha/Biblio/Metadata/Extractor/MARC.pm

@@ -104,6 +104,29 @@ sub get_control_number {
     return $control_number;
 }
 
+=head3 get_normalized_oclc
+
+    my $normalized_oclc = $extractor->get_normalized_oclc();
+
+Returns a normalized OCLC number from 035$a (field is flavor-independent).
+
+=cut
+
+sub get_normalized_oclc {
+    my ($self) = @_;
+
+    my $record = $self->metadata;
+    my @fields = $record->field('035');
+    foreach my $field (@fields) {
+        my $oclc = $field->subfield('a');
+        if ( $oclc && $oclc =~ /OCoLC/i ) {
+            $oclc =~ s/^\([^)]*\)\s*//;
+            return $oclc;
+        }
+    }
+    return q{};
+}
+
 =head3 _normalize_string
 
     my $normalized_string = $self->_normalize_string($string);

Koha/Biblio/Metadata/Extractor/MARC/MARC21.pm

@@ -74,26 +74,27 @@ sub get_normalized_upc {
     }
 }
 
-=head2 get_normalized_oclc
+=head2 get_normalized_ean
 
-    my $normalized_oclc = $extractor->get_normalized_oclc();
+    my $normalized_ean = $extractor->get_normalized_ean();
 
-Returns a normalized OCLC number.
+Returns a normalized EAN from 024$a with indicator 1 = 3.
 
 =cut
 
-sub get_normalized_oclc {
+sub get_normalized_ean {
     my ($self) = @_;
 
     my $record = $self->metadata;
-    my @fields = $record->field('035');
+    my @fields = $record->field('024');
     foreach my $field (@fields) {
-        my $oclc = $field->subfield('a');
-        if ( $oclc && $oclc =~ /OCoLC/ ) {
-            $oclc =~ s/\(OCoLC\)//;
-            return $oclc;
+        my $indicator = $field->indicator(1);
+        my $ean       = $self->_normalize_string( $field->subfield('a') );
+        if ( $ean && $indicator eq '3' ) {
+            return $ean;
         }
     }
+    return;
 }
 
 =head2 check_fixed_length

Koha/Biblio/Metadata/Extractor/MARC/UNIMARC.pm

@@ -72,6 +72,28 @@ sub get_normalized_upc {
     }
 }
 
+=head2 get_normalized_ean
+
+    my $normalized_ean = $extractor->get_normalized_ean();
+
+Returns a normalized EAN from 073$a.
+
+=cut
+
+sub get_normalized_ean {
+    my ($self) = @_;
+
+    my $record = $self->metadata;
+    my @fields = $record->field('073');
+    foreach my $field (@fields) {
+        my $ean = $self->_normalize_string( $field->subfield('a') );
+        if ($ean) {
+            return $ean;
+        }
+    }
+    return;
+}
+
 =head1 AUTHOR
 
 Tomas Cohen Arazi, E<lt>tomascohen@theke.ioE<gt>

Koha/Booking.pm

@@ -39,6 +39,22 @@ Koha::Booking - Koha Booking object class
 
 =head2 Class methods
 
+=head3 set_itemtype_filter
+
+    $booking->set_itemtype_filter($itemtype_id);
+
+Sets a transient itemtype filter for item selection. This is used when
+creating "any item" bookings to filter items by type before optimal selection.
+This value is not persisted to the database.
+
+=cut
+
+sub set_itemtype_filter {
+    my ( $self, $itemtype_id ) = @_;
+    $self->{_itemtype_filter} = $itemtype_id;
+    return $self;
+}
+
 =head3 biblio
 
 Returns the related Koha::Biblio object for this booking
@@ -134,6 +150,13 @@ sub store {
 
     $self->_result->result_source->schema->txn_do(
         sub {
+            # Nothing changed, nothing to validate; circulation may issue
+            # redundant status writes (e.g. when switching an on-site
+            # checkout) that must not re-trigger clash detection
+            if ( $self->in_storage && !( () = $self->_result->get_dirty_columns ) ) {
+                return $self->SUPER::store;
+            }
+
             if ( $self->item_id ) {
                 Koha::Exceptions::Object::FKConstraint->throw(
                     broken_fk => 'item_id',
@@ -157,25 +180,33 @@ sub store {
                 value     => $self->biblio_id,
             ) unless ( $self->biblio );
 
-            # Throw exception for item level booking clash
-            Koha::Exceptions::Booking::Clash->throw()
-                if $self->item_id && !$self->item->check_booking(
-                {
-                    start_date => $self->start_date,
-                    end_date   => $self->end_date,
-                    booking_id => $self->in_storage ? $self->booking_id : undef
-                }
-                );
+            # Skip clash detection when the status transition cannot
+            # introduce a new clash: terminal statuses (cancelled,
+            # completed) and collection (issued) leave the booked
+            # period untouched, and the checks can produce false
+            # positives (e.g. against the booking's own checkout).
+            unless ( $self->_skip_clash_detection ) {
 
-            # Throw exception for biblio level booking clash
-            Koha::Exceptions::Booking::Clash->throw()
-                if !$self->biblio->check_booking(
-                {
-                    start_date => $self->start_date,
-                    end_date   => $self->end_date,
-                    booking_id => $self->in_storage ? $self->booking_id : undef
-                }
-                );
+                # Throw exception for item level booking clash
+                Koha::Exceptions::Booking::Clash->throw()
+                    if $self->item_id && !$self->item->check_booking(
+                    {
+                        start_date => $self->start_date,
+                        end_date   => $self->end_date,
+                        booking_id => $self->in_storage ? $self->booking_id : undef
+                    }
+                    );
+
+                # Throw exception for biblio level booking clash
+                Koha::Exceptions::Booking::Clash->throw()
+                    if !$self->biblio->check_booking(
+                    {
+                        start_date => $self->start_date,
+                        end_date   => $self->end_date,
+                        booking_id => $self->in_storage ? $self->booking_id : undef
+                    }
+                    );
+            }
 
             # FIXME: We should be able to combine the above two functions into one
 
@@ -190,7 +221,6 @@ sub store {
                 $self->_send_notice( { notice => 'BOOKING_CONFIRMATION' } );
             } else {
                 my %updated_columns = $self->_result->get_dirty_columns;
-                return $self->SUPER::store unless %updated_columns;
 
                 my $old_booking = $self->get_from_storage;
                 $self->SUPER::store;
@@ -261,17 +291,28 @@ sub _assign_item_for_booking {
     my $checkouts =
         $biblio->current_checkouts->search( { date_due => { '>=' => $dtf->format_datetime($start_date) } } );
 
-    my $bookable_items = $biblio->bookable_items->search(
-        {
-            itemnumber => [
-                '-and' => { '-not_in' => $existing_bookings->_resultset->get_column('item_id')->as_query },
-                { '-not_in' => $checkouts->_resultset->get_column('itemnumber')->as_query }
-            ]
-        },
-        { order_by => \'RAND()', rows => 1 }
-    );
+    # Build search conditions for bookable items
+    my $item_search_conditions = {
+        itemnumber => [
+            '-and' => { '-not_in' => $existing_bookings->_resultset->get_column('item_id')->as_query },
+            { '-not_in' => $checkouts->_resultset->get_column('itemnumber')->as_query }
+        ]
+    };
 
-    my $itemnumber = $bookable_items->single->itemnumber;
+    # Filter by itemtype if specified (for "any item" bookings)
+    if ( $self->{_itemtype_filter} ) {
+        $item_search_conditions->{itype} = $self->{_itemtype_filter};
+    }
+
+    my $bookable_items = $biblio->bookable_items->search($item_search_conditions);
+
+    # Use optimal selection instead of random selection
+    my $optimal_item = $self->_select_optimal_item($bookable_items);
+
+    Koha::Exceptions::Booking::Clash->throw("No available items found for booking")
+        unless $optimal_item;
+
+    my $itemnumber = $optimal_item->itemnumber;
     return $self->item_id($itemnumber);
 }
 
@@ -309,6 +350,125 @@ sub to_api_mapping {
 
 =head2 Internal methods
 
+=head3 _skip_clash_detection
+
+    my $bool = $self->_skip_clash_detection;
+
+Returns true when the booking is being transitioned to a status for which
+clash detection is not meaningful: the terminal statuses C<cancelled> and
+C<completed>, or C<issued> (collection). A booking being collected already
+occupies the period being validated, and the item's own checkout would
+register as a false clash. The transition to C<issued> only skips the
+checks while the booked period and item remain unchanged, and only from an
+active (C<new> or C<issued>) stored status; reactivating a terminal booking
+is still validated.
+
+=cut
+
+sub _skip_clash_detection {
+    my ($self) = @_;
+
+    return 0 unless $self->in_storage;
+
+    my $updated_columns = { $self->_result->get_dirty_columns };
+    my $new_status      = $updated_columns->{status};
+
+    return 0 unless $new_status;
+    return 1 if any { $_ eq $new_status } qw( cancelled completed );
+
+    if ( $new_status eq 'issued' ) {
+        return 0 if any { exists $updated_columns->{$_} } qw( start_date end_date item_id biblio_id );
+
+        my $stored_status = $self->get_from_storage->status;
+        return 1 if any { $_ eq $stored_status } qw( new issued );
+    }
+
+    return 0;
+}
+
+=head3 _select_optimal_item
+
+    my $item_id = $self->_select_optimal_item($available_items);
+
+Selects the optimal item from a set of available items by choosing the item
+with the longest future availability after the booking ends.
+
+This maximizes future booking opportunities by preserving items with shorter
+future availability for bookings that specifically need them.
+
+=cut
+
+sub _select_optimal_item {
+    my ( $self, $available_items ) = @_;
+
+    return unless $available_items && $available_items->count > 0;
+
+    # If only one item available, return it immediately
+    return $available_items->next if $available_items->count == 1;
+
+    my $check_date = dt_from_string( $self->end_date )->add( days => 1 );
+    my $dtf        = Koha::Database->new->schema->storage->datetime_parser;
+
+    # Get item IDs from the available items
+    my @item_ids = map { $_->itemnumber } $available_items->as_list;
+
+    # Find the item with the latest (furthest in future) next booking start date
+    # Items with no future bookings will have NULL and sort first (most desirable)
+    my $search_conditions = {
+        item_id    => { '-in'     => \@item_ids },
+        start_date => { '>='      => $dtf->format_datetime($check_date) },
+        status     => { '-not_in' => [ 'cancelled', 'completed' ] }
+    };
+
+    # Exclude current booking if we're editing
+    if ( $self->in_storage ) {
+        $search_conditions->{booking_id} = { '!=' => $self->booking_id };
+    }
+
+    # Query to find the earliest future booking for each item
+    my $rs = Koha::Bookings->search(
+        $search_conditions,
+        {
+            select   => [ 'item_id', { min => 'start_date', -as => 'next_booking_start' } ],
+            as       => [ 'item_id', 'next_booking_start' ],
+            group_by => ['item_id'],
+        }
+    );
+
+    # Get items that have future bookings, sorted by next booking date (desc = later is better)
+    my %next_booking_by_item;
+    while ( my $row = $rs->next ) {
+        $next_booking_by_item{ $row->get_column('item_id') } = $row->get_column('next_booking_start');
+    }
+
+    # Find the best item: items without future bookings first, then by latest next booking
+    my $best_item_id;
+    my $latest_next_booking;
+
+    foreach my $item_id (@item_ids) {
+        my $next_booking = $next_booking_by_item{$item_id};
+
+        # Items with no future bookings are best (infinite availability)
+        if ( !defined $next_booking ) {
+            $best_item_id = $item_id;
+            last;
+        }
+
+        # Otherwise, prefer items with later (further in future) next bookings
+        if ( !defined $latest_next_booking || $next_booking gt $latest_next_booking ) {
+            $latest_next_booking = $next_booking;
+            $best_item_id        = $item_id;
+        }
+    }
+
+    # Return the optimal item
+    return Koha::Items->find($best_item_id) if $best_item_id;
+
+    # Fallback: shouldn't reach here, but return first available item
+    $available_items->reset;
+    return $available_items->next;
+}
+
 =head3 _send_notice
 
     $self->_send_notice();

Koha/Bookings.pm

@@ -36,18 +36,14 @@ Koha::Bookings - Koha Booking object set class
 
     $bookings->filter_by_active;
 
-Will return the bookings that have not ended, were cancelled or are completed.
+Returns bookings that are still active, i.e. awaiting collection (C<new>) or
+currently on loan (C<issued>).  Cancelled and completed bookings are excluded.
 
 =cut
 
 sub filter_by_active {
     my ($self) = @_;
-    return $self->search(
-        {
-            end_date => { '>='      => \'NOW()' },
-            status   => { '-not_in' => [ 'cancelled', 'completed' ] }
-        }
-    );
+    return $self->search( { status => { '-in' => [ 'new', 'issued' ] } } );
 }
 
 =head2 Internal Methods

Koha/CSV.pm

@@ -0,0 +1,226 @@
+package Koha::CSV;
+
+# Copyright 2026 Theke Solutions
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <https://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Text::CSV_XS;
+use C4::Context;
+
+use base qw(Class::Accessor);
+
+__PACKAGE__->mk_accessors(qw( binary formula always_quote eol sep_char ));
+
+=head1 NAME
+
+Koha::CSV - Wrapper around Text::CSV_XS with Koha-specific defaults
+
+=head1 SYNOPSIS
+
+    my $csv = Koha::CSV->new();
+    $csv->combine(@fields);
+    my $line = $csv->string();
+
+    # Override defaults
+    my $csv = Koha::CSV->new( { sep_char => ';', always_quote => 1 } );
+
+=head1 DESCRIPTION
+
+This class wraps Text::CSV_XS providing consistent defaults and methods
+used across Koha for CSV generation and parsing.
+
+Configuration is inherited from Koha system preferences where applicable,
+but can be overridden per instance.
+
+=head2 Configuration Inheritance
+
+=over 4
+
+=item * B<sep_char> - Defaults to I<CSVDelimiter> system preference (or ',' if not set)
+
+=item * B<binary> - Always 1 (required for UTF-8 support)
+
+=item * B<formula> - Always 'empty' (security: prevents formula injection)
+
+=item * B<always_quote> - Defaults to 0, can be overridden
+
+=item * B<eol> - Defaults to "\n", can be overridden
+
+=back
+
+=cut
+
+=head2 new
+
+    my $csv = Koha::CSV->new();
+    my $csv = Koha::CSV->new({ sep_char => ';', always_quote => 1 });
+
+Creates a new Koha::CSV object. Accepts optional parameters to override defaults.
+
+Parameters:
+- sep_char: CSV delimiter (defaults to CSVDelimiter system preference)
+- always_quote: Whether to quote all fields (defaults to 0)
+- eol: End of line character (defaults to "\n")
+
+Note: binary and formula parameters are fixed for security and cannot be overridden.
+
+=cut
+
+sub new {
+    my ( $class, $params ) = @_;
+    $params //= {};
+
+    # Get delimiter from Koha configuration if not explicitly provided
+    my $sep_char = $params->{sep_char} // C4::Context->csv_delimiter();
+
+    my $self = $class->SUPER::new(
+        {
+            binary       => 1,                                  # Always 1 for UTF-8
+            formula      => 'empty',                            # Hard-coded to 'empty' for security
+            always_quote => $params->{always_quote} // 0,       # Overridable
+            eol          => $params->{eol}          // "\n",    # Overridable
+            sep_char     => $sep_char,                          # From Koha config or override
+        }
+    );
+
+    $self->{_csv} = Text::CSV_XS->new(
+        {
+            binary       => $self->binary,
+            formula      => $self->formula // 'empty',          # Hard-coded catch-all of 'empty' for security
+            always_quote => $self->always_quote,
+            eol          => $self->eol,
+            sep_char     => $self->sep_char,
+        }
+    );
+
+    return $self;
+}
+
+=head2 combine
+
+    $csv->combine(@fields);
+
+Combines fields into a CSV line. Returns true on success.
+
+=cut
+
+sub combine {
+    my ( $self, @fields ) = @_;
+    return $self->{_csv}->combine(@fields);
+}
+
+=head2 string
+
+    my $line = $csv->string();
+
+Returns the combined CSV line as a string.
+
+=cut
+
+sub string {
+    my ($self) = @_;
+    return $self->{_csv}->string();
+}
+
+=head2 add_row
+
+    my $line = $csv->add_row(@fields);
+    # or
+    my $line = $csv->add_row(\@fields);
+
+Convenience method that combines fields and returns the CSV line as a string.
+Accepts either an array or arrayref of fields.
+
+=cut
+
+sub add_row {
+    my ( $self, @fields ) = @_;
+
+    # Handle arrayref or array
+    @fields = @{ $fields[0] } if @fields == 1 && ref $fields[0] eq 'ARRAY';
+
+    $self->combine(@fields) or return;
+    return $self->string();
+}
+
+=head2 parse
+
+    $csv->parse($line);
+
+Parses a CSV line. Returns true on success.
+
+=cut
+
+sub parse {
+    my ( $self, $line ) = @_;
+    return $self->{_csv}->parse($line);
+}
+
+=head2 fields
+
+    my @fields = $csv->fields();
+
+Returns the parsed fields from the last parse() call.
+
+=cut
+
+sub fields {
+    my ($self) = @_;
+    return $self->{_csv}->fields();
+}
+
+=head2 print
+
+    $csv->print($fh, \@fields);
+
+Prints fields to a filehandle as a CSV line.
+
+=cut
+
+sub print {
+    my ( $self, $fh, $fields ) = @_;
+    return $self->{_csv}->print( $fh, $fields );
+}
+
+=head2 getline
+
+    my $fields = $csv->getline($fh);
+
+Reads and parses a line from a filehandle. Returns arrayref of fields.
+
+=cut
+
+sub getline {
+    my ( $self, $fh ) = @_;
+    return $self->{_csv}->getline($fh);
+}
+
+=head2 error_diag
+
+    my $error = $csv->error_diag();
+
+Returns error diagnostics from the last operation.
+
+=cut
+
+sub error_diag {
+    my ($self) = @_;
+    return $self->{_csv}->error_diag();
+}
+
+1;

Koha/Cache.pm

@@ -45,9 +45,8 @@ use Module::Load::Conditional qw( can_load );
 use Sereal::Encoder;
 use Sereal::Decoder;
 
-use C4::Context;
-use Koha::Cache::Object;
 use Koha::Config;
+use Koha::Cache::Object;
 
 use base qw(Class::Accessor);
 
@@ -76,8 +75,8 @@ sub new {
     # Should we continue to support MEMCACHED ENV vars?
     $self->{'namespace'} ||= $ENV{MEMCACHED_NAMESPACE};
     my @servers = split /,/, $ENV{MEMCACHED_SERVERS} || '';
-    $self->{namespace} ||= C4::Context->config('memcached_namespace') || 'koha';
-    @servers = split /,/, C4::Context->config('memcached_servers') // ''
+    $self->{namespace} ||= Koha::Config->get_instance->get('memcached_namespace') || 'koha';
+    @servers = split /,/, Koha::Config->get_instance->get('memcached_servers') // ''
         unless @servers;
     $self->{namespace} .= ":$subnamespace:";
 

Koha/Cash/Register.pm

@@ -16,12 +16,19 @@ package Koha::Cash::Register;
 # along with Koha; if not, see <https://www.gnu.org/licenses>.
 
 use Modern::Perl;
+use DateTime;
+use Scalar::Util qw( looks_like_number );
+use Try::Tiny    qw( catch try );
 
+use Koha::Account;
+use Koha::Account::Line;
 use Koha::Account::Lines;
+use Koha::Account::Offset;
 use Koha::Account::Offsets;
 use Koha::Cash::Register::Actions;
 use Koha::Cash::Register::Cashups;
 use Koha::Database;
+use Koha::DateUtils qw( dt_from_string );
 
 use base qw(Koha::Object);
 
@@ -112,19 +119,14 @@ Return a set of accountlines linked to this cash register since the last cashup
 sub outstanding_accountlines {
     my ( $self, $conditions, $attrs ) = @_;
 
-    my $since = $self->_result->search_related(
-        'cash_register_actions',
-        { 'code' => 'CASHUP' },
-        {
-            order_by => { '-desc' => [ 'timestamp', 'id' ] },
-            rows     => 1
-        }
-    );
+    # Find the start timestamp for the current "open" session
+    my $start_timestamp = $self->_get_session_start_timestamp;
 
     my $local_conditions =
-        $since->count
-        ? { 'date' => { '>' => $since->get_column('timestamp')->as_query } }
+        $start_timestamp
+        ? { 'date' => { '>' => $start_timestamp } }
         : {};
+
     my $merged_conditions =
         $conditions
         ? { %{$conditions}, %{$local_conditions} }
@@ -138,6 +140,40 @@ sub outstanding_accountlines {
     return Koha::Account::Lines->_new_from_dbic($rs);
 }
 
+=head3 cashup_in_progress
+
+Check if there is currently a cashup in progress (CASHUP_START without corresponding CASHUP).
+Returns the CASHUP_START action if in progress, undef otherwise.
+
+=cut
+
+sub cashup_in_progress {
+    my ($self) = @_;
+
+    my $last_start = $self->_result->search_related(
+        'cash_register_actions',
+        { 'code'   => 'CASHUP_START' },
+        { order_by => { '-desc' => [ 'timestamp', 'id' ] }, rows => 1 }
+    )->single;
+
+    return unless $last_start;
+
+    my $last_completion = $self->cashups(
+        {},
+        { order_by => { '-desc' => [ 'timestamp', 'id' ] }, rows => 1 }
+    )->single;
+
+    # If we have a start but no completion, or the start is more recent than completion
+    if ( !$last_completion
+        || DateTime->compare( dt_from_string( $last_start->timestamp ), dt_from_string( $last_completion->timestamp ) )
+        > 0 )
+    {
+        return Koha::Cash::Register::Action->_new_from_dbic($last_start);
+    }
+
+    return;
+}
+
 =head3 store
 
 Local store method to prevent direct manipulation of the 'branch_default' field
@@ -204,31 +240,380 @@ sub drop_default {
     return $self;
 }
 
+=head3 start_cashup
+
+    my $cashup_start = $cash_register->start_cashup(
+        {
+            manager_id => $logged_in_user->id,
+        }
+    );
+
+Start a new cashup period. This marks the beginning of the cash counting process
+and creates a snapshot point for calculating outstanding amounts. Returns the
+CASHUP_START action.
+
+=cut
+
+sub start_cashup {
+    my ( $self, $params ) = @_;
+
+    # check for mandatory params
+    my @mandatory = ('manager_id');
+    for my $param (@mandatory) {
+        unless ( defined( $params->{$param} ) ) {
+            Koha::Exceptions::MissingParameter->throw( error => "The $param parameter is mandatory" );
+        }
+    }
+    my $manager_id = $params->{manager_id};
+
+    # Check if there's already a cashup in progress
+    my $last_cashup_start_rs = $self->_result->search_related(
+        'cash_register_actions',
+        { 'code'   => 'CASHUP_START' },
+        { order_by => { '-desc' => [ 'timestamp', 'id' ] }, rows => 1 }
+    )->single;
+
+    my $last_cashup_completed = $self->cashups(
+        {},
+        { order_by => { '-desc' => [ 'timestamp', 'id' ] }, rows => 1 }
+    )->single;
+
+    # If we have a CASHUP_START that's more recent than the last CASHUP, there's already an active cashup
+    if (
+        $last_cashup_start_rs
+        && (
+            !$last_cashup_completed || DateTime->compare(
+                dt_from_string( $last_cashup_start_rs->timestamp ),
+                dt_from_string( $last_cashup_completed->timestamp )
+            ) > 0
+        )
+        )
+    {
+        Koha::Exceptions::Object::DuplicateID->throw( error => "A cashup is already in progress for this register" );
+    }
+
+    my $expected_amount = $self->outstanding_accountlines->total( { payment_type => [ 'CASH', 'SIP00' ] } ) * -1;
+
+    # Prevent starting a cashup when there are no transactions at all
+    my $total_transactions = $self->outstanding_accountlines->total() * -1;
+    unless ( $total_transactions != 0 ) {
+        Koha::Exceptions::Object::BadValue->throw(
+            error => "Cannot start cashup with no transactions",
+            type  => 'amount',
+            value => $total_transactions
+        );
+    }
+
+    # Create the CASHUP_START action, translating raw DBIC exceptions
+    my $schema = $self->_result->result_source->schema;
+    my $rs;
+    try {
+        $rs = $self->_result->add_to_cash_register_actions(
+            {
+                code       => 'CASHUP_START',
+                manager_id => $manager_id,
+                amount     => $expected_amount
+            }
+        )->discard_changes;
+    } catch {
+        $schema->translate_exception($_) if ref($_) eq 'DBIx::Class::Exception';
+        $_->rethrow();
+    };
+
+    return Koha::Cash::Register::Cashup->_new_from_dbic($rs);
+}
+
 =head3 add_cashup
 
     my $cashup = $cash_register->add_cashup(
         {
-            manager_id => $logged_in_user->id,
-            amount     => $cash_register->outstanding_accountlines->total
+            manager_id            => $logged_in_user->id,
+            amount                => $amount_removed_from_register,
+            [ reconciliation_note => $reconciliation_note ]
         }
     );
 
-Add a new cashup action to the till, returns the added action.
+Complete a cashup period started with start_cashup(). This performs the actual
+reconciliation against the amount counted and creates surplus/deficit accountlines
+if needed. Returns the completed CASHUP action.
 
 =cut
 
 sub add_cashup {
     my ( $self, $params ) = @_;
 
-    my $rs = $self->_result->add_to_cash_register_actions(
-        {
-            code       => 'CASHUP',
-            manager_id => $params->{manager_id},
-            amount     => $params->{amount}
+    # check for mandatory params
+    my @mandatory = ( 'manager_id', 'amount' );
+    for my $param (@mandatory) {
+        unless ( defined( $params->{$param} ) ) {
+            Koha::Exceptions::MissingParameter->throw( error => "The $param parameter is mandatory" );
         }
-    )->discard_changes;
+    }
+    my $manager_id = $params->{manager_id};
 
-    return Koha::Cash::Register::Cashup->_new_from_dbic($rs);
+    # Validate amount is a valid number
+    my $amount = $params->{amount};
+    unless ( looks_like_number($amount) ) {
+        Koha::Exceptions::Account::AmountNotPositive->throw( error => 'Cashup amount must be a valid number' );
+    }
+
+    # Sanitize reconciliation note - treat empty/whitespace-only as undef
+    my $reconciliation_note = $params->{reconciliation_note};
+    if ( defined $reconciliation_note ) {
+        $reconciliation_note = substr( $reconciliation_note, 0, 1000 );    # Limit length
+        $reconciliation_note =~ s/^\s+|\s+$//g;                            # Trim whitespace
+        $reconciliation_note = undef if $reconciliation_note eq '';        # Empty after trim = undef
+    }
+
+    # Find the most recent CASHUP_START to determine if we're in two-phase mode
+    my $cashup_start;
+    my $cashup_start_rs = $self->_result->search_related(
+        'cash_register_actions',
+        { 'code'   => 'CASHUP_START' },
+        { order_by => { '-desc' => [ 'timestamp', 'id' ] }, rows => 1 }
+    )->single;
+
+    if ($cashup_start_rs) {
+
+        # Two-phase mode: Check if this CASHUP_START has already been completed
+        my $existing_completion = $self->_result->search_related(
+            'cash_register_actions',
+            {
+                'code'      => 'CASHUP',
+                'timestamp' => { '>' => $cashup_start_rs->timestamp }
+            },
+            { rows => 1 }
+        )->single;
+
+        if ( !$existing_completion ) {
+            $cashup_start = Koha::Cash::Register::Cashup->_new_from_dbic($cashup_start_rs);
+        }
+
+    }
+
+    # Calculate expected amount from session accountlines
+    my $expected_amount = (
+          $cashup_start
+        ? $cashup_start->accountlines->total( { payment_type => [ 'CASH', 'SIP00' ] } )
+        : $self->outstanding_accountlines->total( { payment_type => [ 'CASH', 'SIP00' ] } )
+    ) * -1;
+
+    # Calculate difference (actual - expected)
+    my $difference = $amount - $expected_amount;
+
+    # Validate reconciliation note requirement if there's a discrepancy
+    if ( $difference != 0 ) {
+        my $note_required = C4::Context->preference('CashupReconciliationNoteRequired') // 0;
+
+        if ( $note_required && !defined $reconciliation_note ) {
+            Koha::Exceptions::MissingParameter->throw(
+                error => "Reconciliation note is required when cashup amount differs from expected amount" );
+        }
+
+        # If notes are restricted to an authorised value category, reject anything
+        # that isn't one of the allowed values (the UI only offers a matching
+        # select, but the API/form param isn't otherwise constrained server-side)
+        my $note_av_category = C4::Context->preference('CashupReconciliationNoteAuthorisedValue');
+        if ( $note_av_category && defined $reconciliation_note ) {
+            require Koha::AuthorisedValues;
+            my $valid = Koha::AuthorisedValues->search(
+                {
+                    category         => $note_av_category,
+                    authorised_value => $reconciliation_note,
+                }
+            )->count;
+            unless ($valid) {
+                Koha::Exceptions::BadParameter->throw(
+                    error     => "Reconciliation note is not a valid authorised value for this category",
+                    parameter => 'reconciliation_note',
+                );
+            }
+        }
+    }
+
+    # Use database transaction to ensure consistency
+    my $schema = $self->_result->result_source->schema;
+    my $cashup;
+
+    $schema->txn_do(
+        sub {
+            try {
+                # Create the cashup action (raw DBIC call; Koha::Object stores below are already translated)
+                my $rs = $self->_result->add_to_cash_register_actions(
+                    {
+                        code       => 'CASHUP',
+                        manager_id => $manager_id,
+                        amount     => $amount
+                    }
+                )->discard_changes;
+                $cashup = Koha::Cash::Register::Cashup->_new_from_dbic($rs);
+
+                # Create reconciliation accountline if there's a difference
+                if ( $difference != 0 ) {
+
+                    # Determine reconciliation date based on mode
+                    my $reconciliation_date;
+                    if ($cashup_start) {
+
+                        # Two-phase mode: Backdate reconciliation lines to just before the CASHUP_START timestamp
+                        # This ensures they belong to the previous session, not the current one
+                        $reconciliation_date = \[ 'DATE_SUB(?, INTERVAL 1 SECOND)', $cashup_start->timestamp ];
+                    } else {
+
+                        # Legacy mode: Use the original backdating approach
+                        $reconciliation_date = \'DATE_SUB(NOW(), INTERVAL 1 SECOND)';
+                    }
+
+                    if ( $difference > 0 ) {
+
+                        # Surplus: more cash found than expected (credits are negative amounts)
+                        my $surplus = Koha::Account::Line->new(
+                            {
+                                date              => $reconciliation_date,
+                                amount            => -abs($difference),      # Credits are negative
+                                amountoutstanding => 0,
+                                credit_type_code  => 'CASHUP_SURPLUS',
+                                manager_id        => $manager_id,
+                                interface         => 'intranet',
+                                branchcode        => $self->branch,
+                                register_id       => $self->id,
+                                payment_type      => 'CASH',
+                                note              => $reconciliation_note
+                            }
+                        )->store();
+
+                        # Record the account offset
+                        my $account_offset = Koha::Account::Offset->new(
+                            {
+                                credit_id => $surplus->id,
+                                type      => 'CREATE',
+                                amount    => -abs($difference)    # Offsets match the line amount
+                            }
+                        )->store();
+
+                    } else {
+
+                        # Deficit: less cash found than expected
+                        my $deficit = Koha::Account::Line->new(
+                            {
+                                date              => $reconciliation_date,
+                                amount            => abs($difference),
+                                amountoutstanding => 0,
+                                debit_type_code   => 'CASHUP_DEFICIT',
+                                manager_id        => $manager_id,
+                                interface         => 'intranet',
+                                branchcode        => $self->branch,
+                                register_id       => $self->id,
+                                payment_type      => 'CASH',
+                                note              => $reconciliation_note
+                            }
+                        )->store();
+                        my $account_offset = Koha::Account::Offset->new(
+                            {
+                                debit_id => $deficit->id,
+                                type     => 'CREATE',
+                                amount   => abs($difference)    # Debits have positive offsets
+                            }
+                        )->store();
+
+                    }
+                }
+            } catch {
+                $schema->translate_exception($_) if ref($_) eq 'DBIx::Class::Exception';
+                $_->rethrow();
+            };
+        }
+    );
+
+    return $cashup;
+}
+
+=head3 _get_session_start_timestamp
+
+Internal method to determine the start timestamp for the current "open" session.
+This handles the following cashup scenarios:
+
+=over 4
+
+=item 1. No cashups ever → undef (returns all accountlines)
+
+=item 2. Quick cashup completed → Uses CASHUP timestamp
+
+=item 3. Two-phase started → Uses CASHUP_START timestamp
+
+=item 4. Two-phase completed → Uses the CASHUP_START timestamp that led to the last CASHUP
+
+=item 5. Mixed workflows → Correctly distinguishes between quick and two-phase cashups
+
+=back
+
+=cut
+
+sub _get_session_start_timestamp {
+    my ($self) = @_;
+
+    # Check if there's a cashup in progress (CASHUP_START without corresponding CASHUP)
+    my $cashup_in_progress = $self->cashup_in_progress;
+
+    if ($cashup_in_progress) {
+
+        # Scenario 3: Two-phase cashup started - return accountlines since CASHUP_START
+        return $cashup_in_progress->timestamp;
+    }
+
+    # No cashup in progress - find the most recent cashup completion
+    my $last_cashup = $self->cashups(
+        {},
+        {
+            order_by => { '-desc' => [ 'timestamp', 'id' ] },
+            rows     => 1
+        }
+    )->single;
+
+    if ( !$last_cashup ) {
+
+        # Scenario 1: No cashups have ever taken place - return all accountlines
+        return;
+    }
+
+    # Find if this CASHUP was part of a two-phase workflow
+    my $corresponding_start = $self->_result->search_related(
+        'cash_register_actions',
+        {
+            'code'      => 'CASHUP_START',
+            'timestamp' => { '<' => $last_cashup->timestamp }
+        },
+        {
+            order_by => { '-desc' => [ 'timestamp', 'id' ] },
+            rows     => 1
+        }
+    )->single;
+
+    if ($corresponding_start) {
+
+        # Check if this CASHUP_START was completed by this CASHUP
+        # (no other CASHUP between them)
+        my $intervening_cashup = $self->_result->search_related(
+            'cash_register_actions',
+            {
+                'code'      => 'CASHUP',
+                'timestamp' => {
+                    '>' => $corresponding_start->timestamp,
+                    '<' => $last_cashup->timestamp
+                }
+            },
+            { rows => 1 }
+        )->single;
+
+        if ( !$intervening_cashup ) {
+
+            # Scenario 4: Two-phase cashup completed - return accountlines since the CASHUP_START
+            return $corresponding_start->timestamp;
+        }
+    }
+
+    # Scenarios 2 & 5: Quick cashup (or orphaned CASHUP) - return accountlines since CASHUP
+    return $last_cashup->timestamp;
 }
 
 =head3 to_api_mapping

Koha/Cash/Register/Cashup.pm

@@ -23,7 +23,7 @@ use base qw(Koha::Cash::Register::Action);
 
 =head1 NAME
 
-Koha::Cash::Register::Actions - Koha Cash Register Action Object set class
+Koha::Cash::Register::Cashup - Koha Cash Register Cashup Object class
 
 =head1 API
 
@@ -61,29 +61,43 @@ Return a hashref containing a summary of transactions that make up this cashup.
 sub summary {
     my ($self) = @_;
     my $summary;
-    my $prior_cashup = Koha::Cash::Register::Cashups->search(
-        {
-            'timestamp' => { '<' => $self->timestamp },
-            register_id => $self->register_id
-        },
-        {
-            order_by => { '-desc' => [ 'timestamp', 'id' ] },
-            rows     => 1
-        }
-    );
 
-    my $previous = $prior_cashup->single;
+    # Get the session boundaries for this cashup
+    my ( $session_start, $session_end ) = $self->_get_session_boundaries;
 
-    my $conditions =
-        $previous
-        ? { 'date' => { '-between' => [ $previous->_result->get_column('timestamp'), $self->timestamp ] } }
-        : { 'date' => { '<'        => $self->timestamp } };
+    my $conditions;
+    if ( $session_start && $session_end ) {
+
+        # Complete session: between start and end (exclusive)
+        $conditions = {
+            'date' => {
+                '>' => $session_start,
+                '<' => $session_end
+            }
+        };
+    } elsif ($session_end) {
+
+        # Session from beginning to end
+        $conditions = { 'date' => { '<' => $session_end } };
+    } else {
+
+        # Shouldn't happen for a completed cashup, but fallback
+        $conditions = { 'date' => { '<' => $self->timestamp } };
+    }
 
     my $payout_transactions = $self->register->accountlines->search(
-        { %{$conditions}, credit_type_code => undef },
+        {
+            %{$conditions},
+            credit_type_code => undef,
+            debit_type_code  => { '!=' => 'CASHUP_DEFICIT' }
+        },
     );
     my $income_transactions = $self->register->accountlines->search(
-        { %{$conditions}, debit_type_code => undef },
+        {
+            %{$conditions},
+            debit_type_code  => undef,
+            credit_type_code => { '!=' => 'CASHUP_SURPLUS' }
+        },
     );
 
     my $income_summary = Koha::Account::Offsets->search(
@@ -170,23 +184,168 @@ sub summary {
         my $typed_income = $income_transactions->total( { payment_type => $type->authorised_value } );
         my $typed_payout = $payout_transactions->total( { payment_type => $type->authorised_value } );
         my $typed_total  = ( $typed_income + $typed_payout );
-        push @total_grouped, { payment_type => $type->lib, total => $typed_total };
+
+        # Flip sign to match the convention used for `total` above:
+        # positive = net amount collected (i.e. removed from register at cashup),
+        # negative = net amount paid out (i.e. needed to be added to register).
+        push @total_grouped, { payment_type => $type->lib, total => $typed_total * -1 };
     }
 
+    # Check for reconciliation lines separately (for footer display only)
+    my $surplus_lines =
+        $self->register->accountlines->search( { %{$conditions}, credit_type_code => 'CASHUP_SURPLUS' } );
+    my $deficit_lines =
+        $self->register->accountlines->search( { %{$conditions}, debit_type_code => 'CASHUP_DEFICIT' } );
+
+    my $surplus_total = $surplus_lines->count ? $surplus_lines->total : undef;
+    my $deficit_total = $deficit_lines->count ? $deficit_lines->total : undef;
+
+    # Extract notes from reconciliation lines
+    my ($surplus_record) = $surplus_lines->_resultset->search( {}, { rows => 1 } )->all;
+    my $surplus_note = $surplus_record ? $surplus_record->note : undef;
+
+    my ($deficit_record) = $deficit_lines->_resultset->search( {}, { rows => 1 } )->all;
+    my $deficit_note = $deficit_record ? $deficit_record->note : undef;
+
     $summary = {
-        from_date      => $previous ? $previous->timestamp : undef,
-        to_date        => $self->timestamp,
+        from_date      => $session_start,
+        to_date        => $session_end,
         income_grouped => \@income,
         income_total   => abs($income_total),
         payout_grouped => \@payout,
         payout_total   => abs($payout_total),
         total          => $total * -1,
-        total_grouped  => \@total_grouped
+        total_grouped  => \@total_grouped,
+
+        # Reconciliation data for footer display
+        surplus_total => $surplus_total ? $surplus_total * 1 : undef,
+        deficit_total => $deficit_total ? $deficit_total * 1 : undef,
+        surplus_note  => $surplus_note,
+        deficit_note  => $deficit_note
     };
 
     return $summary;
 }
 
+=head3 accountlines
+
+Fetch the accountlines associated with this cashup
+
+=cut
+
+sub accountlines {
+    my ($self) = @_;
+
+    # Get the session boundaries for this cashup
+    my ( $session_start, $session_end ) = $self->_get_session_boundaries;
+
+    my $conditions;
+    if ( $session_start && $session_end ) {
+
+        # Complete session: between start and end (exclusive)
+        $conditions = {
+            'date' => {
+                '>' => $session_start,
+                '<' => $session_end
+            }
+        };
+    } elsif ($session_end) {
+
+        # Session from beginning to end
+        $conditions = { 'date' => { '<' => $session_end } };
+    } else {
+
+        # Shouldn't happen for a completed cashup, but fallback
+        $conditions = { 'date' => { '<' => $self->timestamp } };
+    }
+
+    return $self->register->accountlines->search($conditions);
+}
+
+=head3 _get_session_boundaries
+
+Internal method to determine the session boundaries for this cashup.
+Returns ($session_start, $session_end) timestamps.
+
+=cut
+
+sub _get_session_boundaries {
+    my ($self) = @_;
+
+    my $session_end = $self->_get_session_end;
+
+    # Find the previous CASHUP
+    my $session_start;
+    my $previous_cashup = $self->register->cashups(
+        { 'timestamp' => { '<' => $session_end } },
+        {
+            order_by => { '-desc' => [ 'timestamp', 'id' ] },
+            rows     => 1
+        }
+    )->single;
+
+    $session_start = $previous_cashup ? $previous_cashup->_get_session_end : undef;
+
+    return ( $session_start, $session_end );
+}
+
+=head3 _get_session_end
+
+Internal method to determine the effective end timestamp of the session
+this cashup closes.
+
+For a one-phase cashup, the session ends at C<< $self->timestamp >>.
+For a two-phase workflow (a preceding C<CASHUP_START> with no intervening
+C<CASHUP>), the session ends at the C<CASHUP_START> timestamp so that
+transactions made between C<CASHUP_START> and C<CASHUP> are excluded
+from this cashup's summary.
+
+Returns the session end timestamp.
+
+=cut
+
+sub _get_session_end {
+    my ($self) = @_;
+
+    my $session_end = $self->timestamp;
+
+    # Find if this CASHUP was part of a two-phase workflow
+    my $nearest_start = $self->register->_result->search_related(
+        'cash_register_actions',
+        {
+            'code'      => 'CASHUP_START',
+            'timestamp' => { '<' => $session_end }
+        },
+        {
+            order_by => { '-desc' => [ 'timestamp', 'id' ] },
+            rows     => 1
+        }
+    )->single;
+
+    if ($nearest_start) {
+
+        # Check if this CASHUP_START was completed by this CASHUP
+        # (no other CASHUP between them)
+        my $intervening_cashup = $self->register->cashups(
+            {
+                'timestamp' => {
+                    '>' => $nearest_start->timestamp,
+                    '<' => $session_end
+                }
+            },
+            { rows => 1 }
+        )->single;
+
+        if ( !$intervening_cashup ) {
+
+            # Two-phase workflow: session runs to CASHUP_START
+            $session_end = $nearest_start->timestamp;
+        }
+    }
+
+    return $session_end;
+}
+
 =head3 to_api_mapping
 
 This method returns the mapping for representing a Koha::Cash::Register::Cashup object