Attachment #58105 for bug #17557

View | Details | Raw Unified | Return to bug 17557
Collapse All | Expand All




        &GetFirstValidEmailAddress
        &GetNoticeEmailAddress

        &GetAge

        &GetMemberAccountRecords
        &GetBorNotifyAcctRecord


    return $results;
}

=head2 GetAge

  $dateofbirth,$date = &GetAge($date);

this function return the borrowers age with the value of dateofbirth

=cut

#'
sub GetAge{
    my ( $date, $date_ref ) = @_;

    if ( not defined $date_ref ) {
        $date_ref = sprintf( '%04d-%02d-%02d', Today() );
    }

    my ( $year1, $month1, $day1 ) = split /-/, $date;
    my ( $year2, $month2, $day2 ) = split /-/, $date_ref;

    my $age = $year2 - $year1;
    if ( $month1 . $day1 > $month2 . $day2 ) {
        $age--;
    }

    return $age;
}    # sub get_age

=head2 SetAge

  $borrower = C4::Members::SetAge($borrower, $datetimeduration);
  $borrower = C4::Members::SetAge($borrower, '0015-12-10');
  $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);

  eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
  if ($@) {print $@;} #Catch a bad ISO Date or kill your script!

This function sets the borrower's dateofbirth to match the given age.
Optionally relative to the given $datetime_reference.

@PARAM1 koha.borrowers-object
@PARAM2 DateTime::Duration-object as the desired age
        OR a ISO 8601 Date. (To make the API more pleasant)
@PARAM3 DateTime-object as the relative date, defaults to now().
RETURNS The given borrower reference @PARAM1.
DIES    If there was an error with the ISO Date handling.

=cut

#'
sub SetAge{
    my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
    $datetime_ref = DateTime->now() unless $datetime_ref;

    if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
        if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
            $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
        }
        else {
            die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
        }
    }

    my $new_datetime_ref = $datetime_ref->clone();
    $new_datetime_ref->subtract_duration( $datetimeduration );

    $borrower->{dateofbirth} = $new_datetime_ref->ymd();

    return $borrower;
}    # sub SetAge

=head2 GetBorrowersToExpunge

  $borrowers = &GetBorrowersToExpunge(




    return $issues;
}

=head3 get_age

my $age = $patron->get_age

Return the age of the patron

=cut

sub get_age {
    my ($self)    = @_;
    my $today_str = dt_from_string->strftime("%Y-%m-%d");
    my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");

    my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
    my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;

    my $age = $today_y - $dob_y;
    if ( $dob_m . $dob_d > $today_m . $today_d ) {
        $age--;
    }

    return $age;
}

=head3 type

=cut

Lines 316-322 if ($op eq 'save' \|\| $op eq 'insert'){ Link Here

(-)a/members/memberentry.pl (-1 / +2 lines)
316	}	316	}
317		317
318	if ( $dateofbirth ) {	318	if ( $dateofbirth ) {
319	my $age = GetAge($dateofbirth);	319	my $patron = Koha::Patron->new({ dateofbirth => $dateofbirth });
		320	my $age = $patron->get_age;
320	my $borrowercategory = Koha::Patron::Categories->find($categorycode);	321	my $borrowercategory = Koha::Patron::Categories->find($categorycode);
321	my ($low,$high) = ($borrowercategory->dateofbirthrequired, $borrowercategory->upperagelimit);	322	my ($low,$high) = ($borrowercategory->dateofbirthrequired, $borrowercategory->upperagelimit);
322	if (($high && ($age > $high)) or ($age < $low)) {	323	if (($high && ($age > $high)) or ($age < $low)) {

Lines 237-245 my $overdues_exist = 0; Link Here

(-)a/members/moremember.pl (-3 / +1 lines)
237	my $totalprice = 0;	237	my $totalprice = 0;
238		238
239	# Calculate and display patron's age	239	# Calculate and display patron's age
240	my $dateofbirth = $data->{ 'dateofbirth' };	240	$template->param( age => Koha::Patron->new({ dateofbirth => $data->{dateofbirth} })->get_age );
241	my $age = GetAge($dateofbirth);
242	$template->param( age => $age );
243		241
244	### ###############################################################################	242	### ###############################################################################
245	# BUILD HTML	243	# BUILD HTML




    plan tests => 5;
    ##Testing age restriction for a borrower.
    my $now = DateTime->now();
    my $borrower = { dateofbirth => $now->add( years => -15 )->strftime("%Y-%m-%d") };
    C4::Members::SetAge( $borrower, '0015-00-00' );
    TestPatron($borrower,0);
};



            ##Testing age restriction for a borrower.
            my $now = DateTime->now();
            my $borrower = { dateofbirth => $now->add( years => -15 )->strftime("%Y-%m-%d") };
            C4::Members::SetAge( $borrower, '0015-00-00' );
            TestPatron($borrower,$offset);

            $offset++;




is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving an ageRestricted Biblio without a borrower dateofbirth succeeds" );

#Set the dateofbirth for the Borrower making him "too young".
$borrower->{dateofbirth} = DateTime->now->add( years => -15 );
C4::Members::SetAge( $borrower, '0015-00-00' );
C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );

is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'ageRestricted', "Reserving a 'PEGI 16' Biblio by a 15 year old borrower fails");

#Set the dateofbirth for the Borrower making him "too old".
$borrower->{dateofbirth} = DateTime->now->add( years => -30 );
C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );

is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving a 'PEGI 16' Biblio by a 30 year old borrower succeeds");
- 

Return to bug 17557

Lines 70-77 BEGIN { Link Here

(-)a/C4/Members.pm (-72 lines)
70	&GetFirstValidEmailAddress	70	&GetFirstValidEmailAddress
71	&GetNoticeEmailAddress	71	&GetNoticeEmailAddress
72		72
73	&GetAge
74
75	&GetMemberAccountRecords	73	&GetMemberAccountRecords
76	&GetBorNotifyAcctRecord	74	&GetBorNotifyAcctRecord
77		75
Lines 1211-1286 sub GetUpcomingMembershipExpires { Link Here
1211	return $results;	1209	return $results;
1212	}	1210	}
1213		1211
1214	=head2 GetAge
1215
1216	$dateofbirth,$date = &GetAge($date);
1217
1218	this function return the borrowers age with the value of dateofbirth
1219
1220	=cut
1221
1222	#'
1223	sub GetAge{
1224	my ( $date, $date_ref ) = @_;
1225
1226	if ( not defined $date_ref ) {
1227	$date_ref = sprintf( '%04d-%02d-%02d', Today() );
1228	}
1229
1230	my ( $year1, $month1, $day1 ) = split /-/, $date;
1231	my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1232
1233	my $age = $year2 - $year1;
1234	if ( $month1 . $day1 > $month2 . $day2 ) {
1235	$age--;
1236	}
1237
1238	return $age;
1239	} # sub get_age
1240
1241	=head2 SetAge
1242
1243	$borrower = C4::Members::SetAge($borrower, $datetimeduration);
1244	$borrower = C4::Members::SetAge($borrower, '0015-12-10');
1245	$borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1246
1247	eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1248	if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1249
1250	This function sets the borrower's dateofbirth to match the given age.
1251	Optionally relative to the given $datetime_reference.
1252
1253	@PARAM1 koha.borrowers-object
1254	@PARAM2 DateTime::Duration-object as the desired age
1255	OR a ISO 8601 Date. (To make the API more pleasant)
1256	@PARAM3 DateTime-object as the relative date, defaults to now().
1257	RETURNS The given borrower reference @PARAM1.
1258	DIES If there was an error with the ISO Date handling.
1259
1260	=cut
1261
1262	#'
1263	sub SetAge{
1264	my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1265	$datetime_ref = DateTime->now() unless $datetime_ref;
1266
1267	if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1268	if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1269	$datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1270	}
1271	else {
1272	die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1273	}
1274	}
1275
1276	my $new_datetime_ref = $datetime_ref->clone();
1277	$new_datetime_ref->subtract_duration( $datetimeduration );
1278
1279	$borrower->{dateofbirth} = $new_datetime_ref->ymd();
1280
1281	return $borrower;
1282	} # sub SetAge
1283
1284	=head2 GetBorrowersToExpunge	1212	=head2 GetBorrowersToExpunge
1285		1213
1286	$borrowers = &GetBorrowersToExpunge(	1214	$borrowers = &GetBorrowersToExpunge(

Lines 519-524 sub get_overdues { Link Here

(-)a/Koha/Patron.pm (+24 lines)
519	return $issues;	519	return $issues;
520	}	520	}
521		521
		522	=head3 get_age
		523
		524	my $age = $patron->get_age
		525
		526	Return the age of the patron
		527
		528	=cut
		529
		530	sub get_age {
		531	my ($self) = @_;
		532	my $today_str = dt_from_string->strftime("%Y-%m-%d");
		533	my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
		534
		535	my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
		536	my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
		537
		538	my $age = $today_y - $dob_y;
		539	if ( $dob_m . $dob_d > $today_m . $today_d ) {
		540	$age--;
		541	}
		542
		543	return $age;
		544	}
		545
522	=head3 type	546	=head3 type
523		547
524	=cut	548	=cut

Lines 526-539 C4::Biblio::ModBiblio( $record, $bibnum, '' ); Link Here

(-)a/t/db_dependent/Reserves.t (-4 / +2 lines)
526	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving an ageRestricted Biblio without a borrower dateofbirth succeeds" );	526	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving an ageRestricted Biblio without a borrower dateofbirth succeeds" );
527		527
528	#Set the dateofbirth for the Borrower making him "too young".	528	#Set the dateofbirth for the Borrower making him "too young".
529	my $now = DateTime->now();	529	$borrower->{dateofbirth} = DateTime->now->add( years => -15 );
530	C4::Members::SetAge( $borrower, '0015-00-00' );
531	C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );	530	C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );
532		531
533	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'ageRestricted', "Reserving a 'PEGI 16' Biblio by a 15 year old borrower fails");	532	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'ageRestricted', "Reserving a 'PEGI 16' Biblio by a 15 year old borrower fails");
534		533
535	#Set the dateofbirth for the Borrower making him "too old".	534	#Set the dateofbirth for the Borrower making him "too old".
536	C4::Members::SetAge( $borrower, '0030-00-00' );	535	$borrower->{dateofbirth} = DateTime->now->add( years => -30 );
537	C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );	536	C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );
538		537
539	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving a 'PEGI 16' Biblio by a 30 year old borrower succeeds");	538	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving a 'PEGI 16' Biblio by a 30 year old borrower succeeds");
540	-

Lines 39-46 subtest 'Patron tests - 15 years old' => sub { Link Here

(-)a/t/Circulation/AgeRestrictionMarkers.t (-4 / +2 lines)
39	plan tests => 5;	39	plan tests => 5;
40	##Testing age restriction for a borrower.	40	##Testing age restriction for a borrower.
41	my $now = DateTime->now();	41	my $now = DateTime->now();
42	my $borrower = {};	42	my $borrower = { dateofbirth => $now->add( years => -15 )->strftime("%Y-%m-%d") };
43	C4::Members::SetAge( $borrower, '0015-00-00' );
44	TestPatron($borrower,0);	43	TestPatron($borrower,0);
45	};	44	};
46		45
Lines 57-64 subtest 'Patron tests - 15 years old (Time Zone shifts)' => sub { Link Here
57		56
58	##Testing age restriction for a borrower.	57	##Testing age restriction for a borrower.
59	my $now = DateTime->now();	58	my $now = DateTime->now();
60	my $borrower = {};	59	my $borrower = { dateofbirth => $now->add( years => -15 )->strftime("%Y-%m-%d") };
61	C4::Members::SetAge( $borrower, '0015-00-00' );
62	TestPatron($borrower,$offset);	60	TestPatron($borrower,$offset);
63		61
64	$offset++;	62	$offset++;