Bug 28692: (follow-up) Add tests

Test plan:
Run t/db_dependent/Log.t

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>

C4/Log.pm

@@ -24,7 +24,9 @@ package C4::Log;
 use strict;
 use warnings;
 
+use Data::Dumper qw( Dumper );
 use JSON qw( to_json );
+use Scalar::Util qw( blessed );
 
 use C4::Context;
 use Koha::Logger;
@@ -76,6 +78,17 @@ sub logaction {
     $usernumber ||= 0;
     $interface //= C4::Context->interface;
 
+    if( blessed($infos) && $infos->isa('Koha::Object') ) {
+        $infos = $infos->get_from_storage if $infos->in_storage;
+        local $Data::Dumper::Sortkeys = 1;
+
+        if ( $infos->isa('Koha::Item') && $modulename eq 'CATALOGUING' && $actionname eq 'MODIFY' ) {
+            $infos = "item " . Dumper( $infos->unblessed );
+        } else {
+            $infos = Dumper( $infos->unblessed );
+        }
+    }
+
     my $dbh = C4::Context->dbh;
     my $sth=$dbh->prepare("Insert into action_logs (timestamp,user,module,action,object,info,interface) values (now(),?,?,?,?,?,?)");
     $sth->execute($usernumber,$modulename,$actionname,$objectnumber,$infos,$interface);

C4/Reserves.pm

@@ -46,7 +46,6 @@ use Koha::Old::Hold;
 use Koha::Patrons;
 use Koha::Plugins;
 
-use Data::Dumper qw( Dumper );
 use List::MoreUtils qw( any );
 
 =head1 NAME
@@ -261,7 +260,7 @@ sub AddReserve {
     )->store();
     $hold->set_waiting() if $found && $found eq 'W';
 
-    logaction( 'HOLDS', 'CREATE', $hold->id, Dumper($hold->unblessed) )
+    logaction( 'HOLDS', 'CREATE', $hold->id, $hold )
         if C4::Context->preference('HoldsLog');
 
     my $reserve_id = $hold->id();
@@ -1053,14 +1052,14 @@ sub ModReserve {
         $hold->cancel({ cancellation_reason => $cancellation_reason });
     }
     elsif ($hold->found && $hold->priority eq '0' && $date) {
-        logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, Dumper($hold->unblessed) )
+        logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, $hold )
             if C4::Context->preference('HoldsLog');
 
         # The only column that can be updated for a found hold is the expiration date
         $hold->expirationdate(dt_from_string($date))->store();
     }
     elsif ($rank =~ /^\d+/ and $rank > 0) {
-        logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, Dumper($hold->unblessed) )
+        logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, $hold )
             if C4::Context->preference('HoldsLog');
 
         my $properties = {
@@ -1122,7 +1121,7 @@ sub ModReserveFill {
         }
     );
 
-    logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, Dumper($hold->unblessed) )
+    logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, $hold )
         if C4::Context->preference('HoldsLog');
 
     # FIXME Must call Koha::Hold->cancel ? => No, should call ->filled and add the correct log
@@ -1250,7 +1249,7 @@ sub ModReserveAffect {
     });
     $std->execute($hold->reserve_id);
 
-    logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, Dumper($hold->get_from_storage->unblessed) )
+    logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, $hold )
         if C4::Context->preference('HoldsLog');
 
     return;

Koha/Hold.pm

@@ -20,7 +20,6 @@ package Koha::Hold;
 
 use Modern::Perl;
 
-use Data::Dumper qw( Dumper );
 use List::MoreUtils qw( any );
 
 use C4::Context;
@@ -113,7 +112,7 @@ sub suspend_hold {
     $self->suspend_until($date);
     $self->store();
 
-    logaction( 'HOLDS', 'SUSPEND', $self->reserve_id, Dumper( $self->unblessed ) )
+    logaction( 'HOLDS', 'SUSPEND', $self->reserve_id, $self )
         if C4::Context->preference('HoldsLog');
 
     return $self;
@@ -133,7 +132,7 @@ sub resume {
 
     $self->store();
 
-    logaction( 'HOLDS', 'RESUME', $self->reserve_id, Dumper($self->unblessed) )
+    logaction( 'HOLDS', 'RESUME', $self->reserve_id, $self )
         if C4::Context->preference('HoldsLog');
 
     return $self;
@@ -150,7 +149,7 @@ sub delete {
 
     my $deleted = $self->SUPER::delete($self);
 
-    logaction( 'HOLDS', 'DELETE', $self->reserve_id, Dumper($self->unblessed) )
+    logaction( 'HOLDS', 'DELETE', $self->reserve_id, $self )
         if C4::Context->preference('HoldsLog');
 
     return $deleted;
@@ -568,7 +567,7 @@ sub cancel {
                 );
             }
 
-            C4::Log::logaction( 'HOLDS', 'CANCEL', $self->reserve_id, Dumper($self->unblessed) )
+            C4::Log::logaction( 'HOLDS', 'CANCEL', $self->reserve_id, $self )
                 if C4::Context->preference('HoldsLog');
         }
     );

Koha/Item.pm

@@ -20,7 +20,6 @@ package Koha::Item;
 use Modern::Perl;
 
 use List::MoreUtils qw( any );
-use Data::Dumper qw( Dumper );
 
 use Koha::Database;
 use Koha::DateUtils qw( dt_from_string output_pref );
@@ -205,7 +204,7 @@ sub store {
     if ( $log_action && C4::Context->preference("CataloguingLog") ) {
         $action eq 'create'
           ? logaction( "CATALOGUING", "ADD", $self->itemnumber, "item" )
-          : logaction( "CATALOGUING", "MODIFY", $self->itemnumber, "item " . Dumper( $self->unblessed ) );
+          : logaction( "CATALOGUING", "MODIFY", $self->itemnumber, $self );
     }
     my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
     $indexer->index_records( $self->biblionumber, "specialUpdate", "biblioserver" )

koha-tmpl/intranet-tmpl/prog/css/holds.css

@@ -0,0 +1 @@
+.hold_title{border:1px solid #b9d8d9;border-bottom-color:#87bcbe;border-top-color:#daeaeb;border-radius:5px;margin:.5em 0;padding-bottom:1em;padding:1em}.holds_table{margin-bottom:1em;width:100%}.holds_by_itemtype,.holds_by_library{margin-bottom:1em;margin-left:1em}.holds_by_itemtype:last-child .holds_table,.holds_by_library:last-child .holds_table{margin-bottom:0}.holds_by_library .itemtype_holds{color:#5d6a8a}.holds_by_library:last-child{margin-bottom:0}

t/db_dependent/Log.t

@@ -15,7 +15,8 @@
 # with Koha; if not, see <http://www.gnu.org/licenses>.
 
 use Modern::Perl;
-use Test::More tests => 3;
+use Data::Dumper qw( Dumper );
+use Test::More tests => 4;
 
 use C4::Context;
 use C4::Log qw( logaction cronlogaction );
@@ -150,4 +151,35 @@ subtest 'GDPR logging' => sub {
     is( $logs->count, 1, 'We expect only one auth success line for this patron' );
 };
 
+subtest 'Reduce log size by unblessing Koha objects' => sub {
+    plan tests => 7;
+
+    my $builder = t::lib::TestBuilder->new;
+    my $item = $builder->build_sample_item;
+
+    logaction( 'MY_MODULE', 'TEST01', $item->itemnumber, $item, 'opac' );
+    my $str = Dumper($item->unblessed);
+    my $logs = Koha::ActionLogs->search({ module => 'MY_MODULE', action => 'TEST01', object => $item->itemnumber });
+    is( $logs->count, 1, 'Action found' );
+    is( length($logs->next->info), length($str), 'Length exactly identical' );
+
+    logaction( 'CATALOGUING', 'MODIFY', $item->itemnumber, $item, 'opac' );
+    $logs = Koha::ActionLogs->search({ module => 'CATALOGUING', action => 'MODIFY', object => $item->itemnumber });
+    is( substr($logs->next->info, 0, 5), 'item ', 'Prefix item' );
+    is( length($logs->reset->next->info), 5+length($str), 'Length + 5' );
+
+    my $hold = $builder->build_object({ class => 'Koha::Holds' });
+    logaction( 'MY_CIRC_MODULE', 'TEST', $item->itemnumber, $hold, 'opac' );
+    $logs = Koha::ActionLogs->search({ module => 'MY_CIRC_MODULE', action => 'TEST', object => $item->itemnumber });
+    is( length($logs->next->info), length( Dumper($hold->unblessed)), 'Length of dumped unblessed hold' );
+
+    logaction( 'MY_MODULE', 'TEST02', $item->itemnumber, [], 'opac' );
+    $logs = Koha::ActionLogs->search({ module => 'MY_MODULE', action => 'TEST02', object => $item->itemnumber });
+    like( $logs->next->info, qr/^ARRAY\(/, 'Dumped arrayref' );
+
+    logaction( 'MY_MODULE', 'TEST03', $item->itemnumber, $builder, 'opac' );
+    $logs = Koha::ActionLogs->search({ module => 'MY_MODULE', action => 'TEST03', object => $item->itemnumber });
+    like( $logs->next->info, qr/^t::lib::TestBuilder/, 'Dumped TestBuilder object' );
+};
+
 $schema->storage->txn_rollback;