Bug 26311: Add patron invalid age to search_for_data_inconsistencies.pl
authorFridolin Somers <fridolin.somers@biblibre.com>
Thu, 27 Aug 2020 15:21:14 +0000 (17:21 +0200)
committerTomas Cohen Arazi <tomascohen@theke.io>
Tue, 5 Jul 2022 12:20:50 +0000 (09:20 -0300)
Patron categories may have age limits.
Add to script misc/maintenance/search_for_data_inconsistencies.pl the list of patrons which age is invalid regarding there category.

Test plan :
1) Create an adult patron category limited to 18-99 years
2) Create a patron in the category
3) Edit in database its date of birth so that he is 17 years old
4) Run misc/maintenance/search_for_data_inconsistencies.pl
=> You see the patron

Signed-off-by: Owen Leonard <oleonard@myacpl.org>
Signed-off-by: Katrin Fischer <katrin.fischer.83@web.de>
Signed-off-by: David Nind <david@davidnind.com>
Signed-off-by: Katrin Fischer <katrin.fischer.83@web.de>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
misc/maintenance/search_for_data_inconsistencies.pl

index 96b15f3..e64758d 100755 (executable)
@@ -25,6 +25,7 @@ use Koha::BiblioFrameworks;
 use Koha::Biblioitems;
 use Koha::Items;
 use Koha::ItemTypes;
+use Koha::Patrons;
 use C4::Biblio qw( GetMarcFromKohaField );
 
 {
@@ -276,6 +277,22 @@ use C4::Biblio qw( GetMarcFromKohaField );
     }
 }
 
+{
+    my $patrons = Koha::Patrons->search( {}, { order_by => [ 'categorycode', 'borrowernumber' ] } );
+    my @invalid_patrons;
+    while ( my $patron = $patrons->next ) {
+        push @invalid_patrons, $patron unless $patron->is_valid_age;
+    }
+    if (@invalid_patrons) {
+        new_section("Patrons with invalid age for category");
+        foreach my $patron (@invalid_patrons) {
+            new_item( sprintf "Patron borrowernumber=%s in category '%s' has invalid age '%s'",
+                $patron->borrowernumber, $patron->category->categorycode, $patron->get_age );
+        }
+        new_hint("You may change patron's category automatically with misc/cronjobs/update_patrons_category.pl");
+    }
+}
+
 sub new_section {
     my ( $name ) = @_;
     say "\n== $name ==";